         TITLE    'QPREP ** VERSION 0 ** PROCEDURES'
*******************************************************************
*
*                         Q  P R  E  P
*
*
*           PREPARE THE QUEUE FOR TP RESTART
*         PHASE 8 OF TRANSACTION PROCESSING RECOVERY
*
********************************************************************
*
         SYSTEM   BPM
         SYSTEM   TP:TPO
         SYSTEM   LP:TPOQ
         SYSTEM   SIG7FDP
*
         DEF      QPREP,PATCH,@D,FPTSECT
*
SAVE%Q:TID   EQU  TTP+14
*
*                 PSD TO GET  QPREP BACK TO SLAVE MODE
         BOUND    8
BACK%TO%SLAVE   EQU   %
         GEN,8,1,1,5,17   0,1,1,0,OPENQ6
         DATA     0
         REF      M:SI,M:LO
         REF      F:QUEUE,F:IPLIST,F:TPFILES
***************************************************************
DBGKEY   EQU      0                 NO DEBUG TRACES
* SET DBGKEY TO 1 FOR A DEBUG TRACE   RMC   3-1-74
*
REPORTFLAG   DATA   0
*                                   SET REPORTFLAG TO 1 TO DELETE
*                                   SET REPORTFLAG TO 0 TO RERUN REPORTS
********************************************************************
         GENTABS
*
*
*
         PCC      0
PUSH     CNAME    X'0B'
PULL     CNAME    X'0A'
*
*                 FORMAT OF CALL:
*                    PULL     2,R7       PULLS R7,R8 FROM R:TSTACK
*                    PUSH   3,R0       PUSHES R0,R1,R2 INTO R:TSTACK
*                 NOTE THAT R:TSTACK MUST BE DECLARED AND
*                 INITIALIZED AS A STACK DOUBLEWORD POINTER
*
         PROC
LF       EQU      %
TMP      SET      -2
         DO       NUM(AF)>1
         DO       AF(1)<16
         LCI      AF(1)
         ELSE
         LCI      0
         FIN
TMP      SET      0
         FIN
         GEN,8,4,20  NAME+TMP,AF(NUM(AF)),R:TSTACK
         PEND
***********************************************************************
DEBUG    CNAME
         PROC
         LOCAL    %1,%2
         DO       DBGKEY=1
         B        %1
%2       TEXTC    AF
%1       EQU      %
         M:PRINT  (MESS,%2)
         FIN
         PEND
******************************************************************
*
***********************************************************
*
EXPLAIN  CNAME,0                    PRINTS OUT EXPLANATIONS
         PROC
         OPEN     X,I
X        SET      S:UFV(AF)         LIST OF MESSAGES
I        DO       NUM(X)
         ERROR,*  ;
         '                                                       ****';
                  ,X(I)
         FIN
         CLOSE    X,I
         PEND
******************************************************************
*
*        CALL, ENTRY, AND RETURN ARE FOR INTERNAL LINKING.
*                 THE LINK LABEL IS A 2-ITEM LIST:
*                 1.  ADDRESS  OF A ROUTINE
*                 2.  ADDRESS OF A TEMP FOR REMEMBERING CALLER'S
*                      ADDRESS
*                 ENTRY IS THE ENTRY POINT INTO THE CALLED ROUTINE.
*                 RETURN RETURNS CONTROL TO THE
*                 CALLING PROGRAM.
*
*                 THESE ROUTINES WERE DONATED BY TED MARTNER
*                 THEIR OPERATION IS IDENTICAL TO THEIR USE IN THE
*                 TRANSACTION PROCESSING CONTROLLER
*
******************************************************************
         OPEN     X
*
CALL     CNAME                      CALL CALLS A SUBROUTINE
         PROC
X        SET      S:UFV(AF)
         ERROR,7,NUM(X)<2     'BAD CALL'  COMPLAIN IF IT ISN'T A SUBR
LF       BAL,11   X(1)              CALL IT
         EXPLAIN  X(3)
         PEND
*
ENTRY    CNAME                      ENTRY STARTS A SUBROUTINE
         PROC
         LOCAL    X,Y
         USECT    @T                PRESERVE A WORD IN TEMP SPACE
X        EQU      %
         DATA     0                 FOR HOLDING RETURN ADDRESS
         USECT    @P
Y        EQU      %
LF       EQU      Y,X,(AF)
         STW,11   X                 REMEMBER CALLER'S ADDRESS
         PEND
