image of READY prompt

Wang2200.org

Listing of file='ACPAMENU' on disk='vmedia/701-2654C.wvd.zip'

# Sector 565, program filename = 'ACPAMENU'
0010 REM ACPAMENU, RELEASE 2.2, (09/11/80) THIS PROGRAM IS A COPYRIGHT PRODUCT
      OF WANG LABORATORIES INC. UNAUTHORIZED REPRODUCTION OR USE IS PROHIBITED
0020 REM --------------------------------------------------------------------
0030 REM SYSTEM & MODULE   =  GBS/MVP ACCOUNTS PAYABLE SYSTEM
0040 REM PROGRAM FUNCTION  =  SELECT PROGRAM & LOAD MODULES FOR ACCOUNTS PAYAB
     LE
0050 REM DATE WRITTEN      =  06/26/79
0060 REM LAST REVISION     =  09/11/80 TM
0065 REM THIS PROGRAM WAS UPGRADED TO 2.2 BY ERRATA 1157 + 1172
0070 REM --------------------------------------------------------------------
0170     COM I,Q,M5$,O0,M0,M$8
   : REM MENU VARIABLES
0172     COM Q$(2)80,Q6$80,Q7$80
   : REM DATA ENTRY VARIABLES USED BY MENU
0174     COM Q3,Q4,Q5,Q6,Q7,Q8,Q9
   : REM DATA ENTRY VARIABLES USED BY MENU
0176     COM M(17),F5$(3)1,M2$4
   : REM CONTROL FILE VARIABLES
0198     GOTO 4000
3996 REM ******************
3997 REM ! ACCOUNTS PAYABLE MENU !
3998 REM ******************
3999 REM
4000     DIM A6$(8)124
4001     N=11
   : REM NUMBER OF PROGRAMS ON MENU
4010     I=40
   : REM STARTING COLUMN - RIGHT SIDE OF MENU
4015     M0=INT(249/(40+VAL(Q0$(4))+VAL(Q0$(6))))
   : REM OPEN ITEM BLOCKING
4020     Q0=VAL(Q0$(4))
   : REM LENGTH OF VENDOR ID
4030     IF M$="SYS MENU" THEN M5$=" "
4040     M$="ACPAMENU"
   : REM NAME OF MENU PROGRAM
4050 REM TITLE FOR MENU, LABEL FOR FUNCTION KEY '31
4060     Q7$="GBS/MVP ACCOUNTS PAYABLE SYSTEM"
4070     STR(Q7$,47)="SYSTEM MENU"
4080     LOAD T"GBS MENU"10,4080
   : ERRORPRINT HEX(03);"GBS Menu is not available."
   : END
7000 REM %RESPONSE TO FUNCTION KEY '31
7010     DEFFN'32
7020     Q6$="SYS MENU"
7030     COM CLEAR I
7040     LOAD TQ6$
   : ERRORPRINT HEX(03);"System menu is not available."
   : END
7050 REM %SET-UP UNIQUE COMPANY PROGRAM CODE
7060     DEFFN'38
7110     RETURN
7120 REM %CHECK FLAGS IN CONTROL FILE, DO ANYTHING THAT IS PROGRAM-SPECIFIC
7130     DEFFN'39
7140 REM OPEN CONTROL FILE AND CHECK FLAGS
7170     IF M5$="ACPA070A" OR M5$="ACPA080A" THEN GOSUB '98
7172     V7$="GBS1F010"
7174     GOSUB '97
7176     MAT SEARCH A6$(),=STR(V7$,,7)TO Q6$STEP 11
7178     Q9=INT((VAL(Q6$,2)+10)/11)
7180     Q6$="A/P Control file"
7182     Q7$="(Filename is not in company control file)."
7184     IF Q9=0 THEN GOSUB '33
7186     Q7$=" "
7188     SELECT #1<STR(A6$(Q9),9,3)>
7190     DATA LOAD DC OPEN T#1,STR(A6$(Q9),,8)
   : ERRORGOSUB '33
7195     Q5=VAL(Q0$(5))
7200     LOAD T "A/PCONT"10,199 BEG  7210
7210     SELECT @PART S0$
7215     GOSUB '66(1,0,1)
7218     DATA SAVE DC CLOSE#1
7220     RESTORE M2*5+2
7230     READ Q6$
7255     MAT SEARCH "ACPA050 ACPA060 ACPA120",= STR(M5$,,7) TO Q7$
7260     IF STR(Q7$,,2)=HEX(0000) THEN 7380
7270     Q7$="Cash Requirement Report must precede "&Q6$
7280     IF M(3) = 0 THEN 7340
7290     Q7$="Payment selection must precede "&Q6$
7300     IF M5$="ACPA060A" AND F5$(2) = " " THEN 7340
7310     IF M5$="ACPA050A" THEN 7380
7320     Q7$ = "Check print must precede "&Q6$
7330     IF M5$<>"ACPA120A" OR F5$(2) = "2" THEN GOSUB '98
7340     PRINT HEX(030D0A);Q7$
7344     PRINT AT(2,0,80)
7345     Q7$=" "
7346     KEYIN Q7$,7346,7346
7350     LINPUT "Key 'RETURN' to resume.",? STR(Q7$,,1)
7352     Q6$=" "
7354     GOSUB '33
7380     IF F5$(2) <> "2" THEN GOSUB '98
7390     PRINT HEX(03);AT(0,0);"Caution - Purge Paid Item/Vendor update has no
     t followed check print";HEX(07)
7400     PRINT AT(1,0);"If the A/P payment cycle is not completed, the checks
     will be lost"
