image of READY prompt

Wang2200.org

Listing of file='ACPA050A' on disk='vmedia/701-2652C.wvd.zip'

# Sector 350, program filename = 'ACPA050A'
0010 REM ACPA050A, RELEASE 1-0, (01/31/79)   THIS PROGRAM IS A COPYRIGHT PRODU
     CT OF WANG LABORATORIES INC. UNAUTHORIZED REPRODUCTION OR USE IS PROHIBIT
     ED
0170 DIM A6$1,A9$12,K9$30,N9$Q0
   : GOTO 4000
4000 SELECT @PARTS0$
   : A6$="X"
   : GOSUB '66(5,0,1)
   : A6$=F5$(2)
4240 PRINT AT(4,0,);AT(5,21);"0 = RETURN TO MENU"
   : PRINT TAB(21);"1 = FILE BY DUE DATE"
   : PRINT TAB(21);"2 = VENDOR BY DUE DATE"
   : PRINT TAB(21);"3 = VENDOR BY INVOICE NO."
   : GOSUB '100("0","3",1,0,"ENTER OPTION DESIRED",1)
   : IF Q6$=HEX(1F)THEN Q9=0
   : O9=Q9
   : PRINT AT(4,0,)
   : ON Q9+1GOTO 6620,4360,4690,4690
4360 GOSUB '235(2,0)
   : PRINT AT(4,0,80);"PROCESSING VENDOR ID. ";HEX(06)
   : GOTO 4400
4390 GOSUB '237(2,0)
4400 N9$=STR(T7$,,Q0)
   : J$(1)=" "
   : GOSUB '91
   : IF J0=1AND O9=2THEN 4690
   : IF J0=1THEN 4240
   : ELSE IF J0>1THEN 5130
4450 GOSUB '71(4,Q)
   : A6=Q
   : IF STR(K9$,,Q0)=STR(N9$,,Q0)THEN 4600
   : IF O9=2THEN 4690
   : GOSUB '232(1,0,N9$)
   : A6$=" "
   : Q6$="VENDOR MASTER FILE"
   : IF Q$<>" "THEN 6560
   : GOSUB '70(2)
   : PRINT AT(4,23,Q0);N9$
4600 IF B4$>" "OR B4(A6)>M(3)THEN IF POS(" CP"=C3$(A6))<>0THEN C5$(A6)=" "
   : ELSE C5$(A6)="1"
   : DBACKSPACE #4,1S
   : GOSUB '61(4,A6)
   : A6$="1"
   : GOTO 4390
4690 GOSUB '100(" ",HEX(7F),Q0,0,"ENTER VENDOR ID. (OR END)",2)
   : IF Q6$="END"OR Q6$="end"OR Q6$=HEX(1F)THEN 4240
   : GOSUB '96(4)
   : N9$,K9$=Q6$
   : GOSUB '232(1,0,N9$)
   : GOSUB '91
   : IF J0<>0THEN 4690
   : GOSUB '70(2)
   : PRINT AT(4,0,80);"VENDOR ID. ";N9$
   : IF O9=3THEN 4960
   : GOSUB '232(2,0,K9$)
   : GOSUB '237(2,0)
   : J$(1)=" "
   : GOSUB '91
   : IF J0<>0THEN 4690
4910 IF STR(T7$,,Q0)=N9$THEN 4450
   : PRINT AT(3,0,80);HEX(07);"INVOICE NOT FOUND"
   : GOTO 4690
4960 PRINT AT(5,0,)
4970 GOSUB '100(" ",HEX(7F),VAL(Q0$(6)),0,"ENTER INVOICE NO. (OR END)",2)
   : IF Q6$="END"OR Q6$="end"OR Q6$=HEX(1F)THEN 6010
   : GOSUB '96(6)
   : STR(K9$,Q0+1)=Q6$
   : PRINT AT(4,0,)
   : GOSUB '232(2,0,K9$)
   : GOSUB '237(2,0)
   : J$(1),J$(3)="INVOICE NOT FOUND"
   : GOSUB '91
   : IF J0<>0THEN 4970
   : Q9=Q0+VAL(Q0$(6))
   : IF STR(K9$,1,Q9)=STR(T7$,1,Q9)THEN 5190