*
*                 ENTRYR NOT IMPLEMENTED FOR THIS PROGRAM
*
RETURN   CNAME
         PROC
X        SET      S:UFV(AF)
         ERROR,7,NUM(X)<2   'BAD RETURN'
LF       B        *X(2)             RETURN TO CALLER
         PEND
         CLOSE    X
*
@T       CSECT    0
@P       CSECT    1
         TITLE    'QPREP ** VERSION 0 ** MAINPROGRAM'
********************************************************************
*
*                      Q   P   R   E   P
*
*        PREPARES THE QUEUE FOR TP RESTART.
*        INPUT:   THE LIST OF IN PROGRESS TRANSACTIONS IN
*                 TPIPLIST,  THE QUEUE FILE IN TPQUEUE, AND
*                 QUEUE RELATED INFORMATION IN TPFILES.
*        OUTPUT:  ALL IN PROGRESS TRANSACTIONS  IN THE QUEUE
*                 WILLL BE RESET TO ALLOW THEIR RESTART
*                 WHEN TP IS REACTIVATED AND ALL IN PROGRESS
*                 REPORTS WILL EITHER BE RESTARTED OR DELETED, DEPENDING
*                 ON THE VALUE OF ASSEMBLY-TIME PARAMETER DELIPREP.
*
********************************************************************
*
QPREP    EQU      %
,FPTSECT   M:TYPE   (MESS,INTROMES)
         CALL     PROGRAM%CONTROL
         CALL     CKTPFILES
         CI,R1    0                 ANY ACTIVE ENTRIES?
         BL       QPREP70           NOTHING TO DO
         CALL     CKIPLIST
         CALL     OPENQ
         LI,R1    0
QPREP10  EQU      %
*                 PROCESS THE IN PROGRESS TRANSACTIONS
         CALL     NEXTTRAN
         MTW,0    R1                ANY MORE ENTRIES
         BLEZ     QPREP30           NO
         M:QUEUE  PUTLIST,PUT,(LSIZE,1),(WAIT)
         BCR,12   QPREP10
         BCS,8    Q%UNAVAILABLE
         B        Q%ERROR
QPREP30  EQU      %
*                 PROCESS THE IN PROGRESS REPORTS
         LI,R1    0                 INITIALIZATION MODE
QPREP40  EQU      %
         CALL     NEXTREPT
         MTW,0    R1                ANY MORE ENTRIES?
         BLEZ     QPREP50           NO
         M:QUEUE  PUTLIST,PUT,(LSIZE,1),(WAIT)
         BCR,12   QPREP40
         BCS,8    Q%UNAVAILABLE
         B        Q%ERROR
QPREP50  EQU      %
QPREP55  EQU      %
         CALL     SUMMARY
QPREP60  EQU      %
         CALL     CLSFILES
QPREP70   EQU     %
         M:TYPE   (MESS,ENDMESS)
         M:EXIT
*
         TITLE    'QPREP ** VERSION 0 ** DATA AND CONSTANTS'
*******************************************************************
*                 DATA AREA FOR QPREP
*
******************************************************************
@D       CSECT    0
         BOUND    8
R:TSTACK EQU      %
         DATA     WA(STKSTRT)
         GEN,16,16  64,0
STKSTRT  RES      64
*
PUTLIST   GEN,8,24 0,WA(KEYBUF)
*
         BOUND    8
KEYBUF   RES      520
KEYSZ    DATA     2080
*
         BOUND    8
CTLKEY   GEN,8,24  7,C'CTL'
         DATA     C'0000'
*
         BOUND    8
CTLBUF   EQU      %
KEYTRAN  DATA     0
KEYTRANCNT  DATA  0
KEYREPT  DATA     0
KEYREPTCNT  DATA
KEYTIME  RES      4
KEYHTID   DATA   0
CTLSZ    EQU      36
*
         BOUND    8
DATATRAN GEN,8,24  7,C'TRN'
DATATRANCNT  DATA C'    '
DATAREPT   GEN,8,24   7,C'RPT'
DATAREPTCNT  DATA   '    '
BINTRANCNT  DATA  0
BINREPTCNT   DATA  0
*
ENDMESS  TEXTC    'RECOVERY COMPLETED : OK TO RESTART TP'
INTROMES   TEXTC    'QPREP - VERSION 0'
*
DELFLAG  DATA     X'1F'
RERUNFLG   DATA   X'9F'
*
BEEN%HERE%BEFORE   DATA   0
         BOUND    8
