*DECK DB$DS27 
USETEXT CDCSCTX 
      PROC DB$DS27; 
      BEGIN 
 #
* *   DB$DS27 - LIST SCHEMA STATUS LINES         PAGE  1
* *   C F RICHARDS                               DATE  11/30/78 
* *   BOB MCALLESTER                             DATE  01/19/84 
* 
* DC  PURPOSE 
* 
*     LIST STATUS LINES FOR ONE OR MORE SCHEMAS 
* 
* DC  ENTRY CONDITIONS
* 
*     ASSUMPTIONS 
* 
*     DB$DSFL - OPTION FLAGS SET FOR THIS COMMAND 
*     DB$DSSI - SCHEMA-ID IF SPECIFIED, ELSE ZERO.
*     DB$DSSN - SCHEMA-NAME IF SPECIFIED, ELSE BLANKS.
*     DB$DSVN - PRIMARY VERSION NAME, ELSE BLANKS.
* 
* DC  EXIT CONDITIONS 
* 
*     NORMAL EXIT (VALID COMBINATION OF OPTIONS)
*       STATUS LINES HAVE BEEN GIVEN TO DISPLAY MANAGER.
*       EXIT VIA DB$YES.
* 
*     ABNORMAL EXIT 
*       EXIT VIA DB$NO. 
* 
* DC  CALLING ROUTINES
* 
*     DB$DSTX - SYNGEN SPECIFICATION (THROUGH DB$DDIF)
* 
* DC  CALLED ROUTINES 
# 
      XREF PROC DB$DBHL;           # BEGIN HEADER LINES                #
      XREF PROC DB$DBLL;           # BEGIN LIST LINES                  #
      XREF PROC DB$DEDL;           # ENTER DIAGNOSTIC LINE ON CONSOLE  #
      XREF PROC DB$DEHL;           # ENTER HEADER LINES TO CONSOLE     #
      XREF PROC DB$DELL;          # ENTER CONSOLE LIST LINE            #
      XREF PROC DB$DSUA;           # DETERMN IF RUNUNIT USING AREA     #
      XREF PROC DB$FLOP;           # GENERATE FLOW POINT               #
      XREF PROC DB$MFF;            # FREE A FIXED BUFFER               #
      XREF PROC DB$NO;             # FAIL RETURN TO SCANNER            #
      XREF PROC DB$YES;            # SUCCESS RETURN TO SCANNER         #
# 
*     INTERNAL PROCS
* 
*     PROC LISTARLINES,            - LIST AREA STATUS LINES            -
*     PROC LISTJLINES,             - LIST JOB STATUS LINES             -
*     PROC LISTSCLINES,            - LIST SCHEMA STATUS LINES          -
* 
* DC  NON-LOCAL VARIABLES 
# 
*CALL DSFDCLS 
      XREF ITEM DB$DSSI I;
      XREF ITEM DB$DSSN C(30);
      XREF ITEM DB$DSVN C(07);     # PRIMARY VERSION NAME              #
# 
 #
  
  
#     LOCAL ITEMS                                                      #
  
      ITEM FOUND B;                # TRUE IF SCHEMA ENTRY FOUND        #
      ITEM INDEX I;                # LOOP INDEX                        #
      ITEM INUSE B;                # PARAMETER TO DB$DSUA              #
      ITEM I I;                    # LOOP INDUCTION VARIABLE           #
      ITEM MSG6 C(14) = "UNKNOWN SCHEMA"; 
  
#     LOCAL DEFS                                                       #
  
      DEF DFARHLG  # 60 #;         # LENGTH OF AREA HEADER LINE        #
      DEF DFLGMSG6 # 14 #;         # LENGTH OF MESSAGE 6               #
      DEF DFSCHLG  # 57 #;         # LENGTH OF SCHEMA HEADER LINE      #
  
  
  
#     HEADERS FOR SCHEMA AND AREA LIST LINES                           #
  
      ITEM ARHEADER C(DFARHLG) =   # HEADER LINE FOR AREA LIST LINE    #
 "   AREA ID/NAME                    ST ACT USERS VERSION     ";
  
      ITEM SCHDRLINE C(DFSCHLG) =  # HEADER LINER FOR SCHEMA LIST LINE #
 " SCHEMA ID/NAME                    ST USE JLF QRF RIF TRF"; 
  
  
  
  