5130 Q7$="SEQUENCE ERROR IN OPEN ITEM FILE"
   : IF STR(T7$,1,Q9)<STR(K9$,1,Q9)THEN 6560
   : PRINT AT(3,0,80);HEX(07);"INVOICE NOT FOUND"
   : GOTO 4970
5190 GOSUB '71(4,Q)
   : A6=Q
   : A7=T6
   : Q9=POS(" CEPX"=C3$(A6))
   : IF Q9=0THEN 5130
   : Q6$="INVOICE         CREDIT MEMO     EXTERNAL PAYMENT"
   : IF Q9>3THEN Q9=3
   : Q6$=STR(Q6$,Q9*16-15,16)
   : PRINT AT(4,20,60);"INVOICE NO. - ";C1$(A6);"    *** ";Q6$;" ***"
5290 PRINTUSING "   P.O. NUMBER     ########     CHECK NO    ########",C4$(A6)
     ,B2(A6)
   : PRINTUSING "   GROSS AMOUNT  #,###,###.##   DISC %     ",B(A6);
   : IF ROUND((B0(A6),2)=B0(A6)THEN Q6$="##.##"
   : ELSE Q6$="##.########"
   : PRINTUSING Q6$,B0(A6)
   : GOSUB '123(B3(A6))
   : IF Q6$="E"THEN U9$,Q6$=" "
5350 PRINTUSING "   DISC AMOUNT   #,###,###.##   INV DATE    ########",ROUND((
     B(A6)*B0(A6)/100,2),U9$
   : IF B4(A6)<>99999THEN GOSUB '123(B4(A6))
   : ELSE U9$="HOLD"
   : IF Q6$="E"THEN U9$,Q6$=" "
   : PRINTUSING "   NET AMOUNT    #,###,###.##   DUE DATE    ########",B(A6)-R
     OUND((B(A6)*B0(A6)/100,2),U9$
   : GOSUB '123(B5(A6))
5400 IF Q6$="E"THEN U9$,Q6$=" "
   : PRINTUSING "   PART PYMT AMT #,###,###.##   DATE PAID   ########",B1(A6),
     U9$
   : GOSUB '237(2,0)
   : A8=Q
   : A9=T6
   : J$(1)=" "
   : GOSUB '91
   : Q9=Q0+VAL(Q0$(6))
   : IF J0=0AND STR(T7$,1,Q9)=STR(K9$,1,Q9)THEN J9=1
   : ELSE J9=0
   : IF J9=1THEN PRINT AT(10,0,80);"*** MORE INVOICES FOLLOW ***"
   : ELSE PRINT AT(10,0,80)
5500 C5$(A6)=" "
   : IF C3$(A6)=" "THEN 5600
   : GOSUB '100("Y,N","Y YyNn",1,1,"DO YOU WISH TO SELECT THIS TRANSACTION FOR
      PAYMENT (Y OR N)",2)
   : IF Q6$="Y"THEN GOTO 5870
   : ELSE GOTO 5890
5600 GOSUB '100("Y,N","Y YyNn",1,1,"IS THIS INVOICE TO BE PAID (Y OR N)",2)
   : IF Q6$="Y"THEN 5670
   : ELSE GOTO 5890
5670 GOSUB '100("Y,N","Y YyNn",1,1,"DO YOU WISH TO CHANGE THE PARTIAL PAYMENT
     AMOUNT (Y OR N)",2)
   : IF Q6$="Y"THEN 5730
   : ELSE GOTO 5870
5730 GOSUB '100("0","9999999.99",7,2,"ENTER PARTIAL PAYMENT AMOUNT",1)
   : IF Q9<B(A6)THEN 5770
   : PRINT AT(3,0,80);HEX(07);"Partial payment amount must be less than gross
     amount"
   : GOTO 5730
5770 B1(A6)=Q9
   : PRINT AT(9,0,0)
   : PRINTUSING "   PART PYMT AMT #,###,###.##",B1(A6)
   : GOSUB '100("Y,N","Y YyNn",1,1,"IS ENTRY OK (Y OR N)",2)
   : IF Q6$="Y"THEN 5870
   : ELSE GOTO 5600
5870 C5$(A6)="1"
5890 A6$=" "
   : DBACKSPACE #4,BEG
   : DSKIP #4,A7S
   : GOSUB '61(4,A6)
   : IF J9=0THEN 4970
   : DBACKSPACE #4,BEG
   : DSKIP #4,A9S
   : Q=A8
   : T6=A9
   : GOTO 5190
6010 GOSUB '100("Y,N","Y YyNn",1,1,"ACCEPT THIS VENDOR'S ENTRIES (Y OR N)",2)
   : D8,D9=0
   : IF Q6$="N"OR Q6$=HEX(1F)THEN 6370
   : GOSUB '232(2,0,N9$)
6090 GOSUB '237(2,0)
   : J$(1)=" "
   : GOSUB '91
   : IF J0>1THEN 5130
   : IF J0=1OR STR(T7$,,Q0)<>N9$THEN 6230
   : GOSUB '71(4,Q)
   : Q6$=C3$(Q)
   : IF C5$(Q)<>"1"THEN 6090
   : IF Q6$=" "THEN Q9=1
   : ELSE Q9=-1
   : IF B1(Q)<>0THEN Q6=B1(Q)
   : ELSE Q6=B(Q)
   : D9=D9+Q6*Q9*SGN(POS(" CPX"=Q6$))
   : D8=D8+ROUND((B0(Q)*Q6/100,2)*Q9*SGN(POS(" PX"=Q6$))
   : GOTO 6090
6230 Q6$=" "
   : IF D9-D8<0THEN Q6$="CREDIT BALANCE FOR ITEMS SELECTED"
   : IF D9-D8>A2THEN Q6$="VENDOR ENTRIES SELECTED EXCEED VENDOR BALANCE."
   : IF B4$="1"THEN B4$="2"
   : IF Q6$=" "THEN 6500
   : IF B4$="2"THEN B4$="1"
   : PRINT AT(3,0,80);HEX(07);Q6$
6300 GOSUB '100("V,A","VvAa",1,1,"ENTER V = VOID, OR A = ADDITIONAL ENTRIES",2
     )
   : IF Q6$="A"THEN 4970
6370 GOSUB '232(2,0,N9$)
6380 GOSUB '237(2,0)
   : J$(1)=" "
   : GOSUB '91
   : IF J0>1THEN 5130
   : IF J0=1OR STR(T7$,,Q0)<>N9$THEN 6500
   : GOSUB '71(4,Q)
   : DBACKSPACE #4,1S
   : C5$(Q)=" "
   : GOSUB '61(4,Q)
   : PRINT AT(4,20,60);"INVOICE NO. - ";C1$(Q);" WILL NOT BE PAID"
   : GOTO 6380
6500 DBACKSPACE #2,1S
   : A6$="1"
   : GOSUB '60(2)
   : GOTO 4690
6560 GOSUB '91
   : PRINT AT(1,0,80);"PROGRAM WILL BE TERMINATED - ";Q7$;AT(3,16);"- ";Q6$
   : GOSUB '254
6620 DEFFN'31
   : IF A6$="X"THEN 6740
   : $OPEN #5
   : GOSUB '66(5,0,1)
   : F5$(2)=A6$
   : GOSUB '66(5,0,0)
   : $CLOSE#5
6740 LOAD TM$
9999 DEFFN'29"Q$= ";HEX(22);"ACPA050A";HEX(22);":SCRATCH T Q$:SAVE T$()Q$";HEX
     (0D)