ACPAGE
PROGRAM ACPAGE(RAF,TAPE2=RAF,TAPE3,TAPE7,TAPE10,
1 TAPE11,OUTPUT,TAPE12)
C
C --- PROGRAM TO PRINT OUT FORMATTED DATA REGARDING USER-
C --- REQUESTED PRINTS.
C
C --- TAPE2 (RAF) IS THE RAW ACCOUNTING DATA (INPUT).
C --- TAPE3 IS THE UNSORTED FILE WITH ONLY PRINT-RELATED
C --- DATA.
C --- TAPE7 IS WHERE ALL ERROR MESSAGES ARE WRITTEN, UNLESS
C --- THE REPORT ABORTS.
C --- TAPE10 IS THE SORTED PRINT-DATA FILE.
C --- OUTPUT IS THE RESULT OF THE PROCESSING OF TAPE10.
C --- IT IS IN A FORMAT SIMILAR TO BCYTD-TYPE FILES.
C
***** ***** ***** PHASE 1 ***** ***** *****
C
DIMENSION NAMES(5000,4),INPUT(55),LETTER(18)
C
C --- ARRAYS --
C
C --- *NAMES* IS THE LIST OF PRINT-RELATED JOBNAMES.
C --- *NAMES(XXX,1)* IS THE JOB DATE.
C --- *NAMES(XXX,2)* IS THE JOB TIME.
C --- *NAMES(XXX,3)* IS THE JOB NAME.
C --- *NAMES(XXX,4)* IS JOB NAME OF OUTPUT FILE(NOS V2)
C --- * TO MATCH OUTPUT JSN BACK TO ORIGINAL JOB JSN
C --- *INPUT* IS THE LIST OF ALL CHARS IN A PRINT ENTRY.
C --- *LETTER* IS THE LETTERS IN EACH WORD OF SAID ENTRY
C
COMMON/BLOCK1/JOBDAT,JOBTIM,JOBNAM,NINPUT(6),NPER
COMMON/BLOCK2/LIST(12),MASKL4,MASKL6
COMMON/WHATEVR/ KWASTE,WASTE
C
C --- COMMON *BLOCK1* --
C
C --- *JOBDAT* - DATE OF JOB FROM NOS ACCOUNTING FILE.
C --- *JOBTIM* - TIME . . . . .
C --- *JOBNAM* - NAME . . . . .
C --- *NINPUT* - ARRAY CONTAINING THE OTHER 54 CHARS OF
C --- THE ACCNTING FILE ENTRY.
C --- *NPER* - HOLLERITH CONSTANT = 1H.
C
C --- COMMON *BLOCK2* --
C
C --- *LIST* - THE LIST OF ALL POSSIBLE PRINT-RELATED
C --- ENTRIES IN THE ACCNTING FILE (IN L-FORMAT).
C --- *MASKL4* - OCTAL MASK OF LEFTMOST 4 CHARACTERS.
C --- *MASKL6* - OCTAL MASK OF LEFTMOST 6 CHARACTERS.
C
INTEGER WCNT, WORD (7), ARRAY (6), WASTE (3)
C
C --- INTEGER VARIABLE --
C
C --- *WCNT* - WORD COUNT VARIABLE
C
C --- INTEGER ARRAYS --
C
C --- *WORD* - THE WORDS FROM THE PRINT REQUEST ENTRY IN THE
C --- ACCNTING FILE.
C ---
C --- *WORD(1)* - *TPRINT*, *DPRINT*, *NPRINT*,
C --- *MODPRT* OR *DOCPRT*.
C --- *WORD(3)* - ACCOUNT OF USER REQUESTING PRINT.
C --- *WORD(4)* - GROUP OF USER REQUESTING PRINT.
C --- *WORD(5)*,*WORD(6)* - NAME (18 CHARS) OF USER
C --- REQUESTING PRINT.
C --- *WORD(7)* - USED AS ROOM FOR EXPANSION.
C
DATA LABUN/4LABUN/
DATA LACUN/4LACUN/
DATA LABSY/4LABSY/
DATA LARSY/4LARSY/
DATA LPS/4LPS /
C
DATA (LIST(I),I=1,4)/4LTPRI,4LNPRI,4LDPRI,4LMODP/
DATA (LIST(I),I=5,6)/4LDOCP,4LNMOD/
DATA (LIST(I),I=7,10)/4LNDOC,1L ,1L ,1L /
C
C --- ARRAY *LIST* - SEE DESCRIPTION AT DIMENSION STMT.
C
DATA MASKL2/7777 0000 0000 0000 0000B/
DATA MASKL4/7777 7777 0000 0000 0000B/
DATA MASKL6/7777 7777 7777 0000 0000B/
C
C --- OCTAL CONSTANTS *MASKL4* + *MASKL6* -- SEE DESCRIP-
C --- TION AT COMMON STATEMENT (COMMON BLOCK *BLOCK2*)
C
DATA LPRINTS/6LPRINTS/
DATA JOBDAT/10H /
DATA NZZ/0/
DATA KOUNT/0/
DATA NPER/1H./
DATA NCOM/1H,/
DATA NPNT, NPNT2/2*1/
DATA JOBDAT2/1H /
C
C
REWIND 2
REWIND 3
REWIND 7
REWIND 10
REWIND 11
C
10 CONTINUE
C
C --- CHECK FOR LIMIT IN JOB NAMES IN ARRAY *NAMES*, FOR
C --- WHICH *KOUNT* IS A COUNTER.
C
IF(KOUNT .GE. 5000) GOTO 3000
C
C --- READ 1 RECORD FROM NOS ACCOUNTING FILE.
C
READ(2,5000) JOBTIM,JOBNAM,NINPUT
5000 FORMAT(1X,A8,1X,A7,3X,6A10)
C
C --- CHECK FOR END-OF-FILE. IF REACHED, GO TO PHASE 2.
C
IF(EOF(2))2000,15
15 CONTINUE
C IF NOS V2 THEN JOBNAMES ARE SHIFTED 2 CHARS TO RIGHT
IBLNK = JOBNAM .AND. MASK(12)
IF(IBLNK.EQ.2L ) JOBNAM=SHIFT(JOBNAM,12)
C
C --- MASK OFF LEFTMOST 4 CHARACTERS OF ACCNTING FILE
C
N1 = NINPUT(1) .AND. MASKL4
C
C --- CHECK FOR ALL POSSIBLE WAYS OF RE/SETTING DATE
C
IF (N1 .NE. LABSY) GO TO 18
DECODE (15,17,NINPUT) JOBDAT
17 FORMAT(7X,A8)
GO TO 24
18 IF (N1 .NE. LARSY) GO TO 21
DECODE (17,19,NINPUT) JOBDAT
19 FORMAT(9X,A8)
GO TO 24
21 IF (N1 .NE. LPS) GO TO 23
DECODE (19,22,NINPUT) JOBDAT
22 FORMAT(11X,A8)
C
24 CONTINUE
C FLAG THAT FACT THAT DATE WAS FOUND AND KEEP POINTER
C INTO JSN TABLE FOR WHERE CURRENT DAY AND PREVIOUS
C DAY START
NZZ=-1
IF(JOBDAT.EQ.JOBDAT2) GOTO 25
JOBDAT2=JOBDAT
NPNT2=NPNT
NPNT=KOUNT
25 CONTINUE
GO TO 10
23 CONTINUE
C
C --- CHECK TO SEE IF ANY DATE HAS BEEN SET YET. IF NONE,
C --- GO BACK AND READ UNTIL ONE IS REACHED.
C
IF (NZZ .NE. -1) GO TO 10
C
C --- CHECK FOR JOBNAM .EQ. PLATXXX. IF FOUND, GO BACK TO
C --- TOP OF READ LOOP.
C
C FOLLOWING IS FOR NOS V1 AND NOS V2 CHANGES
IF ((JOBNAM.AND.MASK(24)).EQ.4LPLAT) GO TO 10
IF ((JOBNAM.AND.MASK(24)).EQ.4LPLA1) GOTO 10
C
C CHECK FOR =UCLP= ENTRIES
IF(N1.NE.4LUCLP) GOTO 39
IF(KOUNT.LT.1) GOTO 10
C FOR NOS V2
JNAME2=(JOBNAM.AND.MASKL4).OR.5555 5555 5555B
C CHANGE =UCLP= TO =ZZZZ= FOR SORT PURPOSES
NINPUT(1)=(NINPUT(1).AND.7777 7777 7777B).OR.4LZZZZ
C MATCH JSN OF OUTPUT FILE =UCLP=(PRINT PAGES) ENTRY
C BACK TO THE ORIGINAL SUBMITTED JOBS JSN.
C SEARCH CURRENT DAY FOR MATCH TO JSN.
DO 35 L=NPNT,KOUNT
IF(NAMES(L,4).NE.JNAME2) GOTO 35
C APPEND THE VAR LL FOR SORT PURPOSES
LL=(2*L)+1
WRITE(3,103) NAMES(L,1), JOBTIM, NAMES(L,3),
+ NINPUT, LL
C MARK THE FACT THAT =UCLP= WAS MATCHED TO JOB
NAMES(L,4)=-1
GOTO 10
35 CONTINUE
C FOR NOS V1 (JOBNAME AND =UCLP= ENTRY HAVE SAME JSN)
C SEARCH CURRENT DAY FOR JSN
DO 36 L=NPNT,KOUNT
IF(NAMES(L,3).NE.JOBNAM) GOTO 36
IF(NAMES(L,4).EQ.-1) GOTO 36
C APPEND THE VAR LL FOR SORT PURPOSES
LL=(2*L)+1
WRITE(3,103) JOBDAT, JOBTIM, JOBNAM, NINPUT, LL
NAMES(L,4)=-1
GOTO 10
36 CONTINUE
39 CONTINUE
C
C --- ENTRY WITH FIRST 4 CHARS AS *ABUN* OR *ACUN* SHOWS THE
C --- BEGINNING OF A JOB.
C
IF ((N1 .NE. LABUN) .AND. (N1 .NE. LACUN)) GO TO 49
C
C --- IF IT IS *ACUN*, SKIP 2 CHARS, AND DECODE OFF NEXT
C --- 6 CHARS INTO *N2* AND SEE IF IT EQUALS *LPRINTS*.
C
DECODE (12,40,NINPUT) N2
40 FORMAT(6X,A6)
N2 = N2 .AND. MASKL6
C
C --- IF *N2* NOT EQUAL *LPRINTS*, IGNORE RECORD.
C --- IF *N2* EQUALS *LPRINTS*, ADD 1 TO *KOUNT* AND ADD
C --- *JOBDAT*, *JOBTIM*, AND *JOBNAM* TO THE LIST OF JOB
C --- NAMES AND THEN GO BACK.
IF (N2 .NE. LPRINTS) GO TO 10
C
C --- FIRST CHECK TO SEE IF THE NAME IS ALREADY IN THE LIST.
C NOTE THAT WE DO NOT NEED BOTH =ABUN= AND =ACUN= ENTRY.
IDUP=0
DO 43 NK = NPNT, KOUNT
IF (JOBNAM .NE. NAMES(NK,3)) GO TO 43
IF (JOBDAT .NE. NAMES(NK,1)) GO TO 43
IDUP=1
IF (JOBTIM .NE. NAMES(NK,2)) GO TO 43
WRITE (7,41) JOBDAT,JOBTIM,JOBNAM,(NINPUT(MM),MM=1,4)
41 FORMAT (2A8,A7,1X,4A10,25X,*DUPLICATE RECORD*)
GO TO 10
43 CONTINUE
IF(IDUP.GT.0) GOTO 10
KOUNT = KOUNT + 1
NAMES(KOUNT,1) = JOBDAT
NAMES(KOUNT,2) = JOBTIM
NAMES(KOUNT,3) = JOBNAM
NAMES(KOUNT,4) = 0
GO TO 10
C
C --- SINCE THE FIRST 4 CHARS WERE NOT *ABUN*/*ACUN*, CHECK
C --- TO SEE IF THE JOB NAME IS ON THE LIST, BY LOOPING
C --- THROUGH ARRAY *NAMES* *KOUNT* TIMES.
C
49 CONTINUE
IF(KOUNT.LT.1) GOTO 10
C SEARCH JSNS OF CURRENT DAY TO SEE IF RECORD HAS
C JOBNAME OF A JOB BEING PROCESSED
DO 101 I=NPNT,KOUNT
IF (JOBNAM .NE. NAMES(I,3)) GO TO 101
C CHECK THAT JSN NOT ALREADY MATCHED/PROCESSED
IF(NAMES(I,4).EQ.0) GOTO 100
IF(N1.EQ.4LABLQ) GOTO 101
100 CONTINUE
INDXX=I
GOTO 102
101 CONTINUE
C
C --- IF THIS POINT IS REACHED, JOB NAME WAS NOT FOUND IN
C --- ARRAY *NAMES*, SO THE RECORD IS IGNORED.
C
GO TO 10
C
C --- THIS LOOP CHECKS TO SEE IF THE FIRST 4 CHARS EQUAL
C --- ANY OF THE PRINT-TYPE ENTRIES THAT ARE TO BE PRO-
C --- CESSED.
C
102 CONTINUE
DO 104 J=1,7
IF (N1 .NE. LIST(J)) GO TO 104
LL=2*INDXX
WRITE(3,103) JOBDAT, JOBTIM, JOBNAM, NINPUT, LL
103 FORMAT(2A8,A7,1X,6A10,I5)
GO TO 10
104 CONTINUE
C
C GET JOBNAME OF OUTPUT FILE FROM =ABLQ= RECORD
IF(N1.NE.4LABLQ) GOTO 105
IF((SHIFT(NINPUT(1),36).AND.MASKL2).NE.2LC1) GOTO 105
C SAVE THE JSN OF OUTPUT FILE TO MATCH THE LATER
C =UCLP= ENTRY TO COME WHEN FILE IS PRINTED.
NAMES(INDXX,4)=(NINPUT(2).AND.MASKL4).OR.5555 5555 5555B
105 CONTINUE
C
C --- IF THIS POINT IS REACHED, THEN THE ENTRY IS ONE OF
C --- THE NON-DESIRABLE PRINT-TYPE ENTRIES, AND THIS
C --- RECORD IS ALSO IGNORED.
GO TO 10
C
2000 CONTINUE
C
***** ***** ***** PHASE 2 ***** ***** *****
C
C --- SORT TAPE 3, RESULT IS ON TAPE 10
C --- SORT WITH RESPECT TO --
C
C --- 1) JOB DATE
C --- 2) JOB NAME
C --- 3) TYPE FIELD
C
REWIND 3
REWIND 10
C
CALL SM5SORT(0)
CALL SM5FROM("TAPE3")
CALL SM5TO("TAPE10")
C SORT ONLY ON INTEGER FIELD APPENDED TO THE PRINT
C AND UCLP ENTRIES. ONCE SORTED, ALL UCLP ENTRIES
C SHOULD FOLLOW THE JOBS PRINT TYPE ENTRY.
CALL SM5KEY(85,5,"COBOL6")
CALL SM5END
C
C --- THIS SECTION READS DATA OFF THE SORTED FILE AND PRO-
C --- CESSES IT.
C
REWIND 3
REWIND 10
C
C --- SET EACH ELEMENT OF *LETTER* TO O55 = 1H = BLANK
C
201 DO 202 IZ=1,18
202 LETTER (IZ) = 1H
C
C --- SET EACH ELEMENT OF *WORD* TO 1 BLANK-FILLED WORD.
C
DO 203 IZ=1,7
203 WORD(IZ)=10H
C
C --- SET WORD AND LETTER COUNTS TO ZERO.
C
LCNT = 0
WCNT = 0
C
C --- READ ONE RECORD, COMPOSED OF JOBNAME (*JWASTE*) AND
C --- *ARRAY*, WHICH IS THE -TPRINT- RECORD.
C
210 CONTINUE
READ (10,220) JOBDAT, JOBTIM, JWASTE, ARRAY
220 FORMAT(2A8,A7,1X,6A10)
C
C --- CHECK FOR END-OF-FILE -- IF FOUND, GO TO -STOP- STMT
C --- (I.E., END REPORT).
C
IF (EOF(10)) 999, 211
211 CONTINUE
C
C --- CHECK TO SEE IF *UCLP* ENTRY.
C
IF ((ARRAY(1).AND.MASK(24)).EQ.4LZZZZ) GO TO 210
C
C --- BREAK UP *ARRAY* INTO 55 INDIVIDUAL LETTERS.
C
DECODE(55,221,ARRAY)(INPUT(I),I=1,55)
221 FORMAT(55A1)
C
C --- LOOP TO SEARCH FOR PERIODS/COMMAS IN *INPUT*.
C
NFLG1 = NFLG2 = 0
C
DO 245 I = 1, 55
C
C --- CHECK TO SEE IF WCNT EQUALS 5 OR MORE YET. IF SO,
C --- GO TO A POINT BEYOND THIS LOOP, BECAUSE ALL THE
C --- WORDS HAVE BEEN SEPARATED.
C
222 CONTINUE
IF (WCNT.GE.5) GO TO 246
C
NZ = INPUT(I)
C
C --- CHECK FOR CHAR EQUALING 1H. OR 1H, OR THE LETTER
C --- COUNT BEING GREATER THAN OR EQUAL TO 18, THE MAXIMUM
C --- NUMBER OF PERMISSIBLE LETTERS IN A WORD (NOT COMPUTER
C --- WORD, BUT TEXT WORD).
C
IF((NZ.EQ.NCOM).OR.(NZ.EQ.NPER).OR.(LCNT.GE.18)) GO TO 230
C
C --- LETTER IS NON-PERIOD/COMMA AND LETTER COUNT IS LESS
C --- THAN 18.
C
C --- ADD 1 TO THE LETTER COUNT AND PUT THE CHAR PRESENTLY
C --- UNDER CONSIDERATION INTO ARRAY *LETTER*, AS THE
C --- *LCNT*TH ELEMENT. THEN GO TO THE -CONTINUE- TO
C --- CONTINUE PROCESSING WITH THE NEXT CHAR.
C
LCNT = LCNT + 1
LETTER (LCNT) = NZ
GO TO 245
C
C --- A PERIOD OR COMMA HAS BEEN FOUND (OR THE LETTER COUNT
C --- HAS REACHED 18).
C
230 CONTINUE
C
IF ((WORD(1).AND.MASK(24)).EQ.LIST(4)) NFLG1 = -1
IF ((WORD(1).AND.MASK(24)).EQ.LIST(5)) NFLG1 = -1
IF((WORD(1).AND.MASK(24)).EQ.LIST(11)) NFLG1=-1
C
C --- ADD 1 TO THE WORD COUNT, *WCNT*.
C
WCNT = WCNT + 1
C
C --- IN CASE OF ERROR, SKIP THE WORD, LEAVING IT BLANK.
C
IF (LCNT .EQ. 0) GO TO 234
C
C --- PUT ALL *LCNT* LETTERS INTO ARRAY *WORD*, STARTING
C --- WITH *WORD(WCNT)*. (FORMAT IS OF 18 CHARS, SINCE THAT
C --- IS THE MAXIMUM NUMBER OF CHARS THAT CAN BE ASSEMBLED.)
C
ENCODE(LCNT,233,WORD(WCNT))(LETTER(K),K=1,LCNT)
233 FORMAT(18A1)
C
C --- SET EACH ELEMENT OF ARRAY *LETTER* TO 1 BLANK.
C
234 CONTINUE
IF (NFLG1.EQ.0) GOTO 235
IF (NFLG2.EQ.0) GOTO 236
NFLG1 = NFLG2 = 0
GO TO 235
236 IF (WCNT.NE.3) GOTO 235
WCNT = WCNT - 1
NFLG2 = -1
C
235 CONTINUE
DO 237 K=1,18
237 LETTER(K) = 1H
C
C --- RESET *LCNT* TO ZERO AND CONTINUE PROCESSING.
C
LCNT = 0
245 CONTINUE
246 CONTINUE
C
C --- AFTER ALL THE CHARS OF THE FIRST STRING HAVE BEEN
C --- PROCESSED, READ THE NEXT RECORD. THIS RECORD IS
C --- MADE OF THE JOBNAME (*KWASTE*) AND THE NUMBER OF
C --- KILO-LINES PRINTED TO FULFILL THE PRINT REQUEST.
C --- THE SECOND OF THESE IS READ IN ALPHANUMERIC FORMAT
C --- IN ORDER TO CATCH MISTAKES, LIKE A MISSING RECORD
C --- FOR THE NUMBER OF PRINTED LINES, ETC.
C
READ (10,247) KWASTE, WASTE
247 FORMAT (16X,A7,1X,3A10)
C
C --- CHECK FOR END-OF-FILE. IF ENCOUNTERED, PRINT AN ERROR
C --- MESSAGE ABOUT A MISSING -UCLP- ENTRY AND PROCEED TO
C --- ROUTINE *PHASE3*.
C
IF (EOF(10) .EQ. 0) GO TO 250
C
WRITE (7,4001) JOBDAT, JOBTIM, JOBNAM, ARRAY
GO TO 999
C
250 CONTINUE
C
C --- CHECK TO SEE IF THE TWO ENTRIES HAVE THE SAME JOB
C --- NAME. IF NOT, PRINT OUT AN ERROR MESSAGE.
C
N99 = WASTE(1).AND.MASK(24)
IF ((KWASTE.NE.JWASTE).OR.(N99.NE.4LZZZZ)) GO TO 4000
C
C
C FORMAT OF -UCLP- ENTRIES SEEMS TO KEEP CHANGING SO
C THE FLOATING POINT FIELD CONTAINING NUMBER OF LINES
C PRINTED KEEPS MOVING. SOLUTION IS TO HAVE THE
C FOLLOWING ROUTINE LOCATE THE DECIMAL POINT AND THEN
C RETURN THE NUMBER OF LINES BASED ON WHERE THE
C DECIMAL POINT WAS FOUND.
CALL FINDPNT(JJNUM)
C MAKE SURE WE REALLY HAVE A FLOATING POINT NUMBER
CALL FCHECK(JJNUM,JFLAG)
IF(JFLAG.LT.0) GOTO 201
DECODE(10,301,JJNUM) XLINES
301 FORMAT(F10.3)
C
C --- CONVERT KILO-LINES TO PRINTER PAGES.
C
320 CONTINUE
NOPAGES = INT (XLINES * 100. / 6.)
C
C --- CHECK TO SEE IF EQUATION YIELDS A FRACTION OF A PAGE.
C --- IF SO, ADD 1 TO NOPAGES.
C
IF ((XLINES*100./6.)-FLOAT(NOPAGES).GT.0.001)NOPAGES = NOPAGES+1
C
C --- OUTPUT -- USER ACCNT, USER GROUP, USER NAME, NAME
C --- OF LESSON/FILE BEING PRINTED, NUMBER OF PAGES OF
C --- OUTPUT AND DATE OF PRINTING.
C
WRITE (11,401) (WORD(L),L=3,6),WORD(2),NOPAGES,JOBDAT
401 FORMAT(1X,A7,1X,2(A8,A10),I10,3X,A8)
GO TO 201
C
999 CALL PHASE3
C
STOP
C
C --- ERROR MESSAGES.
C
3000 CONTINUE
PRINT 3001
3001 FORMAT(////* ERROR -- DIMENSION OF ARRAY -NAMES- OF */
1 * 5000 HAS BEEN EXCEEDED. REPORT STOPPED.*/)
STOP
C
C ---
C
4000 CONTINUE
WRITE (7,4001) JOBDAT,JOBTIM,JWASTE,ARRAY
4001 FORMAT(2A8,A7,1X,6A10,5X,*RECORD IGNORED*)
C
C --- BACKSPACE TAPE10 ONE RECORD IN ORDER TO RE-READ
C --- THE RECORD WHICH DID NOT MATCH WITH THE CONTENTS
C --- OF *ARRAY* AT THE TIME OF THE PRINTING OF THIS
C --- ERROR MESSAGE.
C
BACKSPACE 10
C
C --- GO BACK TO THE TOP OF THE READ LOOP.
C
GO TO 201
C
C ---
C
END
SUBROUTINE PHASE3
C
C --- ROUTINE TO PROCESS THE DATA FROM TAPE11 TO PRODUCE
C --- REPORT-TYPE OUTPUT.
C
COMMON/PAGE/IPAGE,ILINE
C
INTEGER ACCT(500,2)
DIMENSION INPLIN(9), MESS(2)
C
DATA IACCT/-1/,LACCT/0/,IFLAG1/-1/
DATA KOUNT/1/,ACCT/1000*0/,NTOTAL/0/
C
REWIND 11
REWIND 12
C
C --- SORT TAPE11 BY ACCOUNT, GROUP, USER NAME, FILE NAME,
C --- DATE PRINTED AND NUMBER OF PAGES PRINTED.
C
CALL SM5SORT(0)
CALL SM5FROM("TAPE11")
CALL SM5TO("TAPE12")
CALL SM5KEY(2,7,"DISPLAY")
CALL SM5KEY(10,8,"DISPLAY")
CALL SM5KEY(18,18,"DISPLAY")
CALL SM5KEY(36,10,"COBOL6")
CALL SM5KEY(59,8,"DISPLAY")
CALL SM5KEY(46,10,"COBOL6")
CALL SM5END
C
REWIND 12
IPAGE = 1
ILINE = 12
C
1 CONTINUE
READ (12,2) IACCT,IGRP,NAME1,NAME2,IFLNAM,NPAGES,IDATE
2 FORMAT(1X,A7,1X,2(A8,A10),I10,3X,A8)
C
C --- CHECK FOR END-OF-FILE.
C
IF (EOF(12)) 10, 3
C
C --- CHECK TO SEE IF THIS ACCOUNT NAME = LAST ACCOUNT NAME
C
3 CONTINUE
IF (LACCT.EQ.IACCT) GO TO 6
C
C --- IF NOT, PRINT OUT THE TOTAL NUMBER OF PAGES FOR LACCT,
C --- THE LAST ACCOUNT NAME AND A NEW PAGE FOR IACCT, THE
C --- ACCOUNT NAME JUST READ IN.
C
C --- FIRST CHECK TO SEE IF *IFLAG1* IS -1, MEANING THAT
C --- THIS IS THE FIRST TIME THIS AREA HAS BEEN REACHED
C --- AND NO -TOTAL PAGES PRINTED- OUTPUT IS NEEDED.
C
IF (IFLAG1.EQ.-1) GO TO 9
IF (ILINE.LE.49) GO TO 907
CALL PAGE
PRINT 5, IACCT
907 CONTINUE
PRINT 4, ACCT(KOUNT-1,2)
4 FORMAT(///11X,7H*TOTAL*,57X,I10)
C
C --- PRINT THE NEW PAGE HEADING FOR *IACCT*.
C
9 CONTINUE
CALL PAGE
PRINT 5, IACCT
5 FORMAT (///21X,*ACCOUNT *,A7///11X,*NAME*,19X,*GROUP*,
1 8X,*FILE NAME*,8X,*DATE*,12X,*PAGES*//)
C
C --- SET ACCT(KOUNT,1) TO IACCT
C
ACCT(KOUNT,1) = IACCT
KOUNT = KOUNT + 1
IF (KOUNT.EQ.501) GO TO 10
C
C --- SET *IFLAG1* TO 0.
C
IFLAG1 = 0
C
C --- PRINT OUT THE USER'7S RECORD. FIRST, HOWEVER, CHECK TO
C --- SEE IF THE OUTPUT WILL BE GOING PAST THE 55TH LINE ON
C --- THE PAPER. IF SO, RESTORE THE LINE COUNT AND PRINT A
C --- NEW HEADING.
C
6 CONTINUE
IF (ILINE.LE.52) GO TO 7
CALL PAGE
PRINT 5, IACCT
7 CONTINUE
PRINT 8, NAME1,NAME2,IGRP,IFLNAM,IDATE,NPAGES
8 FORMAT (11X,A10,2(A8,5X),A10,5X,A8,5X,I10)
C
ACCT(KOUNT-1,2) = ACCT(KOUNT-1,2) + NPAGES
ILINE = ILINE + 1
LACCT = IACCT
C
C --- RETURN BACK TO THE TOP OF THE READ LOOP.
C
GO TO 1
C
C --- END-OF-FILE ENCOUNTERED -- PRINT THE TOTAL OF THE
C --- LAST ACCOUNT PROCESSED AND PRINT OUT THE SUMMARY.
C
10 CONTINUE
IF (KOUNT.EQ.1) GO TO 32
IF (ILINE.LE.49) GO TO 908
CALL PAGE
PRINT 5, IACCT
908 CONTINUE
PRINT 4, ACCT(KOUNT-1,2)
C
C --- PRINT OUT THE SUMMARY OF ACCOUNT PRINT REQUESTS.
C
CALL PAGE
PRINT 11
11 FORMAT (///36X,*SUMMARY OF PAGES PRINTED*////)
C
C --- LOOP TO PRINT OUT THE LIST OF ACCOUNTS
C
KOUNT = KOUNT - 1
C
DO 20 I = 1, KOUNT
IF (ILINE.LE.52) GO TO 14
CALL PAGE
PRINT 11
14 CONTINUE
PRINT 15, ACCT(I,1), ACCT(I,2)
15 FORMAT (21X,*ACCOUNT *,A7,30X,I10,* PAGES*)
NTOTAL = NTOTAL + ACCT(I,2)
20 CONTINUE
C
C --- PRINT OUT THE GRAND TOTAL NUMBER OF PAGES PRINTED.
C
IF (ILINE.LE.49) GO TO 909
CALL PAGE
PRINT 5, IACCT
909 CONTINUE
PRINT 30, NTOTAL
30 FORMAT (///21X,7H*TOTAL*,38X,I10,* PAGES*)
GOTO 40
32 CONTINUE
PRINT 33
33 FORMAT(1H1///,5X,2H**,* NO USERS TO BILL WITH INPUT*,
+ * DATA PROVIDED*)
C
C --- PRINT OUT LIST OF ERRORS ON TAPE7.
C
40 IPAGE = 1
ILINE = 12
CALL PAGE
C
PRINT 50
50 FORMAT (1H1///,5X,2H**,* ERROR SUMMARY FOR INPUT DATA*
+ ,3H **)
C
REWIND 7
C
C --- LOOP TO READ FROM TAPE7 AND PRINT TO OUTPUT.
C
51 CONTINUE
IF (ILINE.LE.52) GO TO 52
CALL PAGE
PRINT 50
52 CONTINUE
C
READ (7,60) INPLIN, MESS
60 FORMAT (8A10,A3,5X,2A10)
C
C --- CHECK FOR END-OF-FILE. IF ENCOUNTERED, STOP.
C
IF (EOF(7)) 65,59
59 CONTINUE
C
PRINT 61, INPLIN, MESS
61 FORMAT (5X,8A10,A3,15X,2A10)
C
GO TO 51
65 CONTINUE
PRINT 66
66 FORMAT(5X,* -- END OF INFORMATION --*)
STOP
C
END
SUBROUTINE FINDPNT(JJNUM)
INTEGER WASTE(3),STRING(30)
COMMON/WHATEVR/ KWASTE,WASTE
JJNUM=0
K=0
C BREAK ARRAY UP INTO A STRING OF CHARACTERS
DO 100 I=1,3
ITEMP=WASTE(I)
DO 100 J=1,10
K=K+1
ITEMP=SHIFT(ITEMP,6)
ICHAR=ITEMP.AND.77B
STRING(K)=ICHAR
100 CONTINUE
C
C FIND DECIMAL POINT IN FLOATING POINT NUMBER OF LINES
DO 200 I=7,27
IF(STRING(I).NE.1R.) GOTO 200
IPNT=I
GOTO 300
200 CONTINUE
PRINT 250
250 FORMAT(* -- ERROR WITH UCLP ENTRIES*)
STOP
300 CONTINUE
C
IPNT=IPNT-6
C COPY FLOATING POINT NUMBER TO A SEPERATE WORD
DO 400 I=1,10
JJNUM=SHIFT(JJNUM,6)
JJNUM=JJNUM.OR.STRING(IPNT)
IPNT=IPNT+1
400 CONTINUE
RETURN
END
C
C
SUBROUTINE FCHECK(JPARAM,IFLAG)
INTEGER WASTE(3)
COMMON/WHATEVR/ KWASTE,WASTE
C
JVAL = JPARAM
DO 100 I = 1,10
ITEMP = JVAL.AND.77B
JVAL = SHIFT(JVAL,-6)
IF(I.NE.4) GOTO 50
IF(ITEMP.NE.57B) GOTO 200
GOTO 100
50 CONTINUE
IF( .NOT.( ((ITEMP.GT.32B).AND.(ITEMP.LT.45B))
+ .OR. (ITEMP.EQ.55B) )) GOTO 200
100 CONTINUE
C
IFLAG = 0
RETURN
200 CONTINUE
WRITE(7,300) KWASTE, WASTE
300 FORMAT(* BAD REC - *,4A10)
IFLAG = -1
RETURN
END
SUBROUTINE PAGE
C
C --- SUBROUTINE TO PRINT OUT AND INCREMENT THE PAGE NUMBER.
C
COMMON/PAGE/IPAGE,ILINE
C
PRINT 1, IPAGE
1 FORMAT (1H1////106X,*PAGE *,I4)
C
IPAGE = IPAGE + 1
ILINE = 12
C
RETURN
END