TPFBUF   EQU      %
         DO1      6                 WORDS 0 THRU 5
         DATA     0
TPFFLG   DATA     0                 WORD 6
TPFILEHTID  DATA  0                 WORD 7
TPFSZ    EQU      32
*
         BOUND    8
CONTROLBLK  RES   512
*
IPBUF    EQU      %
         GEN,4,28  9,0              RECOVERY FILE
         DO1      2
         DATA     0
IPKEY    TEXTC    'TPIPLIST'
         GEN,8,24  0,0              FILE CAN BE DESTROYED OK
IP:HTID  DATA     0
IPBUFSZ  EQU      32
*
ACTIVEFLG  DATA   X'01000000'
BAD%TID%FLAG   DATA   0
*
END%OF%TRANS   DATA   0             TO FLAG END OF TRANS IN TPIPLIST
END%OF%REPTS   DATA   0             TO FLAG END OF REPRS IN TPIPLIST
         USECT    @P
         TITLE    'QPREP ** VERSION 0 ** NEXTTRAN'
********************************************************************
*
*                 N E X T T R A N
*
*        GET THE NEXT TRANSACTION RECORD OUT OF FILE TPIPLIST
*
*        INPUT:  R1=0 IF IN INITIALIZATION MODE
*                  >O NEXT ENTRY SUCCESSFULLY RETRIEVED
*        OUTPUT:  R1<0 AT THE END OF PROCESSING
*                 R1>0 IF THE ENTRY WAS RETRIEVED SUCCESSFULLY
*                 NEXT RECORD IN KEYBUF
*        REGISTERS USED: R1,R4, R5
*                 R1 IS LEFT POSITIVE AND R4-R5 ARE NOT DESTROYED
*        ROUTINES  CALLED: EBCDICCNT
*        CALLED BY: QPREP
*
**********************************************************************
*
NEXTTRAN   ENTRY    'GET NEXT TRANSACTION OUT OF TPIPLIST'
         DEBUG    'ENTERING NEXTTRAN'
         PUSH     3,R4
         CI,R1    0                 INITIALIZATION MODE?
         BE       NEXTTINIT         YES
NEXTT10  EQU      %
         MTW,0    END%OF%TRANS      END OF TRANS IN TPIPLIST?
         BGZ      NEXTT30           YES
         LI,R5    1                 SENTINEL FOR TRANS
         CALL     EBCDICCNT         INCREMENT CALCULATED KEY
         LW,R4    DATATRANCNT       SAVE IT
         CW,R4    KEYTRANCNT        COMPARE WITH GIVEN KEY
         BNE      NEXTT20           CONTINUE PROCESSING
         MTW,1    END%OF%TRANS      THIS IS THE LAST TRANSACTION
NEXTT20  EQU      %
         M:READ   F:IPLIST,(BUF,KEYBUF),(SIZE,*KEYSZ);
                  ,(KEY,DATATRAN);
                  ,(ERR,RDTRANERR),(ABN,RDTRANABN)
         DO       DBGKEY=1          DO DEBUG OPERATION IF SET
         M:SNAP   'KEYBUF',(KEYBUF,KEYBUF+14)
         FIN
         LI,R6    KEYBUF
         GET,R4,R5   JFLAGS,*R6
         AND,R4   RERUNFLG
         STB,R4   PUTLIST
         LI,R1    1                 SET FLAG FOR ENTRY RETRIEVED OK
ENDNEXTTRAN  EQU  %
         PULL     3,R4
         DEBUG    'EXITING NEXTTRAN'
         RETURN   NEXTTRAN
*
NEXTTINIT  EQU    %
         LW,R1    DATATRANCNT       PICK UP DATA KEY
         CW,R1    KEYTRANCNT        COMPARE TO MAX VALUE KEY
         BNE      NEXTT10           THERE ARE TRANSACTIONS TO RETRIEVE
NEXTT30  EQU      %
         LI,R1    -1                SET NO MORE ENTRIES FLAG
         B        ENDNEXTTRAN
*
RDTRANERR   EQU   %
         M:SNAP   'CHK 10'
         LI,R1    ERROR6
         CALL     ADVISE
