Listing of file='ACPA010A' on disk='vmedia/701-2654C.wvd.zip'
# Sector 22, program filename = 'ACPA010A'
0010 REM ACPA010A, RELEASE 2.0, (06/01/79) THIS PROGRAM IS A COPYRIGHT PRODUCT
OF WANG LABORATORIES INC. UNAUTHORIZED REPRODUCTION OR USE IS PROHIBITED
0020 REM ---------------------------------------------------------------------
--
0030 REM SYSTEM = GBS/MVP ACCOUNTS PAYABLE SYSTEM
0035 REM MODULE = A/P OPEN ITEM PRINT/DISPLAY
0040 REM PROGRAM FUNCTION = DISPLAY AND/OR PRINT THE A/P OPEN ITEM FILE
0050 REM DATE WRITTEN = 03/08/79
0060 REM LAST REVISION = 04/16/79
0070 REM ---------------------------------------------------------------------
--
0170 DIM A6$1,B6$1,C6$1,D6$8
0172 DIM K$1,K1$Q0,K2$Q0,K3$17
0176 DIM A6(6),A7(6)
0198 GOTO 4000
3990 REM
3996 REM ************************************
3997 REM ! A/P OPEN ITEM FILE PRINT/DISPLAY !
3998 REM ************************************
3999 REM
4000 SELECT @PART S0$
4010 REM %PROGRAM CONSTANTS
4012 % ##,###,###.##-
4014 % ########
4020 K2$=ALL(FF)
4030 A6$="N"
4040 B6$="Y"
4050 P1=0
4052 K=9
4060 L=L0
4070 K1,K2,K3=0
: REM CLEAR TOTALS
4080 REM %ACQUIRE REPORT OPTIONS
4090 GOSUB '100("Y,N","NnYyY ",1,1,"PRINT REPORT (Y OR N)",2)
4100 IF Q6$=HEX(1F) THEN GOSUB '31
4110 A6$=Q6$
: REM SAVE 'PRINT' SWITCH
4120 IF A6$="Y" THEN 4150
4130 $CLOSE#15
4140 GOTO 4230
4150 GOSUB '93(" ")
: REM IS PRINTER AVAILABLE?
4160 IF I0$=" "THEN A6$="N"
: REM DID WE GET THE PRINTER?
4170 REM %SCREEN DISPLAY?
4180 GOSUB '100("Y,N","NnYyY ",1,1,"SCREEN DISPLAY (Y OR N)",2)
4190 IF Q6$=HEX(1F) THEN GOSUB '31
4200 B6$=Q6$
: REM SAVE 'DISPLAY' SWITCH
4210 IF B6$="N" AND A6$="N" THEN 5230
: REM NO PRINT, NO DISPLAY?
4220 REM %CHOOSE REPORT TYPE
4230 PRINT AT(5,0,);TAB(16);"A = List all items"
4240 PRINT TAB(16);"B = List only items selected for payment"
4260 GOSUB '100("A,B","AaBb",1,1,"ENTER REPORT TYPE",2)
4270 IF Q6$=HEX(1F) THEN GOSUB '31
4280 C6$=Q6$
4290 REM %CHOOSE INQUIRY TYPE
4300 PRINT AT(5,0,)
4310 GOSUB '100("A,R,I","AaIiRr",1,1,"ENTER INQUIRY TYPE (A=ALL, R=RANGE,
I=INDIVIDUAL)",2)
4320 IF Q6$=HEX(1F) THEN GOSUB '31
4330 K$=Q6$
4340 Q6$="ALL RANGE INDIVIDUAL"
4350 K3$=STR(Q6$,Q9*10-9,10)
4360 K3$=K3$&" OPTION"
: REM INITIALIZE CAPTION
4370 ON Q9GOTO ,4530,4440
: REM BRANCH ON INQUIRY TYPE
4380 REM %ALL OPTION
4390 GOSUB '235(1,0)
: REM ALL OPTION => FIND FIRST
4400 IF Q$="B" THEN 4000
4410 IF Q$>" "THEN 5320
4415 K1$=HEX(00)
4420 GOTO 4670
4430 REM %INDIVIDUAL OPTION
4440 K9=0
: REM SWITCH FOR INDIVIDUAL VENDOR SELECTION
4445 GOSUB '34(HEX(08))
: REM ACQUIRE INDIVIDUAL ID
4450 IF Q6$="END"THEN 5230
4455 IF Q6$=" " THEN 4440
: REM DON'T ACCEPT BLANK FOR ID
4460 K1$,K2$=Q6$
: REM SAVE STARTING ID
4490 GOTO 4613
: REM GO TO FINDNEXT
4510 REM %RANGE OPTION
4520 PRINT AT(3,0,80);"Starting ID must be lower than Ending ID.";HEX(07)
4530 MAT A6= ZER
4531 MAT A7= ZER
4532 K3=0
4533 K=9
4540 L=L0
4550 GOSUB '34("STARTING")
: REM ACQUIRE STARTING ID
4560 IF Q6$="END"THEN 5230
4570 K1$=Q6$
4580 GOSUB '34("ENDING")
: REM ACQUIRE ENDING ID
4590 K2$=ALL(FF)
4600 IF Q6$<>"END"THEN K2$=Q6$
4605 IF Q6$=" " THEN 4580
: REM ENDING ID CAN'T BE BLANK
4610 IF K1$>K2$ THEN 4520
: REM STARTING ID > ENDING ID?
4613 Q6$=STR(K1$)&ALL(00)
4615 GOSUB '232(1,0,Q6$)
: REM DUMMY FINDOLD
4618 K1$=HEX(00)
: REM SET FIRST TIME THROUGH SWITCH
4619 GOTO 4870
4620 K1$=STR(T7$,,Q0)
4670 GOSUB '71(2,Q)
: REM READ OPEN ITEM RECORD
4671 E=Q
4675 K9=1
4680 IF K1$>K2$THEN 4820
: REM OUT-OF-RANGE CHECK
4685 IF C6$="B" AND C5$(Q)=" " THEN 4820
4690 REM %CONVERT DATES
4700 INIT(20) C7$,C8$,C9$
4710 GOSUB '123(B5(E))
: REM CONVERT DATE
4720 IF Q6$ <> "E" THEN C9$ = U9$
4722 GOSUB '123(B3(E))
4723 IF Q6$ <> "E" THEN C7$ = U9$
4725 IF B4(E)=99999 THEN U9$="HOLD"
: ELSE GOSUB '123(B4(E))
4726 IF Q6$ <> "E" THEN C8$ = U9$
4735 REM ----------
4736 REM ACCUMULATE SUBTOTALS ACCORDING TO INVOICE TYPE
4743 K3=K3+1
4744 K1=K1+1
4745 K2=K2+1
4746 Q9=POS(" CEPX"=C3$(E))
4747 IF Q9<1OR Q9>5 THEN Q9=1
4748 Q6$="INV C/M EPAYPPAYXPAY"
4749 E6$=STR(Q6$,Q9*4-3,4)
4750 Q8=-1
4751 IF Q9=1 THEN Q8=1
4752 Q7=B(E)
4753 IF B1(E)>0AND C6$="B" THEN Q7=B1(E)
4754 A6(Q9) = A6(Q9) + Q7*Q8
4755 A7(Q9) = A7(Q9) + ROUND((Q7*B0(E)/100,2)*Q8
4756 REM VENDOR TOTALS
4757 IF Q9=3 THEN Q8=0
4758 A6=A6+Q7*Q8
4759 A7=A7+ROUND((Q7*B0(E)/100,2)*Q8
4760 REM %DISPLAY/PRINT
4770 SELECT PRINT 005(80)
4780 IF B6$="Y"THEN GOSUB 7080
: ELSE PRINT AT(5,0,80);"Processing record ID ";T7$
4790 IF A6$="Y"THEN GOSUB '90
4800 IF A6$="Y"THEN GOSUB 7290
4810 SELECT PRINT 005(80)
4820 IF K$="I"THEN 4870
: REM NEXT VENDOR RECORD
4825 IF K1$=K2$ AND K$="R" THEN 4850
: REM NECES. TO PROCSS PAST 1st REC FOR EACH VENDOR
4830 IF K1$>=K2$THEN 4950
: REM END OF RANGE?
4850 IF Q6$=HEX(1F)THEN GOSUB '31
4860 REM %PROCESS NEXT RECORD
4870 IF J0=7 THEN GOSUB '92
4875 IF K1$=HEX(00) AND J0=0 THEN K1$=STR(T7$,,Q0)
: REM 1ST TIME THROUGH?
4880 GOSUB '237(1,0)
: REM ALL/RANGE => FIND NEXT
4885 IF STR(K1$,,Q0)<>STR(T1$,,Q0) AND K$="I" AND K9=0 THEN 4440
4890 IF Q$="E" THEN 4923
: REM END OF FILE CHECK
4893 J$(1)=" "
4900 GOSUB '91
4903 IF J0=7 THEN 4870
: REM RECORD BUSY
4906 IF J0>1 THEN 5320
: REM FATAL KFAM ERROR
4909 IF J0=1 THEN T7$=HEX(FF)
: REM SET EOF FLAG
4915 IF STR(K1$,,Q0)=STR(T7$,,Q0) THEN 4670
: REM FALL THRU FOR VEND BREAK
4920 K1$=STR(T7$,,Q0)
4921 K=9
: REM TURN ON SWITCH FOR SCRN HDNGS
4923 IF B6$="Y" AND K2>0 THEN PRINT AT(4,21,59); "** No more records for t
his vendor **"
4924 IF B6$="Y" AND T7$<>HEX(FF) THEN GOSUB ' 254
4925 IF B6$="Y" AND Q6$=HEX(1F) THEN GOSUB '31
4926 IF A6$="Y" AND K2>0 THEN GOSUB 7450
4927 A6,A7,K2=0
: REM CLEAR VENDOR TOTALS
4931 IF Q$="E" THEN 4950
: REM AT EOF, PRINT TOTALS
4932 REM IF K$="I" THEN 4440
: REM IF INDIV, ASK FOR NXT
4933 IF K$="I" THEN 4950
: REM IF INDIV, ASK FOR NXT
4934 GOTO 4670
: REM IF NO EOF, NEXT RECORD
4940 REM %PRINT TOTALS
4950 IF A6$="N"AND K$="R"THEN 4530
: REM ANOTHER RANGE?
4951 REM IF A6$="N"AND K$="R"THEN 5090
: REM ANOTHER RANGE?
4960 IF A6$="N"OR K$<>"R"THEN 5100
: REM PRINT RANGE TOTALS?
4970 L=L+2
4980 GOSUB '90
5060 PRINT HEX(0A)
5070 IF K3>0 THEN PRINT "NO. OF RECORDS PROCESSED = ";K3
5080 SELECT PRINT 005(80)
5090 REM GOTO 4530
5100 IF A6$="N" THEN 5230
5110 SELECT PRINT <I0$>(132)
5120 PRINT HEX(0A)
5140 L=L+15
5150 GOSUB '90
5160 PRINT HEX(0A)
5162 PRINT TAB(12);"NO. OF RECORDS PROCESSED = ";
5163 PRINTUSING "###,###",K1
5164 PRINT HEX(0A)
5165 PRINT TAB(55);"TOTAL GROSS";TAB(71);"TOTAL DISC";TAB(89);"NET AMT"
5166 PRINT HEX(0A0A)
5167 Q8,Q9=0
5168 MAT REDIM M$(5)40
5169 M$(1)="INVOICES"
5170 M$(2)="CREDIT MEMOS"
5171 M$(3)="EXTERNAL PAYMENTS (ITEMS NOT ON FILE)"
5172 M$(4)="EXTERNAL PAYMENTS AFTER PAYMENT CYCLE"
5173 M$(5)="EXTERNAL PAYMENTS (ITEMS ON FILE)"
5174 FOR I=1TO 5
5175 PRINT TAB(37-LEN(M$(I)));M$(I);TAB(52);
5176 PRINTUSING 4012,A6(I);A7(I);A6(I)-A7(I)
5177 J=1
5178 IF I=3THEN J=0
5179 Q8=Q8+A6(I)*J
5180 Q9=Q9+A7(I)*J
5181 PRINT HEX(0A)
5182 NEXT I
5183 PRINT TAB(24);"REPORT TOTALS";TAB(52);
5184 PRINTUSING 4012,Q8;Q9;Q8-Q9
5187 L=60
5188 MAT A6=ZER
5189 MAT A7=ZER
5190 MAT REDIM M$(4)62
5200 PRINT HEX(0A)
5210 PRINT HEX(0C)
5220 REM %RESTART/MENU
5225 IF K$="I" THEN 4440
: REM IF INDIV, ASK FOR NXT
5230 SELECT PRINT 005(80)
5240 PRINT AT(1,0,)
5250 GOSUB '100("M,R","MmRr",1,1,"KEY R TO RESTART, M FOR MENU",2)
5260 IF Q6$=HEX(1F) THEN GOSUB '31
5270 IF Q6$="R"THEN 4000
5280 REM %END OF PROGRAM
5290 DEFFN '31
5300 LOAD TM$
5310 REM %KFAM ERROR PROCESSING
5320 GOSUB '91
5330 GOSUB '254
5340 GOTO 5290
6000 REM %^SUBROUTINES
6010 REM %PAGE EJECT
6020 DEFFN'90
6030 Q6$=" "
6040 KEYIN Q6$,6050,6050
: REM OPERATOR INTERRUPT CHECK
6050 IF Q6$="P" THEN GOSUB '254
6060 IF Q6$=HEX(1F) THEN GOSUB '31
6070 SELECT PRINT <I0$>(132)
6080 IF L<L0THEN RETURN
: REM LINE COUNT CHECK
6090 P1=P1+1
6100 PRINT HEX(0C0A0E);TAB(3);N2$
: REM PRINT COMPANY NAME
6121 Q6$=" "
6122 IF C6$="B" THEN Q6$=" - PAYMENT SELECTION REPORT"
6123 PRINT K3$;TAB(50);"A/P OPEN ITEM FILE ";Q6$;TAB(110);Q1$;TAB(122);"PA
GE";P1
6124 PRINT HEX(0A)
6125 PRINT "VENDOR";TAB(10);"INVOICE #";TAB(23);"INV DATE";TAB(34);"P.O. N
O.";TAB(46);"GROSS AMOUNT";TAB(61);"DISC %";TAB(75);"PARTIAL PYMT";TAB(90
);"CHECK NO.";TAB(103);"DUE DATE";TAB(115);"TYPE";TAB(121);"DATE PAID"
6126 PRINT HEX(0A)
6130 L=4
6140 RETURN
6150 REM %ACQUIRE FILE ID
6160 DEFFN'34(Q7$)
6162 SELECT PRINT 005(80)
6165 PRINT AT(1,0,80);"ENTER ";Q7$;" VENDOR ID (OR END)"
6166 REM ENTER VENDOR ID (KEY FIELD)
6168 GOSUB '238(1)
6170 GOSUB '100(" ",HEX(7F),Q0,0," ",2)
6172 IF Q6$="END" OR Q6$="end" THEN RETURN
6173 IF Q6$=HEX(1F) THEN GOSUB '31
6175 GOSUB '96(4)
: REM CONSTRUCT VENDOR ID
6193 RETURN
7060 REM --------------------
7070 REM SCREEN DISPLAY
7080 K=K+1
7081 IF K=10 OR K1$=HEX(00) THEN 7088
7082 IF K<5 THEN 7140
: REM PRINT 5 PER SCREEN
7084 GOSUB '254
: REM OPERATOR WAIT
7086 IF Q6$=HEX(1F) THEN GOSUB '31
7088 K=0
7090 PRINT HEX(03);TAB(21);"OPEN ITEM INQUIRY/LIST"
7100 PRINT AT(4,0,0);"VENDOR ID ";C0$(E)
7110 PRINT "INVOICE #";TAB(11);"TYPE";TAB(17);"INV DATE";TAB(28);"P.O. NO.
";TAB(41);"DISC %";TAB(54);"GROSS AMT"
7120 PRINT TAB(17);"DUE DATE";TAB(27);"CHECK NO.";TAB(39);"DATE PAID";TAB(
54);"PART PYMT"
7130 REM DETAIL LINE
7140 PRINT AT(7+3*K,0,0)
7150 INIT(".")Q6$
7160 PRINT Q6$
7170 PRINT TAB(1);C1$(E);TAB(11);E6$;TAB(17);C7$;TAB(28);C4$(E);TAB(40);
7180 IF ROUND((B0(E),2) = B0(E) THEN Q6$ = "##.##"
: ELSE Q6$ = "##.######"
7190 PRINTUSING Q6$,B0(E);
7200 PRINT TAB(49);
7210 PRINTUSING 4012,B(E)
7220 PRINT TAB(17);C8$;TAB(28);
7230 PRINTUSING 4014,B2(E);
7240 PRINT TAB(40);C9$;TAB(49);
7250 PRINTUSING 4012,B1(E)
7260 RETURN
7270 REM --------------------
7280 REM HARDCOPY REPORT
7290 GOSUB '90
7300 PRINT TAB(1);C0$(E);TAB(11);C1$(E);TAB(23);C7$;TAB(34);C4$(E);TAB(44)
;
7310 IF B(E)<>0 THEN PRINTUSING 4012,B(E);
7320 PRINT TAB(62);
7330 IF ROUND((B0(E),2) = B0(E) THEN Q6$ = "##.##"
: ELSE Q6$ = "##.######"
7340 IF B0(E)<>0 THEN PRINTUSING Q6$,B0(E);
7350 PRINT TAB(71);
7360 IF B1(E)<>0 THEN PRINTUSING 4012,B1(E);
7370 PRINT TAB(90);
7380 IF B2(E)<>0 THEN PRINTUSING 4014,B2(E);
7390 PRINT TAB(103);C8$;TAB(115);E6$;TAB(122);C9$
7400 SELECT PRINT 005(80)
7410 L=L+1
7420 RETURN
7430 REM -------------
7440 REM PRINT VENDOR TOTALS
7450 L=L+3
7460 GOSUB '90
7470 IF L=4THEN L=7
7480 PRINT HEX(0A)
7490 PRINT TAB(22);"VENDOR TOTALS - GROSS";TAB(44);
7500 PRINTUSING 4012,A6;
7540 PRINT TAB(61);"NET AMOUNT";
7550 PRINTUSING 4012,A6-A7
7560 PRINT HEX(0A)
7570 RETURN
9000 REM %VARIABLES
9010 REM A6$ = PRINT REPORT?
9020 REM B6$ = SCREEN DISPLAY?
9030 REM C6$ = REPORT TYPE
9040 REM D6$ = GREGORIAN DATE
9050 REM D7$ = GREGORIAN DATE
9060 REM K0 = NO. OF RECORDS - FINAL TOTAL
9070 REM K = NO. OF RECORDS - RANGE TOTAL
9075 REM K9 = INDIVIDUAL VENDOR OPEN ITEM SELECTION SWITCH
9076 REM = 0 NO OPEN ITEMS FOR VENDOR
9077 REM = 1 VENDOR HAS OPEN ITEMS
9080 REM K$ = INQUIRY TYPE
9090 REM K1$ = STARTING zzzzzzzz ID
9100 REM K2$ = ENDING zzzzzzzz ID
9110 REM K3$ = OPTION CAPTION
9120 REM Q0 = LENGTH OF RECORD ID
9130 REM Z0 = SUBSCRIPT FOR Q0$() - RECORD ID CONSTRUCTION PARAMETERS
9140 REM Z$ = RECORD ID
9150 REM Z2$ = RECORD DESCRIPTION
9160 REM $
9992 DEFFN'29"Q$=";HEX(22);"ACPA010A";HEX(22);":SCRATCH T Q$:SAVE T$ ()Q$";HEX
(0D)
9999 DEFFN'30"DIM Z$57:IF STR(I0$,,1)=HEX(20)THENI0$=HEX(323135):Z$=";HEX(22);
"GBS/MVP - PRINT/DISPLAY A/P OPEN ITEM FILE.";HEX(22);":SELECT#15<I0$>:$O
PEN#15:SELECTLIST<I0$>(80): LIST Z$:LIST Z$#:LIST Z$V:LIST Z$':LISTZ$THEX
(7A):$CLOSE#15:SELECTLIST005(80)";HEX(0D)