#     SWITCH FOR STATUS OPTIONS                                        #
  
  
#     THE FOLLOWING SWITCH IS INDEXED BY ITEM *DSFINDEX* WHICH OVERLAPS#
#     SOME BOOLEAN FLAGS IN ARRAY DB$DSFL. THE OVERLAP ITEM IS USED TO #
#     ALLOW EASY VALIDATION OF ORDER-INDEPENDENT SYNTAX OPTIONS. THE   #
#     LIST BELOW SHOWS THE COMBINATION OF FLAGS WHICH, IF SET, WOULD   #
#     SELECT THAT SWITCH ENTRY. THE FLAGS ARE IDENTIFIED BY THEIR KEY  #
#     WORD COUNTERPARTS, SO *ALL* REFERS TO FLAG *DSFALL*.             #
  
      SWITCH STATUSOPTION 
        ILLEGAL,                   #  0 - NO OPTIONS SPECIFIED         #
        ILLEGAL,                   #  1 - ALL                          #
        ILLEGAL,                   #  2 - AR                           #
        ILLEGAL,                   #  3 - AR, ALL                      #
        SC,                        #  4 - SC                           #
        SCALL,                     #  5 - SC, ALL                      #
        SCAR,                      #  6 - SC, AR                       #
        ILLEGAL,                   #  7 - SC, AR, ALL                  #
        JOBS,                      #  8 - JOBS                         #
        ILLEGAL,                   #  9 - JOBS, ALL                    #
        ILLEGAL,                   # 10 - JOBS, AR                     #
        ILLEGAL,                   # 11 - JOBS, AR, ALL                #
        JOBSSC,                    # 12 - JOBS, SC                     #
        ILLEGAL,                   # 13 - JOBS, SC, ALL                #
        JOBSSCAR,                  # 14 - JOBS, SC, AR                 #
        ILLEGAL,                   # 15 - JOBS, SC, AR, ALL            #
        ILLEGAL,                   # 16 - VN                           #
        ILLEGAL,                   # 17 - VN, ALL                      #
        ILLEGAL,                   # 18 - VN, AR                       #
        ILLEGAL,                   # 19 - VN, AR, ALL                  #
        ILLEGAL,                   # 20 - VN, SC                       #
        ILLEGAL,                   # 21 - VN, SC, ALL                  #
        SCAR,                      # 22 - VN, SC, AR                   #
        ILLEGAL,                   # 23 - VN, SC, AR, ALL              #
        ILLEGAL,                   # 24 - VN, JOBS                     #
        ILLEGAL,                   # 25 - VN, JOBS, ALL                #
        ILLEGAL,                   # 26 - VN, JOBS, AR                 #
        ILLEGAL,                   # 27 - VN, JOBS, AR, ALL            #
        ILLEGAL,                   # 28 - VN, JOBS, SC                 #
        ILLEGAL,                   # 29 - VN, JOBS, SC, ALL            #
        JOBSSCAR,                  # 30 - VN, JOBS, SC, AR             #
        ILLEGAL;                   # 31 - VN, JOBS, SC, AR, ALL        #
  
      ARRAY STATCHARS [0:5] S(1); 
        BEGIN 
        ITEM STATCHAR C(00,00,01) = [ "U",       # CHAR FOR S"UP"      #
                                   "I",          # CHAR FOR S"IDLING"  #
                                   "I",          # CHAR FOR S"IDLE"    #
                                   "D",          # CHAR FOR S"DOWNING" #
                                   "D",          # CHAR FOR S"DOWN"    #
                                   "E"];         # CHAR FOR S"ERRDOWN" #
        END 
  
*CALL DB$FUNC 
  
  
  
  
  
#     I N T E R N A L   P R O C E D U R E   -   L I S T S C L I N E S .#
  
  
  
      PROC LISTSCLINES((SINGLESCHEMA)); 
      BEGIN 
 #
* *   DB$DS27                                    PAGE  1
* *   LISTSCLINES - LIST SCHEMA STATUS LINES
* *   C F RICHARDS                               DATE  12/02/78 
* *   M. E. STERMER                              DATE  12/02/80 
* 
* DC  PURPOSE 
* 
*     LIST STATUS LINES FOR ONE OR MORE SCHEMAS.
* 
* DC  ENTRY CONDITIONS
* 
*     PARAMETERS
# 
      ITEM SINGLESCHEMA B;         # TRUE IF LIST FOR SINGLE SCHEMA    #
                                   # WITH SAL INDEX OF SALX            #
