home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / cpmug / cpmug045.ark / P_R330.BAS < prev    next >
Encoding:
BASIC Source File  |  1984-04-29  |  5.3 KB  |  174 lines
  1.     REMARK    **********************************\
  2.         *  P/R330.BAS         JOB CLOSE  *\
  3.         *  5/09/79             10:00 AM  *\
  4.         **********************************
  5.  
  6. %INCLUDE CURSOR
  7.  
  8.     DIM W(2),W1(2),W2(14),W2$(2),G3(5),G2$(5),JOB.GRID(2,25),K(14),R(14)
  9.  
  10.     DEF FNR(A1)=INT(A1*100+.5)/100                    REMARK  ROUNDING FUNCTION
  11.  
  12.     DEF FNEXACT(M1,M2)=M1*1000+M2                    REMARK  KEY LOCATOR FUNCTION
  13.  
  14.     GOTO 6000
  15.  
  16. %INCLUDE SUBS1
  17. %INCLUDE GENINFO
  18. %INCLUDE PR-SEARC
  19. %INCLUDE JOBFILE
  20.  
  21. 5300    W2$(1)="1"                             REMARK  SET AN ACTIVE JOB TO 'COMPLETE' STATUS
  22.     W1(2)=G3(1)
  23.     X0=L
  24.     GOSUB 1110 
  25.     RETURN 
  26.  
  27. 5310    W2$(1)="9"                            REMARK  SET ANY JOB TO 'CANCELLED' STATUS
  28.     X0=L
  29.     GOSUB 1110
  30.     RETURN 
  31.  
  32. 5320    W2$(1)="9"                             REMARK  CANCEL AND REDISTRIBUTE AMONG LIKE JOBS
  33.     X0=L
  34.     GOSUB 1110                             REMARK  REWRITE HEADER WITH 'CANCELLED' STATUS
  35.     J$=W2$(2)
  36.  
  37. 5325    L=L+1                                REMARK  READ EACH DETAIL RECORD, ACCUMULATING COST AMOUNTS
  38.     X0=L
  39.     IF X0 > JOB.RECORDS THEN GOTO 5340
  40.     GOSUB 1100 
  41.     IF W(1)=JOB.GRID(1,J%)\                        REMARK  IF NOT A NEW JOB, KEEP ADDING TO DISTRIBUTION TOTAL
  42.     THEN\
  43.     FOR I%=1 TO 14:\
  44.     K(I%)=K(I%)+W2(I%):\
  45.     R(I%)=R(I%)+W2(I%):\
  46.     NEXT I%:\
  47.     GOTO 5325
  48.  
  49. 5340    FILE.POINTER% = 1
  50.     X0=1
  51.     GOSUB 1100
  52. 5350    IF W(2)<>0 THEN\                        REMARK  PRINT ERROR MESSAGE IF NO HEADER RECORD WAS FOUND
  53.     LPRINTER:\
  54.     PRINT "NO HEADER ON JOB";W(1):\
  55.     RETURN
  56.  
  57.     Z=W(1)                                 REMARK  SET CURRENT JOB NUMBER TO NEW JOB NUMBER
  58.  
  59. 5370    FILE.POINTER%=FILE.POINTER%+1
  60.     IF FILE.POINTER% > JOB.RECORDS THEN GOTO 5400
  61.     X0=FILE.POINTER%:GOSUB 1100
  62.     IF W(1)<>Z  THEN 5350
  63.     IF W2$(1)="9" OR W2$(1)="D" THEN GOTO 5370            REMARK  IF JOB IS CANCELLED, DELETED, NOT THE SAME TYPE
  64.     IF JOB.GRID(2,J)=4 AND W2$(2)<>J$ THEN GOTO 5370        REMARK  OR A NON-OVERHEAD JOB, DO NOT ACCUMULATE IT
  65.     IF JOB.GRID(2,J)=3 AND W2$(2) < "2" THEN GOTO 5370
  66.  
  67.     IF W2(3)=-1 THEN GOTO 5370
  68.  
  69.     FOR I%=1 TO 14                             REMARK  ACCUMULATE TOTAL FOR REDISTRIBUTION
  70.     R(I%)=R(I%)+W2(I%) 
  71.     NEXT I%
  72.     GOTO 5370
  73.  
  74. 5400    FILE.POINTER%=1:X0=FILE.POINTER%                    REMARK  GO BACK THROUGH THE FILE TO PRO-RATE JOBS
  75.     GOSUB 1100
  76.     IF W(2)<>0 THEN GOSUB 5350
  77.  
  78. 5410    Z=W(1) 
  79.     IF W2$(1)="9" OR W2$(1)="D" THEN GOTO 5440            REMARK  IF JOB IS DELETED, CANCELLED, NOT SAME TYPE
  80.     IF JOB.GRID(2,J)=4 AND W2$(2)<>J$ THEN GOTO 5440        REMARK  OR NON-OVERHEAD, PRO-RATE NO FUNDS TO IT
  81.     IF JOB.GRID(2,J)=3 AND W2$(2)<"2" THEN GOTO 5440
  82.  
  83. 5425    FILE.POINTER%=FILE.POINTER% + 1                    REMARK  READ SEQUENTIALLY THROUGH JOB FILE
  84.     X0=FILE.POINTER%
  85.     IF X0>JOB.RECORDS THEN RETURN
  86.     GOSUB 1100
  87.     IF W(1)<>Z  THEN 5410                        REMARK  IF NEW JOB WAS JUST READ, BRANCH BACK TO CHECK IT
  88.  
  89. 5435    FOR I%=1 TO 14 
  90.     IF R(I%)>0 THEN W2(I%)=W2(I%)+FNR(W2(I%)/R(I%)*K(I%)) 
  91. 5437    NEXT I%
  92.     X0=FILE.POINTER%:GOSUB 1110                    REMARK  REWRITE JOB DETAIL RECORD WITH PRORATED TOTALS
  93.     GOTO 5425
  94.  
  95. 5440    FILE.POINTER%=FILE.POINTER% + 1                    REMARK  READ THROUGH INELIGIBLE JOBS
  96.     X0=FILE.POINTER%
  97.     IF X0>JOB.RECORDS THEN RETURN
  98.     GOSUB 1100
  99.     IF W(1)=Z  THEN 5440 
  100.     GOTO 5410
  101.  
  102.  
  103. 6000    Y9=2
  104.     Y6=1:Y2=Y6
  105.     CTRL.C%=1
  106.     OPEN "JOB0F100.DAT" RECL 160 AS 1,\
  107.     "G/I0F010.DAT" RECL 200 AS 2,\                    REMARK  OPEN DATA FILES
  108.     "CRT" RECL 1100 AS 19
  109.     GOSUB 700                            REMARK  LOAD GENERAL INFORMATION FILE
  110.     RECORD.COUNT=JOB.RECORDS
  111.  
  112.  
  113. 6015    X0=16:GOSUB 260                            REMARK  DISPLAY CRT MASK FOR JOB CLOSE
  114.  
  115. 6020    FOR J%=1 TO 25                             REMARK  ENTER GRID OF JOB NUMBERS AND ACTION CODES
  116.  
  117.     Z=375+INT((J%-1)/5)*4+12*J%
  118. 6025    X1=Z:X2=6:X3=0:X4=999999:GOSUB 345                REMARK  ENTER JOB NUMBER
  119.     IF X%=3 THEN GOTO 6120                        REMARK  IF CTRL-C WAS DEPRESSED, EXIT PROGRAM
  120.     IF X0=0 THEN 6045                        REMARK  END ROUTINE IF ZERO ENTERED
  121.     JOB.GRID(1,J%)=X0 
  122.  
  123. 6030    K=FNEXACT(JOB.GRID(1,J%),0)                    REMARK  SEARCH FOR A VALID JOB HEADER
  124.     GOSUB 1060
  125.     IF H <> -1 THEN X0=L:GOSUB 1100                    REMARK  IF A VALID JOB WAS NOT FOUND, REJECT IT
  126.     IF H=-1 OR W2$(1)="D"\
  127.     THEN\
  128.     X2$="NOT ON FILE":GOSUB 615:\
  129.     GOTO 6025
  130.  
  131.  
  132.     X1=Z+9:X2=1:X3=0:X4=4:GOSUB 345                    REMARK  ENTER ACTION CODE
  133.     JOB.GRID(2,J%)=X0
  134. 6040    NEXT J%
  135.  
  136. 6045    X2=1:X3=0:X4=5:X2$="ENTER ROW  TO CHANGE (0=NONE)":GOSUB 665    REMARK  PROMPT OPERATOR FOR CHANGES TO GRID
  137.     IF X0=0  THEN 6100                         REMARK  IF FIELD ENTERED=0, START PROCESSING
  138.     I%=X0
  139. 6050    X2=1:X3=1:X4=5:X2$="ENTER COLUMN  TO CHANGE":GOSUB 665        REMARK  PROMPT OPERATOR FOR COLUMN TO CHANGE ON GRID
  140.     J%=X0  
  141.     Z=311+I%*64+J%*12
  142.  
  143. 6055    X1=Z:X2=6:X3=0:X4=999999:GOSUB 345                REMARK  ENTER NEW JOB NUMBER
  144.     JOB.GRID(1,J%+(I%-1)*5)=X0 
  145.  
  146. 6060    K=FNEXACT(X0,0):GOSUB 1060                    REMARK  CHECK JOB FILE FOR A VALID ENTRY
  147.     IF H<>-1 THEN X0=L:GOSUB 1100
  148.     IF H=-1 OR W2$(1) = "D"\                    REMARK  IF AN INVALID JOB NUMBER WAS ENTERED, REJECT IT
  149.     THEN\
  150.     X2$="NOT ON FILE":GOSUB 615:\
  151.     GOTO 6055
  152.  
  153. 6070    X1=Z+9:X2=1:X3=0:X4=4:GOSUB 345                    REMARK  ENTER ACTION CODE
  154.     JOB.GRID(2,J%+(I%-1)*5)=X0 
  155.     GOTO 6045
  156.  
  157. 6100    Z=-1                                REMARK  BEGIN JOB CLOSE PROCESSING
  158.     PRINT "WORKING...DO NOT INTERRUPT"
  159.     FOR J%=1 TO 25
  160.     IF JOB.GRID(1,J%)=0 THEN 6117
  161. 6105    K=FNEXACT(JOB.GRID(1,J%),0):GOSUB 1060                REMARK  SEARCH FOR GRID ENTRY ON FILE
  162.     X0=L
  163.     GOSUB 1100                            REMARK  READ HEADER RECORD
  164. 6115    IF JOB.GRID(2,J%) < 1 THEN GOTO 6117
  165.     IF JOB.GRID(2,J%)=1 THEN GOSUB 5300
  166.     IF JOB.GRID(2,J%)=2 THEN GOSUB 5310
  167.     IF JOB.GRID(2,J%)=3 THEN GOSUB 5320
  168.     IF JOB.GRID(2,J%)=4 THEN GOSUB 5320
  169. 6117    NEXT J%
  170.  
  171. 6120    CONSOLE                                REMARK  TERMINATE PROGRAM AND LOAD MENU
  172.     PRINT CLEAR.SCREEN$;"JOB CLOSE LOADING MENU"
  173.     CHAIN "P/R000"
  174.