image of READY prompt

Wang2200.org

Listing of file='ACCTMENU' on disk='vmedia/701-2661A.wvd.zip'

# Sector 527, program filename = 'ACCTMENU'
0010 REM ACCTMENU, RELEASE 2.0,INV.MGT.,(06/01/79) THIS PROGRAM IS A COPYRIGHT
      PRODUCT OF WANG LABORATORIES INC. UNAUTHORIZED REPRODUCTION OR USE IS PR
     OHIBITED
0170 COM I,Q,M5$,M0,N0,O0,M$8
   : COM Q$(2)80,Q6$80,Q7$80
   : COM Q2,Q3,Q4,Q5,Q6,Q7,Q8,Q9
   : COM M2$4,M3$1,M(17)
4000 DIM A6$(32)31
   : N=17
   : I=42
   : Q9=38+VAL(Q0$(1))
   : M0=INT(253/Q9)
   : Q9=43+VAL(Q0$(2))
   : N0=INT((248-6)/Q9)
   : Q9=49+VAL(Q0$(2))
   : O0=INT((248-4)/Q9)
   : Q0=VAL(Q0$(1))-1
   : IF M$="SYS MENU"THEN M5$=" "
   : M$="ACCTMENU"
   : Q7$="GBS/MVP INVOICING & ACCOUNTS RECEIVABLE SYSTEM"
   : STR(Q7$,47)="SYSTEM MENU"
4130 LOAD T"GBS MENU"10,4130
   : ERRORPRINT HEX(03);"GBS Menu is not available."
   : END
7010 DEFFN'32
   : Q6$="SYS MENU"
   : COM CLEAR I
   : LOAD TQ6$
   : ERRORPRINT HEX(03);"System menu is not available."
   : END
7060 DEFFN'38
   : Q6$=ALL("0")
   : STR(M5$,7,1)=STR(Q6$,S+1,1)
   : RETURN
7110 DEFFN'39
   : IF M5$="SALE010A"OR M5$="SALE020A"THEN Q0=VAL(Q0$(3))
   : IF M5$="INVC030A"THEN Q0=VAL(Q0$(2))
   : Q6$="A/RCONT"
   : LOAD TQ6$199,199BEG 7160
   : ERRORGOSUB '33
7160 V7$="GBS1F010"
   : GOSUB '97
   : MAT SEARCHA6$(),=STR(V7$,,7)TO Q6$STEP 11
   : Q9=INT((VAL(Q6$,2)+10)/11)
   : Q6$="A/R Control file"
   : Q7$="(Filename is not in company control file)."
   : IF Q9=0THEN GOSUB '33
   : Q7$=" "
   : SELECT #1<STR(A6$(Q9),9,3)>
   : DATA LOAD DC OPEN T#1,STR(A6$(Q9),,8)
   : ERRORGOSUB '33
7260 SELECT @PARTS0$
   : M2$=HEX(A0015206)
   : GOSUB '46(1,0,1)
   : DATA SAVE DC CLOSE#1
   : M2$=ALL(00)
   : MAT SEARCH"INVC040 INVC050 ACCT050 ACCT060 GBS1020 INVC020 SALE020 INVC01
     0 SALE010 ACCT010 ACCT080 GBS1010",=STR(M5$,,7)TO M2$
   : IF M2$>HEX(0000)THEN GOSUB '98
   : MAT SEARCH"INVC030 ACCT040 ACCT030",=STR(M5$,,7)TO M2$
7360 IF M2$>HEX(0000)THEN 7540
   : IF M5$="OREN120A"THEN 7540
   : IF M5$<>"ACCT070A"THEN GOSUB '98
   : IF M3$="1"THEN GOSUB '98
   : Q6$="Purge is in progress."
   : IF M3$="2"THEN 7560
   : Q6$="End of month aging must precede purge process."
   : GOTO 7560
7460 Q6$="Old"
   : Q9=6
   : IF M(11)=0THEN Q9=13
   : IF M(Q9)*M(Q9+1)*M(Q9+2)=1THEN GOSUB '98
   : IF M(Q9)=0THEN Q6$=Q6$&", Invoices"
   : IF M(Q9+1)=0THEN Q6$=Q6$&", Invoice Register"
   : IF M(Q9+2)=0THEN Q6$=Q6$&", Shipping Register"
   : STR(Q6$,4)=STR(Q6$,5)
   : Q6$=Q6$&" must be printed before posting"
   : GOTO 7560
7540 IF M3$=" "THEN GOSUB '98
   : IF M3$<>"2"THEN 7610
7560 PRINT HEX(030D0A07);Q6$
   : Q6$=" "
   : LINPUT "Key 'RETURN' to resume.",?STR(Q6$,,1)
   : Q6$=" "
   : GOSUB '33
7610 PRINT HEX(030D0A);"End of month aging completed, purge should be run next
     .";HEX(0D0A);"Is ";Q$();" still desired (Y or N)";
   : Q6$="N"
   : LINPUT ?STR(Q6$,,1)
   : $TRAN(Q6$,"Yy n N")R
   : IF Q6$=" "THEN GOSUB '33
   : IF Q6$<>"Y"THEN 7610
   : GOSUB '98