# 
*     ASSUMPTIONS 
* 
*     DSFALL - TRUE IF SHOULD LIST INACTIVE AS WELL AS ACTIVE SCHEMAS.
*              (FORCED TO TRUE FOR SINGLE SCHEMA CASE SO ALWAYS LIST).
*     SALX - CONTAINS CORRECT INDEX INTO SAL FOR SINGLE SCHEMA CASE.
* 
* DC  EXIT CONDITIONS 
* 
*     RETURN TO CALLER AFTER SENDING ALL LINES TO DISPLAY MANAGER.
* 
* DC  CALLING ROUTINES
* 
*     DB$DS27 - LIST STATUS LINES 
* 
* DC  CALLED ROUTINES 
# 
      XREF FUNC DB$CDEB C(10);     # INTEGER TO DECIMAL, LEADING BLANKS#
      XREF FUNC DB$CFIL C(30);     # BLANK/BINARY ZERO CHARACTER FILL  #
      XREF PROC DB$DELL;           # ENTER CONSOLE LIST LINE           #
# 
* DC  DESCRIPTION 
* 
*     IF SINGLE SCHEMA CASE, SET DSFALL TO INSURE THE SCHEMA STATUS IS
*     LISTED WHETHER OR NOT THE SCHEMA IS ACTIVE, SET LOOP LIMITS TO
*     PROCESS THE SINGLE SCHEMA.
*     IF NOT THE SINGLE SCHEMA CASE, SET LOOP LIMITS TO PROCESS ALL 
*     SCHEMAS.
*     GENERATE THE CONSOLE HEADER LINES.
*     PREPARE DISPLAY MANAGER TO BEGIN RECEIVING LIST LINES.
*     LOOP THROUGH ALL SCHEMAS INDICATED AND PREPARE THE MODEL LINE AND 
*     SEND IT TO DISPLAY MANAGER FOR EACH SCHEMA. 
*     RETURN. 
 #
  
  
#     LOCAL VARIABLES                                                  #
  
  
      BASED ARRAY FET;;            # USED TO LET DB$CFIL READ LOG LFNS #
      ITEM INDEX I;                # LOOP INDUCTION VARIABLE           #
      ITEM LIMIT I;                # LOOP INDUCTION LIMIT              #
      ARRAY SCSTATUSLINE[0:0] S(7);  # MODEL SCHEMA LIST LINE          #
        BEGIN 
        ITEM SC$ID        C(00,00,04);  # ID - PIC ZZZ9                #
        ITEM SC$SLASH     C(00,24,01);  # SLASH FOR ID/NAME SEPARATOR  #
        ITEM SC$NAME      C(00,30,30);  # NAME - PIC X(30)             #
        ITEM SC$STATUS    C(03,36,01);  # STATUS - PIC X - U/I/D/E     #
        ITEM SC$USERS     C(03,48,03);  # NUMBER OF ACTIVE USERS       #
        ITEM SC$JLF       C(04,18,01);  # JLF (A) ACTIVE / (I) INACTIVE#
        ITEM SC$QRF       C(04,42,01);  # QRF (A) ACTIVE / (I) INACTIVE#
        ITEM SC$RIF       C(05,06,01);  # RIF (A) ACTIVE / (I) INACTIVE#
        ITEM SC$ARF       C(05,30,01);  # TRF (A) ACTIVE / (I) INACTIVE#
        ITEM SC$WORD      C(00,00,64) = [" "]; # PRESET TO ALL BLANKS  #
        END 
  
  
  
  