*
RDTRANABN   EQU   %
         M:SNAP   'CHK 10'
         LI,R1    ERROR7
         CALL     ADVISE
*******************************************************************
         TITLE    'QPREP ** VERSION 0 ** PROGRAM%CONTROL'
********************************************************************
*
*                 P R O G R A M % C O N T R O L
*
*                 NO INPUT OR OUTPUT
*                 EXIT%CONTROL IS THE EXIT ROUTINE
****************************************************************
PROGRAM%CONTROL                     ;
         ENTRY   ;
                  'ESTABLISH TRAP AND EXIT CONTROL'
         DEBUG    'ENTERING PROGRAM%CONTROL'
         M:TRAP   (IGNORE,FX)
         M:XCON   EXIT%CONTROL
         DEBUG    'EXITING PROGRAM%CONTROL'
         RETURN   PROGRAM%CONTROL
*
EXIT%CONTROL   EQU   %
         M:PRINT  (MESS,EXIT%MES%1)
         MTW,0    BEEN%HERE%BEFORE
         BGZ      EXIT%CONT%2       CONT'T LOOP IN EXIT
         MTW,1    BEEN%HERE%BEFORE
         CI,R8    0
         BE       EXIT%CONT%3       R8=ABORT CODE OR 0
         M:SNAP   'CHK 10'
         M:TYPE   (MESS,EXIT%MES%2)
         M:QUEUE  F:QUEUE,LOCK
         BCR,12   QLOCKED
         M:SNAP   'CHK 10'
         M:TYPE   (MESS,EXIT%MES%3)
QLOCKED   EQU   %
         M:XXX
EXIT%CONT%2   EQU   %
         M:TYPE   (MESS,EXIT%MES%4)
EXIT%CONT%3   EQU   %
         M:EXIT
*
         USECT    @D
EXIT%MES%1  TEXTC 'ENTRY TO EXIT CONTROL'
EXIT%MES%2   TEXTC   'UNEXPECTED ENTRY TO EXIT%CONTROL'
EXIT%MES%3   TEXTC   'UNABLE TO LOCK QUEUE'
EXIT%MES%4   TEXTC    'LOOPING IN EXIT CONTROL - PROGRAM ABORTED'
***********************************************************************
         USECT    @P
         TITLE    'QPREP ** VERSION 0 ** EBCDICCNT'
******************************************************************
*
*                 E B C D I C C N T
*
*        GENERATION OF DATA FOR TPIPLIST
*
*        INPUT: R5=1 FOR TRANSACTION
*                  2 FOR REPORT
*        OUTPUT: NEW KEY  IS STORED IN DATA DOUBLEWORD
*                 (DATATRAN FOR TRANSACTIONS, DATAREPT FOR REPORTS)
*        REGISTERS USED: R13-R15
*        CALLED BY: NEXTTRAN, NEXTREPT
*        SUBROUTINES USED: CONVERTID
*
****************************************************************************
EBCDICCNT   ENTRY    'GENERATE TPIPLIST DATA IN EBCDIC'
         DEBUG    'ENTERING EBCDICCNT'
         CI,R5    1
         BNE      EBCNT2            PROCESS REPORT SEPERATELY
         MTW,1    BINTRANCNT        INCREMENT COUNTER
         LW,R13   BINTRANCNT        INIT REGISTER FOR CONVERTID
         CALL     CONVERTID
         STW,R15  DATATRANCNT
EBCNT1   EQU      %
         DEBUG    'EXITING EBCDICCNT'
         RETURN   EBCDICCNT
EBCNT2   EQU      %
         MTW,1    BINREPTCNT
         LW,R13   BINREPTCNT
         CALL     CONVERTID
         STW,R15  DATAREPTCNT
         B        EBCNT1
*
*******************************************************************
         TITLE    'QPREP ** VERSION 0 ** NEXTREPT'
********************************************************************
*
*                 N E X T R E P T
*
*        GET NEXT IN PROGRESS OUT REPORT OUT OF TPIPLIST
*
*        INPUT: R0=0 FOR INITIALIZATION,
*        OUTPUT: R0<0 AT END OF PROCESSING
*        SUBROUTINES USED: EBCDICCNT
*        REGISTERS USED: R1 IS DESTROYED; R4-R5 ARE USED
*
*****************************************************************
NEXTREPT   ENTRY    'GET NEXT OUTPUT REPORT OUT IF TPIPLIST'
         DEBUG    'ENTERING NEXTREPT'
         PUSH     3,R4
         CI,R1    0
         BE       NEXTRINIT         YES
