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

You are viewing proxied material from gopher.floodgap.com. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.