#     E X E C U T A B L E   C O D E   F O R   L I S T S C L I N E S    #
  
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP ("DS27-1");        # GENERATE A FLOW POINT.            #
      CONTROL ENDIF;
  
      DB$DBHL;                     # SET UP FOR DISPLAY                #
  
      IF SINGLESCHEMA              # IF ONLY DOING A SINGLE SCHEMA     #
      THEN
        BEGIN 
        INDEX = SALX;              # START WITH THE SPECIFIED SCHEMA   #
        LIMIT = SALX;              # SPECIFIED SCHEMA IS LAST TO LIST  #
        DSFALL[0] = TRUE;          # FORCE LIST OF INACTIVE SCHEMA     #
        DB$DBLL;                   # BEGIN LIST LINES                  #
        DB$DELL(SCHDRLINE,DFSCHLG);  # WRITE SCHEMA HEADER LINE        #
        DB$DELL(" ",1);            # WRITE A SPACER LINE               #
        END 
  
      ELSE                         # ELSE DOING ALL SCHEMAS            #
        BEGIN 
        INDEX = 0;                 # START WITH FIRST SCHEMA           #
        LIMIT = SALL;              # LAST SCHEMA IS LAST TO LIST       #
        DB$DEHL(SCHDRLINE,DFSCHLG);  # WRITE SCHEMA HEADER LINE        #
        DB$DBLL;                   # BEGIN LIST LINES                  #
        END 
  
  
      FOR INDEX = INDEX STEP 1     # FOR EACH SAL ENTRY FROM FIRST     #
        UNTIL LIMIT                # UNTIL LAST (AS FIGURED ABOVE)     #
      DO
        BEGIN 
        IF NOT DSFALL[0]              # IF NOT FOIND *ALL* SCHEMAS     #
           AND SASCUSERS[INDEX] EQ 0  # AND THIS SCHEMA IS INACTIVE    #
        THEN
          BEGIN 
          TEST INDEX;              # SKIP THIS SCEHMA, ON TO THE NEXT  #
  
          END 
  
        SC$ID[0] = DB$CDEB(SASCHID[INDEX], 4);
        SC$SLASH[0] = "/";
        SC$NAME[0] = SASCNAME[INDEX]; 
        SC$STATUS[0] = STATCHAR[SASCHST[INDEX]];
        SC$USERS[0] = DB$CDEB(SASCUSERS[INDEX], 3); 
  
        IF SAJLFPTR[INDEX] NQ 0    # IF JLF ACTIVE                     #
        THEN
          BEGIN 
          SC$JLF[0] = "A";         # SET JLF FLAG TO ACTIVE            #
          END 
  
        ELSE
          BEGIN 
          SC$JLF[0] = "I";         # SET JLF FLAG TO INACTIVE          #
          END 
  
        IF SAQRFPTR[INDEX] NQ 0    # IF QRF ACTIVE                     #
        THEN
          BEGIN 
          SC$QRF[0] = "A";         # SET QRF FLAG TO ACTIVE            #
          END 
  
        ELSE
          BEGIN 
          SC$QRF[0] = "I";         # SET QRF FLAG TO INACTIVE          #
          END 
  
        IF SARIDFIT[INDEX] NQ 0    # IF RIF ACTIVE                     #
        THEN
          BEGIN 
          SC$RIF[0] = "A";         # SET RIF FLAG TO ACTIVE            #
          END 
  
        ELSE
          BEGIN 
          SC$RIF[0] = "I";         # SET RIF FLAG TO INACTIVE          #
          END 
  
        IF SATRFPTR[INDEX] NQ 0    # IF TRF ACTIVE                     #
        THEN
          BEGIN 
          SC$ARF[0] = "A";         # SET TRF FLAG TO ACTIVE            #
          END 
  
        ELSE
          BEGIN 
          SC$ARF[0] = "I";         # SET TRF FLAG TO INACTIVE          #
          END 
  
        DB$DELL(SCSTATUSLINE, 64);  # ENTER LIST LINE ON CONSOLE       #
        END 
  
      RETURN; 
  
      END 
  
  
  
  
  
#     I N T E R N A L   P R O C E D U R E   -   L I S T A R L I N E S .#
  
  
  
      PROC LISTARLINES; 
      BEGIN 
 #
* *   DB$DS27                                    PAGE  1
* *   LISTARLINES - LIST AREA STATUS LINES
* *   LG WHITE                                   DATE  11/01/79 
* *   M. E. STERMER                              DATE  12/02/80 
* 
* DC  PURPOSE 
* 
*     LIST STATUS LINES FOR AN AREA 
* 
* DC  ENTRY CONDITIONS
* 
*     ASSUMPTIONS 
# 
      XREF ITEM DB$DSAN C(30);     # AREA NAME SPECIFIED               #
      XREF ITEM DB$DSAI;           # AREA ID SPECIFIED                 #
      XREF ITEM DB$DSVN C(07);     # VERSION NAME                      #
#     SALX - INDEX TO THE SAL SHOULD BE SET 
* 
* DC  EXIT CONDITIONS 
* 
*     RETURN TO CALLER AFTER SENDING STATUS LINES TO DISPLAY MANAGER
*     POINTERS TO TQT AND RCB ARE RESET TO THE VALUES EXPECTED BY DB$MTR
* 
* DC  CALLING ROUTINES
* 
*     DB$DS27 - LIST STATUS LINES 
* 
* DC  CALLED ROUTINES 
# 
      XREF FUNC DB$CDEB C(10);     # INTEGER TO DECIMAL, LEADING BLANKS#
      XREF PROC DB$DELL;           # ENTER CONSOLE LIST LINES          #
# 
* DC  DESCRIPTION 
* 
*     FIND OFT FOR SPECIFIED AREA.  EXTRACT AND FORMAT STATUS INFOR-
*     MATION.  WRITE INFORMATION TO SCREEN.  RESTORE TQT AND RCB PTRS.
 #
  
  
