Retro1.org codex

*DECK NNETREL 
USETEXT NIPDEF
USETEXT BPIPBUF 
USETEXT PT
USETEXT DBGBUF
PROC NNETREL((LFN),(FRWD)); 
STARTIMS; 
 #
*1DC  NNETREL 
*     1. PROC NAME           AUTHOR              DATE 
*        NNETREL             C. BITTNER          83/04/01 
* 
*     2. FUNCTIONAL DESCRIPTION 
*        RELEASE DEBUG LOG FILE.
* 
*     3. METHOD USED
*        ROUTE ZZZZZDN LOG FILE TO INPUT.  REOPEN ZZZZZDN.
*        CALL OPITRCE TO REINITIALIZE NIP DEBUG LOG FILE. 
* 
*     4. ENTRY PARAMETERS 
*        LFN - NAME OF LOCAL JOB RECORD (NRF1/NRF2) 
*        FRWD - REWIND FLAG 
*               0 - REWIND FILE BEFORE READ 
*               1 - NO REWIND 
* 
*     5. EXIT PARAMETERS
*        BPAT[0] - NONZERO IF DISK ERROR ON FILE AFTER INITIALIZATION.
* 
*     6. COMDECKS CALLED AND SYMPL TEXTS USED 
*        NIPDEF     BPIPBUF     PT     DBGBUF 
* 
*     7. ROUTINES CALLED
*        OMSG - ISSUE DAYFILE MESSAGE 
*        OPITRCE - INITIALIZE NIP DEBUG LOG FILE
*        OPRETN - RETURN FILE 
*        ROUTE - ROUTE FILE 
*        WRITER - WRITE END OF RECORD 
*        XTRACE - TRACE PROCEDURE CALL
* 
*     8. DAYFILE MESSAGES AND OTHER IMPORTANT INFORMATION 
*        NONE 
* 
 #
STOPIMS;
 
# 
      FORMAL PARAMETERS 
# 
      ITEM LFN C(10);        # NAME OF LOCAL JOB RECORD (JCL)          #
      ITEM FRWD B;           # REWIND FLAG                             #
                             # 0 - REWIND FILE BEFORE READ             #
                             # 1 - NO REWIND                           #
 
# 
      EXTERNAL REFERENCES 
# 
 XREF 
   BEGIN
   PROC OMSG;                # ISSUE DAYFILE MESSAGE                   #
   PROC OPITRCE;             # INITIALIZE NIP DEBUG LOG FILE           #
   PROC OPRETN;              # RETURN FILE                             #
   PROC ROUTE;               # ROUTE FILE                              #
   PROC WRITER;              # WRITE END OF RECORD                     #
   PROC XTRACE;              # TRACE PROCEDURE CALL                    #
   END
 
# 
      INTERNAL VARIABLES
