PRINT NOGEN                                                   
****************************************************************
*        FILENAME:  TEACH4B.MLC                                *
*        AUTHOR  :  Bill Qualls                                *
*        SYSTEM  :  Compaq 286LTE, PC/370 R4.2                 *
*        REMARKS :  This is a revision of TEACH4A.MLC.         *
*                   Produce list of tenured instructors.       *
*                   How to structure a BAL program.            *
****************************************************************
         START 0                                                       
         REGS
BEGIN    BEGIN
         WTO   'TEACH4B ... Begin execution'
         BAL   10,SETUP
MAIN     EQU   *
         BAL   10,PROCESS
         B     MAIN
ATEND    EQU   *
         BAL   10,WRAPUP
         WTO   'TEACH4B ... Normal end of program'
         RETURN
****************************************************************
*        SETUP - Those things which happen one time only,      *
*                before any records are processed.             *
****************************************************************
SETUP    EQU   *
         ST    10,SVSETUP
         OI    TEACHERS+10,X'08'  PC/370 ONLY - Convert all
*                                 input from ASCII to EBCDIC
         OI    REPORT+10,X'08'    PC/370 ONLY - Convert all
*                                 output from EBCDIC to ASCII
         OPEN  TEACHERS                                                    
         OPEN  REPORT
         BAL   10,HDGS
         L     10,SVSETUP
         BR    10
****************************************************************
*        HDGS - Print headings.                                *
****************************************************************
HDGS     EQU   *
         ST    10,SVHDGS
         PUT   REPORT,HD1
         PUT   REPORT,HD2
         PUT   REPORT,HD3
         PUT   REPORT,HD4
         L     10,SVHDGS
         BR    10
****************************************************************
*        PROCESS - Those things which happen once per record.  *
****************************************************************
PROCESS  EQU   * 
         ST    10,SVPROC
         BAL   10,READ
         CLI   ITTEN,C'Y'         Is teacher tenured?
         BNE   PROCESSX           No, then skip this record
         BAL   10,FORMAT          Otherwise format a line
         BAL   10,WRITE           ...and write it
PROCESSX EQU   *
         L     10,SVPROC
         BR    10
****************************************************************
*        READ - Read a record.                                 *
****************************************************************
READ     EQU   *
         ST    10,SVREAD
         GET   TEACHERS,IREC      Read a single teacher record
         L     10,SVREAD
         BR    10
****************************************************************
*        FORMAT - Format a single detail line.                 *
****************************************************************
FORMAT   EQU   *
         ST    10,SVFORM
         MVC   OTID,ITID          Move teacher ID Nbr to output     
         MVC   OTNAME,ITNAME      Move teacher Name to output
         CLC   ITDEG,=CL4'PHD'    Highest degree = PhD?
         BE    YESPHD             .. Yes, branch
         MVI   OPHD,C'N'          .. No, Show PhD = 'N'
         B     OTHERS             .. Branch around YES logic
YESPHD   EQU   *                  Highest degree is PhD, so...
         MVI   OPHD,C'Y'          Show PhD = 'Y'
OTHERS   EQU   *                  Continue moving other fields...
         MVC   O517,=CL4'517-'    All phone nbrs begin w/ '517-'
         MVC   OTPHONE,ITPHONE    Move phone nbr to output
         MVC   OCRLF,WCRLF        PC/370 ONLY - end line w/ CR/LF         
         L     10,SVFORM
         BR    10
****************************************************************
*        WRITE - Write a single detail line.                   *
****************************************************************
WRITE    EQU   *
         ST    10,SVWRITE
         PUT   REPORT,OREC        Write report line
         L     10,SVWRITE
         BR    10
****************************************************************
*        WRAPUP - Those things which happen one time only,     *
*                 after all records have been processed.       *
****************************************************************
WRAPUP   EQU   *
         ST    10,SVWRAP
         CLOSE TEACHERS
         CLOSE REPORT
         WTO   'TEACH4B ... Teacher list on REPORT.TXT'
         L     10,SVWRAP
         BR    10
****************************************************************
*        Literals, if any, will go here                        *
****************************************************************
         LTORG
****************************************************************
*        File definitions                                      *
****************************************************************
TEACHERS DCB   LRECL=29,RECFM=F,MACRF=G,EODAD=ATEND,
               DDNAME='TEACHER.DAT'  
REPORT   DCB   LRECL=62,RECFM=F,MACRF=P,
               DDNAME='REPORT.TXT'      
****************************************************************
*        RETURN ADDRESSES                                      *
****************************************************************
SVSETUP  DC    F'0'               SETUP
SVHDGS   DC    F'0'               HDGS
SVPROC   DC    F'0'               PROCESS
SVREAD   DC    F'0'               READ
SVFORM   DC    F'0'               FORMAT
SVWRITE  DC    F'0'               WRITE
SVWRAP   DC    F'0'               WRAPUP
****************************************************************
*        Miscellaneous field definitions                       *
****************************************************************
WCRLF    DC    X'0D25'            PC/370 ONLY - EBCDIC CR/LF
****************************************************************
*        Input record definition                               *
****************************************************************
IREC     DS    0CL29              Teacher record
ITID     DS    CL3                Teacher ID nbr
ITNAME   DS    CL15               Teacher name
ITDEG    DS    CL4                Highest degree
ITTEN    DS    CL1                Tenured?
ITPHONE  DS    CL4                Phone nbr
ITCRLF   DS    CL2                PC/370 only - CR/LF
****************************************************************
*        Output (line) definition                              *
****************************************************************
OREC     DS    0CL62              
OTID     DS    CL3                Teacher ID nbr
         DC    CL3' '
OTNAME   DS    CL15               Teacher name
         DC    CL4' '
OPHD     DS    CL1                PhD? (Y/N)
         DC    CL5' '
OPHONE   DS    0CL8               Phone nbr
O517     DS    CL4
OTPHONE  DS    CL4                Phone nbr
         DC    CL21' ' 
OCRLF    DS    CL2                PC/370 only - CR/LF
****************************************************************
*        Headings definitions                                  *
****************************************************************
HD1      DS    0CL62
         DC    CL40'      LIST OF TENURED INSTRUCTORS       '
         DC    CL20' '
         DC    XL2'0D25'
HD2      DS    0CL62
         DC    CL60' '
         DC    XL2'0D25'
HD3      DS    0CL62
         DC    CL40'ID#        Name         PhD?    Phone   '
         DC    CL20' '
         DC    XL2'0D25'
HD4      DS    0CL62
         DC    CL40'---   ---------------   ----   -------- '
         DC    CL20' '
         DC    XL2'0D25'
         END   BEGIN