#     LOCAL VARIABLES                                                  #
  
      ARRAY ARSTATUS[0:0] S(6); 
        BEGIN 
        ITEM AR$ID    C(00,00,04); # AREA ID PIC ZZZ9                  #
        ITEM AR$SLASH C(00,24,01); # SEPARATOR FOR ID/NAME             #
        ITEM AR$NAME  C(00,30,30); # AREA NAME LEFT JUST. BLANK FILL   #
        ITEM AR$STAT  C(03,36,01); # AREA STATUS - U/D/I/E             #
        ITEM AR$ACT   C(03,54,01); # ACTIVITY (A) ACTIVE / (I) INACTIVE#
        ITEM AR$USRS  C(04,12,04); # NUMBER OF USERS                   #
        ITEM AR$VERN  C(04,48,07); # VERSION FOR THIS AREA             #
        ITEM AR$WORD  C(00,00,60) = [" "]; # PRESET TO ALL BLANKS      #
        END 
#     LOCAL DEFS                                                       #
  
      DEF DFARLNCLG # 60 #;        # AREA LINE CHARACTER LENGTH        #
  
  
  
  
#     E X E C U T A B L E   C O D E   L I S T A R L I N E S            #
  
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP ("DS27-2");        # GENERATE A FLOW POINT.            #
      CONTROL ENDIF;
  
      FOUND = FALSE;
  
      IF DB$DSVN EQ " " 
      THEN
        BEGIN 
        DB$DSVN = DFMASTER; 
        END 
  
      P<OFT> = LOC(SAOFTLSP[SALX]); 
      FOR INDEX=INDEX WHILE NOT FOUND AND OFNEXT[0] NQ 0 DO 
        BEGIN 
        P<OFT> = OFNEXT[0]; 
        IF OFARID[0] EQ DB$DSAI 
          AND OFVENAME[0] EQ DB$DSVN
        THEN
          BEGIN 
          FOUND = TRUE; 
          AR$ID[0] = DB$CDEB(OFARID[0],4);
          AR$SLASH[0] = "/";
          AR$NAME[0] = DB$DSAN; 
          AR$STAT = STATCHAR[OFSTATUS[0]];
          AR$ACT = "A"; 
          AR$USRS[0] = DB$CDEB(OFUSERS[0],4); 
          AR$VERN[0] = DB$DSVN; 
          END 
  
        END 
      IF NOT FOUND THEN            # IF NO OFT FOR AREA                #
        BEGIN                      # SET STATUS FOR INACTIVE AREA      #
        AR$ID[0] = DB$CDEB(DB$DSAI,4);
        AR$SLASH = "/"; 
        AR$NAME[0] = DB$DSAN; 
        AR$STAT[0] = " "; 
        AR$ACT[0] = "I";
        AR$USRS[0] = "   0";
        AR$VERN[0] = DB$DSVN; 
        END 
  
      DB$DELL(" ",1);              # WRITE TWO SPACER LINES            #
      DB$DELL(" ",1); 
      DB$DELL(ARHEADER,DFARHLG);   # WRITE THE AREA HEADER LINE        #
      DB$DELL(" ",1);              # WRITE A SPACER LINE               #
      DB$DELL(ARSTATUS,DFARLNCLG);  # WRITE THE AREA STATUS LINE       #
      DB$DELL(" ",1); 
      END 
  
  
  
  
  
#     I N T E R N A L   P R O C E D U R E   -   L I S T J L I N E S .  #
  
  
  
      PROC LISTJLINES;
      BEGIN 
 #
* *   DB$DS27                                    PAGE  1
* *   LISTJLINES - LIST JOB STATUS LINES
* *   LG WHITE                                   DATE  11/06/79 
* *   M. E. STERMER                              DATE  12/02/80 
* 
* DC  PURPOSE 
* 
*     LIST STATUS LINES FOR A JOB 
* 
* DC  ENTRY CONDITIONS
* 
*     ASSUMPTIONS 
* 
*     TQT AND RSB POINTERS ARE SET TO JOB WHOSE STATUS IS TO BE WRITTEN 
*     TO THE CONSOLE.  SALX IS SET TO SCHEMA FOR THAT TQT.
* 
* DC  EXIT CONDITIONS 
* 
*     RETURN TO CALLER AFTER SENDING STATUS LINES TO DISPLAY MGR. 
* 
* DC  CALLING ROUTINES
* 
*     DB$DS27 - LIST STATUS LINES 
* 
* DC  CALLED ROUTINES 
# 
      XREF FUNC DB$CDEB C(10);     # INTEGER TO DECIMAL, LEADING BLANKS#
      XREF FUNC DB$COCT C(10);     # INTEGER TO OCTAL, LEADING ZEROS   #
      XREF PROC DB$DELL;           # ENTER LIST LINES TO CONSOLE       #