# 
      ITEM BPFETX I;         # TEMPORARY - FET POINTERS                #
      ITEM DTIME;            # TIME WORD                               #
 
      BASED ARRAY LFNNAME;
        BEGIN 
        ITEM LFNAME    C(00,00,10);  # NAME OF LOCAL FILE              #
        ITEM LFILE     I(00,00,60);  # =0 IF NO LOCAL FILE             #
        END 
 
      ARRAY PARAM   P(7);    # PARAM BLK TO ROUTE LFN TO INPUT         #
        BEGIN 
        ITEM PAR$NAME    C(00,00,07)=["ZZZZZDN"];  # NAME OF FILE RTD  #
        ITEM PAR$EC      U(00,42,06);  # ERROR CODE RESPONSE           #
        ITEM PAR$F       B(00,48,01);  # FORCED ORIGIN FLAG            #
        ITEM PAR$OT      U(00,53,06);  # FORCED JOB ORIGIN TYPE        #
        ITEM PAR$CB      B(00,59,01)=[FALSE];  # COMPLETE BIT          #
        ITEM PAR$DISP    C(01,24,02);  # DISPOSITION OF FILE           #
        ITEM PAR$EP      B(01,47,01);  # ERROR PROCESSING FLAG         #
        ITEM PAR$ID      B(01,58,01);  # ROUTE TO CENTRAL SITE         #
        ITEM PAR$DCF     B(01,55,01);  # DISPOSITION CODE SET FLAG     #
        ITEM PAR$WD1     I(01,00,WL)=[0]; 
        ITEM PAR$WD2     I(02,00,WL)=[0]; 
        END 
 
      ARRAY DSKERRMSG  S(4);
        BEGIN 
        ITEM DSKERRTEXT C(0,0,30) = [" XXX ERROR NNB, LFN = ZZZZZDN."]; 
        ITEM DSKPPNAME  U(0,6,18);     # PP NAME - DSP OR CIO          #
        ITEM DSKERRNN   U(1,6,12);     # ERROR CODE FIELD IN DAY MSG   #
        ITEM DSKERREND  U(3,0,60) = [0];
        END 
 
 
 
 
      BEGIN 
 
      CONTROL IFEQ ZZDN,1;
 
      CONTROL IFEQ DEBUG,1; 
        XTRACE("NETREL"); 
      CONTROL FI; 
 
 
      P<LFNNAME> = LOC(LFN);
      IF LFILE[0] NQ 0
      THEN                   # THERE IS A LOCAL FILE TO BE COPIED      #
        BEGIN 
        IF BPNAME[0] EQ "ZZZZZDN" AND NIPINIT 
        THEN
          BEGIN              # ROUTE ZZZZZDN LOG FILE TO INPUT         #
          IF BPAT[0] EQ 0 
          THEN               # NO I/O ERROR HAS OCCURRED ON ZZZZZDN FIL#
            BEGIN 
            WRITER(BPFET,1); # WRITE END OF RECORD TO ZZZZZDN FILE     #
            IF BPAT[0] NQ 0 
            THEN             # I/O ERROR HAS OCCURRED ON ZZZZZDN FILE  #
              BEGIN 
              DSKPPNAME[0] = "CIO";  # NAME OF PP WHICH DETECTED ERROR #
              DSKERRNN[0] = BPAT[0] - (BPAT[0]/8)*8 + 
                            (BPAT[0]/8)*64 + O"3333"; 
              OMSG(DSKERRMSG,0);  # ISSUE DAYFILE MESSAGE              #
              END 
            ELSE             # NO I/O ERROR HAS OCCURRED ON ZZZZZDN    #
              BEGIN 
              PAR$F[0] = TRUE; # SET ROUTE TO SYSTEM ORIGIN            #
              PAR$OT[0] = SYOT;# SYSTEM ORIGIN JOB TYPE                #
              PAR$CB[0] = FALSE;  # CLEAR COMPLETION BIT               #
              PAR$DISP[0] = "IN";  # DISPOSITION OF FILE IS INPUT QUEUE#
              PAR$DCF[0] = TRUE;  # DISPOSITION CODE SET FLAG          #
              PAR$EC[0] = 0; # INITIALIZE ERROR CODE FIELD             #
              PAR$EP[0] = TRUE;# SET ERROR PROCESSING FLAG             #
              PAR$ID[0] = TRUE;# ROUTE TO CENTRAL SITE                 #
              ROUTE(PARAM,1);  # ROUTE ZZZZZDN FILE                    #
              IF PAR$EC[0] NQ 0 
              THEN           # DSP DETECTED ERROR - FILE NOT ROUTED    #
                BEGIN 
                DSKPPNAME[0] = "DSP";  # NAME OF PP WHICH DETECTED ERRO#
                DSKERRNN[0] = PAR$EC[0] - (PAR$EC[0]/8)*8 + 
                              (PAR$EC[0]/8)*64 + O"3333"; 
                OMSG(DSKERRMSG,0);  # ISSUE DAYFILE MESSAGE            #
                OPRETN(BPFET); # RETURN BAD FILE                       #
                END 
              END 
            END 
          IF BPAT[0] NQ 0 
          THEN               # ZZZZZDN FILE IS BAD                     #
            BEGIN 
            OPRETN(BPFET);   # RETURN BAD FILE                         #
            END 
          END 
 
        OPITRCE(LFN,FRWD);   # INITIALIZE NEW NIP DEBUG LOG FILE       #
        END 
      CONTROL FI; 
      END 
TERM