7410     PRINT AT(2,0,80);"IS ";Q6$;" STILL DESIRED (Y OR N)";
7420     Q6$,Q7$ = " "
7430     LINPUT ?STR(Q7$,,1)
7440     $TRAN(Q7$,"YyNn")R
7450     IF Q7$="N" THEN GOSUB '33
7460     IF Q7$="Y" THEN GOSUB '98
7470     PRINT AT(3,0,80);"RE-ENTER";HEX(07)
7480     GOTO 7410
7510 REM -------------------------
7530 REM THERE ARE TWO DATA STATEMENTS FOR EACH PROGRAM, WITH 5 DATA ELEMENTS
7540 REM THE FIRST ELEMENT IS THE PROGRAM NAME
7550 REM THE SECOND ELEMENT IS THE PROGRAM DESCRIPTION DISPLAYED BY THE MENU
7560 REM THE THIRD ELEMENT IS A LIST OF SUBROUTINES USED BY THE PROGRAM
7570 REM THE FOURTH ELEMENT INDICATES THE NUMBER OF KFAM FILES TO BE OPENED
7580 REM <IF ONLY SEQUENTIAL FILES ARE OPENED, THIS ELEMENT MUST BE '1'>
7585 REM <FOR SORT SET-UPS, IF NO FILES ARE OPENED, THIS ELEMENT IS '0'>
7590 REM THE FIFTH ELEMENT INDICATES WHICH FILES ARE TO BE OPENED
7600 REM <BYTES 1-8 = GBS FILE NAME, BYTE 9 = ACCESS MODE>
7605 REM <<FOR SORTS, THE ACCESS MODE IS SET TO '0'>>
7610 REM <BYTE 10 = KEY FILE NO.>
7615 REM <FOR SEQUENTIAL FILES, THE KEY FILE NO. IS SET TO '0'>
7620 REM <BYTE 11 = USER FILE DEVICE NO.>
7630 REM <IF THE DEVICE NO. IS GREATER THAN 9, 'A' = 10, ...., 'E' = 15>
7660     DATA "ACPA030A","ENTER TRANSACTIONS","KFAMCODESUBUTIL JENFILE VENFILE
      A/PFILE GENFILE A/PCONT DENTRY  SUBDATE TRAUFILE"
7665     DATA 3,"ACPAF01 312 ACPAF02 314 GENLF01 116 GENLF02 307 GENLF03 308 G
     BS1F01 309 AUDIF02 30A GENLF05 30B"
7670     DATA "ACPA040A","PRINT CASH REQUIREMENTS","KFAMCODESUBUTIL VENFILE A/
     PFILE A/PCONT DENTRY  SUBDATE PRNTAVAL"
7675     DATA 2,"ACPAF01 412 ACPAF02 414 GBS1F01 305"
7680     DATA "ACPA050A","SELECT ITEMS FOR PAYMENT","KFAMCODESUBUTIL VENFILE A
     /PFILE A/PCONT DENTRY  SUBDATE"
7685     DATA 2,"ACPAF01 412 ACPAF02 414 GBS1F01 305"
7690     DATA "ACPA060A","PRINT CHECKS","KFAMCODESUBUTIL VENFILE A/PFILE CHKFI
     LE A/PCONT DENTRY  SUBDATE PRNTAVAL"
7695     DATA 2,"ACPAF01 112 ACPAF02 414 ACPAF03 405 GBS1F01 306"
7700     DATA "ACPA070A","PRINT CHECK REGISTER","KFAMCODESUBUTIL DENTRY  PRNTA
     VAL"
7705     DATA 1,"ACPAF03 001 ACPAF03 002 SORTWORK003 SORTWORK004 PROGRAM 005 P
     ROGRAM 006"
7710     DATA "ACPA120A","PURGE PAID ITEMS","KFAMCODESUBUTIL VENFILE A/PFILE A
     /PCONT DENTRY  SUBDATE TRAUFILE"
7715     DATA 2,"ACPAF01 412 ACPAF02 414 AUDIF02 305 GBS1F01 306"
7730     DATA "ACPA080A","MAINTAIN VENDOR FILE","KFAMCODESUBUTIL GENFILE VENFI
     LE DENTRY  SUBDATE AUDIFILE"
7735     DATA 2,"ACPAF01 312 GENLF01 315 AUDIF01 303"
7740     DATA "ACPA020A","MAINTAIN OPEN ITEM FILE","KFAMCODESUBUTIL VENFILE A/
     PCONT A/PFILE DENTRY  AUDIFILESUBDATE PRNTAVAL"
7745     DATA 2,"ACPAF02 312 ACPAF01 116 AUDIF01 303 GBS1F01 304"
7750     DATA "ACPA090A","DISPLAY/PRINT VENDOR FILE","KFAMCODESUBUTIL VENFILE
     DENTRY  SUBDATE PRNTAVAL"
7755     DATA 1,"ACPAF01 112"
7760     DATA "ACPA010A","DISPLAY/PRINT OPEN ITEM FILE","KFAMCODESUBUTIL VENFI
     LE A/PFILE SUBDATE DENTRY  PRNTAVAL"
7765     DATA 2,"ACPAF02 112 ACPAF01 116"
7770     DATA "ACPA110A","REPORT ON DISTRIBUTION","KFAMCODESUBUTIL A/PCONT DEN
     TRY  SUBDATE PRNTAVAL"
7775     DATA 1,"GBS1F01 309 GENLF02 001 GENLF02 002 SORTWORK003 GENLF05 004 P
     ROGRAM 005 PROGRAM 006 GENLK11 007 GENLF01 008"
7800 DEFFN'29"Q$=";HEX(22);"ACPAMENU";HEX(22);":SCRATCHTQ$:SAVET$()Q$";HEX(0D)