# 
* DC  DESCRIPTION 
* 
*     EXTRACT AND FORMAT STATUS INFORMATION FOR JOB.  WRITE TO SCREEN 
*     LINE AT A TIME. 
 #
  
#     LOCAL VARIABLES                                                  #
  
      ITEM SEPARATOR C(10) = ">00";  # GROUP SEPARATOR FOR JOB STATUS  #
  
      ARRAY JOBSTATUS[0:0] S(25); 
        BEGIN 
        ITEM JB$JBPRGM    C(00,00,42) = 
                     ["JOBNAME = XXXXXXX     PROGRAM = XXXXXXXXXX"];
        ITEM JB$TASKID    C(04,12,14) = 
                     ["TASK ID = XXXX"];
        ITEM JB$ACTIV     C(05,36,25) = 
                    ["JOB ACTIVITY =           "];
        ITEM JB$SCNMID    C(08,06,52) = 
           ["SCHEMA ID/NAME = NNNN/XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"];
        ITEM JB$SBNM      C(13,18,47) = 
                    ["SUBSCHEMA NAME = XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"];
        ITEM JB$FUNC      C(18,00,29) = 
                    ["CURRENT FUNCTION =           "];
        ITEM JB$CURREQVN  C(20,54,35) = 
                    ["CURRENT REQUESTED VERSION = XXXXXXX"];
        END 
  
      DEF DFJNCP   #10#;           # CHAR POSITION JOBNAME INSERTION   #
      DEF DFPGCP   #32#;           # CHAR POSITION PROGRAM NAME INSERT #
      DEF DFTASKCP #10#;           # CHAR POSITION TASK NAME INSERT    #
      DEF DFACTCP  #15#;           # CHAR POSITION ACTIVITY INSERT     #
      DEF DFSCIDCP #17#;           # CHAR POSITION SCHEMA ID           #
      DEF DFSCNMCP #22#;           # CHAR POSITION SCHEMA NAME         #
      DEF DFSBNMCP #17#;           # CHAR POSITION SUBSCHEMA NAME      #
      DEF DFFNCP   #19#;           # CHAR POSITION FUNCTION INSERT     #
      DEF DFCVNCP  #28#;           # CHAR POS CURRENT REQUESTED VERSION#
  
      DEF DFJNLG   # 7#;           # JOBNAME LENGTH                    #
      DEF DFPRGMLG #10#;           # LENGTH PROGRAM ID                 #
      DEF DFTASKLG # 8#;           # TASK ID STRING LENGTH             #
      DEF DFACTLG  #10#;           # ACTIVITY STRING LENGTH            #
      DEF DFSCIDLG # 4#;           # SCHEMA ID STRING LENGTH           #
      DEF DFSCNMLG #30#;           # LENGTH SCHEMA NAME                #
      DEF DFSBNMLG #30#;           # LENGTH SUBSCHEMA NAME             #
      DEF DFFUNCLG #10#;           # LENGTH FUNCTION STRING            #
      DEF DFVERNLG # 7#;           # LENGTH VERSION NAME               #
  
#     DEFS FOR LIST LINE LENGTHS                                       #
  
      DEF DFLINE1LG  #42#;
      DEF DFLINE2LG  #14#;
      DEF DFLINE3LG  #25#;
      DEF DFLINE4LG  #52#;
      DEF DFLINE5LG  #47#;
      DEF DFLINE6LG  #29#;
      DEF DFLINE7LG  #35#;
  
  
  