NEXTR10  EQU      %
         MTW,0    END%OF%REPTS      ANY MORE REPORTS?
         BNEZ     NEXTR30           NO
         LI,R5    2                 LOAD SENTINEL FOR REPORT
         CALL     EBCDICCNT         INCREMENT CALCULATED KEY
         LW,R4    DATAREPTCNT       SAVE IT
         CW,R4    KEYREPTCNT        COMPARE WITH GIVEN KEY
         BNE      NEXTR20           IS THIS THE LAST REPORT?
         MTW,1    END%OF%REPTS      YES, FLAG IT
NEXTR20  EQU      %
         M:READ   F:IPLIST,(BUF,KEYBUF),(SIZE,*KEYSZ),;
                  (KEY,DATAREPT),(ERR,RDTRANERR),(ABN,RDTRANABN)
         DO       DBGKEY=1          DO DEBUG OPERATION IF SET
         M:SNAP   'KEYBUF',(KEYBUF,KEYBUF+14)
         FIN
         LI,R6    KEYBUF
         GET,R4,R5   JFLAGS,*R6
         MTW,0    REPORTFLAG
         BNEZ     DELOPTION         SPECIAL TO DELETE REPORTS
         AND,R4   RERUNFLG
         B        SETFLG
DELOPTION   EQU   %
         AND,R4   DELFLAG
SETFLG   EQU      %
         STB,R4   PUTLIST
         LI,R1    1                 SET ENTRY RETRIEVED OK FLG
ENDNEXTREPT  EQU  %
         PULL     3,R4
         DEBUG    'EXITING NEXTREPT'
         RETURN   NEXTREPT
*
NEXTRINIT  EQU    %
         LW,R1    DATAREPTCNT       PICK UP DATA KE
         CW,R1    KEYREPTCNT        COMPARE TO MAX VALUE KEY
         BNE      NEXTR10           THERE ARE REPTSACTIONS TO RETRIEVE
NEXTR30  EQU      %
         LI,R1    -1                SET NO MORE ENTRIES FLAG
         B        ENDNEXTREPT
*
*******************************************************************
         TITLE    'QPREP ** VERSION 0 ** DEFLIST'
         TITLE    'QPREP ** VERSION 0 ** CKTPFILES'
***************************************************************
*
*                 C K T P F I L E S
*
*        OPENS THE FILE 'TPFILES', READS THE RECORD FOR
*        TPIPLIST AND VERIFIES THAT THERE IS A LIST OF
*        IN PROGRESS ITEMS IN FILE TPIPLIST TO BE
*        RESTORED.
*
*        INPUT:  NONE
*        OUTPUT: TPFILHTID IS INITIALIZED WITH THE HIGHEST TID VALUE
*                 FROM THE CREATION OF TPIPLIST
*        REGISTERS USED: R1, R3, R4
*        SUBROUTINES CALLED*  ADVISE
*        CALLED BY: QPREP
*
**************************************************************************
*
CKTPFILES   ENTRY   'OPEN TPFILES AND CHECK FOR AN ';
                     ,'ACTIVE IN-PROGRESS LIST'
         DEBUG    'ENTERING CKTPFILES'
         M:OPEN   F:TPFILES,(FILE,'TPFILES'),(KEYED),(DIRECT);
                  ,(INOUT),(ERR,OPNTPFERR),(ABN,OPNTPFABN)
         M:READ   F:TPFILES,(BUF,TPFBUF),(SIZE,TPFSZ),;
                  (KEY,IPKEY),(ERR,RDTPFERR),;
                  (ABN,RDTPFABN)
         LW,R4    TPFFLG            CONTAINING THE ACTIVE FLAG
         AND,R4   ACTIVEFLG          IS IT SET?
         BEZ      CKTP20            BRANCH IF NOTHING TO DO
         LI,R1    0                 SET THINGS TO DO FLAG
         DEBUG    'EXITING CKTPFILES'
         RETURN   CKTPFILES
CKTP20   EQU      %
         M:TYPE   (MESS,CKTPMES)
         M:CLOSE  F:TPFILES,(SAVE)
         LI,R1    -1                SET NOTHING TO DO SENTINEL
         DEBUG    'NOTHING TO DO CKTPFILES'
         RETURN   CKTPFILES
