Table of Contents

ACPAGE

Table Of Contents

Source Code

ACPAGE.txt
  1. ACPAGE
  2. PROGRAM ACPAGE(RAF,TAPE2=RAF,TAPE3,TAPE7,TAPE10,
  3. 1 TAPE11,OUTPUT,TAPE12)
  4. C
  5. C --- PROGRAM TO PRINT OUT FORMATTED DATA REGARDING USER-
  6. C --- REQUESTED PRINTS.
  7. C
  8. C --- TAPE2 (RAF) IS THE RAW ACCOUNTING DATA (INPUT).
  9. C --- TAPE3 IS THE UNSORTED FILE WITH ONLY PRINT-RELATED
  10. C --- DATA.
  11. C --- TAPE7 IS WHERE ALL ERROR MESSAGES ARE WRITTEN, UNLESS
  12. C --- THE REPORT ABORTS.
  13. C --- TAPE10 IS THE SORTED PRINT-DATA FILE.
  14. C --- OUTPUT IS THE RESULT OF THE PROCESSING OF TAPE10.
  15. C --- IT IS IN A FORMAT SIMILAR TO BCYTD-TYPE FILES.
  16. C
  17. ***** ***** ***** PHASE 1 ***** ***** *****
  18. C
  19. DIMENSION NAMES(5000,4),INPUT(55),LETTER(18)
  20. C
  21. C --- ARRAYS --
  22. C
  23. C --- *NAMES* IS THE LIST OF PRINT-RELATED JOBNAMES.
  24. C --- *NAMES(XXX,1)* IS THE JOB DATE.
  25. C --- *NAMES(XXX,2)* IS THE JOB TIME.
  26. C --- *NAMES(XXX,3)* IS THE JOB NAME.
  27. C --- *NAMES(XXX,4)* IS JOB NAME OF OUTPUT FILE(NOS V2)
  28. C --- * TO MATCH OUTPUT JSN BACK TO ORIGINAL JOB JSN
  29. C --- *INPUT* IS THE LIST OF ALL CHARS IN A PRINT ENTRY.
  30. C --- *LETTER* IS THE LETTERS IN EACH WORD OF SAID ENTRY
  31. C
  32. COMMON/BLOCK1/JOBDAT,JOBTIM,JOBNAM,NINPUT(6),NPER
  33. COMMON/BLOCK2/LIST(12),MASKL4,MASKL6
  34. COMMON/WHATEVR/ KWASTE,WASTE
  35. C
  36. C --- COMMON *BLOCK1* --
  37. C
  38. C --- *JOBDAT* - DATE OF JOB FROM NOS ACCOUNTING FILE.
  39. C --- *JOBTIM* - TIME . . . . .
  40. C --- *JOBNAM* - NAME . . . . .
  41. C --- *NINPUT* - ARRAY CONTAINING THE OTHER 54 CHARS OF
  42. C --- THE ACCNTING FILE ENTRY.
  43. C --- *NPER* - HOLLERITH CONSTANT = 1H.
  44. C
  45. C --- COMMON *BLOCK2* --
  46. C
  47. C --- *LIST* - THE LIST OF ALL POSSIBLE PRINT-RELATED
  48. C --- ENTRIES IN THE ACCNTING FILE (IN L-FORMAT).
  49. C --- *MASKL4* - OCTAL MASK OF LEFTMOST 4 CHARACTERS.
  50. C --- *MASKL6* - OCTAL MASK OF LEFTMOST 6 CHARACTERS.
  51. C
  52. INTEGER WCNT, WORD (7), ARRAY (6), WASTE (3)
  53. C
  54. C --- INTEGER VARIABLE --
  55. C
  56. C --- *WCNT* - WORD COUNT VARIABLE
  57. C
  58. C --- INTEGER ARRAYS --
  59. C
  60. C --- *WORD* - THE WORDS FROM THE PRINT REQUEST ENTRY IN THE
  61. C --- ACCNTING FILE.
  62. C ---
  63. C --- *WORD(1)* - *TPRINT*, *DPRINT*, *NPRINT*,
  64. C --- *MODPRT* OR *DOCPRT*.
  65. C --- *WORD(3)* - ACCOUNT OF USER REQUESTING PRINT.
  66. C --- *WORD(4)* - GROUP OF USER REQUESTING PRINT.
  67. C --- *WORD(5)*,*WORD(6)* - NAME (18 CHARS) OF USER
  68. C --- REQUESTING PRINT.
  69. C --- *WORD(7)* - USED AS ROOM FOR EXPANSION.
  70. C
  71. DATA LABUN/4LABUN/
  72. DATA LACUN/4LACUN/
  73. DATA LABSY/4LABSY/
  74. DATA LARSY/4LARSY/
  75. DATA LPS/4LPS /
  76. C
  77. DATA (LIST(I),I=1,4)/4LTPRI,4LNPRI,4LDPRI,4LMODP/
  78. DATA (LIST(I),I=5,6)/4LDOCP,4LNMOD/
  79. DATA (LIST(I),I=7,10)/4LNDOC,1L ,1L ,1L /
  80. C
  81. C --- ARRAY *LIST* - SEE DESCRIPTION AT DIMENSION STMT.
  82. C
  83. DATA MASKL2/7777 0000 0000 0000 0000B/
  84. DATA MASKL4/7777 7777 0000 0000 0000B/
  85. DATA MASKL6/7777 7777 7777 0000 0000B/
  86. C
  87. C --- OCTAL CONSTANTS *MASKL4* + *MASKL6* -- SEE DESCRIP-
  88. C --- TION AT COMMON STATEMENT (COMMON BLOCK *BLOCK2*)
  89. C
  90. DATA LPRINTS/6LPRINTS/
  91. DATA JOBDAT/10H /
  92. DATA NZZ/0/
  93. DATA KOUNT/0/
  94. DATA NPER/1H./
  95. DATA NCOM/1H,/
  96. DATA NPNT, NPNT2/2*1/
  97. DATA JOBDAT2/1H /
  98. C
  99. C
  100. REWIND 2
  101. REWIND 3
  102. REWIND 7
  103. REWIND 10
  104. REWIND 11
  105. C
  106. 10 CONTINUE
  107. C
  108. C --- CHECK FOR LIMIT IN JOB NAMES IN ARRAY *NAMES*, FOR
  109. C --- WHICH *KOUNT* IS A COUNTER.
  110. C
  111. IF(KOUNT .GE. 5000) GOTO 3000
  112. C
  113. C --- READ 1 RECORD FROM NOS ACCOUNTING FILE.
  114. C
  115. READ(2,5000) JOBTIM,JOBNAM,NINPUT
  116. 5000 FORMAT(1X,A8,1X,A7,3X,6A10)
  117. C
  118. C --- CHECK FOR END-OF-FILE. IF REACHED, GO TO PHASE 2.
  119. C
  120. IF(EOF(2))2000,15
  121. 15 CONTINUE
  122. C IF NOS V2 THEN JOBNAMES ARE SHIFTED 2 CHARS TO RIGHT
  123. IBLNK = JOBNAM .AND. MASK(12)
  124. IF(IBLNK.EQ.2L ) JOBNAM=SHIFT(JOBNAM,12)
  125. C
  126. C --- MASK OFF LEFTMOST 4 CHARACTERS OF ACCNTING FILE
  127. C
  128. N1 = NINPUT(1) .AND. MASKL4
  129. C
  130. C --- CHECK FOR ALL POSSIBLE WAYS OF RE/SETTING DATE
  131. C
  132. IF (N1 .NE. LABSY) GO TO 18
  133. DECODE (15,17,NINPUT) JOBDAT
  134. 17 FORMAT(7X,A8)
  135. GO TO 24
  136. 18 IF (N1 .NE. LARSY) GO TO 21
  137. DECODE (17,19,NINPUT) JOBDAT
  138. 19 FORMAT(9X,A8)
  139. GO TO 24
  140. 21 IF (N1 .NE. LPS) GO TO 23
  141. DECODE (19,22,NINPUT) JOBDAT
  142. 22 FORMAT(11X,A8)
  143. C
  144. 24 CONTINUE
  145. C FLAG THAT FACT THAT DATE WAS FOUND AND KEEP POINTER
  146. C INTO JSN TABLE FOR WHERE CURRENT DAY AND PREVIOUS
  147. C DAY START
  148. NZZ=-1
  149. IF(JOBDAT.EQ.JOBDAT2) GOTO 25
  150. JOBDAT2=JOBDAT
  151. NPNT2=NPNT
  152. NPNT=KOUNT
  153. 25 CONTINUE
  154. GO TO 10
  155. 23 CONTINUE
  156. C
  157. C --- CHECK TO SEE IF ANY DATE HAS BEEN SET YET. IF NONE,
  158. C --- GO BACK AND READ UNTIL ONE IS REACHED.
  159. C
  160. IF (NZZ .NE. -1) GO TO 10
  161. C
  162. C --- CHECK FOR JOBNAM .EQ. PLATXXX. IF FOUND, GO BACK TO
  163. C --- TOP OF READ LOOP.
  164. C
  165. C FOLLOWING IS FOR NOS V1 AND NOS V2 CHANGES
  166. IF ((JOBNAM.AND.MASK(24)).EQ.4LPLAT) GO TO 10
  167. IF ((JOBNAM.AND.MASK(24)).EQ.4LPLA1) GOTO 10
  168. C
  169. C CHECK FOR =UCLP= ENTRIES
  170. IF(N1.NE.4LUCLP) GOTO 39
  171. IF(KOUNT.LT.1) GOTO 10
  172. C FOR NOS V2
  173. JNAME2=(JOBNAM.AND.MASKL4).OR.5555 5555 5555B
  174. C CHANGE =UCLP= TO =ZZZZ= FOR SORT PURPOSES
  175. NINPUT(1)=(NINPUT(1).AND.7777 7777 7777B).OR.4LZZZZ
  176. C MATCH JSN OF OUTPUT FILE =UCLP=(PRINT PAGES) ENTRY
  177. C BACK TO THE ORIGINAL SUBMITTED JOBS JSN.
  178. C SEARCH CURRENT DAY FOR MATCH TO JSN.
  179. DO 35 L=NPNT,KOUNT
  180. IF(NAMES(L,4).NE.JNAME2) GOTO 35
  181. C APPEND THE VAR LL FOR SORT PURPOSES
  182. LL=(2*L)+1
  183. WRITE(3,103) NAMES(L,1), JOBTIM, NAMES(L,3),
  184. + NINPUT, LL
  185. C MARK THE FACT THAT =UCLP= WAS MATCHED TO JOB
  186. NAMES(L,4)=-1
  187. GOTO 10
  188. 35 CONTINUE
  189. C FOR NOS V1 (JOBNAME AND =UCLP= ENTRY HAVE SAME JSN)
  190. C SEARCH CURRENT DAY FOR JSN
  191. DO 36 L=NPNT,KOUNT
  192. IF(NAMES(L,3).NE.JOBNAM) GOTO 36
  193. IF(NAMES(L,4).EQ.-1) GOTO 36
  194. C APPEND THE VAR LL FOR SORT PURPOSES
  195. LL=(2*L)+1
  196. WRITE(3,103) JOBDAT, JOBTIM, JOBNAM, NINPUT, LL
  197. NAMES(L,4)=-1
  198. GOTO 10
  199. 36 CONTINUE
  200. 39 CONTINUE
  201. C
  202. C --- ENTRY WITH FIRST 4 CHARS AS *ABUN* OR *ACUN* SHOWS THE
  203. C --- BEGINNING OF A JOB.
  204. C
  205. IF ((N1 .NE. LABUN) .AND. (N1 .NE. LACUN)) GO TO 49
  206. C
  207. C --- IF IT IS *ACUN*, SKIP 2 CHARS, AND DECODE OFF NEXT
  208. C --- 6 CHARS INTO *N2* AND SEE IF IT EQUALS *LPRINTS*.
  209. C
  210. DECODE (12,40,NINPUT) N2
  211. 40 FORMAT(6X,A6)
  212. N2 = N2 .AND. MASKL6
  213. C
  214. C --- IF *N2* NOT EQUAL *LPRINTS*, IGNORE RECORD.
  215. C --- IF *N2* EQUALS *LPRINTS*, ADD 1 TO *KOUNT* AND ADD
  216. C --- *JOBDAT*, *JOBTIM*, AND *JOBNAM* TO THE LIST OF JOB
  217. C --- NAMES AND THEN GO BACK.
  218. IF (N2 .NE. LPRINTS) GO TO 10
  219. C
  220. C --- FIRST CHECK TO SEE IF THE NAME IS ALREADY IN THE LIST.
  221. C NOTE THAT WE DO NOT NEED BOTH =ABUN= AND =ACUN= ENTRY.
  222. IDUP=0
  223. DO 43 NK = NPNT, KOUNT
  224. IF (JOBNAM .NE. NAMES(NK,3)) GO TO 43
  225. IF (JOBDAT .NE. NAMES(NK,1)) GO TO 43
  226. IDUP=1
  227. IF (JOBTIM .NE. NAMES(NK,2)) GO TO 43
  228. WRITE (7,41) JOBDAT,JOBTIM,JOBNAM,(NINPUT(MM),MM=1,4)
  229. 41 FORMAT (2A8,A7,1X,4A10,25X,*DUPLICATE RECORD*)
  230. GO TO 10
  231. 43 CONTINUE
  232. IF(IDUP.GT.0) GOTO 10
  233. KOUNT = KOUNT + 1
  234. NAMES(KOUNT,1) = JOBDAT
  235. NAMES(KOUNT,2) = JOBTIM
  236. NAMES(KOUNT,3) = JOBNAM
  237. NAMES(KOUNT,4) = 0
  238. GO TO 10
  239. C
  240. C --- SINCE THE FIRST 4 CHARS WERE NOT *ABUN*/*ACUN*, CHECK
  241. C --- TO SEE IF THE JOB NAME IS ON THE LIST, BY LOOPING
  242. C --- THROUGH ARRAY *NAMES* *KOUNT* TIMES.
  243. C
  244. 49 CONTINUE
  245. IF(KOUNT.LT.1) GOTO 10
  246. C SEARCH JSNS OF CURRENT DAY TO SEE IF RECORD HAS
  247. C JOBNAME OF A JOB BEING PROCESSED
  248. DO 101 I=NPNT,KOUNT
  249. IF (JOBNAM .NE. NAMES(I,3)) GO TO 101
  250. C CHECK THAT JSN NOT ALREADY MATCHED/PROCESSED
  251. IF(NAMES(I,4).EQ.0) GOTO 100
  252. IF(N1.EQ.4LABLQ) GOTO 101
  253. 100 CONTINUE
  254. INDXX=I
  255. GOTO 102
  256. 101 CONTINUE
  257. C
  258. C --- IF THIS POINT IS REACHED, JOB NAME WAS NOT FOUND IN
  259. C --- ARRAY *NAMES*, SO THE RECORD IS IGNORED.
  260. C
  261. GO TO 10
  262. C
  263. C --- THIS LOOP CHECKS TO SEE IF THE FIRST 4 CHARS EQUAL
  264. C --- ANY OF THE PRINT-TYPE ENTRIES THAT ARE TO BE PRO-
  265. C --- CESSED.
  266. C
  267. 102 CONTINUE
  268. DO 104 J=1,7
  269. IF (N1 .NE. LIST(J)) GO TO 104
  270. LL=2*INDXX
  271. WRITE(3,103) JOBDAT, JOBTIM, JOBNAM, NINPUT, LL
  272. 103 FORMAT(2A8,A7,1X,6A10,I5)
  273. GO TO 10
  274. 104 CONTINUE
  275. C
  276. C GET JOBNAME OF OUTPUT FILE FROM =ABLQ= RECORD
  277. IF(N1.NE.4LABLQ) GOTO 105
  278. IF((SHIFT(NINPUT(1),36).AND.MASKL2).NE.2LC1) GOTO 105
  279. C SAVE THE JSN OF OUTPUT FILE TO MATCH THE LATER
  280. C =UCLP= ENTRY TO COME WHEN FILE IS PRINTED.
  281. NAMES(INDXX,4)=(NINPUT(2).AND.MASKL4).OR.5555 5555 5555B
  282. 105 CONTINUE
  283. C
  284. C --- IF THIS POINT IS REACHED, THEN THE ENTRY IS ONE OF
  285. C --- THE NON-DESIRABLE PRINT-TYPE ENTRIES, AND THIS
  286. C --- RECORD IS ALSO IGNORED.
  287. GO TO 10
  288. C
  289. 2000 CONTINUE
  290. C
  291. ***** ***** ***** PHASE 2 ***** ***** *****
  292. C
  293. C --- SORT TAPE 3, RESULT IS ON TAPE 10
  294. C --- SORT WITH RESPECT TO --
  295. C
  296. C --- 1) JOB DATE
  297. C --- 2) JOB NAME
  298. C --- 3) TYPE FIELD
  299. C
  300. REWIND 3
  301. REWIND 10
  302. C
  303. CALL SM5SORT(0)
  304. CALL SM5FROM("TAPE3")
  305. CALL SM5TO("TAPE10")
  306. C SORT ONLY ON INTEGER FIELD APPENDED TO THE PRINT
  307. C AND UCLP ENTRIES. ONCE SORTED, ALL UCLP ENTRIES
  308. C SHOULD FOLLOW THE JOBS PRINT TYPE ENTRY.
  309. CALL SM5KEY(85,5,"COBOL6")
  310. CALL SM5END
  311. C
  312. C --- THIS SECTION READS DATA OFF THE SORTED FILE AND PRO-
  313. C --- CESSES IT.
  314. C
  315. REWIND 3
  316. REWIND 10
  317. C
  318. C --- SET EACH ELEMENT OF *LETTER* TO O55 = 1H = BLANK
  319. C
  320. 201 DO 202 IZ=1,18
  321. 202 LETTER (IZ) = 1H
  322. C
  323. C --- SET EACH ELEMENT OF *WORD* TO 1 BLANK-FILLED WORD.
  324. C
  325. DO 203 IZ=1,7
  326. 203 WORD(IZ)=10H
  327. C
  328. C --- SET WORD AND LETTER COUNTS TO ZERO.
  329. C
  330. LCNT = 0
  331. WCNT = 0
  332. C
  333. C --- READ ONE RECORD, COMPOSED OF JOBNAME (*JWASTE*) AND
  334. C --- *ARRAY*, WHICH IS THE -TPRINT- RECORD.
  335. C
  336. 210 CONTINUE
  337. READ (10,220) JOBDAT, JOBTIM, JWASTE, ARRAY
  338. 220 FORMAT(2A8,A7,1X,6A10)
  339. C
  340. C --- CHECK FOR END-OF-FILE -- IF FOUND, GO TO -STOP- STMT
  341. C --- (I.E., END REPORT).
  342. C
  343. IF (EOF(10)) 999, 211
  344. 211 CONTINUE
  345. C
  346. C --- CHECK TO SEE IF *UCLP* ENTRY.
  347. C
  348. IF ((ARRAY(1).AND.MASK(24)).EQ.4LZZZZ) GO TO 210
  349. C
  350. C --- BREAK UP *ARRAY* INTO 55 INDIVIDUAL LETTERS.
  351. C
  352. DECODE(55,221,ARRAY)(INPUT(I),I=1,55)
  353. 221 FORMAT(55A1)
  354. C
  355. C --- LOOP TO SEARCH FOR PERIODS/COMMAS IN *INPUT*.
  356. C
  357. NFLG1 = NFLG2 = 0
  358. C
  359. DO 245 I = 1, 55
  360. C
  361. C --- CHECK TO SEE IF WCNT EQUALS 5 OR MORE YET. IF SO,
  362. C --- GO TO A POINT BEYOND THIS LOOP, BECAUSE ALL THE
  363. C --- WORDS HAVE BEEN SEPARATED.
  364. C
  365. 222 CONTINUE
  366. IF (WCNT.GE.5) GO TO 246
  367. C
  368. NZ = INPUT(I)
  369. C
  370. C --- CHECK FOR CHAR EQUALING 1H. OR 1H, OR THE LETTER
  371. C --- COUNT BEING GREATER THAN OR EQUAL TO 18, THE MAXIMUM
  372. C --- NUMBER OF PERMISSIBLE LETTERS IN A WORD (NOT COMPUTER
  373. C --- WORD, BUT TEXT WORD).
  374. C
  375. IF((NZ.EQ.NCOM).OR.(NZ.EQ.NPER).OR.(LCNT.GE.18)) GO TO 230
  376. C
  377. C --- LETTER IS NON-PERIOD/COMMA AND LETTER COUNT IS LESS
  378. C --- THAN 18.
  379. C
  380. C --- ADD 1 TO THE LETTER COUNT AND PUT THE CHAR PRESENTLY
  381. C --- UNDER CONSIDERATION INTO ARRAY *LETTER*, AS THE
  382. C --- *LCNT*TH ELEMENT. THEN GO TO THE -CONTINUE- TO
  383. C --- CONTINUE PROCESSING WITH THE NEXT CHAR.
  384. C
  385. LCNT = LCNT + 1
  386. LETTER (LCNT) = NZ
  387. GO TO 245
  388. C
  389. C --- A PERIOD OR COMMA HAS BEEN FOUND (OR THE LETTER COUNT
  390. C --- HAS REACHED 18).
  391. C
  392. 230 CONTINUE
  393. C
  394. IF ((WORD(1).AND.MASK(24)).EQ.LIST(4)) NFLG1 = -1
  395. IF ((WORD(1).AND.MASK(24)).EQ.LIST(5)) NFLG1 = -1
  396. IF((WORD(1).AND.MASK(24)).EQ.LIST(11)) NFLG1=-1
  397. C
  398. C --- ADD 1 TO THE WORD COUNT, *WCNT*.
  399. C
  400. WCNT = WCNT + 1
  401. C
  402. C --- IN CASE OF ERROR, SKIP THE WORD, LEAVING IT BLANK.
  403. C
  404. IF (LCNT .EQ. 0) GO TO 234
  405. C
  406. C --- PUT ALL *LCNT* LETTERS INTO ARRAY *WORD*, STARTING
  407. C --- WITH *WORD(WCNT)*. (FORMAT IS OF 18 CHARS, SINCE THAT
  408. C --- IS THE MAXIMUM NUMBER OF CHARS THAT CAN BE ASSEMBLED.)
  409. C
  410. ENCODE(LCNT,233,WORD(WCNT))(LETTER(K),K=1,LCNT)
  411. 233 FORMAT(18A1)
  412. C
  413. C --- SET EACH ELEMENT OF ARRAY *LETTER* TO 1 BLANK.
  414. C
  415. 234 CONTINUE
  416. IF (NFLG1.EQ.0) GOTO 235
  417. IF (NFLG2.EQ.0) GOTO 236
  418. NFLG1 = NFLG2 = 0
  419. GO TO 235
  420. 236 IF (WCNT.NE.3) GOTO 235
  421. WCNT = WCNT - 1
  422. NFLG2 = -1
  423. C
  424. 235 CONTINUE
  425. DO 237 K=1,18
  426. 237 LETTER(K) = 1H
  427. C
  428. C --- RESET *LCNT* TO ZERO AND CONTINUE PROCESSING.
  429. C
  430. LCNT = 0
  431. 245 CONTINUE
  432. 246 CONTINUE
  433. C
  434. C --- AFTER ALL THE CHARS OF THE FIRST STRING HAVE BEEN
  435. C --- PROCESSED, READ THE NEXT RECORD. THIS RECORD IS
  436. C --- MADE OF THE JOBNAME (*KWASTE*) AND THE NUMBER OF
  437. C --- KILO-LINES PRINTED TO FULFILL THE PRINT REQUEST.
  438. C --- THE SECOND OF THESE IS READ IN ALPHANUMERIC FORMAT
  439. C --- IN ORDER TO CATCH MISTAKES, LIKE A MISSING RECORD
  440. C --- FOR THE NUMBER OF PRINTED LINES, ETC.
  441. C
  442. READ (10,247) KWASTE, WASTE
  443. 247 FORMAT (16X,A7,1X,3A10)
  444. C
  445. C --- CHECK FOR END-OF-FILE. IF ENCOUNTERED, PRINT AN ERROR
  446. C --- MESSAGE ABOUT A MISSING -UCLP- ENTRY AND PROCEED TO
  447. C --- ROUTINE *PHASE3*.
  448. C
  449. IF (EOF(10) .EQ. 0) GO TO 250
  450. C
  451. WRITE (7,4001) JOBDAT, JOBTIM, JOBNAM, ARRAY
  452. GO TO 999
  453. C
  454. 250 CONTINUE
  455. C
  456. C --- CHECK TO SEE IF THE TWO ENTRIES HAVE THE SAME JOB
  457. C --- NAME. IF NOT, PRINT OUT AN ERROR MESSAGE.
  458. C
  459. N99 = WASTE(1).AND.MASK(24)
  460. IF ((KWASTE.NE.JWASTE).OR.(N99.NE.4LZZZZ)) GO TO 4000
  461. C
  462. C
  463. C FORMAT OF -UCLP- ENTRIES SEEMS TO KEEP CHANGING SO
  464. C THE FLOATING POINT FIELD CONTAINING NUMBER OF LINES
  465. C PRINTED KEEPS MOVING. SOLUTION IS TO HAVE THE
  466. C FOLLOWING ROUTINE LOCATE THE DECIMAL POINT AND THEN
  467. C RETURN THE NUMBER OF LINES BASED ON WHERE THE
  468. C DECIMAL POINT WAS FOUND.
  469. CALL FINDPNT(JJNUM)
  470. C MAKE SURE WE REALLY HAVE A FLOATING POINT NUMBER
  471. CALL FCHECK(JJNUM,JFLAG)
  472. IF(JFLAG.LT.0) GOTO 201
  473. DECODE(10,301,JJNUM) XLINES
  474. 301 FORMAT(F10.3)
  475. C
  476. C --- CONVERT KILO-LINES TO PRINTER PAGES.
  477. C
  478. 320 CONTINUE
  479. NOPAGES = INT (XLINES * 100. / 6.)
  480. C
  481. C --- CHECK TO SEE IF EQUATION YIELDS A FRACTION OF A PAGE.
  482. C --- IF SO, ADD 1 TO NOPAGES.
  483. C
  484. IF ((XLINES*100./6.)-FLOAT(NOPAGES).GT.0.001)NOPAGES = NOPAGES+1
  485. C
  486. C --- OUTPUT -- USER ACCNT, USER GROUP, USER NAME, NAME
  487. C --- OF LESSON/FILE BEING PRINTED, NUMBER OF PAGES OF
  488. C --- OUTPUT AND DATE OF PRINTING.
  489. C
  490. WRITE (11,401) (WORD(L),L=3,6),WORD(2),NOPAGES,JOBDAT
  491. 401 FORMAT(1X,A7,1X,2(A8,A10),I10,3X,A8)
  492. GO TO 201
  493. C
  494. 999 CALL PHASE3
  495. C
  496. STOP
  497. C
  498. C --- ERROR MESSAGES.
  499. C
  500. 3000 CONTINUE
  501. PRINT 3001
  502. 3001 FORMAT(////* ERROR -- DIMENSION OF ARRAY -NAMES- OF */
  503. 1 * 5000 HAS BEEN EXCEEDED. REPORT STOPPED.*/)
  504. STOP
  505. C
  506. C ---
  507. C
  508. 4000 CONTINUE
  509. WRITE (7,4001) JOBDAT,JOBTIM,JWASTE,ARRAY
  510. 4001 FORMAT(2A8,A7,1X,6A10,5X,*RECORD IGNORED*)
  511. C
  512. C --- BACKSPACE TAPE10 ONE RECORD IN ORDER TO RE-READ
  513. C --- THE RECORD WHICH DID NOT MATCH WITH THE CONTENTS
  514. C --- OF *ARRAY* AT THE TIME OF THE PRINTING OF THIS
  515. C --- ERROR MESSAGE.
  516. C
  517. BACKSPACE 10
  518. C
  519. C --- GO BACK TO THE TOP OF THE READ LOOP.
  520. C
  521. GO TO 201
  522. C
  523. C ---
  524. C
  525. END
  526. SUBROUTINE PHASE3
  527. C
  528. C --- ROUTINE TO PROCESS THE DATA FROM TAPE11 TO PRODUCE
  529. C --- REPORT-TYPE OUTPUT.
  530. C
  531. COMMON/PAGE/IPAGE,ILINE
  532. C
  533. INTEGER ACCT(500,2)
  534. DIMENSION INPLIN(9), MESS(2)
  535. C
  536. DATA IACCT/-1/,LACCT/0/,IFLAG1/-1/
  537. DATA KOUNT/1/,ACCT/1000*0/,NTOTAL/0/
  538. C
  539. REWIND 11
  540. REWIND 12
  541. C
  542. C --- SORT TAPE11 BY ACCOUNT, GROUP, USER NAME, FILE NAME,
  543. C --- DATE PRINTED AND NUMBER OF PAGES PRINTED.
  544. C
  545. CALL SM5SORT(0)
  546. CALL SM5FROM("TAPE11")
  547. CALL SM5TO("TAPE12")
  548. CALL SM5KEY(2,7,"DISPLAY")
  549. CALL SM5KEY(10,8,"DISPLAY")
  550. CALL SM5KEY(18,18,"DISPLAY")
  551. CALL SM5KEY(36,10,"COBOL6")
  552. CALL SM5KEY(59,8,"DISPLAY")
  553. CALL SM5KEY(46,10,"COBOL6")
  554. CALL SM5END
  555. C
  556. REWIND 12
  557. IPAGE = 1
  558. ILINE = 12
  559. C
  560. 1 CONTINUE
  561. READ (12,2) IACCT,IGRP,NAME1,NAME2,IFLNAM,NPAGES,IDATE
  562. 2 FORMAT(1X,A7,1X,2(A8,A10),I10,3X,A8)
  563. C
  564. C --- CHECK FOR END-OF-FILE.
  565. C
  566. IF (EOF(12)) 10, 3
  567. C
  568. C --- CHECK TO SEE IF THIS ACCOUNT NAME = LAST ACCOUNT NAME
  569. C
  570. 3 CONTINUE
  571. IF (LACCT.EQ.IACCT) GO TO 6
  572. C
  573. C --- IF NOT, PRINT OUT THE TOTAL NUMBER OF PAGES FOR LACCT,
  574. C --- THE LAST ACCOUNT NAME AND A NEW PAGE FOR IACCT, THE
  575. C --- ACCOUNT NAME JUST READ IN.
  576. C
  577. C --- FIRST CHECK TO SEE IF *IFLAG1* IS -1, MEANING THAT
  578. C --- THIS IS THE FIRST TIME THIS AREA HAS BEEN REACHED
  579. C --- AND NO -TOTAL PAGES PRINTED- OUTPUT IS NEEDED.
  580. C
  581. IF (IFLAG1.EQ.-1) GO TO 9
  582. IF (ILINE.LE.49) GO TO 907
  583. CALL PAGE
  584. PRINT 5, IACCT
  585. 907 CONTINUE
  586. PRINT 4, ACCT(KOUNT-1,2)
  587. 4 FORMAT(///11X,7H*TOTAL*,57X,I10)
  588. C
  589. C --- PRINT THE NEW PAGE HEADING FOR *IACCT*.
  590. C
  591. 9 CONTINUE
  592. CALL PAGE
  593. PRINT 5, IACCT
  594. 5 FORMAT (///21X,*ACCOUNT *,A7///11X,*NAME*,19X,*GROUP*,
  595. 1 8X,*FILE NAME*,8X,*DATE*,12X,*PAGES*//)
  596. C
  597. C --- SET ACCT(KOUNT,1) TO IACCT
  598. C
  599. ACCT(KOUNT,1) = IACCT
  600. KOUNT = KOUNT + 1
  601. IF (KOUNT.EQ.501) GO TO 10
  602. C
  603. C --- SET *IFLAG1* TO 0.
  604. C
  605. IFLAG1 = 0
  606. C
  607. C --- PRINT OUT THE USER'7S RECORD. FIRST, HOWEVER, CHECK TO
  608. C --- SEE IF THE OUTPUT WILL BE GOING PAST THE 55TH LINE ON
  609. C --- THE PAPER. IF SO, RESTORE THE LINE COUNT AND PRINT A
  610. C --- NEW HEADING.
  611. C
  612. 6 CONTINUE
  613. IF (ILINE.LE.52) GO TO 7
  614. CALL PAGE
  615. PRINT 5, IACCT
  616. 7 CONTINUE
  617. PRINT 8, NAME1,NAME2,IGRP,IFLNAM,IDATE,NPAGES
  618. 8 FORMAT (11X,A10,2(A8,5X),A10,5X,A8,5X,I10)
  619. C
  620. ACCT(KOUNT-1,2) = ACCT(KOUNT-1,2) + NPAGES
  621. ILINE = ILINE + 1
  622. LACCT = IACCT
  623. C
  624. C --- RETURN BACK TO THE TOP OF THE READ LOOP.
  625. C
  626. GO TO 1
  627. C
  628. C --- END-OF-FILE ENCOUNTERED -- PRINT THE TOTAL OF THE
  629. C --- LAST ACCOUNT PROCESSED AND PRINT OUT THE SUMMARY.
  630. C
  631. 10 CONTINUE
  632. IF (KOUNT.EQ.1) GO TO 32
  633. IF (ILINE.LE.49) GO TO 908
  634. CALL PAGE
  635. PRINT 5, IACCT
  636. 908 CONTINUE
  637. PRINT 4, ACCT(KOUNT-1,2)
  638. C
  639. C --- PRINT OUT THE SUMMARY OF ACCOUNT PRINT REQUESTS.
  640. C
  641. CALL PAGE
  642. PRINT 11
  643. 11 FORMAT (///36X,*SUMMARY OF PAGES PRINTED*////)
  644. C
  645. C --- LOOP TO PRINT OUT THE LIST OF ACCOUNTS
  646. C
  647. KOUNT = KOUNT - 1
  648. C
  649. DO 20 I = 1, KOUNT
  650. IF (ILINE.LE.52) GO TO 14
  651. CALL PAGE
  652. PRINT 11
  653. 14 CONTINUE
  654. PRINT 15, ACCT(I,1), ACCT(I,2)
  655. 15 FORMAT (21X,*ACCOUNT *,A7,30X,I10,* PAGES*)
  656. NTOTAL = NTOTAL + ACCT(I,2)
  657. 20 CONTINUE
  658. C
  659. C --- PRINT OUT THE GRAND TOTAL NUMBER OF PAGES PRINTED.
  660. C
  661. IF (ILINE.LE.49) GO TO 909
  662. CALL PAGE
  663. PRINT 5, IACCT
  664. 909 CONTINUE
  665. PRINT 30, NTOTAL
  666. 30 FORMAT (///21X,7H*TOTAL*,38X,I10,* PAGES*)
  667. GOTO 40
  668. 32 CONTINUE
  669. PRINT 33
  670. 33 FORMAT(1H1///,5X,2H**,* NO USERS TO BILL WITH INPUT*,
  671. + * DATA PROVIDED*)
  672. C
  673. C --- PRINT OUT LIST OF ERRORS ON TAPE7.
  674. C
  675. 40 IPAGE = 1
  676. ILINE = 12
  677. CALL PAGE
  678. C
  679. PRINT 50
  680. 50 FORMAT (1H1///,5X,2H**,* ERROR SUMMARY FOR INPUT DATA*
  681. + ,3H **)
  682. C
  683. REWIND 7
  684. C
  685. C --- LOOP TO READ FROM TAPE7 AND PRINT TO OUTPUT.
  686. C
  687. 51 CONTINUE
  688. IF (ILINE.LE.52) GO TO 52
  689. CALL PAGE
  690. PRINT 50
  691. 52 CONTINUE
  692. C
  693. READ (7,60) INPLIN, MESS
  694. 60 FORMAT (8A10,A3,5X,2A10)
  695. C
  696. C --- CHECK FOR END-OF-FILE. IF ENCOUNTERED, STOP.
  697. C
  698. IF (EOF(7)) 65,59
  699. 59 CONTINUE
  700. C
  701. PRINT 61, INPLIN, MESS
  702. 61 FORMAT (5X,8A10,A3,15X,2A10)
  703. C
  704. GO TO 51
  705. 65 CONTINUE
  706. PRINT 66
  707. 66 FORMAT(5X,* -- END OF INFORMATION --*)
  708. STOP
  709. C
  710. END
  711. SUBROUTINE FINDPNT(JJNUM)
  712. INTEGER WASTE(3),STRING(30)
  713. COMMON/WHATEVR/ KWASTE,WASTE
  714. JJNUM=0
  715. K=0
  716. C BREAK ARRAY UP INTO A STRING OF CHARACTERS
  717. DO 100 I=1,3
  718. ITEMP=WASTE(I)
  719. DO 100 J=1,10
  720. K=K+1
  721. ITEMP=SHIFT(ITEMP,6)
  722. ICHAR=ITEMP.AND.77B
  723. STRING(K)=ICHAR
  724. 100 CONTINUE
  725. C
  726. C FIND DECIMAL POINT IN FLOATING POINT NUMBER OF LINES
  727. DO 200 I=7,27
  728. IF(STRING(I).NE.1R.) GOTO 200
  729. IPNT=I
  730. GOTO 300
  731. 200 CONTINUE
  732. PRINT 250
  733. 250 FORMAT(* -- ERROR WITH UCLP ENTRIES*)
  734. STOP
  735. 300 CONTINUE
  736. C
  737. IPNT=IPNT-6
  738. C COPY FLOATING POINT NUMBER TO A SEPERATE WORD
  739. DO 400 I=1,10
  740. JJNUM=SHIFT(JJNUM,6)
  741. JJNUM=JJNUM.OR.STRING(IPNT)
  742. IPNT=IPNT+1
  743. 400 CONTINUE
  744. RETURN
  745. END
  746. C
  747. C
  748. SUBROUTINE FCHECK(JPARAM,IFLAG)
  749. INTEGER WASTE(3)
  750. COMMON/WHATEVR/ KWASTE,WASTE
  751. C
  752. JVAL = JPARAM
  753. DO 100 I = 1,10
  754. ITEMP = JVAL.AND.77B
  755. JVAL = SHIFT(JVAL,-6)
  756. IF(I.NE.4) GOTO 50
  757. IF(ITEMP.NE.57B) GOTO 200
  758. GOTO 100
  759. 50 CONTINUE
  760. IF( .NOT.( ((ITEMP.GT.32B).AND.(ITEMP.LT.45B))
  761. + .OR. (ITEMP.EQ.55B) )) GOTO 200
  762. 100 CONTINUE
  763. C
  764. IFLAG = 0
  765. RETURN
  766. 200 CONTINUE
  767. WRITE(7,300) KWASTE, WASTE
  768. 300 FORMAT(* BAD REC - *,4A10)
  769. IFLAG = -1
  770. RETURN
  771. END
  772. SUBROUTINE PAGE
  773. C
  774. C --- SUBROUTINE TO PRINT OUT AND INCREMENT THE PAGE NUMBER.
  775. C
  776. COMMON/PAGE/IPAGE,ILINE
  777. C
  778. PRINT 1, IPAGE
  779. 1 FORMAT (1H1////106X,*PAGE *,I4)
  780. C
  781. IPAGE = IPAGE + 1
  782. ILINE = 12
  783. C
  784. RETURN
  785. END