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)