#     B E G I N   E X E C U T A B L E   C O D E   L I S T J L I N E S  #
  
  
      CONTROL IFGR DFFLOP,0;
        DB$FLOP ("DS27-3");        # GENERATE A FLOW POINT.            #
      CONTROL ENDIF;
  
      SEPARATOR = ">04";           # INITIALIZE GROUP SEPARATOR        #
  
      IF C<5,1>TQRUID[0] EQ ":"    # IF A NOS-STYLE JOBNAME            #
      THEN
        C<DFJNCP,DFJNLG>JB$JBPRGM = C<0,4>TQRUID[0]; # USE ONLY 4 CHARS#
      ELSE
        C<DFJNCP,DFJNLG>JB$JBPRGM = C<0,7>TQRUID[0]; # ELSE USE 7 CHARS#
  
      C<DFPGCP,DFPRGMLG>JB$JBPRGM = TQPRNAME[0];
      C<DFCVNCP,DFVERNLG>JB$CURREQVN = TQVENAME[0]; 
  
      IF TQTASK[0] NQ 0            # IF JOB HAS NONZERO TASK NUMBER    #
      THEN
        BEGIN 
        C<DFTASKCP,DFTASKLG>JB$TASKID[0] =
                             DB$COCT(TQTASK[0],DFTASKLG); 
        IF C<DFTASKCP,4>JB$TASKID[0] EQ "0000"
        THEN
          BEGIN                    # REMOVE FOUR LEADING ZEROS         #
          C<DFTASKCP,DFTASKLG>JB$TASKID[0] =
                  C<DFTASKCP +4,DFTASKLG -4>JB$TASKID[0]; 
          END 
        B<0,18>SEPARATOR = B<0,18>SEPARATOR +1;  # ADD TO GROUP LENGTH #
        END 
  
      IF TQSWPF[0] THEN            # LIST JOB*S ACTIVITY# 
        BEGIN 
        C<DFACTCP,DFACTLG>JB$ACTIV = "ROLLED OUT";
        END 
      ELSE
        BEGIN 
        IF TQRCB[0] GR 0 THEN 
          BEGIN 
          C<DFACTCP,DFACTLG>JB$ACTIV = "ACTIVE";
          END 
        ELSE
          BEGIN 
          C<DFACTCP,DFACTLG>JB$ACTIV = "INACTIVE";
          END 
        END 
  
      IF NOT DSFSC[0] THEN         # IF SCHEMA NOT SPECIFIED IN COMMAND#
        BEGIN 
        C<DFSCNMCP,DFSCNMLG>JB$SCNMID = SASCNAME[SALX]; 
        C<DFSCIDCP,DFSCIDLG>JB$SCNMID = 
                             DB$CDEB(SASCHID[0],DFSCIDLG);
        B<0,18>SEPARATOR = B<0,18>SEPARATOR +1;  # ADD TO GROUP LENGTH #
        END 
      P<ASL> = TQASL[0];
      C<DFSBNMCP,DFSBNMLG>JB$SBNM = ASSBNAME[0];
      IF TQRCB[0] GR 0
      THEN
        BEGIN 
        P<RCB> = TQRCB[0];         # SET UP RCB FOR FUNCTION INSERT    #
        C<DFFNCP,DFFUNCLG>JB$FUNC = FUNCODE[RCFUNC[0]]; 
        B<0,18>SEPARATOR = B<0,18>SEPARATOR +1;  # ADD TO GROUP LENGTH #
        END 
  
#     INSERTIONS COMPLETE - WRITE LINES TO CONSOLE                     #
  
      DB$DELL(SEPARATOR,10);
      DB$DELL(JB$JBPRGM[0],DFLINE1LG);
      IF TQTASK[0] NQ 0 THEN
        DB$DELL(JB$TASKID[0],DFLINE2LG);
      DB$DELL(JB$ACTIV[0],DFLINE3LG); 
      IF NOT DSFSC[0] THEN
        DB$DELL(JB$SCNMID[0],DFLINE4LG);
      DB$DELL(JB$SBNM[0],DFLINE5LG);
      IF TQRCB[0] GR 0
      THEN
        BEGIN 
        DB$DELL(JB$FUNC[0],DFLINE6LG);
        END 
      DB$DELL(JB$CURREQVN[0],DFLINE7LG);
  
      END 
  
  
  
  
  
  
#     E X E C U T A B L E   C O D E   F O R   D B $ D S 2 7            #
  
        BEGIN 
  
        CONTROL IFGR DFFLOP,0;
          DB$FLOP ("DS27  ");      # GENERATE A FLOW POINT.            #
        CONTROL ENDIF;
  
        GOTO STATUSOPTION[DSFINDEX[0]]; 
  
  
SC: 
        IF DB$DSSI NQ 0            # IF A SCHEMA ID SPECIFIED          #
           OR DB$DSSN NQ " "       # OR A SCHEMA NAME SPECIFIED        #
        THEN
          BEGIN 
          LISTSCLINES(TRUE);       # LIST SCHEMA STATUS ON CONSOLE     #
                                   # DISPLAY. TRUE MEANS STATUS OF A   #
                                   # SINGLE SCHEMA ONLY.               #
          GOTO YES;                # EXIT TO SCANNER (VALID OPTION)    #
  
          END 
  
        LISTSCLINES(FALSE);        # LIST SCHEMA STATUS ON CONSOLE     #
                                   # DISPLAY. FALSE MEANS NOT JUST     #
                                   # STATUS OF A SINGLE SCHEMA, BUT ALL#
                                   # SCHEMAS ARE CHECKED.              #
        GOTO YES;                  # EXIT TO SCANNER (VALID OPTION)    #
  
  
