image of READY prompt

Wang2200.org

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

# Sector 539, program filename = 'ACPA120A'
0010 REM ACPA120A, RELEASE 1-0, (01/31/79)   THIS PROGRAM IS A COPYRIGHT PRODU
     CT OF WANG LABORATORIES INC. UNAUTHORIZED REPRODUCTION OR USE IS PROHIBIT
     ED
0020 REM PROGRAM NAME      = ACPA120A
0030 REM RELEASE NUMBER   =  01
0040 REM REVISION NUMBER  =  00
0050 REM DATE WRITTEN      = 1/14/79
0060 REM **************************************************
0070 REM *     THIS PROGRAM IS PART OF A GENERALIZED      *
0080 REM *   APPLICATION. COPYRIGHT WANG LABS INC. 1979   *
0090 REM **************************************************
0110 REM SYSTEM NAME      = GBS/MVP ACCOUNTS PAYABLE
0120 REM MODULE NAME      = OPEN ITEM & VENDOR UPDATE
0130 REM PROGRAM FUNCTION = THE PURPOSE OF THIS PROGRAM IS TO ALLOW FOR THE UP
     DATING OF THE OPEN ITEM & VENDOR FILE.
0140 REM **************************************************
0160 REM
0170     DIM A9$1,K9$Q0,N9$20
0171 REM
0172     DIM N2$(6)40
0198     GOTO 4000
3990 REM
3996 REM *******************************
3997 REM ! OPEN ITEM AND VENDOR UPDATE !
3998 REM *******************************
3999 REM
4000     SELECT @PART S0$
4080     B$(1)="O"
4090     PACK(##)STR(B$(1),2)FROM S2
4100     N2$()=ALL(FF)
4120     PRINT AT(4,0,80);"This program deletes all transactions that were sel
     ected for payment."
4130     Q6$="After this program, it will not be possible to reprint checks."O
     R ALL(80)
4140     PRINT Q6$
4150     GOSUB '100("Y,N","YyNn",1,1,"ARE YOU SURE YOU WANT TO RUN THIS PROGRA
     M (Y OR N)",2)
4160     IF Q9=2 THEN 5340
4320 REM GET DATE FROM CONTROL FILE
4340     GOSUB '66(6,0,1)
4350 REM --------------
4360 REM READ OPEN ITEM FILE RECORDS
4370     GOSUB '235(2,0)
4380     K9$ = STR(T7$,,Q0)
4390     PRINT AT(4,0,160);"Processing Vendor ID. ";K9$;HEX(06)
4400     GOTO 4450
4410 REM FINDNEXT
4420     GOSUB '237(2,0)
4430     N9$ = HEX(FF)
4440     IF Q$ = "E" THEN 4540
4450     N9$ = T7$
4460     Q6$ = "A/P OPEN ITEM FILE"
4470     IF Q$ = " " THEN 4480
4471 REM TERMINATE FOR KFAM ERROR
4472     GOSUB '91
4474     PRINT AT(1,0,80);"PROGRAM WILL BE TERMINATED";AT(3,16);"- ";Q6$
4476     GOSUB '254
4478     GOTO 5340
4480     A6 = Q
4490     GOSUB '71(4,A6)
4500     IF C5$(A6) <> "1" THEN 4420
4510 REM CHECK FOR VENDOR BREAK
4520     IF K9$ = C0$(A6) THEN 4730
4530 REM READ VENDOR RECORD
4540     IF A7 = 0 AND A8 = 0 THEN 4680
   : REM FIRST TIME THROUGH, OR '0' CHECK
4550     GOSUB '232(1,0,K9$)
4560     IF Q$ = " " THEN 4610
4570     PRINT AT(3,0,80);"Vendor ID. ";K9$;" is not in file";HEX(0607)
4580     GOSUB '254
4590     PRINT AT(1,0,240)
4600     GOTO 4680
4610     GOSUB '70(2)
4620     A3 = A3 + A8
4630     A2 = A2 - A7
4640     A0 = B8
4650     DBACKSPACE #2,1S
4660 REM WRITE UPDATED VENDOR RECORD
4670     GOSUB '60(2)
4680     A7,A8 = 0
4690 REM CHECK FOR END OF A/P FILE
4700     IF N9$ = HEX(FF) THEN 5230
4710     K9$ = C0$(A6)
4720     PRINT AT(4,0,80);"Processing Vendor ID. ";K9$;HEX(06)
4730     B8=MAX(A0,B5(Q),M(3))
   : REM DATE OF LAST PAYMENT
4740 REM CHANGE 'X' ==> 'P' PAYMENT ?
4750     IF C3$(A6) = "X" THEN IF B4$ = "1" OR B4(A6) > M(3) THEN 5160
4760     IF B1(A6) > 0 THEN 5030
   : REM IS THERE A PARTIAL PAYMENT ?
4770 REM -------------
4780 REM DELETE OPEN ITEM RECORD
4790     GOSUB '231(2,0,N9$)
4800     IF Q$ = " " THEN 4850
4810     PRINT AT(3,0,80);"Transaction ";N9$;" not on file"
4820     GOSUB '254
4830     PRINT AT(1,0,240)
4840     GOTO 4420
4850     A6 = Q
4860     Q9 = -B(A6)
4870     IF C3$(A6) = " " THEN Q9 = B(A6)
4880     IF C3$(A6) = "E" THEN Q9 = 0
4890     A7 = A7 + Q9
4900     A8 = A8 + ROUND((B(A6)*B0(A6)/100,2)
4910     D9 = D9 + ROUND((B(A6)*B0(A6)/100,2)
4920     B9 = B9 + Q9
4930     GOSUB '71(4,A6)
4940     DBACKSPACE #4,1S
4950     STR(C0$(A6),1,1) = HEX(FF)
4960     GOSUB '61(4,A6)
4970 REM WRITE TRANSACTION AUDIT FILE RECORD
4980     IF A9$ <> "F" THEN GOSUB 7040
4990     GOTO 4420
5000 REM -------------
5010 REM PARTIAL PAYMENT
5020 REM ADD TO TOTALS, CALCULATE NEW AMOUNT
5030     A7 = A7 + B1(A6)
5040     A8 = A8 + ROUND((B1(A6)*B0(A6)/100,2)
5050     D9 = D9 + ROUND((B1(A6)*B0(A6)/100,2)
5060     B9 = B9 + B1(A6)
5070     B(A6) = B(A6) - B1(A6)
5080 REM WRITE TRANSACTION AUDIT FILE RECORD, SET PARTIAL PAYMENT AMOUNT TO 0
5090     A9$ = "PARTIAL PAYMENT"
5100     IF A9$ <> "F" THEN GOSUB 7040
5110     B1(A6) = 0
5120     GOTO 5170
5130 REM -----------------
5140 REM EXTERNAL PAYMENT - TYPE 'X' BECOMES A 'P' PAYMENT
5150 REM THIS NOW BECOMES A P-PAYMENT
5160     C3$(A6) = "P"
5170     DBACKSPACE #4,1S
5180     GOSUB '61(4,A6)
5190     GOTO 4420
5200 REM -------------
5210 REM END PROGRAM, RETURN TO MENU
5230     GOSUB '66(6,0,1)
5240     M(3) = 0
5250     D8,M(2) = M(2) - B9
5260     F5$(2) = " "
5270     GOSUB '66(6,0,0)
5280     GOSUB '66(6,Q1,1)
5290     M(9) = D8
5300     M(3) = M(3) + B9
5310     M(8) = M(8) + D9
5320     GOSUB '66(6,Q1,0)
5330 REM CLOSE FILES
5340     DEFFN '31
5400     LOAD T M$
7000 REM ***************
7010 REM * SUBROUTINES *
7020 REM ***************
7030 REM WRITE TRANSACTION AUDIT FILE RECORD
7040     IF B1(A6) > 0 THEN Q9 = B1(A6)
   : ELSE Q9 = B(A6)
7050     A9 = A9 + 1
7054     Q8=Q0+VAL(Q0$(6))
7055     Q6$=HEX(A0)&BIN(Q8)&HEX(500350035003520552055001)
7060     $PACK(F=Q6$)N2$(A9)FROM STR(N9$,,Q8),B3(A6),B4(A6),B5(A6),Q9,ROUND((B
     0(A6)*Q9/100,2),SGN(B1(A6))
7070     IF A9 < 4 THEN RETURN
7080     N1$()=N2$()
7090     GOSUB '48(5)
7100     N2$() = ALL(FF)
7110     A9 = 0
7120     IF Q9 < .99 THEN RETURN
7130     PRINT AT(3,0,80);"Transaction Audit File is full - remaining update r
     ecords will be lost"
7140     GOSUB '254
7150     A9$ = "F"
7160     RETURN
9000 REM *************
9010 REM * VARIABLES *
9020 REM *************
9030 REM  A6  =  RECORD NUMBER - A/P OPEN ITEM FILE
9040 REM  A7  =  TRANSACTION TOTAL - CURRENT VENDOR
9050 REM  A8  =  DISCOUNTS TAKEN - CURRENT VENDOR
9060 REM  A9  =  RECORD NUMBER - TRANSACTION AUDIT FILE
9070 REM  D9  =  WORK FIELD FOR YTD DISCOUNTS TAKEN
9080 REM A9$  =  AUDIT FILE FULL INDICATOR
9090 REM K9$  =  CURRENT VENDOR ID.
9100 REM N9$  =  CURRENT A/P OPEN ITEM KEY
9110 REM $
9999 DEFFN'29"Q6$=";HEX(22);"ACPA120A";HEX(22);":SCRATCHTQ6$:SAVET()Q6$";HEX(0
     D)