image of READY prompt

Wang2200.org

Listing of file='SALE010A' on disk='vmedia/701-2616C.wvd.zip'

# Sector 719, program filename = 'SALE010A'
0010 REM SALE010A, 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 & MODULE   =  GBS/MVP SALES SYSTEM, PRINT/DISPLAY SALESMAN
0040 REM PROGRAM FUNCTION  =  DISPLAY AND/OR PRINT THE SALESMAN MASTER FILE
0050 REM DATE WRITTEN      =  07/04)79 CC
0060 REM LAST REVISION     =  08/12/79 MK
0070 REM ---------------------------------------------------------------------
     --
0170     DIM A6$1,B6$1
0172     DIM K$1,K1$Q0,K2$Q0,K3$17
3990 REM
3996 REM **************************************
3997 REM ! SALESMAN MASTER FILE PRINT/DISPLAY !
3998 REM **************************************
3999 REM
4000     SELECT @PART S0$
4010 REM %PROGRAM CONSTANTS
4020     K2$=ALL(FF)
4030     A6$="N"
4040     B6$="Y"
4050     K,P1=0
4060     L=L0
4070     C6,C7,C8,C9,F6,F7,F8,F9=0
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
   : REM RELEASE PRINTER
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 5160
   : REM NO PRINT, NO DISPLAY?
4220 REM %CHOOSE INQUIRY TYPE
4230     PRINT AT(5,0,)
4240     GOSUB '100("A,R,I","AaIiRr",1,1,"ENTER INQUIRY TYPE  (A=ALL, R=RANGE,
      I=INDIVIDUAL)",2)
4250     IF Q6$=HEX(1F) THEN GOSUB '31
4260     K$=Q6$
4270     Q6$="ALL       RANGE     INDIVIDUAL"
4280     K3$=STR(Q6$,Q9*10-9,10)
4290     K3$=K3$&" OPTION"
   : REM INITIALIZE CAPTION
4300     ON Q9GOTO ,4460,4370
   : REM BRANCH ON INQUIRY TYPE
4310 REM %ALL OPTION
4320     GOSUB '235(1,0)
   : REM ALL OPTION => FIND FIRST
4330     GOSUB '91
4340     ON J0+1 GOTO 4600,,,,,,,4000
4350     GOTO 5220
4360 REM %INDIVIDUAL OPTION
4370     GOSUB '34(HEX(08))
   : REM ACQUIRE INDIVIDUAL ID
4380     IF Q6$="END"THEN 5040
4390     K1$,K2$=Q6$
4400     GOSUB '232(1,0,K1$)
   : REM INDIVIDUAL => FIND OLD
4410     GOSUB '91
   : REM KFAM ERROR PROCESSING
4420     ON J0+1 GOTO 4600,,,4370,,,,4370
4430     GOTO 5220
4440 REM %RANGE OPTION
4450     PRINT AT(3,0,80);"Starting ID must be lower than Ending ID.";HEX(07)
4460     C6,C7,C8,C9=0
4470     L=L0
4480     GOSUB '34("STARTING")
   : REM ACQUIRE STARTING ID
4490     IF Q6$="END"THEN 5040
4500     K1$=Q6$
4510     GOSUB '34("ENDING")
   : REM ACQUIRE ENDING ID
4520     K2$=ALL(FF)
4530     IF Q6$<>"END"THEN K2$=Q6$
4540     IF K1$>K2$ THEN 4450
   : REM STARTING ID > ENDING ID?
4550     GOSUB '232(1,0,K1$)
   : REM RANGE => STARTING POS.
4560     J$(3)=" "
4570     GOSUB '91
4580     ON J0 GOTO ,,4830,,,,4000
4590     IF J0>0 THEN 5220
4600     GOSUB '53(2)
   : REM READ SALESMAN RECORD
4610     IF E$>K2$THEN 4780
   : REM OUT-OF-RANGE CHECK
4620     K=K+1
   : REM NO. OF RECORDS PROCESSED