OPNTPFERR EQU     %
         M:SNAP   'CHK 10'
         LI,R1    ERROR4            ERR ON OPENING TPFILES
         CALL     ADVISE
OPNTPFABN   EQU   %
         M:SNAP   'CHK 10'
         LI,R1    ERROR5            ABN ON OPENING TPFILES
         CALL     ADVISE
*
CKTPMES  TEXTC    'NO ACTIVE LIST OF IN PROGRESS ENTRIES - ';
                  ,'NOTHING TO DO'
*
*
RDTPFERR   EQU    %
         M:SNAP   'CHK 10'
         LI,R1    ERROR8
         CALL     ADVISE
*
RDTPFABN   EQU    %
         M:SNAP   'CHK 10'
         LI,R1    ERROR9
         CALL     ADVISE
**********************************************************************
         TITLE    'QPREP ** VERSION 0 ** OPENQ'
**************************************************************
*
*                         O P E N Q
*
*        OPEN AND INITIALIZE THE QUEUE FILE; COMPARE THE HIGHEST
*        TRAN ID VALUE FROM TPIPLIST (VIA THE TPFILES ENTRY)
*
*        INPUT: TPFILEHTID FROM CKTPFILES
*                 THE QUEUE FILE
*        OUTPUT:  THE QUEUE IS OPENED AND INITIALIZED
*                 AN APPROPRIATE MESSAGE IS OUTPUT TO STATE WHETHER
*                 THE HIGHEST TRAN IDS FROM THE TWO SOURCES MATCH
*        ROUTINES CALLED: CONVERTID
*        REGISTERS USED: R1,R2,R13,R14,R15
*        CALLED BY:  QPREP
*
***********************************************************************
*
OPENQ     ENTRY     'OPEN AND INITIALIZE QUEUE FILE'
         DEBUG    'ENTERING OPENQ'
         M:OPEN   F:QUEUE,(FILE,'TPQUEUE'),(RANDOM),(INOUT),;
                  (ERR,OPNQERR),(ABN,OPNQABN),;
                  (DIRECT),(SAVE)
         M:QUEUE  F:QUEUE,UNLOCK,(RECOVER),(QPAGES,5),(OLD)
         BCR,12   OPENQ5
         BCS,8    Q%UNAVAILABLE
         B        Q%ERROR
*                 HIGHEST TID VALUE IS RETURNED IN SR1
OPENQ5   EQU      %
         LW,R6    R8
         M:SYS
         STW,R6   SAVE%Q:TID
         LPSD,0   BACK%TO%SLAVE
OPENQ6   EQU   %
         LW,R13   R6
         CW,R13   TPFILEHTID        COMPARE W/ VALUE FROM TPIPLIST
         BNE      OPENQ20           NO COMPARISON
         MTW,0    BAD%TID%FLAG
         BNEZ     OPENQ20
         CALL     CONVERTID
         LI,R1    HTIDMES
         STD,R14  0,R1
         M:TYPE   (MESS,QOKMES)
OPENQ10  EQU      %
         DEBUG    'EXITING OPENQ'
         RETURN   OPENQ
OPENQ20  EQU      %
         CALL     CONVERTID
         LI,R1    WRONGTID1
         STD,R14  0,R1
         M:TYPE   (MESS,WRONGMES1)
         LW,R13   TPFILEHTID        ADVERTISE THE PROBLEM
         CALL     CONVERTID
         LI,R1    WRONGTID2
         STD,R14  0,R1
         M:TYPE   (MESS,WRONGMES2)
         LI,R1    ERROR3
*                                   ERROR: TID'S DON'T COMPARE
         CALL     ADVISE
*
         USECT    @D
         BOUND    8
QOKMES   TEXTC    ' QPREP IN PROGRESS *** HTID IS NNNNNNNN'
HTIDMES  EQU      DA(%)-1
         BOUND    8
WRONGMES1   TEXTC   ' *** HIGHEST TID FROM QUEUE IS NNNNNNNN'
WRONGTID1  EQU    DA(WRONGMES1)+4
         BOUND    8
WRONGMES2  TEXTC    '** HIGHEST TID FROM TPFILES IS NNNNNNNN'
WRONGTID2  EQU    DA(WRONGMES2)+4
WRONGMES3   TEXTC   'HIGHEST TID FROM TPIPLIST IS   NNNNNNNN'
WRONGTID3   EQU   DA(%)-1
*
         USECT    @P