SCALL:  
        IF DB$DSSI NQ 0            # IF A SCHEMA ID SPECIFIED          #
           OR DB$DSSN NQ " "       # OR A SCHEMA NAME SPECIFIED        #
        THEN
          BEGIN 
          DB$NO;                   # EXIT TO SCANNER (INVALID OPTION)  #
                                   # WOULD REQUIRE LISTARLINES(FALSE)  #
          END 
  
        LISTSCLINES(FALSE);        # LIST SCHEMA STATUS ON CONSOLE     #
                                   # DISPLAY. FALSE MEANS NOT JUST     #
                                   # STATUS OF A SINGLE SCHEMA, BUT ALL#
                                   # SCHEMAS ARE CHECKED.              #
        GOTO YES;                  # EXIT TO SCANNER (VALID OPTION)    #
  
  
SCAR: 
      LISTSCLINES(TRUE);           #  OUTPUT SCHEMA STATUS             #
      LISTARLINES;                 #  OUTPUT AREA STATUS               #
      DB$YES; 
  
JOBS: 
  
      DB$DBHL;                     # INITIALIZE THE DISPLAY AREA       #
      DB$DBLL;                     # BEGIN LIST LINES                  #
      P<TQT> = TQTCHAIN;           # POINT TO START OF TQT*S           #
      FOR I=I WHILE TQNEXT[0] NQ 0 DO # STOP BEFORE MONITOR*S TQT      #
        BEGIN 
        SALX = TQSALX[0]; 
        LISTJLINES;                # LIST EVERY JOB*S STATUS TO SCREEN #
        P<TQT> = TQNEXT[0]; 
        END 
  
      P<TQT> = TQTMTR;             # RESET POINTERS TO MONITOR         #
      P<RCB> = LOC(RCBMTR); 
      GOTO YES;                    # RETURN TO SCANNER                 #
  
JOBSSC: 
  
      LISTSCLINES(TRUE);
      DB$DELL(" ",1); 
      P<TQT> = TQTCHAIN;
      FOR I=I WHILE TQNEXT[0] NQ 0 DO 
        BEGIN 
        IF TQSALX[0] EQ SALX THEN  # IF USING SPECIFIED SCHEMA         #
          BEGIN 
          LISTJLINES;              # WRITE USER*S STATUS TO CONSOLE    #
          END 
        P<TQT> = TQNEXT[0]; 
        END 
  
      P<TQT> = TQTMTR;             # RESTORE POINTERS TO MONITOR       #
      P<RCB> = LOC(RCBMTR); 
      GOTO YES;                    # RETURN TO SCANNER                 #
  
JOBSSCAR: 
  
      LISTSCLINES(TRUE);           # WRITE SCHEMA STATUS               #
      LISTARLINES;                 # WRITE AREA STATUS                 #
      P<TQT> = TQTCHAIN;
      FOR I=I WHILE TQNEXT[0] NQ 0 DO # LOOP UNTIL MONITOR*S TQT       #
        BEGIN 
        IF TQSALX[0] EQ SALX THEN  # IF USING SCHEMA SPECIFIED         #
          BEGIN 
          DB$DSUA(LOC(OFT),INUSE); # SEE IF TQT HAS AREA OPEN          #
          IF INUSE THEN 
            BEGIN 
            LISTJLINES;            # WRITE OUT JOB*S STATUS            #
            END                    # HAS AREA OPEN          # 
          END                      # USING SCHEMA                      #
  
        P<TQT> = TQNEXT[0]; 
        END 
  
      P<TQT> = TQTMTR;             # RESET POINTERS TO MONITOR         #
      P<RCB> = LOC(RCBMTR); 
  
  
YES:                               # RETURN TO SCANNER                 #
      DB$DELL(" ",1); 
      DB$DELL("ENTER A PERIOD (.) TO DISPLAY THE LIST OF COMMANDS",50); 
  
      DB$YES;                      # EXIT - THE DISPLAY IS COMPLETED   #
  
  
  
ILLEGAL:  
        DB$NO;                     # EXIT TO SCANNER (INVALID OPTION)  #
  
        END 
  
      END 
  
      TERM