4630 REM ACCUMULATE TOTALS
4640     C6=C6+G
4650     C7=C7+G2
4660     C8=C8+G1+G
4670     C9=C9+G3+G2
4680     F6=F6+G
4690     F7=F7+G2
4700     F8=F8+G1+G
4710     F9=F9+G3+G2
4720 REM %DISPLAY/PRINT RECORD
4730     PRINT AT(5,0,)
4740     IF B6$="Y"THEN GOSUB '37(G,G2,G1+G,G2+G3)
   : ELSE PRINT "Processing record ID ";T7$
4750     IF A6$="Y"THEN GOSUB '90
4760     IF A6$="Y"THEN GOSUB '38(G,G2,G+G1,G2+G3)
4770     SELECT PRINT 005(80)
4780     IF K$="I"THEN 4370
   : REM ANOTHER INDIVIDUAL?
4790     IF E$>=K2$THEN 4910
   : REM END OF RANGE?
4800     IF B6$="Y"THEN GOSUB '254
   : REM PAUSE AFTER EACH SCREEN
4810     IF Q6$=HEX(1F)THEN GOSUB '31
4820 REM %PROCESS NEXT RECORD
4830     IF J0=7 THEN GOSUB '92
4840     GOSUB '237(1,0)
   : REM ALL/RANGE => FIND NEXT
4850     IF Q$=" " THEN 4600
4860     IF Q$="E" THEN 4910
4870     GOSUB '91
4880     IF J0=7THEN 4830
   : REM RECORD BUSY?
4890     GOTO 5220
   : REM FATAL KFAM ERROR
4900 REM %PRINT TOTALS
4910     IF A6$="N"AND K$="R"THEN 4460
   : REM ANOTHER RANGE?
4920     IF K$<>"R"THEN 5040
   : REM PRINT RANGE TOTALS?
4930     L=L+4
4940     GOSUB '90
4950     PRINT HEX(0A)
4960     E$,E2$=" "
4970     E1$="RANGE TOTAL"
4980     GOSUB '90
4990     GOSUB '38(C6,C7,C8,C9)
5000     PRINT HEX(0A)
5010     IF K>0 THEN PRINT "NO. OF RECORDS PROCESSED = ";K
5020     SELECT PRINT 005(80)
5030     GOTO 4460
5040     IF A6$="N" THEN 5160
5050     SELECT PRINT <I0$>(132)
5060     PRINT HEX(0A)
5070     L=L+3
5080     GOSUB '90
5090     PRINT HEX(0A)
5100     E$,E2$=" "
5110     E1$="FINAL TOTAL"
5120     GOSUB '90
5130     GOSUB '38(F6,F7,F8,F9)
5140     PRINT HEX(0C)
5150 REM %RESTART/MENU
5160     SELECT PRINT 005(80)
5170     PRINT AT(1,0,)
5180     GOSUB '100("M,R","MmRr",1,1,"ENTER R TO RESTART, M FOR MENU",2)
5190     IF Q6$="R"THEN 4000
5200     J0=0
5210 REM %END OF PROGRAM
5220     DEFFN '31
5230     IF J0>0 THEN GOSUB '254
5240     LOAD TM$
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
6110     PRINT K3$;TAB(56);"SALESMAN MASTER FILE";TAB(110);Q1$;TAB(122);"PAGE
     ";P1
6120     PRINT HEX(0A)
6130     PRINT TAB(42);"----------- CURRENT MONTH -----------";TAB(88);"------
     ------ YEAR TO DATE ------------"
6140     PRINT "SLSM ID";TAB(Q0+5),;"NAME";TAB(34);"TERR";TAB(47);"SALES";TAB(
     64);"COST";TAB(74);"MARGIN";TAB(93);"SALES";TAB(110);"COST";TAB(120);"MAR
     GIN"
6150     PRINT HEX(0A)
6160     L=7
6170     RETURN
6180 REM %ACQUIRE FILE ID
6190     DEFFN'34(Q7$)
6200     IF B6$="N" THEN PRINT AT(5,0,80)
6210     PRINT AT(1,0,80);"ENTER ";Q7$;" SALESMAN ID (OR END)"
6220     GOSUB '100(" ",HEX(7F),Q0,0," ",2)
6230     IF Q6$=HEX(1F) THEN GOSUB '31
6240     IF Q6$="end" THEN Q6$="END"
6250     IF Q6$="END"THEN RETURN
6260     GOSUB '96(3)
   : REM CONSTRUCT FILE ID
