Base file: C:\Documents and Settings\jxc2\My Documents\Natural Presentation\Debugging Natural Modules Nat Conf 2006\Production Code.txt
Compared file: C:\Documents and Settings\jxc2\My Documents\Natural Presentation\Debugging Natural Modules Nat Conf 2006\Test Code.txt
** 09/27/93 KKH5 A4CERB COURSE MASTER CHANGES REPORT
** 11/05/93 KKH5 RECYCLE TRLOG RECORDS UNTIL THE COURSE SEMESTER END
** DATE IS LESS THAN THE CURRENT SEMESTER. CREDIT TYPE
** AND FACTOR COMES FROM U-INST-CRSES INSTEAD OF
** U-INSTITUTION.
** 11/29/93 KKH5 VERIFY THAT COURSES HAVE REALLY ENDED.
** 02/04/94 SJD1 ADDED DATE TO SORT; RETAIN ORIGINAL DATE IN TRLOG.
** 02/08/94 KKH5 CORRECTED GET SAME LOGIC FOR UCM FILE.
** 10/25/94 SJD1 DON'T OVERLAY END SEM WITH LATER SEMESTER WHEN
** EVALUATION IS A MULTIPLE OR SERIES.
** 11/15/94 SJD1 CORRECTED A HOLD QUEUE PROBLEM AND POSSIBLE HQ PROB.
** 12/05/94 SJD1 DON'T END BEYOND CURRENT SEMESTER; DON'T END
** IF CREDIT ONLY CHANGE WHERE THERE ARE ENOUGH
** CREDITS GRANTED TO COVER THE EVALUATION.
** 06/23/95 SJD1 SEPARATE BEHREND AND CAPITAL EVALUATIONS THAT ARE
** ENDED EACH ONTO SEPARATE REPORTS.
** 09/07/95 SJD1 21ST C-E-N-T-U-R-Y S-M-A-R-T ! ! !
** 01/06/03 JXC2 DO NOT UPDATE BASED ON PAST COURSE TITLE CHANGE
** REMOVED COBOL CALL TO GET UNIV NAME
** ADDED WRITE 'TITLE CHANGE NOT CURRENT:' ...
** 07/03/03 JXC2 WHEN A COURSE ENDS ON THE UCM FILE THE EVALUATION
** SHOULD BE UPDATED TO THE NEW COURSE IF ONE EXISTS
** 09/14/06 JXC2 CODE WAS FIXED TO MAKE SURE COURSE TITLE CHANGES
** HAPPEN AT THE CORRECT TIME
************************************************************************
* *
* PROGRAM ID: A4CERB AUTHOR: KKH5 DATE: 09/27/93 *
* *
* CHART NUMBER: NONE REPORT/SCREEN NUMBER: VPAR4118 *
* *
* GENERAL PROGRAM DESCRIPTION: *
* THIS PROGRAM PRODUCES A REPORT OF CHANGES TO THE UNIVERSITY *
* COURSE MASTER FILE AND THE INSTITUTION COURSES THESE CHANGES *
* MAY AFFECT. COURSE RENUMBERINGS, CREDIT CHANGES, TITLE CHANGES, *
* AND COURSE ENDINGS ARE REPORTED. *
************************************************************************
FORMAT(1) LS=133 PS=58
FORMAT(2) LS=133 PS=58
FORMAT(3) LS=133 PS=58
RESET #CHG-MSG(A14) #CURR-SEM8(A8) #EVAL-LOC(A2) #CHG-END8(A8)
#PREV-COURSE(A9) #PREV-EFF-SEM(A8) #CHG-EFF8(A8) #END-EVAL(A1)
#FLAG-GRANTED(A1) #FLAG-FOUND(A1) #FLAG-MIN-CRDT-CHG(A1)
#FLAG-MAX-CRDT-CHG(A1) #FLAG-TITLE-CHG(A1) #FLAG-CRSE-END(A1)
#FLAG-FIRST-INST-CRSE(A1) #FLAG-CRSE-CHG(A1) #CHG-TITLE(A18)
#NEW-CRDT-MIN(N2.1) #NEW-CRDT-MAX(N2.1) #NEW-TITLE(A18)
#TOT-RECS-READ(N5) #TOT-RECS-REJECTED(N5)
#TOT-CRSES-ENDED(N5)
#TOT-RECS-ACCEPTED(N5) #TOT-CRSES-RENUM(N5)
#TOT-TITLE-CHGS(N5) #TOT-CRDT-CHGS(N5)
#TOT-RECS-UPDATED(N5/1:3) #TOT-RECS-RECYCLED(N5)
#TOT-EVALS-CRDT-ADJ(N5/1:3) #TOT-EVALS-ENDED(N5/1:3)
#TRLOG-REC(A100) #KEY-NON-PSU(A34) #PREV-CRSE-PRINT(A9)
#PREV-CRSE-PRINT-BD(A9) #PREV-CRSE-PRINT-CL(A9)
*
REDEFINE #PREV-COURSE(#PREV-CRSE-ABBR(A5) #PREV-CRSE-NUMB(A4))
REDEFINE #CURR-SEM8(6X #CURR-SESS(A2))
REDEFINE #TRLOG-REC(#TRLOG-LOG-ID(A6) #TRLOG-DATE(N8)
#TRLOG-TIME(N7) #TRLOG-USER-ID(A8) #TRLOG-TERM-ID(A8)
#TRLOG-SEQ(N6) #TRLOG-FILL(A3) #TRLOG-COURSE-DATA(A37))
REDEFINE #TRLOG-COURSE-DATA(#TRLOG-COURSE(A9)
#TRLOG-EFF-SEM(A8) #TRLOG-END-SEM(A8) #TRLOG-COURSE-END(A1)
#TRLOG-TITLE-CHANGE(A1) #TRLOG-CREDIT-CHANGE(A1)
#TRLOG-CURR-COURSE(A9))
REDEFINE #KEY-NON-PSU(#KEY-INST(A6) #KEY-INST-CRSE(A15)
#KEY-INST-CRDT(N2.2) #KEY-CRDT-TYPE(A1) #KEY-SEM-EFF(A8))
*
MOVE '2' TO #CONV2(A1)
MOVE '8' TO #CONV8(A1)
MOVE 15 TO #CONV(N2)
CALL 'A4AIXU' #CONV #CURR-SEM8 #RTC(B4) #CURR-SEM-IDATE(N8)
#CURR-SEM-CP(A2) #CURR-SEM-SDATE(N8) #CURR-SEM-EDATE(N8)
IF #RTC NE 0 DO
MOVE '*** A4CERB - UNABLE TO OBTAIN CURRENT SEMESTER'
TO #GABWTO-MSG(A70)
MOVE +70 TO #GABWTO-LEN(B2)
CALL 'GABWTO' #GABWTO-LEN #GABWTO-MSG
MOVE 'Y' TO #ABEND-SW(A1)
DOEND
ELSE IF #CURR-SESS = MASK('S'N)
MOVE 'SU' TO #CURR-SESS
*
MOVE ' THE PENNSYLVANIA STATE UNIVERSITY' TO #UNIV-NAME(A50)
*
IF #ABEND-SW = 'Y' DO
MOVE 2560 TO #GABEND-CODE(B4)
CALL 'GABEND' #GABEND-CODE
DOEND
*
CALLNAT 'A6CSSA' #RTC #CONV2 #CURR-SEM6(A6) #CURR-SEM8
*************************
READ WORK 1 #TRLOG-REC
REJECT IF #TRLOG-LOG-ID NE 'A40035'
*************************
SORT BY #TRLOG-COURSE
#TRLOG-EFF-SEM
USING #TRLOG-REC
*************************
AT START OF DATA DO
MOVE *INIT-USER TO #CLERK(A8)
MOVE *INIT-ID TO #TERMINAL(A8)
MOVE *DATN TO #TODAYS-DATE(N8)
MOVE *DATU TO #DATE(A8)
MOVE *TIME TO #TIME(A8)
ASSIGN #I(N3) = 1
DOEND
*
AT TOP OF PAGE(1) DO
WRITE(1) NOTITLE NOHDR
1T 'VPAR4118'
42T #UNIV-NAME
118T 'DATE:'
124T #DATE
/ 56T 'COURSE MASTER CHANGES'
118T 'TIME:'
124T #TIME
/ 61T 'THRU' #CURR-SEM6
118T 'PAGE:'
124T *PAGE-NUMBER(1)
// 52T 'CRDT CRDT CHANGE DATE ACAD APPR'
/ 3T 'COURSE EFF END TITLE'
52T ' MIN MAX DATE PROPOSED ADM APPR'
95T 'CWIPSE INST COURSE CRDT EFF'
/
DOEND
*
AT TOP OF PAGE(2) DO
WRITE(2) NOTITLE NOHDR
1T 'VPAR4118' 12X '<PS ERIE>'
42T #UNIV-NAME
118T 'DATE:'
124T #DATE
/ 56T 'COURSE MASTER CHANGES'
118T 'TIME:'
124T #TIME
/ 61T 'THRU' #CURR-SEM6
118T 'PAGE:'
124T *PAGE-NUMBER(2)
// 52T 'CRDT CRDT CHANGE DATE ACAD APPR'
/ 3T 'COURSE EFF END TITLE'
52T ' MIN MAX DATE PROPOSED ADM APPR'
95T 'CWIPSE INST COURSE CRDT EFF'
/
DOEND
*
AT TOP OF PAGE(3) DO
WRITE(3) NOTITLE NOHDR
1T 'VPAR4118' 12X '<PS HARRISBURG>'
42T #UNIV-NAME
118T 'DATE:'
124T #DATE
/ 56T 'COURSE MASTER CHANGES'
118T 'TIME:'
124T #TIME
/ 61T 'THRU' #CURR-SEM6
118T 'PAGE:'
124T *PAGE-NUMBER(3)
// 52T 'CRDT CRDT CHANGE DATE ACAD APPR'
/ 3T 'COURSE EFF END TITLE'
52T ' MIN MAX DATE PROPOSED ADM APPR'
95T 'CWIPSE INST COURSE CRDT EFF'
/
DOEND
*
AT END OF PAGE (1) DO
WRITE (1) // 1T '* - INDICATES CHANGED ITEMS'
MOVE ' ' TO #PREV-CRSE-PRINT
DOEND
*
AT END OF PAGE (2) DO
WRITE (2) // 1T '* - INDICATES CHANGED ITEMS'
MOVE ' ' TO #PREV-CRSE-PRINT-BD
DOEND
*
AT END OF PAGE (3) DO
WRITE (3) // 1T '* - INDICATES CHANGED ITEMS'
MOVE ' ' TO #PREV-CRSE-PRINT-CL
DOEND
*
ADD 1 TO #TOT-RECS-READ
IF #TRLOG-COURSE = #PREV-COURSE AND
#TRLOG-EFF-SEM = #PREV-EFF-SEM DO
ADD 1 TO #TOT-RECS-REJECTED
ESCAPE TOP
DOEND
MOVE #TRLOG-COURSE TO #PREV-COURSE
MOVE #TRLOG-EFF-SEM TO #PREV-EFF-SEM
*
MOVE #TRLOG-END-SEM TO #END-SEM8(A8)
REDEFINE #END-SEM8(6X #END-SEM-SESS(A2))
IF #END-SEM-SESS = MASK('S'N)
MOVE 'SU' TO #END-SEM-SESS
*
MOVE 'N' TO #EVAL-EXISTS(A1)
HISTOGRAM(1) U-INST-CRSES KEY-PSU-CRSE-INST
STARTING FROM #TRLOG-COURSE
REDEFINE KEY-PSU-CRSE-INST(#PSU-CRSE(A9))
IF #PSU-CRSE = #TRLOG-COURSE
MOVE 'Y' TO #EVAL-EXISTS
LOOP(19250)
*
IF #EVAL-EXISTS NE 'Y' DO
ADD 1 TO #TOT-RECS-REJECTED
IF #END-SEM8 GE #CURR-SEM8
PERFORM WRITE-TRLOG
ESCAPE TOP
DOEND
**
** FIND UCM RECORD THAT WAS ENDED
**
MOVE 'N' TO #FLAG-GRANTED
MOVE 'Y' TO #FLAG-FIRST-INST-CRSE
READ U-UNIV-CRSE-MASTER BY CODE-CRSE-KEY
STARTING FROM #TRLOG-COURSE
OBTAIN DATE-CRSE-PROPOSED(1-5)
DATE-CRSE-ACAD-APPROVE(1-5)
DATE-CRSE-ADMIN-APPROVE(1-5)
IF CODE-CRSE-KEY NE #TRLOG-COURSE
ESCAPE
REJECT IF CODE-CRSE-EFF-YRTM NE #TRLOG-EFF-SEM
REJECT IF CODE-CRSE-END-YRTM LT CODE-CRSE-EFF-YRTM AND
CODE-CRSE-END-YRTM NE ' ' /* PROPOSAL
REJECT IF CODE-CRSE-END-YRTM LE ' '
*
MOVE CODE-CRSE-END-YRTM TO #END-SEM8
IF #END-SEM-SESS = MASK('S'N)
MOVE 'SU' TO #END-SEM-SESS
IF #END-SEM8 GT #CURR-SEM8 /* DUE TO VOLATILITY OF UCM CHANGES.
ESCAPE /* DON'T CLOSE OUT FUTURE SEMESTERS.
* COURSE TITLE CHANGE; SEMESTER YOU ARE RUNNING THE OLD TITLE IS STILL
* IN EFFECT - DON'T CHANGE TO THE NEW TITLE TOO SOON
* #END-SEM8 IS THE LAST SEMESTER THE OLD TITLE IS EFFECT
IF #END-SEM8 EQ #CURR-SEM8 AND #TRLOG-CURR-COURSE GT ' '
ESCAPE
*
RESET #CRSE-CURR(A9)
MOVE CODE-CRSE-KEY TO #CRSE(A9)
MOVE CODE-CRSE-EFF-YRTM TO #CRSE-EFF-YRTM(A8)
MOVE CODE-CRSE-END-YRTM TO #CRSE-END-YRTM(A8)
IF CODE-CRSE-CURR-KEY NE CODE-CRSE-KEY
MOVE CODE-CRSE-CURR-KEY TO #CRSE-CURR
MOVE NAME-CRSE-TITLE-SHORT TO #TITLE(A18)
MOVE QNTY-CRSE-CR-MIN TO #CRDT-MIN(N2.1)
MOVE QNTY-CRSE-CR-MAX TO #CRDT-MAX(N2.1)
MOVE DATE-CRSE-CHNG-MADE TO #DATE-CHG-MADE(N8)
MOVE C*CRSE-STATUS-GROUP TO #I
IF #I LE 0 MOVE 1 TO #I
IF #I > 5 DO
GET SAME(21030) DATE-CRSE-PROPOSED(#I)
DATE-CRSE-ACAD-APPROVE(#I)
DATE-CRSE-ADMIN-APPROVE(#I)
MOVE DATE-CRSE-PROPOSED(24190/#I) TO #DATE-PROP(N8)
MOVE DATE-CRSE-ACAD-APPROVE(24190/#I) TO #DATE-ACAD(N8)
MOVE DATE-CRSE-ADMIN-APPROVE(24190/#I) TO #DATE-ADMIN(N8)
DOEND
ELSE DO
MOVE INDEXED DATE-CRSE-PROPOSED(1)<#I> TO #DATE-PROP
MOVE INDEXED DATE-CRSE-ACAD-APPROVE(1)<#I> TO #DATE-ACAD
MOVE INDEXED DATE-CRSE-ADMIN-APPROVE(1)<#I> TO #DATE-ADMIN
DOEND
*
READ U-INST-CRSES BY KEY-PSU-CRSE-INST
STARTING FROM #CRSE
IF CODE-INST-CRSE-PSU NE #CRSE
ESCAPE
REJECT IF CODE-INST-CRSE-SEM-EFF > #END-SEM8
REJECT IF CODE-INST-CRSE-SEM-END NE ' '
*
IF #FLAG-FIRST-INST-CRSE = 'Y' DO
MOVE 'N' TO #FLAG-FIRST-INST-CRSE
PERFORM CHECK-FOR-CHANGE
DOEND
*
MOVE CODE-INST-CRSE-LOC TO #EVAL-LOC
IF #EVAL-LOC = 'BD'
MOVE 2 TO #RPT(N3)
ELSE IF #EVAL-LOC = 'CL'
MOVE 3 TO #RPT
ELSE
MOVE 1 TO #RPT
MOVE *ISN TO #INST-ISN(N8)
IF #CHG-MSG > ' ' DO
MOVE CODE-INST TO #CWIPSE(A6)
MOVE CODE-INST-CRSE-NON-PSU TO #INST-CRSE(A15)
MOVE QNTY-INST-CRSE-NON-PSU-CRDT TO #INST-CRDT(N2.2)
MOVE CODE-INST-CRSE-SEM-EFF TO #INST-EFF8(A8)
MOVE AMNT-INST-CRSE-CRDT-FACTOR TO #CRDT-FACTOR(N1.2)
MOVE CODE-INST-CRSE-CRDT-TYPE TO #CRDT-TYPE(A1)
IF CODE-INST-EXCEPTION NE 'X' DO /* SIMPLE EVALUATIONS
GET U-INST-CRSES #INST-ISN
COMPUTE #CRDT(N2.2) =
QNTY-INST-CRSE-NON-PSU-CRDT *
AMNT-INST-CRSE-CRDT-FACTOR
IF #CHG-MSG = 'CREDIT CHANGE' AND
#CRDT GE #NEW-CRDT-MAX DO
IF QNTY-INST-CRSE-PSU-CRDT LE 0
IGNORE
ELSE
ESCAPE TOP
*
** VARIABLE CREDIT PSU COURSE REQUIRE THAT TOTAL CREDITS
** GRANTED BE POSTED TO THE EVALUATION RECORD. ALSO IF CREDIT
** GRANTED EXCEEDS COURSE VALUE, TOTAL CREDITS ARE NEEDED. SO
** TO COVER ALL TIME FRAMES AND SCENARIOS, POST.
*
UPDATE(282900) WITH
DATE-INST-CRSE-UPDATED = #TODAYS-DATE
CODE-EMPL-USERID-UPDT = #CLERK
QNTY-INST-CRSE-PSU-CRDT = #CRDT
ADD 1 TO #TOT-EVALS-CRDT-ADJ(#RPT)
ADD 1 TO #TOT-RECS-UPDATED(#RPT)
ESCAPE TOP
DOEND
*
MOVE 'Y' TO #FLAG-GRANTED
IF #FLAG-CRSE-CHG = 'Y' DO
UPDATE(282900) WITH
CODE-INST-CRSE-PSU = #CRSE-CURR
DATE-INST-CRSE-UPDATED = #TODAYS-DATE
CODE-EMPL-USERID-UPDT = #CLERK
DESC-INST-CRSE-NON-PSU = #CHG-TITLE
DOEND
ELSE DO
UPDATE(282900) WITH
CODE-INST-CRSE-SEM-END = #END-SEM8
DATE-INST-CRSE-UPDATED = #TODAYS-DATE
CODE-EMPL-USERID-UPDT = #CLERK
DESC-INST-CRSE-NON-PSU = #TITLE
QNTY-INST-CRSE-PSU-CRDT = #CRDT
PERFORM WRITE-DETAIL
DOEND
ADD 1 TO #TOT-RECS-UPDATED(#RPT)
DOEND
*
** GET THE MASTER RECORD AND DETERMINE WHETHER THE EVALUATION
** SHOULD BE ENDED; IF 'YES' END SYSTEM RECORD.
*
ELSE DO
MOVE CODE-INST TO #KEY-INST
MOVE CODE-INST-CRSE-NON-PSU TO #KEY-INST-CRSE
MOVE QNTY-INST-CRSE-NON-PSU-CRDT TO #KEY-INST-CRDT
MOVE CODE-INST-CRSE-CRDT-TYPE TO #KEY-CRDT-TYPE
MOVE CODE-INST-CRSE-SEM-EFF TO #KEY-SEM-EFF
MOVE AMNT-INST-CRSE-CRDT-FACTOR TO #KEY-CRDT-FACTOR(N1.2)
PERFORM UPDATE-MULT-SERIES
IF #END-EVAL = 'Y' DO
GET U-INST-CRSES #INST-ISN
IF #FLAG-CRSE-CHG = 'Y' DO
UPDATE(339470) WITH
CODE-INST-CRSE-PSU = #CRSE-CURR
DATE-INST-CRSE-UPDATED = #TODAYS-DATE
CODE-EMPL-USERID-UPDT = #CLERK
DESC-INST-CRSE-NON-PSU = #CHG-TITLE
DOEND
ELSE DO
UPDATE (339470) WITH
CODE-INST-CRSE-SEM-END = #END-SEM8
DATE-INST-CRSE-UPDATED = #TODAYS-DATE
CODE-EMPL-USERID-UPDT = #CLERK
DOEND
DOEND
DOEND
*
END TRANSACTION
DOEND
ELSE /* NOT A CREDIT, TITLE, ETC. CHANGE
ESCAPE
*
LOOP(254620) /* U-INST-CRSES
*
LOOP(21030) /* U-UNIV-CRSE-MASTER
*
IF #FLAG-GRANTED = 'N'
ADD 1 TO #TOT-RECS-REJECTED
ELSE
ADD 1 TO #TOT-RECS-ACCEPTED
*
IF #FLAG-FIRST-INST-CRSE = 'N' AND #CHG-MSG LE ' '
IGNORE
ELSE IF #END-SEM8 GE #CURR-SEM8
PERFORM WRITE-TRLOG
************************************************************************
** WRITE-DETAIL **
************************************************************************
DEFINE SUBROUTINE WRITE-DETAIL
RESET #END-SEM-DIS(A7) #MIN-CRDT-DIS(A5) #MAX-CRDT-DIS(A5)
REDEFINE #END-SEM-DIS(#END-SEM-AST(A1) #END-SEM6(A6))
REDEFINE #MIN-CRDT-DIS(#CR-MIN-AST(A1) #CR-MIN(A4))
REDEFINE #MAX-CRDT-DIS(#CR-MAX-AST(A1) #CR-MAX(A4))
*
IF #FLAG-TITLE-CHG = 'Y'
COMPRESS '*' #NEW-TITLE INTO #NEW-TITLE-DIS(A19) LEAVING NO SPACE
ELSE
MOVE ' ' TO #NEW-TITLE-DIS
*
IF #FLAG-CRSE-CHG = 'Y'
COMPRESS '*' #CRSE-CURR INTO #CURR-CRSE-DIS(A10) LEAVING NO SPACE
ELSE
MOVE ' ' TO #CURR-CRSE-DIS
*
IF #FLAG-CRSE-END = 'Y'
MOVE '*' TO #END-SEM-AST
*
IF #FLAG-MIN-CRDT-CHG = 'Y' OR #FLAG-MAX-CRDT-CHG = 'Y' DO
IF #FLAG-MIN-CRDT-CHG = 'Y'
MOVE '*' TO #CR-MIN-AST
IF #FLAG-MAX-CRDT-CHG = 'Y'
MOVE '*' TO #CR-MAX-AST
MOVE EDITED #NEW-CRDT-MIN (EM=Z9.9) TO #CR-MIN
MOVE EDITED #NEW-CRDT-MAX (EM=Z9.9) TO #CR-MAX
DOEND
*
CALLNAT 'A6CSSA' #RTC #CONV2 #EFF-SEM6(A6) #CRSE-EFF-YRTM
CALLNAT 'A6CSSA' #RTC #CONV2 #END-SEM6 #CRSE-END-YRTM
CALLNAT 'A6CSSA' #RTC #CONV2 #CHG-EFF6(A6) #CHG-EFF8
CALLNAT 'A6CSSA' #RTC #CONV2 #INST-EFF6(A6) #INST-EFF8
*
CALL 'AU11SA' #RTC #CONV8 #DATE-PROP-DIS(A8) #DATE-PROP
CALL 'AU11SA' #RTC #CONV8 #DATE-ACAD-DIS(A8) #DATE-ACAD
CALL 'AU11SA' #RTC #CONV8 #DATE-ADMIN-DIS(A8) #DATE-ADMIN
CALL 'AU11SA' #RTC #CONV8 #CHG-MADE-DIS(A8) #DATE-CHG-MADE
*
** REDEFINE #TRLOG-COURSE(#TRLOG-CRSE-ABBR(A5) #TRLOG-CRSE-NUMB(A4))
IF #RPT = 1 DO
IF #TRLOG-COURSE = #PREV-CRSE-PRINT DO
WRITE(1) NOTITLE
96T #CWIPSE
103T #INST-CRSE
119T #INST-CRDT(EM=Z9.99)
126T #INST-EFF6 /
DOEND
ELSE DO
MOVE #TRLOG-COURSE TO #PREV-CRSE-PRINT
WRITE(1) NOTITLE
/ 1T #TRLOG-COURSE (EM=XXXXX' 'XXXX)
14T #EFF-SEM6
21T #END-SEM-DIS
30T #TITLE
51T #CRDT-MIN(EM=Z9.9)
59T #CRDT-MAX(EM=Z9.9)
67T #CHG-MADE-DIS
77T #DATE-PROP-DIS
86T #DATE-ACAD-DIS
96T #CWIPSE
103T #INST-CRSE
119T #INST-CRDT(EM=Z9.99)
126T #INST-EFF6
/ 1T #CURR-CRSE-DIS
14T #CHG-EFF6
30T #NEW-TITLE-DIS
50T #MIN-CRDT-DIS
58T #MAX-CRDT-DIS
86T #DATE-ADMIN-DIS
DOEND
DOEND
ELSE IF #RPT = 2 DO
IF #TRLOG-COURSE = #PREV-CRSE-PRINT-BD DO
WRITE(2) NOTITLE
96T #CWIPSE
103T #INST-CRSE
119T #INST-CRDT(EM=Z9.99)
126T #INST-EFF6 /
DOEND
ELSE DO
MOVE #TRLOG-COURSE TO #PREV-CRSE-PRINT-BD
WRITE(2) NOTITLE
/ 1T #TRLOG-COURSE (EM=XXXXX' 'XXXX)
14T #EFF-SEM6
21T #END-SEM-DIS
30T #TITLE
51T #CRDT-MIN(EM=Z9.9)
59T #CRDT-MAX(EM=Z9.9)
67T #CHG-MADE-DIS
77T #DATE-PROP-DIS
86T #DATE-ACAD-DIS
96T #CWIPSE
103T #INST-CRSE
119T #INST-CRDT(EM=Z9.99)
126T #INST-EFF6
/ 1T #CURR-CRSE-DIS
14T #CHG-EFF6
30T #NEW-TITLE-DIS
50T #MIN-CRDT-DIS
58T #MAX-CRDT-DIS
86T #DATE-ADMIN-DIS
DOEND
DOEND
ELSE DO
IF #TRLOG-COURSE = #PREV-CRSE-PRINT-CL DO
WRITE(3) NOTITLE
96T #CWIPSE
103T #INST-CRSE
119T #INST-CRDT(EM=Z9.99)
126T #INST-EFF6 /
DOEND
ELSE DO
MOVE #TRLOG-COURSE TO #PREV-CRSE-PRINT-CL
WRITE(3) NOTITLE
/ 1T #TRLOG-COURSE (EM=XXXXX' 'XXXX)
14T #EFF-SEM6
21T #END-SEM-DIS
30T #TITLE
51T #CRDT-MIN(EM=Z9.9)
59T #CRDT-MAX(EM=Z9.9)
67T #CHG-MADE-DIS
77T #DATE-PROP-DIS
86T #DATE-ACAD-DIS
96T #CWIPSE
103T #INST-CRSE
119T #INST-CRDT(EM=Z9.99)
126T #INST-EFF6
/ 1T #CURR-CRSE-DIS
14T #CHG-EFF6
30T #NEW-TITLE-DIS
50T #MIN-CRDT-DIS
58T #MAX-CRDT-DIS
86T #DATE-ADMIN-DIS
DOEND
DOEND
*
ADD 1 TO #TOT-EVALS-ENDED(#RPT)
RETURN
************************************************************************
** CHECK-FOR-CHANGE **
************************************************************************
DEFINE SUBROUTINE CHECK-FOR-CHANGE
*
RESET #CHG-EFF8 #FLAG-FOUND #FLAG-CRSE-END #CHG-END8 #CHG-TITLE
#FLAG-MIN-CRDT-CHG #FLAG-TITLE-CHG
#FLAG-CRSE-CHG #FLAG-MAX-CRDT-CHG #CHG-MSG
#NEW-CRDT-MIN #NEW-CRDT-MAX #NEW-TITLE
*
IF #CRSE-CURR > ' '
MOVE #CRSE-CURR TO #CRSE-KEY(A9)
ELSE
MOVE #CRSE TO #CRSE-KEY
*
READ U-UNIV-CRSE-MASTER BY CODE-CRSE-KEY STARTING FROM #CRSE-KEY
IF CODE-CRSE-KEY NE #CRSE-KEY
ESCAPE
REJECT IF CODE-CRSE-EFF-YRTM LE #CRSE-END-YRTM
REJECT IF CODE-CRSE-END-YRTM LT CODE-CRSE-EFF-YRTM AND
CODE-CRSE-END-YRTM NE ' '
**REJECT IF #CHG-EFF8 GT ' ' AND /* REMOVED 01/03/03 JXC2
** CODE-CRSE-EFF-YRTM GT #CHG-EFF8
IF #CHG-EFF8 GT ' ' AND /* ADDED 01/03/03 JXC2
CODE-CRSE-EFF-YRTM GT #CHG-EFF8
DO
IF #FLAG-TITLE-CHG = 'Y' /* PRIOR RCD HAD TITLE CHANGE
DO
IF #NEW-TITLE = NAME-CRSE-TITLE-SHORT /* TITLE CHANGE IS NOT
DO /* CURRENT
MOVE ' ' TO #FLAG-TITLE-CHG /* UNDO AFFECT OF TITLE
SUBTRACT 1 FROM #TOT-TITLE-CHGS /* CHANGE
WRITE 'TITLE CHANGE NOT CURRENT:' #TRLOG-COURSE
#TRLOG-EFF-SEM #TRLOG-END-SEM
IF #CHG-MSG = 'TITLE CHANGE'
RESET #CHG-MSG
DOEND
DOEND
ESCAPE TOP
DOEND
**
RESET #FLAG-MIN-CRDT-CHG #FLAG-TITLE-CHG #FLAG-CRSE-END
#FLAG-CRSE-CHG #FLAG-MAX-CRDT-CHG #CHG-MSG
#NEW-CRDT-MIN #NEW-CRDT-MAX #NEW-TITLE
MOVE 'Y' TO #FLAG-FOUND
MOVE CODE-CRSE-EFF-YRTM(53080) TO #CHG-EFF8
MOVE CODE-CRSE-END-YRTM(53080) TO #CHG-END8
MOVE NAME-CRSE-TITLE-SHORT(53080) TO #CHG-TITLE
*
IF QNTY-CRSE-CR-MAX(53080) NE #CRDT-MAX OR
QNTY-CRSE-CR-MIN(53080) NE #CRDT-MIN OR
NAME-CRSE-TITLE-SHORT(53080) NE #TITLE DO
IF (QNTY-CRSE-CR-MAX(53080) NE #CRDT-MAX OR
QNTY-CRSE-CR-MIN(53080) NE #CRDT-MIN) AND
NAME-CRSE-TITLE-SHORT(53080) NE #TITLE DO
MOVE 'CREDIT/TITLE' TO #CHG-MSG
MOVE 'Y' TO #FLAG-TITLE-CHG
ADD 1 TO #TOT-TITLE-CHGS
ADD 1 TO #TOT-CRDT-CHGS
IF QNTY-CRSE-CR-MIN(53080) NE #CRDT-MIN
MOVE 'Y' TO #FLAG-MIN-CRDT-CHG
IF QNTY-CRSE-CR-MAX(53080) NE #CRDT-MAX
MOVE 'Y' TO #FLAG-MAX-CRDT-CHG
DOEND
ELSE IF NAME-CRSE-TITLE-SHORT(53080) NE #TITLE DO
MOVE 'TITLE CHANGE' TO #CHG-MSG
MOVE 'Y' TO #FLAG-TITLE-CHG
ADD 1 TO #TOT-TITLE-CHGS
DOEND
ELSE DO
MOVE 'CREDIT CHANGE' TO #CHG-MSG
ADD 1 TO #TOT-CRDT-CHGS
IF QNTY-CRSE-CR-MIN(53080) NE #CRDT-MIN
MOVE 'Y' TO #FLAG-MIN-CRDT-CHG
IF QNTY-CRSE-CR-MAX(53080) NE #CRDT-MAX
MOVE 'Y' TO #FLAG-MAX-CRDT-CHG
DOEND
*
IF QNTY-CRSE-CR-MAX(53080) NE #CRDT-MAX OR
QNTY-CRSE-CR-MIN(53080) NE #CRDT-MIN DO
MOVE QNTY-CRSE-CR-MAX(53080) TO #NEW-CRDT-MAX
MOVE QNTY-CRSE-CR-MIN(53080) TO #NEW-CRDT-MIN
DOEND
IF NAME-CRSE-TITLE-SHORT(53080) NE #TITLE
MOVE NAME-CRSE-TITLE-SHORT(53080) TO #NEW-TITLE
DOEND
LOOP(53080)
*
IF #FLAG-FOUND NE 'Y' AND #CRSE-CURR LE ' ' DO
MOVE 'CRSE ENDED' TO #CHG-MSG
MOVE 'Y' TO #FLAG-CRSE-END
ADD 1 TO #TOT-CRSES-ENDED
DOEND
ELSE IF #CRSE-CURR > ' ' DO
MOVE 'CRSE # CHANGE' TO #CHG-MSG
MOVE 'Y' TO #FLAG-CRSE-CHG
ADD 1 TO #TOT-CRSES-RENUM
DOEND
*
RETURN
************************************************************************
** WRITE-TRLOG **
************************************************************************
DEFINE SUBROUTINE WRITE-TRLOG
ADD 1 TO #TRLOG-SEQ
*
STORE U-TRLOG WITH
CODE-TRFL-TYPE = 'A40035'
DATE-TRFL-REC = #TRLOG-DATE
TIME-TRFL = #TRLOG-TIME
CODE-TRFL-CLERK = #CLERK
CODE-TRFL-TERM = #TERMINAL
NUMB-TRFL-SEQ = #TRLOG-SEQ
DESC-TRFL-REC(1) = #TRLOG-COURSE-DATA
ADD 1 TO #TOT-RECS-RECYCLED
*
** DO TO THE WAY THIS WAS WRITTEN I'VE OPTED TO DO AN ET FOR EACH
** STORE TO PREVENT BOTH HOLD QUEUE AND TIME-OUT PROBLEMS. SJD1
*
END TRANSACTION
RETURN
************************************************************************
** UPDATE-MULT-SERIES **
** THIS ROUTINE UPDATES THE MASTER RECORD OF A MULITPLE OR SERIES **
** EVALUATION. **
************************************************************************
DEFINE SUBROUTINE UPDATE-MULT-SERIES
MOVE 'Y' TO #END-EVAL
FIND U-INST-CRSES WITH KEY-INST-NON-PSU-CRSE = #KEY-NON-PSU
WHERE CODE-INST-EXCEPTION = 'M' OR = 'S'
OBTAIN CODE-INST-CRSE-PSU-EXC(1-8)
QNTY-INST-CRSE-PSU-CRDT-EXC(1-8)
*
REJECT IF AMNT-INST-CRSE-CRDT-FACTOR NE #KEY-CRDT-FACTOR
REJECT IF CODE-INST-CRSE-LOC NE #EVAL-LOC
*
** DON'T END IF PREVIOUSLY ENDED WITH EARLIER SEM.
*
IF CODE-INST-CRSE-SEM-END GT ' ' AND
CODE-INST-CRSE-SEM-END LT #END-SEM8 DO
MOVE 'N' TO #END-EVAL
ESCAPE
DOEND
*
IF #CHG-MSG = 'CREDIT CHANGE' DO
FOR #I = 1 TO 8
MOVE INDEXED CODE-INST-CRSE-PSU-EXC(1)<#I> TO #CHECK-CRSE(A8)
MOVE INDEXED QNTY-INST-CRSE-PSU-CRDT-EXC(1)<#I> TO #CHECK-CRDT(N2.2)
IF #CHECK-CRSE = #CRSE AND #CHECK-CRDT GE #NEW-CRDT-MAX DO
MOVE 'N' TO #END-EVAL
ESCAPE
DOEND
LOOP(66080)
DOEND
*
IF #END-EVAL = 'Y' DO
IF #FLAG-CRSE-CHG = 'Y' DO
UPDATE(643510) WITH
CODE-INST-CRSE-PSU = #CRSE-CURR
DATE-INST-CRSE-UPDATED = #TODAYS-DATE
CODE-EMPL-USERID-UPDT = #CLERK
DESC-INST-CRSE-NON-PSU = #CHG-TITLE
DOEND
ELSE DO
UPDATE(643510) WITH
CODE-INST-CRSE-SEM-END = #END-SEM8
DATE-INST-CRSE-UPDATED = #TODAYS-DATE
CODE-EMPL-USERID-UPDT = #CLERK
*
PERFORM WRITE-DETAIL
DOEND
MOVE 'Y' TO #FLAG-GRANTED
ADD 1 TO #TOT-RECS-UPDATED(#RPT)
DOEND
LOOP(643510)
RETURN
*
LOOP(09240)
*
NEWPAGE(1)
WRITE(1) NOTITLE NOHDR
/ 21T 'TRLOG RECORDS READ ='
50T #TOT-RECS-READ (EM=ZZ,ZZ9)
/ 21T 'TRLOG RECORDS REJECTED ='
50T #TOT-RECS-REJECTED (EM=ZZ,ZZ9)
/ 21T 'TRLOG RECORDS ACCEPTED ='
50T #TOT-RECS-ACCEPTED (EM=ZZ,ZZ9)
/ 21T 'TRLOG RECORDS RECYCLED ='
50T #TOT-RECS-RECYCLED (EM=ZZ,ZZ9)
// 21T 'COURSES ENDED ='
50T #TOT-CRSES-ENDED (EM=ZZ,ZZ9)
/ 21T 'COURSES RENUMBERED ='
50T #TOT-CRSES-RENUM (EM=ZZ,ZZ9)
/ 21T 'TITLE CHANGES ='
50T #TOT-TITLE-CHGS (EM=ZZ,ZZ9)
/ 21T 'CREDIT CHANGES ='
50T #TOT-CRDT-CHGS (EM=ZZ,ZZ9)
// 21T 'EVALUATION RECORDS UPDATED ='
50T #TOT-RECS-UPDATED(1) (EM=ZZ,ZZ9)
// 21T ' CRDT CHG ONLY/NOT ENDED ='
50T #TOT-EVALS-CRDT-ADJ(1) (EM=ZZ,ZZ9)
// 21T ' REPORTED AND ENDED ='
50T #TOT-EVALS-ENDED(1) (EM=ZZ,ZZ9)
SKIP(1) 5 LINES
WRITE(1) 55T '*** END OF REPORT ***'
*
NEWPAGE(2)
WRITE(2) NOTITLE NOHDR
/ 21T 'TRLOG RECORDS READ ='
50T #TOT-RECS-READ (EM=ZZ,ZZ9)
/ 21T 'TRLOG RECORDS REJECTED ='
50T #TOT-RECS-REJECTED (EM=ZZ,ZZ9)
/ 21T 'TRLOG RECORDS ACCEPTED ='
50T #TOT-RECS-ACCEPTED (EM=ZZ,ZZ9)
/ 21T 'TRLOG RECORDS RECYCLED ='
50T #TOT-RECS-RECYCLED (EM=ZZ,ZZ9)
// 21T 'COURSES ENDED ='
50T #TOT-CRSES-ENDED (EM=ZZ,ZZ9)
/ 21T 'COURSES RENUMBERED ='
50T #TOT-CRSES-RENUM (EM=ZZ,ZZ9)
/ 21T 'TITLE CHANGES ='
50T #TOT-TITLE-CHGS (EM=ZZ,ZZ9)
/ 21T 'CREDIT CHANGES ='
50T #TOT-CRDT-CHGS (EM=ZZ,ZZ9)
// 21T 'EVALUATION RECORDS UPDATED ='
50T #TOT-RECS-UPDATED(2) (EM=ZZ,ZZ9)
// 21T ' CRDT CHG ONLY/NOT ENDED ='
50T #TOT-EVALS-CRDT-ADJ(2) (EM=ZZ,ZZ9)
// 21T ' REPORTED AND ENDED ='
50T #TOT-EVALS-ENDED(2) (EM=ZZ,ZZ9)
SKIP(2) 5 LINES
WRITE(2) 55T '*** END OF REPORT ***'
*
NEWPAGE(3)
WRITE(3) NOTITLE NOHDR
/ 21T 'TRLOG RECORDS READ ='
50T #TOT-RECS-READ (EM=ZZ,ZZ9)
/ 21T 'TRLOG RECORDS REJECTED ='
50T #TOT-RECS-REJECTED (EM=ZZ,ZZ9)
/ 21T 'TRLOG RECORDS ACCEPTED ='
50T #TOT-RECS-ACCEPTED (EM=ZZ,ZZ9)
/ 21T 'TRLOG RECORDS RECYCLED ='
50T #TOT-RECS-RECYCLED (EM=ZZ,ZZ9)
// 21T 'COURSES ENDED ='
50T #TOT-CRSES-ENDED (EM=ZZ,ZZ9)
/ 21T 'COURSES RENUMBERED ='
50T #TOT-CRSES-RENUM (EM=ZZ,ZZ9)
/ 21T 'TITLE CHANGES ='
50T #TOT-TITLE-CHGS (EM=ZZ,ZZ9)
/ 21T 'CREDIT CHANGES ='
50T #TOT-CRDT-CHGS (EM=ZZ,ZZ9)
// 21T 'EVALUATION RECORDS UPDATED ='
50T #TOT-RECS-UPDATED(3) (EM=ZZ,ZZ9)
// 21T ' CRDT CHG ONLY/NOT ENDED ='
50T #TOT-EVALS-CRDT-ADJ(3) (EM=ZZ,ZZ9)
// 21T ' REPORTED AND ENDED ='
50T #TOT-EVALS-ENDED(3) (EM=ZZ,ZZ9)
SKIP(3) 5 LINES
WRITE(3) 55T '*** END OF REPORT ***'
*
END