Q%UNAVAILABLE   EQU   %
         M:SNAP   'CHK 10'
         LI,R1    ERROR12
         CALL     ADVISE
*
Q%ERROR  EQU      %
         M:SNAP   'CHK 10'
         LI,R1    ERROR13
         CALL     ADVISE
*
OPNQERR   EQU   %
         M:SNAP   'CHK 10'
         LI,R1    ERROR14
         CALL     ADVISE
*
OPNQABN   EQU   %
         M:SNAP   'CHK 10'
         LI,R1    ERROR15
         CALL     ADVISE
*
         USECT    @P
********************************************************************
         TITLE    'QPREP ** VERSION 0 ** CKIPLIST'
*****************************************************************
*
*                 C K I P L I S T
*
*        OPEN TPIPLIST AND READ CTLKEY
*
*        INPUT: NONE
*        OUTPUT:  CTLBUF IS INITIALIZED WITH THE CONTROL KEY
*                 FROM TPIPLIST
*        REGISTERS USED: NONE
*        SUBROUTINES CALLED:  NONE
*        CALLED BY: QPREP
*
*************************************************************************
*
CKIPLIST   ENTRY   'OPEN TPIPLIST AND READ CTLKEY'
         DEBUG    'ENTERING CKIPLIST'
         M:OPEN   F:IPLIST,(FILE,'TPIPLIST'),(KEYED),(DIRECT),;
                  (INOUT),(SAVE),;
                  (ERR,IPOPNERR),;
                  (ABN,IPOPNABN)
         M:READ   F:IPLIST,(BUF,CTLBUF),(SIZE,CTLSZ),(KEY,CTLKEY);
                  ,(ERR,IPRDERR),(ABN,IPRDABN)
         LW,R13   KEYHTID           GET HTID FROM CONTROL REC
         CW,R13   TPFILEHTID
         BE       THE%SAME
         CALL     CONVERTID
         LI,R1    WRONGTID3
         STD,R14  0,R1
         M:TYPE   (MESS,WRONGMES3)
         MTW,1    BAD%TID%FLAG
THE%SAME EQU      %
         DEBUG    'EXITING CKIPLIST'
         RETURN   CKIPLIST
IPOPNERR   EQU    %
         M:SNAP   'CK10',(CTLBUF,CTLBUF+10)
         LI,R1    ERROR1            ERROR ON OPENING IPLIST
         CALL     ADVISE
IPOPNABN  EQU     %
         M:SNAP   'CK10',(CTLBUF,CTLBUF+10)
         LI,R1    ERROR2
         CALL     ADVISE
IPRDERR  EQU      %
         M:SNAP   'CHK 10'
         LI,R1    ERROR10
         CALL     ADVISE
*
IPRDABN  EQU      %
         M:SNAP   'CHK 10'
         LI,R1    ERROR11
         CALL     ADVISE
*
************************************************************************
         TITLE    'QPREP ** VERSION 0 ** CONVERTID'
************************************************************************
*
*                           C O N V E R T I D
*
*        CONVERT A HEXADECIMAL ID TO EBCDIC FOR PRINT OUT
*                 THIS ROUTINE SUPPLIED BY TED MARTNER
*
*        INPUT:  R13=ID IN HEXADECIMAL
*        OUTPUT: R14 AND R15 CONTAIN THE TRAN ID IN EBCDIC
*        ENTRY POINT:  CONVERTID
*        SUBROUTINES USED:  NONE
*        REGISTERS DESTROYED:  NONE
*
************************************************************************
CONVERTID   ENTRY   'CONVERT CONTENTS OF R13 INTO AN';
                  ,' EBCDIC VALUE IN R14 AND R15'
         DEBUG    'ENTERING CONVERTID'
         PUSH     1,R12
         LI,R14   0                 INITIALIZE REGISTERS
         LI,R15   0
CONVERTID%1  EQU  %
         LI,R12   '0'**-4           CONVERT 1 DIGIT TO EBCDIC
         SLD,R12  +4
         CI,R12   '9'               WAS IT CONVERTED OK?
         BLE      CONVERTID%2       YES
         AI,R12   'A'-'9'-1         NO ADJUST IT