6270     RETURN
6280     %###,###.##-
6290     %###.##-
6300 REM %SCREEN DISPLAY
6310     DEFFN'37(D6,D7,D8,D9)
6320     PRINT AT(4,0,)
6330     GOSUB '39(D6,D7,D8,D9)
6340     PRINT "SLSM ID";TAB(Q0+7);"NAME";TAB(Q0+33);"TERRITORY"
6350     PRINT E$;TAB(Q0+7);E1$;TAB(Q0+33);E2$
6360     PRINT HEX(0A)
6370     PRINT "------- CURRENT MONTH --------";TAB(32);"-------- YEAR TO DATE
      --------"
6380     PRINT TAB(5);"SALES";TAB(18);"COST";TAB(24);"MARGIN";TAB(37);"SALES";
     TAB(50);"COST";TAB(56);"MARGIN"
6390     PRINTUSING 6280 , D6;
6400     PRINT TAB(12);
6410     PRINTUSING 6280 , D7;
6420     PRINT TAB(24);
6430     PRINTUSING 6290 , A6;
6440     PRINT TAB(32);
6450     PRINTUSING 6280 , D8;
6460     PRINT TAB(44);
6470     PRINTUSING 6280 , D9;
6480     PRINT TAB(56);
6490     PRINTUSING 6290 , A7
6500     RETURN
6510 REM %HARDCOPY REPORT
6520     DEFFN'38(D6,D7,D8,D9)
6530     GOSUB '39(D6,D7,D8,D9)
6540     PRINT E$;TAB(Q0+5);STR(E1$,,MIN(24-Q0,LEN(E1$)));TAB(34);E2$;TAB(42);
6550 REM CURRENT MONTH
6560     IF D6 <>0 THEN PRINTUSING 6280, D6;
6570     PRINT TAB(58);
6580     IF D7 <>0 THEN PRINTUSING 6280, D7;
6590     PRINT TAB(74);
6600     IF A6 <>0 THEN PRINTUSING 6290, A6;
6610 REM YEAR TO DATE
6620     PRINT TAB(88);
6630     IF D8<>0 THEN PRINTUSING 6280, D8;
6640     PRINT TAB(104);
6650     IF D9<>0 THEN PRINTUSING 6280, D9;
6660     PRINT TAB(120);
6670     IF A7<>0 THEN PRINTUSING 6290, A7
   : ELSE PRINT
6680 REM
6690     L=L+1
6700     SELECT PRINT 005(80)
6710     RETURN
6720 REM
6730 REM COMPUTE MARGINS
6740     DEFFN'39(D6,D7,D8,D9)
6750     A6,A7=0
6760     IF D7<>0 THEN A6=ROUND((D6/D7*100-100,2)
6770     IF D9<>0 THEN A7=ROUND((D8/D9*100-100,2)
6780     RETURN
9000 REM %VARIABLES
9010 REM A6$  = PRINT REPORT?
9020 REM B6$  = SCREEN DISPLAY?
9030 REM   K  = NO. OF RECORDS - RANGE TOTAL
9040 REM  K$  = INQUIRY TYPE
9050 REM K1$  = STARTING SALESMAN ID
9060 REM K2$  = ENDING SALESMAN ID
9070 REM K3$  = OPTION CAPTION
9080 REM  Q0  = LENGTH OF RECORD ID
9090 REM $
9996 DEFFN'29"Q$=";HEX(22);"SALE010A";HEX(22);":SCRATCH TQ$:SAVE T$()Q$";HEX(0
     D)
9998 DEFFN'30"DIM Z$57:IF STR(I0$,,1)=HEX(20)THENI0$=HEX(323135):Z$=";HEX(22);
     "GBS/MVP - Print/display salesman master file.";HEX(22);":SELECT#15<I0$>:
     $OPEN#15:SELECTLIST<I0$>(132): LIST Z$:LIST Z$#:LIST Z$V:LIST Z$':$CLOSE#
     15:SELECTLIST005(80)";HEX(0D)