++INCLUDE ESP.BPM               ! standard MAPs for ESP screens

       MAP1 SCREEN'TST,X,8192  ! buffer to FETCH/load ESP screen file
       MAP1 CHAR'TST,F,6       ! GTSCR return character
       MAP1 FIELD'TST,F,6,1    ! GTSCR return field number
       MAP1 FUND'NUM,F,6
       MAP1 REC'AMT,F,6
       MAP1 TAX'DED,S,1
       MAP1 REC'TYPE,S,6
       MAP1 REF,S,30
       MAP1 FUND'DESC,S,30
       MAP1 RECEIPT'DESC,S,20
       MAP1 CUR'DISTR,F,6
       MAP1 TMP'DISTR,F,6
       MAP1 TMP'REC'TOTAL,F,6

       XCALL FETCH, "NRSCR:TST.SCR", SCREEN'TST, ESP'RETCOD
       IF ESP'RETCOD <> 0 THEN GOTO END'OF'PGM'ER

       XCALL INITRM
       XCALL OPNSCR, SCREEN'TST
       XCALL SETVAL, SCREEN'TST, 14, "    [ EXECUTE when correct  |  MENU/F13 to abort ]"
       XCALL SETVAL, SCREEN'TST, 1, "", "", "", "", "", "", "", "", "", ""
       FIELD'TST = 1

     EDTSCR'TST:
     ! **** - Don't know why test is nec, but PREEDIT cond won't work without it here
       IF (CHAR'TST AND ESP'PREEDIT) THEN &
               CHAR'TST = ESP'BEGLIN OR ESP'PREEDIT ELSE &
               CHAR'TST = ESP'BEGLIN OR ESP'DAF
       XCALL GTSCR, SCREEN'TST, CHAR'TST, FIELD'TST
       XCALL GETVAL, SCREEN'TST, 1, FUND'NUM, REC'AMT, TAX'DED, &
               REC'TYPE, REF, FUND'DESC, RECEIPT'DESC, CUR'DISTR, TMP'DISTR, TMP'REC'TOTAL
       IF (CHAR'TST AND 255) = ESP'MENU THEN GOTO END'OF'PGM'M
       IF (CHAR'TST AND ESP'PREEDIT) THEN CALL TST'PRE2
       IF (CHAR'TST AND ESP'POSTEDIT) THEN &
               ON FIELD'TST CALL TST'POST1, TST'POST2, NOCHK, TST'POST4, TST'POST5
       IF (CHAR'TST AND 255) = ESP'EXECUTE THEN GOTO END'OF'PGM'E
       GOTO EDTSCR'TST

     NOCHK:    ! Do nothing (postedit interrupt not set in SCR file)
       RETURN

     TST'POST1:        ! Receipting Fund Number
       IF FUND'NUM = 0 THEN XCALL ERRDSP, "Fund number cannot be zero" : &
               FIELD'TST = 1 : GOTO EDTSCR'TST
     ! **** - if omit following assignment, then cannot move out of field
       FIELD'TST = 2
       GOTO EDTSCR'TST

     TST'PRE2:
       ! Test routine normally goes here, taken out for now
       RETURN

     TST'POST2:        ! Distribution Dollar Amount
       IF REC'AMT = 0 THEN XCALL ERRDSP, "Invalid dollar amount" : &
               FIELD'TST = 2 : GOTO EDTSCR'TST
     ! **** - if omit following assignment, then cannot move out of field
       FIELD'TST = 3
       GOTO EDTSCR'TST

     TST'POST4:        ! G/L Receipt Type
       ! Test routine normally goes here, taken out for now
     ! **** - if omit following assignment, then cannot move out of field
       FIELD'TST = 5
       GOTO EDTSCR'TST

     TST'POST5:        ! G/L Receipt Reference
       GOTO END'OF'PGM'N


     END'OF'PGM'M:
       XCALL CLSSCR, SCREEN'TST
       XCALL INITRM
       PRINT "PROGRAM END WITH MENU KEY"
       END

     END'OF'PGM'E:
       XCALL CLSSCR, SCREEN'TST
       XCALL INITRM
       PRINT "PROGRAM END WITH EXECUTE KEY"
       END

     END'OF'PGM'N:
       XCALL CLSSCR, SCREEN'TST
       XCALL INITRM
       PRINT "PROGRAM ENDED NORMALLY"
       END

     END'OF'PGM'ER:
       PRINT "PROGRAM END DUE TO SCREEN FILE NOT FOUND"

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.