*DECK DLABH
USETEXT DLFPDEF
USETEXT ABH
USETEXT DIRTBLH
USETEXT ERRMSG
USETEXT OUTCDA
USETEXT ZHRCD
PROC DLABH; # SELECT APPLICATION BLOCK HEADER #
*IF DEF,IMS
#
*1DC DLABH
*
* 1. PROC NAME AUTHOR DATE
* DLABH P.C.TAM 79/01/10
*
* 2. FUNCTIONAL DESCRIPTION
* SELECT APPLICATION BLOCKS FOR OUTPUT
*
* 3. METHOD USED
* LOOP THROUGH APPLICATION BLOCK PROCESSING TABLE, PROCESS
* EACH ENTRY AS FOLLOWS UNTIL EITHER THE CHOSEN FLAG IS CLEARED
* OR ALL ENTRIES PROCESSED.
* B IF BREAK FLAG IN ABH WORD IS NOT SET, CLEAR
* CHOSEN FLAG
* C IF CANCEL FLAG IN ABH WORD IS NOT SET, CLEAR
* CHOSEN FLAG
* F IF NO FORMAT EFFECTOR IN ABH WORD IS NOT SET,
* CLEAR CHOSEN FLAG
* P IF PARITY/AUTO INPUT FLAG IS NOT SET, CLEAR
* CHOSEN FLAG
* T IF TRUNCATED DATA FLAG IS NOT SET, CLEAR
* CHOSEN FLAG
* U IF IBU FLAG IS NOT SET, CLEAR CHOSEN FLAG.
* X IF TRANSPARENT DATA FLAG IS NOT SET, CLEAR
* CHOSEN FLAG
* CN IF CN IN MESSAGE IS NOT ZERO AND IT DOES NOT
* MATCH ONE IN PROCESSING TABLE, CLEAR CHOSEN
* FLAG.
*
* 4. ENTRY PARAMETERS
* DIRTBLH COMMON BLOCK CONTAINING THE SELECTION
* CRITERION
* ZHRCD COMMON BLOCK CONTAINING THE INPUT
* RECORD HEADER
*
* 5. EXIT PARAMETERS
* CHOSEN IN ZHRCD COMMON DECK, CLEARED IF
* RECORD NOT SELECTED
*
* 6. COMDECKS CALLED AND SYMPL TEXTS USED.
* ABH DIRTBLH DLFPDEF ERRMSG
* OUTCDA ZHRCD
*
* 7. ROUTINES CALLED.
* DLABEND ABORT PROGRAM
* DLDFM ISSUE DAYFILE MESSAGE
*
* 8. DAYFILE MESSAGES
* BAD DIRECTIVE TABLE ENTRY
*
*
#
*ENDIF
#
EXTERNAL VARIABLES
#
XREF
BEGIN
PROC DLABEND; # ABORT PROGRAM #
PROC DLDFM; # ISSUE DAYFILE MESSAGE #
END
#
INTERNAL VARIABLES
#
SWITCH CRIT
ERR,
ERR, ERR, ERR, ERR, ERR, ERR,
L$B, L$C, L$F, L$P, L$T, L$U, L$X, ERR,
ERR, L$CN, ERR, ERR, ERR, ERR, ERR, ERR;
ITEM
I; # TEMPORARY VARIABLE #
# ******************************************************************** #
BEGIN
#
THE ABH IS IN THE 4TH WORD OF ARRAY TEMPB1 IN COMMON BLOCK
ZHRCD. RTIME(IN ZHWD0), OPCODE, AND TA WORDS PRECEDE THE ABH.
#
P<ABH> = LOC(ZHWD3[0]);
FOR I = 1 STEP 1 WHILE CHOSEN AND I LQ DIRNUMH
DO
BEGIN
GOTO CRIT[DIRHID[I]];
L$B: # BREAK FLAG PROCESSING #
IF ABHBRK[0] NQ 1
THEN
CHOSEN = FALSE;
GOTO NEXT;
L$C: # CANCEL BIT PROCESSING #
IF ABHCAN[0] NQ 1
THEN
CHOSEN = FALSE;
GOTO NEXT;
L$F: # NO FORMAT EFFECTOR PROCESSING #
IF ABHNFE[0] NQ 1
THEN
CHOSEN = FALSE;
GOTO NEXT;
L$P: # PARITY/AUTO INPUT FLAG PROCESSING #
IF ABHBIT[0] NQ 1
THEN
CHOSEN = FALSE;
GOTO NEXT;
L$T: # TRUNCATED DATA FLAG PROCESSING #
IF ABHTRU[0] NQ 1
THEN
CHOSEN = FALSE;
GOTO NEXT;
L$U: # IBU BIT PROCESSING #
IF ABHIBU[0] NQ 1
THEN
CHOSEN = FALSE;
GOTO NEXT;
L$X: # TRANSPARENT BIT PROCESSING #
IF ABHXPT[0] NQ 1
THEN
CHOSEN = FALSE;
GOTO NEXT;
L$CN: # CONNECTION NUMBER PROCESSING #
IF ABHADR[0] NQ 0 AND
ABHADR[0] NQ DIRHVAL[I]
THEN
CHOSEN = FALSE;
GOTO NEXT;
ERR:
DLDFM(BAD$DNTRY); # BAD DIRECTIVE TABLE ENTRY #
DLABEND; # ABORT PROGRAM #
NEXT:
END
END
TERM