7830 DATA "INVC030A","ENTER INVOICES","KFAMCODESUBUTIL SUBDATE DENTRY  CUSFILE
      INVFILE TRNFILE AUDIFILEA/RCONT PRNTAVAL"
   : DATA 4,"INVCF01 315 INVTF01 313 INVCF02 311 INVTF03 317 GBS1F01 309 AUDIF
     01 30A"
7850 DATA "INVC040A","PRINT INVOICE REGISTER","KFAMCODESUBUTIL DENTRY  TRNFILE
      A/RCONT PRNTAVAL"
   : DATA 2,"INVCF02 211 INVCF03 212 GBS1F01 303"
   : DATA "INVC050A","PRINT INVOICES","KFAMCODESUBUTIL DENTRY  TRNFILE A/RCONT
      PRNTAVAL"
7880 DATA 2,"INVCF02 211 INVCF03 212 GBS1F01 303"
   : DATA "OREN120A","POST INVOICES","KFAMCODESUBUTIL SUBDATE DENTRY  CUSFILE
     OPNFILE INVFILE SLSFILE TRNFILE ORDFILE AUDIFILETRAUFILEA/RCONT"
7900 DATA 6,"ORENF05 409 INVCF02 411 ORENF01 313 INVCF01 314 ACCTF01 315 SALEF
     01 316 INVTF01 317 INVCF03 402 GBS1F01 308 ORENF04 40A AUDIF01 30B"
7910 DATA "ACCT040A","AGE A/R & CALCULATE SERVICE CHARGES","KFAMCODESUBUTIL SU
     BDATE DENTRY  CUSFILE OPNFILE SOPFILE TRAUFILEA/RCONT"
   : DATA 2,"ACCTF01 414 INVCF01 116 AUDIF02 407 GBS1F01 301 ACCTF02 402"
7930 DATA "ACCT050A","PRINT A/R STATEMENTS","KFAMCODESUBUTIL SUBDATE DENTRY  C
     USFILE SOPFILE A/RCONT PRNTAVAL"
   : DATA 1,"INVCF01 112 ACCTF02 203 "
   : DATA "ACCT060A","PRINT AGED TRIAL BALANCE","KFAMCODESUBUTIL SUBDATE DENTR
     Y  CUSFILE SOPFILE A/RCONT PRNTAVAL"
7960 DATA 1,"INVCF01 113 ACCTF02 201"
   : DATA "ACCT070A","PURGE OPEN ITEM FILE","KFAMCODESUBUTIL SUBDATE DENTRY  C
     USFILE OPNFILE SOPFILE TRAUFILEA/RCONT"
   : DATA 2,"ACCTF02 401 INVCF01 315 ACCTF01 412 GBS1F01 306 AUDIF02 407"
7990 DATA "GBS1220A","CLEAR FILES","SUBUTIL SUBDATE DENTRY  CUSFILE INVFILE SL
     SFILE A/RCONT"
   : DATA 0,"INVTF01 001 INVTK11 002 SORTWOR 003 SORTWOR 004 PROGRAM 005 PROGR
     AM 006 INVCK11 007 INVCF01 008 SALEK11 009 SALEF01 00A GBS1F01 00B FCSTK1
     1 00C FCSTF01 00D"
8010 DATA "INVC020A","MAINTAIN CUSTOMER FILE","KFAMCODESUBUTIL DENTRY  CUSFILE
      AUDIFILE"
   : DATA 1,"INVCF01 312 AUDIF01 303"
   : DATA "SALE020A","MAINTAIN SALESMAN FILE","KFAMCODESUBUTIL SUBDATE DENTRY
      SLSFILE AUDIFILE"
   : DATA 1,"SALEF01 312 AUDIF01 303"
8050 DATA "ACCT030A","ENTER CASH RECEIPTS","KFAMCODESUBUTIL SUBDATE DENTRY  CU
     SFILE OPNFILE TRAUFILEA/RCONT"
   : DATA 2,"INVCF01 315 ACCTF01 313 AUDIF02 306 GBS1F01 301"
   : DATA "INVC010A","DISPLAY/PRINT CUSTOMERS","KFAMCODESUBUTIL SUBDATE DENTRY
       CUSFILE PRNTAVAL"
8080 DATA 1,"INVCF01 112"
   : DATA "SALE010A","DISPLAY/PRINT SALESMEN","KFAMCODESUBUTIL SUBDATE DENTRY
      SLSFILE PRNTAVAL"
   : DATA 1,"SALEF01 312"
   : DATA "ACCT010A","DISPLAY/PRINT A/R OPEN ITEMS","KFAMCODESUBUTIL SUBDATE D
     ENTRY  CUSFILE OPNFILE PRNTAVAL"
8120 DATA 2,"ACCTF01 112 INVCF01 114"
   : DATA "ACCT080A","PRINT CREDIT REPORT","KFAMCODESUBUTIL SUBDATE DENTRY  CU
     SFILE PRNTAVAL"
   : DATA 1,"INVCF01 112"
   : DATA "GBS1010A","DISPLAY/PRINT CONTROL FILE","SUBUTIL SUBDATE DENTRY  A/R
     CONT PRNTAVAL"
   : DATA 1,"GBS1F01 101"
9998 DEFFN'29"Q$=";HEX(22);"ACCTMENU";HEX(22);":SCRATCHTQ$:SAVET$()Q$";HEX(0D)