CONVERTID%2  EQU  %
         SLD,R14  8
         OR,R15   R12
         BNOV     CONVERTID%1       OV SET BY SLD WHEN DONE
         PULL     1,R12
         DEBUG    'EXITING CONVERTID'
         RETURN   CONVERTID
*
************************************************************************
         TITLE    'QPREP ** VERSION 0 ** SUMMARY'
***************************************************************
*
*                 S U M M A R Y
*
*        RESET THE TPFILES ENTRY FOR TPIPLIST AND CLOSE TPIPLIST
*
*************************************************************
SUMMARY   ENTRY   'RESET TPFILES ENTRY FOR TPIPLIST ';
                  ,'AND CLOSE TPIPLIST'
         DEBUG    'ENTERING SUMMARY'
         M:WRITE  F:TPFILES,(BUF,IPBUF),(SIZE,IPBUFSZ),(KEY,IPKEY);
                  ,(ONEWKEY)
         M:CLOSE  F:IPLIST,(SAVE)
         DEBUG    'EXITING SUMMARY'
         RETURN   SUMMARY
*
*****************************************************************
         TITLE    'QPREP ** VERSION 0 ** CLSFILES'
***************************************************************
*
*                 C L S F I L E S
*
*        CLOSE THE QUEUE AND TPFILES FILE DCBS
*
*************************************************************************
CLSFILES   ENTRY   'CLOSE THE QUEUE AND TPFILES FILE DCBS'
         DEBUG    'ENTERING CLSFILES'
         M:QUEUE  F:QUEUE,LOCK
         BCR,12   CLSFILES10
         BCS,8    Q%UNAVAILABLE
         B        Q%ERROR
CLSFILES10  EQU   %
         M:CLOSE  F:TPFILES,(SAVE)
         DEBUG    'EXITING CLSFILES'
         RETURN   CLSFILES
*
*******************************************************************
         TITLE    'QPREP ** VERSION 0 ** ADVISE'
*******************************************************************
*
*                 A D V I S E
*
*        INTERNAL ROUTINE TO PRINT OUT ERROR MESSAGE FROM
*        MESSAE LIST AND ABORT JOB
*
***************************************************************
ADVISE    ENTRY    'PRINT ERROR MESSAGE AND ABORT JOB'
         DEBUG    'ENTERING ADVISE'
         M:TYPE   (MESS,*R1)
         LI,R3    C' '              GET RID OF BYTE COUNT
         LB,R4    *R1               GET LENGTH OF MESSAGE
         STB,R3   *R1               CHANGE TEXTC TO TEXT
         M:WRITE  M:LO,(BUF,*R1),(SIZE,*R4)
         M:WRITE  M:DO,(BUF,*R1),(SIZE,*R4)
         M:XXX
         RETURN   ADVISE            INCLUDED FOR AESTHETICS
*******************************************************************
         TITLE    'QPREP ** VERSION 0 ** ERROR MESSAGES'
******************************************************************
*
*                     E R R O R   M E S S A G E S
*
*********************************************************************
ERROR1   TEXTC    'ERROR ON OPENING TPIPLIST'
ERROR2   TEXTC    'ABNORMAL ON OPENING TPIPLIST'
ERROR3   TEXTC    'THE HIGHEST TRAN ID VALUES DO NOT AGREE'
ERROR4   TEXTC    'ERROR ON OPENING TPFILES'
ERROR5   TEXTC    'ABNORMAL ON OPENING TPFILES'
ERROR6   TEXTC    'UNEXPECTED READ ERROR ON TPIPLIST'
ERROR7   TEXTC    'UNEXPECTED READ ABNORMAL ON TPIPLIST'
ERROR8   TEXTC    'UNEXPECTED READ ERROR ON TPFILES'
ERROR9   TEXTC    'UNEXPECTED READ ABNORMAL ON TPFILES'
ERROR10  TEXTC    'UNEXPECTED READ ERROR ON CTL KEY OF TPIPLIST'
ERROR11  TEXTC    'UNEXPECTED READ ABNORMAL ON CTL KEY OF TPIPLIST'
ERROR12  TEXTC    'QUEUE NOT AVAILABLE'
ERROR13  TEXTC    'QUEUE  ERROR  - SEE REGISTER 10'
ERROR14  TEXTC    'UNEXPECTED OPEN ERROR ON TPQUEUE'
ERROR15  TEXTC    'UNEXPECTED OPEN ABNORMAL ON TPQUEUE'
PATCH    RES      100
         END      QPREP

