00001 ! BADONE - BIG ISAM PLUS FILE BUG PROBLEM 00004 FILEBASE 1: SIGNIFICANCE 11: XCALL NOECHO 00005 00006 MAP1 SYSTEM'STRINGS 00009 MAP2 PROGRAM'NAME,S,6,"BADONE" 00010 MAP2 PROGRAM'VERSION,S,10,"94.3(21)" PROGRAM BADONE, 94.3(21) 00011 MAP2 DT,S,45 00012 MAP2 ERROR'ANS,S,6 00013 MAP1 SYSTEM'FLOATS 00014 MAP2 ERROR'INXCTL,F 00015 MAP2 CNGCTL,F 00016 MAP2 WHATNO,F 00379 MAP1 STRINGS'SBR 00380 MAP2 JOBNAME,S,30 00381 MAP2 ENTRY,S,2000 !Used for inmemo menu 00382 MAP2 XS,S,8 00383 MAP2 C'RETURN,S,1,CHR(13) 00385 MAP2 TITLE,S,95,"" 00399 MAP2 F'DIRECTION,S,1,"F" 00400 MAP2 ISAM'SEARCH'KEY,S,100 00401 MAP2 ISAM'TEST'KEY,S,100 00402 MAP2 ISAM'TILDES,S,50,"~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~" 00403 MAP2 FILENAME,S,25 00404 MAP1 FLOATS'SBR 00418 !isam 00419 MAP2 E,F !Error # of ERF(chno) 00420 MAP2 E'CHNO,F !Channel # of error 00423 MAP2 BATCH'MODE,F,6,0 !0=Normal 1=Batch mode-only 'ADD needed 00424 MAP2 BATCH'MODE'SAVE,F 00425 MAP2 ISAM'KEY'NO,F 00737 MAP1 PTHTOT !recsiz 4972 Pay Codes 00738 MAP2 PTHT'EMPNO,S,4 00739 !key## T KeyDescription...... D C Siz-Pos Siz-Pos Siz-Pos Siz-Pos Siz-Pos 00740 !@! 01 1 Primary ID 0 1 004-001 000-000 000-000 000-000 000-000 00741 MAP2 PTHT'EMP'NAME,S,25 00742 !key## T KeyDescription...... D C Siz-Pos Siz-Pos Siz-Pos Siz-Pos Siz-Pos 00743 !@! 02 3 EMP NAME 0 1 025-005 004-001 000-000 000-000 000-000 00744 MAP2 PTHT'TOT 00745 MAP3 PTHT'TOTS(201,2),F 00746 MAP2 PTHT'YTD 00747 MAP3 PTHT'YTDS(201,2),F 00748 MAP2 PTHTOT'UPDATE,B,2 00749 ! 00751 MAP1 PTHTOT'ORIGINAL,X,4972 00752 MAP1 PTHTOT'TEMP,X,4972 00753 MAP1 PTHTOT'KEY'CNT,F,6 00754 MAP1 PTHTOT'KEY'NO,F 00755 MAP1 PTHTOT'RECNO,F 00756 MAP1 PTHTOT'RECSIZ,F,6,4972 00757 MAP1 PTHTOT'KEY,S,50 00758 MAP1 PTHTOT'BIN(4972),B,1,@PTHTOT 00759 MAP1 PTHTOT'ORIGINAL'BIN(4972),B,1,@PTHTOT'ORIGINAL 00760 MAP1 PTHTOT'TEMP'BIN(4972),B,1,@PTHTOT'TEMP 00761 00762 MAP1 PTHTOT'CHNO,F,6,100 00763 MAP1 PTHTOT'KEY'ST(2),F 00764 MAP1 PTHTOT'KEY'END(2),F 00765 PTHTOT'KEY'CNT=2 00767 PTHTOT'KEY'ST(1)=1 00768 PTHTOT'KEY'END(1)=4 00769 00771 PTHTOT'KEY'ST(2)=5 00772 PTHTOT'KEY'END(2)=29 00773 00776 MAP1 PTHTOT'STS,F 00777 MAP1 PTHTOT'LAST'KEY'USED,F,6,99 00778 PTHTOT=SPACE(512) 00779 !Primary file 00780 FILENAME="PTHTOT.IDX" 00783 OPEN #PTHTOT'CHNO, FILENAME, INDEXED, PTHTOT'RECNO, PTHTOT'STS, WAIT'RECORD, WAIT'FILE 00785 GOTO GET'PTHTOT'BYPASS 00786 GET'PTHTOT: 00787 IF PTHTOT'KEY="" THEN PTHTOT'KEY=" " 00788 E'CHNO=PTHTOT'CHNO: PTHTOT'LAST'KEY'USED=99 00789 GET #PTHTOT'CHNO, ISAM'KEY(0) = PTHTOT'KEY, PTHTOT'TEMP 00792 E=PTHTOT'STS: IF E=(-3) THEN E=33 00793 IF E#0 THEN RETURN 00794 PTHTOT=PTHTOT'TEMP 00795 RETURN 00796 GET'PTHTOT'BYPASS: 00799 MAP1 FLOATS 00800 MAP2 CNT,F,6,0 00801 MAP1 STRINGS 00802 TITLE="Big record ISAM plus file" 00803 START: 00804 ? TAB(-1,0); TITLE 00805 00806 ANY1: 00807 CNGCTL=2 00808 XCALL ANYCN, CNGCTL, WHATNO 00809 IF CNGCTL#0 THEN GOTO START 00810 00812 ? TAB(14,34);TAB(-1,11);"Initializing";TAB(-1,12); 00813 PTHTOT=SPACE(PTHTOT'RECSIZ) 00814 PTHTOT'KEY'NO=1 00815 INIT'PTHTOT: 00816 CALL FIND'FIRST'PTHTOT 00817 IF E=0 THEN CALL GETLQ'PTHTOT: CALL DELETEQ'PTHTOT: GOTO INIT'PTHTOT 00818 ? TAB(14,34);SPACE(13); 00819 ? TAB(14,42);TAB(-1,11);"Records";TAB(-1,12); 00820 ? TAB(15,34);TAB(-1,21);"Working...";TAB(-1,22); 00821 00822 LOAD'LOOP: 00823 PTHT'EMPNO=CNT USING "#ZZZ" 00824 PTHT'EMP'NAME="NO NAME"+SPACE(25) 00825 CALL ADD'PTHTOT 00826 CNT=CNT+1 00827 ? TAB(14,30);CNT USING "#,###,###"; 00828 GOTO LOAD'LOOP 00829 00830 !++INCLUDE ISMERR.BSI 00831 ISAM'ERR: 00832 IF E=33 THEN RETURN 00833 00834 IF E=0 THEN & E=(1):& ENTRY="Error# 0 ID NOT UNIQUE--Already on file":& GOTO ISAM'ERROR'COMPLETE 00835 IF E=(-3)THEN & E=(1):& ENTRY="Error#(-3) KEY NOT FOUND":& GOTO ISAM'ERROR'COMPLETE 00836 IF E=203 THEN & ENTRY="Error#203 Warning, free index blocks < minimum - CALL FOR HELP":& GOTO ISAM'ERROR'COMPLETE 00837 IF E=204 THEN & ENTRY="Error#204 Data file is full - CALL FOR HELP":& GOTO ISAM'ERROR'COMPLETE 00838 IF E=205 THEN & ENTRY="Error#205 Index file is full - CALL FOR HELP":& GOTO ISAM'ERROR'COMPLETE 00839 IF E=206 THEN & ENTRY="Error#206 Can not change key":& GOTO ISAM'ERROR'COMPLETE 00840 IF E=207 THEN & ENTRY="Error#207 Index structure is smashed - CALL FOR HELP":& GOTO ISAM'ERROR'COMPLETE 00841 IF E=208 THEN & ENTRY="Error#208 Duplicate key":& GOTO ISAM'ERROR'COMPLETE 00842 IF E=209 THEN & ENTRY="Error#209 Can't add, not enough free index blocks - CALL FOR HELP":& GOTO ISAM'ERROR'COMPLETE 00843 IF E=210 THEN & ENTRY="Error#210 Invalid number":& GOTO ISAM'ERROR'COMPLETE 00844 IF E=227 THEN & ENTRY="Error#227 Can not delete primary key":& GOTO ISAM'ERROR'COMPLETE 00845 IF E=229 THEN & ENTRY="Error#229 Data file smashed - CALL FOR HELP":& GOTO ISAM'ERROR'COMPLETE 00846 ENTRY="Error#"+(E USING "#ZZ") 00847 00848 ISAM'ERROR'COMPLETE: 00849 ENTRY=ENTRY+" Ch#"+(E'CHNO USING "####") 00850 ENTRY[1,65]=ENTRY+SPACE(65) 00851 XCALL MESAG,ENTRY,2 00852 ENTRY="" 00854 RETURN 00855 00875 MAP1 PTHTOT'LAST'KEYS(10),S,50 00876 FIND'LAST'PTHTOT: 00877 CALL VALIDATE'PTHTOT'KEY 00878 IF PTHTOT'KEY'NO>1 THEN PTHTOT[PTHTOT'KEY'ST(1),PTHTOT'KEY'END(1)]=SPACE(50) 00879 CALL LOAD'PTHTOT'SEARCH'KEY 00880 XCALL STRIP, ISAM'SEARCH'KEY 00881 ISAM'SEARCH'KEY=ISAM'SEARCH'KEY+ISAM'TILDES 00882 FIND #PTHTOT'CHNO, ISAM'KEY(ISAM'KEY'NO) < ISAM'SEARCH'KEY, ISAM'TEST'KEY 00883 GOTO FIND'PTHTOT'CONTINUE 00884 00885 FIND'PREVIOUS'PTHTOT: 00886 CALL VALIDATE'PTHTOT'KEY 00887 IF PTHTOT'LAST'KEY'USED=ISAM'KEY'NO THEN GOTO GET'PREVIOUS'PTHTOT 00888 ISAM'SEARCH'KEY=PTHTOT'LAST'KEYS(PTHTOT'KEY'NO) 00889 IF ISAM'SEARCH'KEY="" THEN ISAM'SEARCH'KEY=SPACE(50) 00890 FIND #PTHTOT'CHNO, ISAM'KEY(ISAM'KEY'NO) < ISAM'SEARCH'KEY, ISAM'TEST'KEY 00891 GOTO FIND'PTHTOT'CONTINUE 00892 00893 FIND'FIRST'PTHTOT: 00894 CALL VALIDATE'PTHTOT'KEY 00895 CALL LOAD'PTHTOT'SEARCH'KEY 00896 FIND #PTHTOT'CHNO, ISAM'KEY(ISAM'KEY'NO) >= ISAM'SEARCH'KEY, ISAM'TEST'KEY 00897 GOTO FIND'PTHTOT'CONTINUE 00898 00899 FIND'NEXT'PTHTOT: 00900 CALL VALIDATE'PTHTOT'KEY 00901 IF PTHTOT'LAST'KEY'USED=ISAM'KEY'NO THEN GOTO GET'NEXT'PTHTOT 00902 ISAM'SEARCH'KEY=PTHTOT'LAST'KEYS(PTHTOT'KEY'NO) 00903 IF ISAM'SEARCH'KEY="" THEN ISAM'SEARCH'KEY=SPACE(50) 00904 FIND #PTHTOT'CHNO, ISAM'KEY(ISAM'KEY'NO) > ISAM'SEARCH'KEY, ISAM'TEST'KEY 00905 00906 FIND'PTHTOT'CONTINUE: 00907 E=PTHTOT'STS: IF ABS(E)<=1 THEN E=0 00908 IF E#0 THEN & IF E=(-3) THEN E=38: GOTO FIND'DONE'PTHTOT & ELSE GOTO ISAM'ERR 00909 GET'NEXT'PTHTOT: 00910 GET'NEXT #PTHTOT'CHNO, PTHTOT 00911 GOTO GET'PTHTOT'CONTINUE 00912 GET'PREVIOUS'PTHTOT: 00913 GET'PREV #PTHTOT'CHNO, PTHTOT 00914 GET'PTHTOT'CONTINUE: 00915 PTHTOT'LAST'KEYS(PTHTOT'KEY'NO)=PTHTOT[PTHTOT'KEY'ST(PTHTOT'KEY'NO),PTHTOT'KEY'END(PTHTOT'KEY'NO)] 00916 IF PTHTOT'KEY'NO>1 THEN & PTHTOT'LAST'KEYS(PTHTOT'KEY'NO)=PTHTOT'LAST'KEYS(PTHTOT'KEY'NO)+PTHTOT[PTHTOT'KEY'ST(1),PTHTOT'KEY'END(1)] 00917 E=PTHTOT'STS: IF ABS(E)<=1 THEN E=0 00918 IF E#0 THEN & IF E=(-3) THEN E=38: GOTO FIND'DONE'PTHTOT & ELSE GOTO ISAM'ERR 00919 FIND'DONE'PTHTOT: 00920 PTHTOT'LAST'KEY'USED=ISAM'KEY'NO 00921 RETURN 00922 00923 VALIDATE'PTHTOT'KEY: 00924 IF (PTHTOT'KEY'NO<1 OR PTHTOT'KEY'NO>PTHTOT'KEY'CNT) THEN PTHTOT'KEY'NO=1 00925 E'CHNO=PTHTOT'CHNO: ISAM'KEY'NO=PTHTOT'KEY'NO-1 00926 RETURN 00927 00928 LOAD'PTHTOT'SEARCH'KEY: 00929 ISAM'SEARCH'KEY=PTHTOT[PTHTOT'KEY'ST(PTHTOT'KEY'NO),PTHTOT'KEY'END(PTHTOT'KEY'NO)] 00930 IF PTHTOT'KEY'NO>1 THEN & ISAM'SEARCH'KEY=ISAM'SEARCH'KEY+PTHTOT[PTHTOT'KEY'ST(1),PTHTOT'KEY'END(1)] 00931 IF ISAM'SEARCH'KEY="" THEN ISAM'SEARCH'KEY=SPACE(50) 00932 RETURN 00933 !!! FINISH file: ISMSBR.FN1 00934 GETL'PTHTOT: 00935 IF PROGRAM'NAME[4,6]="PST" THEN GOTO GETLQ'PTHTOT 00936 PTHTOT'LAST'KEY'USED=99: E'CHNO=PTHTOT'CHNO 00937 GET #PTHTOT'CHNO, ISAM'KEY(0) = PTHTOT[PTHTOT'KEY'ST(1),PTHTOT'KEY'END(1)], PTHTOT 00938 E=PTHTOT'STS: IF E#0 THEN GOTO ISAM'ERR 00939 GETLNR'PTHTOT: 00940 PTHTOT'ORIGINAL=PTHTOT 00941 RETURN 00942 00943 UPDATE'PTHTOT: 00944 IF PROGRAM'NAME[4,6]="PST" THEN GOTO UPDATEQ'PTHTOT 00945 IF PTHTOT=PTHTOT'ORIGINAL THEN E=0:RETURN 00946 PTHTOT'LAST'KEY'USED=99: E'CHNO=PTHTOT'CHNO 00947 GET'LOCKED #PTHTOT'CHNO, ISAM'KEY(0) = PTHTOT'ORIGINAL[PTHTOT'KEY'ST(1),PTHTOT'KEY'END(1)], PTHTOT'TEMP 00948 E=PTHTOT'STS: IF E#0 THEN IF E=(-3) THEN GOTO ADD'PTHTOT ELSE GOTO ISAM'ERR 00949 00950 IF PTHTOT'ORIGINAL#PTHTOT'TEMP THEN & CALL TRY'FIX'PTHTOT'LOOP: IF E#0 THEN RELEASE'RECORD #PTHTOT'CHNO:& XCALL MESAG,"Record has changed, no update performed. Try again",2: RETURN 00951 00952 UPDATE'RECORD #PTHTOT'CHNO, PTHTOT: RELEASE'RECORD #PTHTOT'CHNO 00953 E=PTHTOT'STS: IF E#0 THEN GOTO ISAM'ERR 00954 PTHTOT'ORIGINAL=PTHTOT 00955 RETURN 00956 00957 TRY'FIX'PTHTOT'LOOP: 00958 E=E+1: IF E>(PTHTOT'RECSIZ) THEN E=0: RETURN 00959 IF PTHTOT'BIN(E)=PTHTOT'TEMP'BIN(E) THEN GOTO TRY'FIX'PTHTOT'LOOP !Disk = Ours, OK 00960 IF PTHTOT'ORIGINAL'BIN(E)=PTHTOT'BIN(E) THEN & PTHTOT'BIN(E)=PTHTOT'TEMP'BIN(E): GOTO TRY'FIX'PTHTOT'LOOP & ELSE & IF PTHTOT'ORIGINAL'BIN(E)#PTHTOT'TEMP'BIN(E) THEN E=(-99): RETURN !Orig # Disk # Ours, bad 00961 GOTO TRY'FIX'PTHTOT'LOOP 00962 00963 DELETE'PTHTOT: 00964 IF PROGRAM'NAME[4,6]="PST" THEN GOTO DELETEQ'PTHTOT 00965 PTHTOT'LAST'KEY'USED=99: E'CHNO=PTHTOT'CHNO 00966 GET'LOCKED #PTHTOT'CHNO, ISAM'KEY(0) = PTHTOT'ORIGINAL[PTHTOT'KEY'ST(1),PTHTOT'KEY'END(1)], PTHTOT'TEMP 00967 E=PTHTOT'STS: IF E#0 THEN & IF E=(-3) THEN E=0: RETURN ELSE GOTO ISAM'ERR 00968 00969 DELETE'RECORD #PTHTOT'CHNO: RELEASE'RECORD #PTHTOT'CHNO 00970 E=PTHTOT'STS: IF E#0 THEN GOTO ISAM'ERR 00971 RETURN 00972 00973 ADD'PTHTOT: !Test - is primary already on file? 00974 PTHTOT'LAST'KEY'USED=99: E'CHNO=PTHTOT'CHNO 00975 GET'LOCKED #PTHTOT'CHNO, ISAM'KEY(0) = PTHTOT[PTHTOT'KEY'ST(1),PTHTOT'KEY'END(1)], PTHTOT'TEMP 00976 00977 ? TAB(22,1);PTHTOT[PTHTOT'KEY'ST(1),PTHTOT'KEY'END(1)];" E=";PTHTOT'STS 00978 XCALL SLEEP,.5 00979 E=PTHTOT'STS: IF E=0 THEN IF PROGRAM'NAME[4,6]#"PST" THEN & PTHTOT'ORIGINAL=PTHTOT: RELEASE'RECORD #PTHTOT'CHNO: GOTO ISAM'ERR ELSE GOTO ISAM'ERR 00980 00981 PTHTOT'UPDATE=0 00982 CREATE'RECORD #PTHTOT'CHNO, PTHTOT 00983 PTHTOT'ORIGINAL=PTHTOT: E=PTHTOT'STS: IF E#0 THEN GOTO ISAM'ERR 00984 IF (PROGRAM'NAME[4,6]#"PST" OR BATCH'MODE#0) THEN RETURN 00985 GET'LOCKED #PTHTOT'CHNO, ISAM'KEY(0) = PTHTOT[PTHTOT'KEY'ST(1),PTHTOT'KEY'END(1)], PTHTOT 00986 E=PTHTOT'STS: IF E#0 THEN GOTO ISAM'ERR 00987 RETURN 00988 00989 DELETEQ'PTHTOT: 00990 DELETE'RECORD #PTHTOT'CHNO: RELEASE'RECORD #PTHTOT'CHNO 00991 GOTO PTHTOT'Q'DONE 00992 GETLQ'PTHTOT: 00993 GET'LOCKED #PTHTOT'CHNO, ISAM'KEY(0) = PTHTOT[PTHTOT'KEY'ST(1),PTHTOT'KEY'END(1)], PTHTOT 00994 GOTO PTHTOT'Q'DONE 00995 UPDATEQ'PTHTOT: 00996 PTHTOT'UPDATE=0 00997 UPDATE'RECORD #PTHTOT'CHNO, PTHTOT: RELEASE'RECORD #PTHTOT'CHNO 00998 PTHTOT'Q'DONE: 00999 PTHTOT'LAST'KEY'USED=99: E'CHNO=PTHTOT'CHNO: E=PTHTOT'STS 01000 IF E#0 THEN GOTO ISAM'ERR 01001 RETURN