Listing of file='ACPA020A' on disk='vmedia/701-2654C.wvd.zip'
# Sector 75, program filename = 'ACPA020A' 0010 REM ACPA020A, RELEASE 2.3, (12/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 OPEN ITEM FILE MAINTENANCE 0040 REM PROGRAM FUNCTION = TO ALLOW FOR MAINTENANCE OF A/P OPEN ITEMS 0060 REM LAST REVISION = 11/21/80 MAF 0065 REM THIS PROGRAM UPGRADED TO 2.3 BY ERRATA 1177 0070 REM --------------------------------------------------------------- 0170 DIM B6(4),B6$(6),D9$15,C6$Q4,C7$Q6 0198 GOTO 4000 3996 REM ****************************** 3997 REM ! OPEN ITEM FILE MAINTENANCE ! 3998 REM ****************************** 3999 REM 4000 SELECT @PARTS0$ 4005 PRINT HEX(03);TAB(19);"A/P OPEN ITEM MAINTENANCE" 4010 B6=24 : REM LONGEST ALPHA FIELD - LEFT SIDE 4015 C6=08 : REM LONGEST NUMERIC FIELD - LEFT SIDE 4030 G0=1 4035 D8=VAL(Q0$(6)) : REM LENGTH OF INVOICE NO. 4038 I9=7 : REM NO. OF FIELDS 4040 REM CHECK AUDIT FILE SPACE 4070 LIMITS T#3,S$(3),Q6,Q7,Q8 4080 Q9=(Q8-2)/(Q7-Q6-1) 4090 IF Q9>.8 THEN PRINT AT(3,0);"Maintenance audit file is more than";INT (Q9*100);"% full." 4100 IF Q9<.95 THEN 4140 4110 GOSUB '254 4120 GOSUB '31 4130 REM ENTER VENDOR ID (KEY FIELD) 4140 GOSUB '238(2) 4150 GOSUB '100(" ",HEX(7F),Q0,0,"ENTER VENDOR ID. (OR END)",2) 4160 IF Q6$=HEX(1F) OR Q6$="END" OR Q6$="end"THEN GOSUB '31 4170 IF Q6$=" " THEN 4140 4180 GOSUB '96(4) : REM CONSTRUCT VENDOR ID 4181 C6$=Q6$ 4182 PRINT AT(4,0,);TAB(5);"VENDOR ID - ";C6$ 4183 GOSUB '232(2,0,C6$) : REM FINDOLD TO VERIFY VENDOR ID 4184 GOSUB '91 : REM CONVERT KFAM ERROR TO NUMERIC 4185 IF J0=0 OR J0=7 THEN 4203 : REM BRANCH IF ID IS VALID 4188 PRINT AT(3,0,80);HEX(07);"Illegal vendor ID, re-enter" 4190 GOTO 4140 4201 REM ENTER INVOICE NUMBER 4203 GOSUB '100(" ",HEX(7F),8,0,"ENTER INVOICE NUMBER (OR END)",2) 4204 IF Q6$=HEX(1F) OR Q6$="END" OR Q6$="end"THEN GOSUB '31 4205 IF Q6$=" " THEN 4203 4206 GOSUB '96(6) : REM CONSTRUCT INVOICE ID 4207 C7$=Q6$ 4220 REM BUILD A/P OPEN ITEM KEY 4230 C9$=STR(C6$,,VAL(Q0$(4)))&C7$ 4250 GOSUB '232(1,0,C9$) : REM DUMMY FINDOLD (NO ID WITH " ") 4260 GOSUB '237(1,1) : REM FINDNEXT 4270 J$(1)=" " : REM SUPPRESS END OF FILE ERROR MSG 4280 GOSUB '91 : REM CONVERT ERROR CODES TO NUMERICS 4290 IF J0=1 THEN T7$=ALL(FF) : REM FOR END OF FILE 4300 IF J0=7 THEN 4140 : REM NEXT ID IF RECORD BUSY 4310 IF J0<2 THEN 4350 : REM CONTINUE IF J0= 0 OR 1 4320 PRINT AT(1,0,80); "PROGRAM WILL BE TERMINATED" 4330 PRINT AT(3,16,64);Q7$ 4340 GOTO 4830 : REM GO TO PROGRAM END 4350 IF STR(T7$,1,Q0+D8)=STR(C9$,1,Q0+D8) THEN 4480 4360 PRINT AT(3,0,80);HEX(07);"Record not found" 4370 GOTO 4140 4480 GOSUB '71(2,Q) : REM READ A/P OPEN ITEM RECORD 4515 REM CHANGE A/P OPEN ITEM RECORD 4517 C7$=C1$(Q) 4520 GOSUB '37 : REM SCREEN DISPLAY 4540 GOSUB '33 : REM ITEM NO. CORRECTION ROUTINE 4550 DBACKSPACE #2,1S 4560 GOSUB '61(2,Q) : REM REWRITE A/P OPEN ITEM RECORD 4563 REM CHECK FOR OTHER RECORDS WITH SAME INVOICE # AND VENDOR # 4565 GOSUB '238(1) 4567 GOSUB '237(1,1) : REM FIND THE NEXT RECORD 4569 J$(1)=" " : REM SUPPRESS E0F ERROR MSG 4571 GOSUB '91 4573 IF J0=1 OR J0=7 THEN 4140 : REM FOR EOF OR BUSY RECORD 4575 IF J0<>0 THEN 4320 : REM TERMINATE PROGRAM IF OTHER ERRORS 4577 IF STR(T7$,1,Q0)<>STR(C9$,1,Q0) THEN 4140 : REM IF #'s NOT THE SAME 4579 C9$=T7$ 4581 GOSUB '100("Y,N","YyY Nn",1,1,"NEXT INVOICE FOR THIS VENDOR? (Y OR N )",2) 4585 IF Q6$="N" THEN 4140 : REM FOR NEXT VENDOR ID 4587 GOTO 4480 : REM GET THE NEXT RECORD 4720 REM %BUILD & WRITE AUDIT FILE DATA 4750 G0$(G0)="@" & C9$ : REM ALL TRANS TYPES - BUILD RECORD ID 4760 G1$(G0)="C" 4770 G0=G0+1 4780 IF G0<4 THEN RETURN 4790 GOSUB '49(3) : REM WRITE TO AUDIT FILE 4800 G0=1 4810 G0$()=ALL(FF) 4820 IF Q9<.95 THEN RETURN 4830 GOSUB '254 4840 REM %END OF PROGRAM 4850 DEFFN'31 4860 IF G0>1 THEN GOSUB '49(3) : REM WRITE REMAINING AUDIT RECORDS 4870 LOAD T M$ 6000 REM %^SUBROUTINES 6050 REM %DISPLAY ENTIRE RECORD 6060 DEFFN'37 6061 Q9=POS(" CEPX"=C3$(Q)) 6062 IF Q9>5 OR Q9<1 THEN Q9=1 6063 Q6$="INVOICE CR MEMO E-PAYMENTP-PAYMENTX-PAYMENT" 6064 Q7$=STR(Q6$,Q9*9-8,9) 6065 PRINT AT(4,25);"INVOICE NUMBER - ";C7$ 6067 PRINT AT(4,50,30);"***";Q7$;"***" 6070 PRINT AT(5,0,) 6080 G7=0 6100 FOR I=1TO I9 6110 GOSUB '35 : REM DISPLAY EACH FIELD 6120 NEXT I 6130 RETURN 6140 REM %ITEM NO. SELECT ROUTINE 6150 DEFFN'33 6160 CONVERT I9TO Q7$,(##) 6170 PRINT AT(1,0,80);"ENTER ITEM NO.(0=END, -1=VOID)"; 6180 GOSUB '100("-1",Q7$,2,0," ",1) 6190 IF Q6$ = HEX(1F) THEN GOSUB '31 6200 I,J9=Q9 6210 IF I=-1 THEN 6290 : REM VOID OPTION? 6217 IF I=0 THEN RETURN : REM END OF CORRECTIONS? 6220 REM ALLOW ONLY VALID REQUESTS FOR EACH TRANSACTION TYPE 6221 IF C3$(Q)= " " AND I=7 THEN 6271 6222 IF C3$(Q)= "C" THEN ON I GOTO ,6271,6271,6271,,6271,6271 6223 IF C3$(Q)= "E" OR C3$(Q)= "X" OR C3$(Q)= "P" THEN ON I GOTO ,6271,627 1,,,,6271 6237 REM DATA ENTRY ROUTINE 6239 Q7$=" " 6240 G7=G7+1 6250 GOSUB '35 6260 GOSUB 4750 : REM WRITE AUDIT TRAIL 6270 GOTO 6150 6271 PRINT AT(3,0,80);"Illegal field selection, re-enter.";HEX(07) 6272 INIT(20)Q$() : GOTO 6150 6280 REM VOID OPTION 6290 RETURN CLEAR 6300 IF G7=0 THEN 4140 6310 CONVERT MIN(G7,99) TO Q6$,(##) 6320 G2$(G0)=Q6$&" previous edits for" 6330 G3$(G0)="this open item are void." 6335 G5$(G0)=" " 6340 GOSUB 4750 6350 GOTO 4140 6440 REM %GENERAL DATA ENTRY SUBROUTINE 6450 DEFFN'34(Q6$,Q9,G5$(G0),Q7$,Q$(1),Q$(2),Q3,Q4,Q5) 6460 IF G7>0THEN PRINT AT(1,0,80);"ENTER ";G5$(G0);Q7$ 6470 IF Q5<2 THEN GOSUB 6650 : REM AUDIT FILE FORMAT-NUMERICS 6480 G2$(G0)=Q6$ : REM SAVE OLD VALUE-AUDIT FILE 6490 IF Q6$>" " AND Q5=2 THEN Q5=3 : REM DEFAULT ALPHA IF NON-BLANK 6495 IF Q9<>0 AND Q5=1 THEN Q5=0 : REM DEFAULT FOR NUMERICS 6500 IF G7>0 THEN GOSUB '100(Q$(1),Q$(2),Q3,Q4," ",Q5) 6510 IF Q6$=HEX(1F) THEN GOSUB '31 6520 IF Q5<2THEN GOSUB 6650 : REM AUDIT FILE FORMAT-NUMERICS 6530 G3$(G0)=Q6$ : REM SAVE NEW VALUE-ALPHA 6535 Q8=50 6550 PRINT AT(I+5,0,Q8); 6555 PRINTUSING "##) ";I; 6560 B8=Q8-B6-2 6565 IF Q5<2 THEN B8=B8+C6-Q3 : REM NUMERIC? 6595 PRINT G5$(G0);TAB(B8);Q6$ : REM PRINT LABEL, VALUE 6600 RETURN 6640 REM PUT NUMERIC VALUES INTO AUDIT FILE FORMAT 6650 Q6$=ALL("#") 6660 Q7$=STR(Q6$,,Q3) : REM PRINTUSING MASK-ALPHA 6670 IF Q4>0THEN Q7$=Q7$&"."&STR(Q6$,,Q4) : REM ANY DIGITS AFTER DECIMAL? 6675 Q7$=Q7$&"-" 6680 Q6$=ALL(00) 6690 PRINTUSING TO Q6$,Q7$,Q9 6700 Q6$=STR(Q6$,3,LEN(Q7$)) 6710 RETURN 6720 REM BRANCH TO THE APPROPRIATE SUBROUTINE FOR EACH FIELD 6730 DEFFN'35 6740 Q$=" " 6750 ON I GOSUB 6800,6830,6860,6890,6920,6945,6980 6760 IF Q$>" "THEN 6730 6770 RETURN 6800 GOSUB '34(C4$(Q),0,"P. O. NUMBER"," "," ",HEX(7F),D8,0,2) 6802 C4$(Q)=Q6$ 6804 RETURN 6830 GOSUB '34(" ",B0(Q),"DISCOUNT %"," ","0","100.00",2,8,1) 6832 B0(Q)=Q9 6834 RETURN 6860 GOSUB '34(" ",B1(Q),"PARTIAL PAYMENT"," ","0","9999999.99",7,2,1) 6862 IF Q9<B(Q) THEN 6870 6864 PRINT AT(3,0,80);HEX(07);"Partial payment amount must be less than gr oss amount, re-enter." 6866 GOTO 6860 6870 B1(Q)=Q9 6872 RETURN 6890 GOSUB '34(" ",B2(Q),"CHECK NUMBER"," ","0","99999999",8,0,1) 6892 B2(Q)=Q9 6894 RETURN 6920 Q7$= " MM/DD/YY" 6921 IF C3$(Q)=" " THEN Q7$= Q7$ & " (OR " & HEX(22) & "HOLD" & HEX(2229) 6922 IF B4(Q)=99999 THEN U9$="HOLD" : ELSE GOSUB '123(B4(Q)) 6925 GOSUB '34(U9$,0,"DUE DATE"," "," ",HEX(7F),8,0,2) 6927 IF Q6$="HOLD" AND C3$(Q)<> " " THEN 6939 6930 IF Q6$="HOLD" THEN U9=99999 : ELSE GOSUB 6959 6933 B4(Q)=U9 6934 U9=0 6936 RETURN 6939 PRINT AT(3,0,80);"Holds may be placed on invoices only, re-enter" 6942 GOTO 6920 6945 GOSUB '123(B5(Q)) 6948 GOSUB '34(U9$,0,"DATE PAID"," MM/DD/YY"," ",HEX(7F),8,0,2) 6951 GOSUB 6959 6954 B5(Q)=U9 6955 U9=0 6957 RETURN 6959 IF G7=0 THEN RETURN : REM U9 IS AS IS WAS 6960 GOSUB '121(Q6$) 6961 IF Q6$<>"E" THEN 6965 6962 PRINT AT(3,0,80);"Illegal date, re-enter." 6963 GOTO 6973 6965 IF U9>=B3(Q) THEN RETURN 6970 GOSUB '123(B3(Q)) 6971 Q6$="Date must equal or exceed " & U9$ & ", re-enter." 6973 RETURN CLEAR 6975 IF I=5 THEN 6920 : ELSE GOTO 6945 6980 GOSUB '34(" ",B(Q),"GROSS AMOUNT"," ","0","99999999.99",8,2,1) 6982 B(Q)=Q9 6983 RETURN 9000 REM %^VARIABLES 9010 REM B6 = LONGEST ALPHA FIELD, LEFT SIDE OF SCREEN 9012 REM B7 = LONGEST ALPHA FIELD, RIGHT SIDE OF SCREEN 9014 REM B8 = SCREEN COLUMN NO. 9016 REM C6 = LONGEST NUMERIC FIELD, LEFT SIDE (DIGITS LEFT OF DECIMAL) 9018 REM C7 = LONGEST NUMERIC FIELD, RIGHT SIDE (DIGITS LEFT OF DECIMAL) 9022 REM G0 = COUNTER FOR AUDIT FILE - RECORDS IN A SECTOR 9024 REM G7 = 0 MEANS DISPLAY MODE, > 0 GIVES A COUNT OF CHANGES MADE 9028 REM I9 = NUMBER OF FIELDS 9030 REM Z0$ = KEY FIELD 9040 REM Z2$ = NAME/DESCRIPTION TO IDENTIFY ADDED/DELETED RECORDS 9070 REM Z0 = SUBSCRIPT FOR Q0$() 9100 REM Z9 = NUMBER OF FIELDS 9101 REM C9$ = FILE KEY 9102 REM A6 = RECORD NUMBER WITHIN DATA RECORD 9110 REM $ 9998 DEFFN'29"Q$=";HEX(22);"ACPA020A";HEX(22);":SCRATCH TQ$:SAVE T$()Q$";HEX(0 D) 9999 DEFFN'30"DIM Z$57:IF STR(I0$,,1)=HEX(20)THENI0$=HEX(323135):Z$=";HEX(22); "GBS/MVP - A/P OPEN ITEM MAINTENANCE";HEX(22);":SELECT#15<I0$>:$OPEN#15:S ELECTLIST<I0$>(132): LIST Z$:LIST Z$#:LIST Z$V:LIST Z$':LISTZ$THEX(7A):$C LOSE#15:SELECTLIST005(80)";HEX(0D)