Forum: >>> Magnum BBS <<<

Program from Unisys Advanced DMSII Class to list dataset fields

From Tom Schaefer@21:1/5 to All on Fri Jun 17 10:53:05 2022

A colleague asked me if I knew anybody that might have this program so I said I would ask.

He is looking for a program (I presume it was an example) to list all the fields in a dataset by reading the Description file.

Does anyone have access to those notes? I suspect things may have changed, but if anyone has it, they would be here.

Regards,

Tom Schaefer

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)

From TKosfeld@21:1/5 to Tom Schaefer on Fri Jun 17 16:45:00 2022

On 6/17/2022 2:53 PM, Tom Schaefer wrote:

A colleague asked me if I knew anybody that might have this program so I said I would ask.

He is looking for a program (I presume it was an example) to list all the fields in a dataset by reading the Description file.

Does anyone have access to those notes? I suspect things may have changed, but if anyone has it, they would be here.

Regards,

Tom Schaefer

BEGIN
DEFINE P =POINTER#
,B =BOOLEAN#
%
,NAMEIN(PX,LX) =PX+1 FOR MIN(LX,REAL(PX,1))
," " FOR LX-REAL(PX,1)#
,PRECISION(X) =((FIRSTONE(SCALERIGHTF(X,12))-1).[8:7]+1)#
%
,INIT_BUFO(X) =BEGIN
REPLACE PO:=P(BUFO) BY " " FOR 108;
REPLACE PO:PO BY X FOR 2 DIGITS
," ";
END#
,WRITE_BUFO =WRITE(INFO_FILE,18,BUFO)#
%
,BLOCKF =[47:16]# % BLOCK FIELD OF NODE
,LISTF =[31:16]# % LIST FIELD OF NODE
,PROPF =[15:16]# % PROP FIELD OF NODE
%
,DBLISTEND[N] =DBDESC[(N).LISTF]#
,LISTEND[N] =DESC [(N).LISTF]#
,LISTEND2[N] =DESC2 [(N).LISTF]#
%
,DBPROP[N,F] =DBDESC[(N).PROPF + F]#
,PROP[N,F] =DESC [(N).PROPF + F]#
,PROP2[N,F] =DESC2 [(N).PROPF + F]#
,PROP3[N,F] =DESC3 [(N).PROPF + F]#
%
,DBLISTELEMENT[N,I]
=DBDESC[(N).LISTF + I]#
,LISTELEMENT[N,I] =DESC [(N).LISTF + I]#
,LISTELEMENT2[N,I]=DESC2 [(N).LISTF + I]#
,LISTELEMENT3[N,I]=DESC3 [(N).LISTF + I]#
%
,NAMEOFFSET =2# % OFFSET TO THE NAME OF RESTART DS
;
FILE INFO_FILE
(KIND =PACK
,MAXRECSIZE=18
,BLOCKSIZE =540
,FRAMESIZE =48
,NEWFILE =TRUE
,FILEUSE =OUT
)
;
REAL DBNODE % DATA BASE NODE
,DSSTRUCTURE % STR. NODE OF DATASET
,LDBSTRUCTURE % NODE OF LDB
,SETLIST % NODE TO LIST OF SETS
;
BOOLEAN LDBB % LOGICAL DB IN SPEC.
,LDBSETSB % SET ID'S ARE IN LDB
;
ARRAY REFERENCE DBDESC[0] % DBNODE BUFFER
;
ARRAY BUFO[0:17]
,FLD_NAME_IX[0:1023]
;
EBCDIC ARRAY RDSNAME[0:17] % RESTART DATA SET
,FLD_NAMES[0:9999]
,LDBRDSNAME[0:17] % RESTART DATA SET ON LDB LIST
;
POINTER PO
,PFN
;
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
PROCEDURE OVERLAYERR;
FORWARD;
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
$INCLUDE PROPERTIES = "DATABASE/59189/PROPERTIES" 20000000-26999999
$INCLUDE PROPERTIES = "DATABASE/59189/PROPERTIES" 28000000-29999999
$INCLUDE PROPERTIES = "DATABASE/59189/PROPERTIES" 33800000-33999999
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
PROCEDURE OVERLAYERR;
BEGIN
DISPLAY("FATAL ERROR");
END OF OVERLAYERR;
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
PROCEDURE GET_INFO_DB;
BEGIN
REAL LN
,LEN
,LDBTOP
,LDBNODE
;
EBCDIC ARRAY WK[0:255]
;
POINTER PWK
;
ARRAY REFERENCE DESC[0]
,DESC2[0]
;
%
DASOPEN;
%
INIT_BUFO(01);
REPLACE PWK:=WK BY DASDL.TITLE;
IF PWK="*"
THEN REPLACE PO:PO BY "*"
," " FOR 17
ELSE BEGIN
PWK:=*+1;
REPLACE PO:PO BY PWK:PWK FOR LEN:17 UNTIL=")"
," " FOR LEN+1;
END;
PWK:=*+1;
IF PWK="DESCRIPTION/"
THEN PWK:=*+12;
REPLACE PO:PO BY PWK:PWK FOR LEN:17 WHILE IN ALPHA
," " FOR LEN+1;
IF PWK=" ON "
THEN REPLACE PO:PO BY PWK+4 FOR LEN:17 WHILE IN ALPHA
," " FOR LEN+1
ELSE REPLACE PO:PO BY "DISK"
," " FOR 14;
REPLACE PWK:=WK BY DASDL.HOSTNAME;
REPLACE PO:PO BY PWK FOR LEN:17 WHILE IN ALPHA
," " FOR LEN+1;
WRITE_BUFO;
%
READPROP(0,DESC);
DBNODE:=DESC[DBNODELOC];
LOCKPROP(DBNODE.BLOCKF,DBDESC);
%
IF LDBB % SET UP LOGICAL DB
THEN BEGIN
LDBNODE := DBDESC[DBPROP[DBNODE,LOGICALDATABASENODE]];
READPROP(LDBNODE.BLOCKF,DESC);
LDBTOP := LISTEND[LDBNODE];
LN := 0;
WHILE LN := * + 1 <= LDBTOP
DO BEGIN
LDBSTRUCTURE := LISTELEMENT[LDBNODE,LN];
IF LDBSTRUCTURE.LISTF NEQ 4"0000"
THEN BEGIN
READPROP(LDBSTRUCTURE.BLOCKF,DESC2);
% P(PROP2[LDBSTRUCTURE,WORDONE])
END;
END;
END;
END GET_INFO_DB;
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
PROCEDURE GET_INFO_DATASET_ITEMS(DSSTRUCTURE,RDS);
VALUE DSSTRUCTURE,RDS;
REAL DSSTRUCTURE;
BOOLEAN RDS;
BEGIN
REAL I
,J
,T
,IT
,LV
,ITEM
,ITEMNODE
,ITEMTOP
,DEPENDITEM
;
ARRAY REFERENCE DESC[0]
;
POINTER PN
;
%
PFN:=FLD_NAMES;
REPLACE FLD_NAME_IX BY 0 FOR SIZE(FLD_NAME_IX) WORDS;
%
READPROP(DSSTRUCTURE.BLOCKF, DESC);
ITEMNODE := DESC[PROP[DSSTRUCTURE,DATAITEMNODE]];
READPROP(ITEMNODE.BLOCKF, DESC);
ITEMTOP := LISTEND[ITEMNODE];
IT := 0;
WHILE IT := * + 1 <= ITEMTOP
DO BEGIN
ITEM := LISTELEMENT[ITEMNODE,IT];
T := PROP[ITEM,TYPEF];
IF T >= TYP
THEN BEGIN
INIT_BUFO(03);
PN:=P(PROP[ITEM,WORDONE]);
REPLACE PO:PO BY PROP[ITEM,ITEMNUM] FOR 3 DIGITS
," "
,PROP[ITEM,LEVELF] FOR 2 DIGITS
," ";
CASE T
OF BEGIN
GRP: REPLACE PO:PO BY "GRP ";
BOLN: REPLACE PO:PO BY "BOLN"
FLD: REPLACE PO:PO BY "FLD ";
ALPH: REPLACE PO:PO BY "ALPH";
DECI: REPLACE PO:PO BY "DECI"
DECF: REPLACE PO:PO BY "DECF";
BINI: REPLACE PO:PO BY "BINI"
BINF: REPLACE PO:PO BY "BINF";
BFLT: IF RDS
THEN BEGIN
REPLACE PO:PO BY "XXXX";
PROP[ITEM,DECLAREDLENGTH]:=6;
PROP[ITEM,SIGNF]:=0;
END
ELSE IF PROP[ITEM,RSNFLD]=1
THEN REPLACE PO:PO BY "RSN "
ELSE REPLACE PO:PO BY "BFLT"
ELSE: REPLACE PO:PO BY T FOR 4 DIGITS
END;
REPLACE PO:PO BY " "
,PROP[ITEM,DECLAREDLENGTH] FOR 5 DIGITS
," "
,PROP[ITEM,SCALEFACTOR] FOR 2 DIGITS
," "
,PROP[ITEM,SIGNF] FOR 1 DIGITS
," "
,PROP[ITEM,TOTALSZ] FOR 5 DIGITS
," "
,PROP[ITEM,REQUIREDF] FOR 1 DIGITS
," "
,PROP[ITEM,NUMSUBSCRIPTS] FOR 3 DIGITS
," ";
IF PROP[ITEM,VFTYPE]^=0
THEN REPLACE PO:PO BY PROP[ITEM,VFTYPE] FOR 2 DIGITS
," "
ELSE REPLACE PO:PO BY " ";
IF B(PROP[ITEM,OCCURSF])
THEN REPLACE PO:PO BY PROP[ITEM,OCCURSMAX] FOR 5 DIGITS
," "
ELSE REPLACE PO:PO BY " ";
% IF PROP[ITEM,OCCURSTYPE] = OCCDEPENDING
% THEN BEGIN
% A[DEPENDSC] := 1;
% DEPENDITEM := LISTELEMENT[ITEMNODE,PROP[ITEM,
% OCCURSVARIABLE]];
% REPLACE PTEMP BY P(PROP[DEPENDITEM,WORDONE]) FOR
% (REAL(P(PROP[DEPENDITEM,WORDONE]),1)+1);
% END
% ELSE A[DEPENDSC] := 0;
REPLACE PO BY NAMEIN(PN,30);
WRITE_BUFO;
%
FLD_NAME_IX[PROP[ITEM,ITEMNUM]]:=OFFSET(PFN);
REPLACE PFN:PFN BY PN FOR REAL(PN,1)+1;
END;
END;
END GET_INFO_DATASET_ITEMS;
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
PROCEDURE GET_INFO_SET;
BEGIN
REAL I
,IX
,OP
,WL
,LEN
,SEQ
,STR
,LSTR
,KITEM
,SETTOP
,KNODE
,KDNODE
,KEYTOP
;
BOOLEAN WB
;
ARRAY REFERENCE DESC [0]
,DESC2[0]
,DESC3[0]
,TEXT [0]
;
POINTER PN
,PW
;
%
READPROP(SETLIST.BLOCKF, DESC);
SETTOP := IF SETLIST IS 0 THEN 0 ELSE LISTEND[SETLIST];
I := 0;
WHILE I := * + 1 <=SETTOP
DO BEGIN
IF LDBSETSB
THEN BEGIN
LSTR := LISTELEMENT[SETLIST,I];
READPROP(LSTR.BLOCKF,DESC2);
STR := DBLISTELEMENT[DBNODE,PROP2[LSTR,STRUCTURENUM]];
END
ELSE BEGIN
LSTR := DBLISTELEMENT[DBNODE,LISTELEMENT[SETLIST,I]];
READPROP(LSTR.BLOCKF, DESC2);
READPROPTEXT(LSTR.BLOCKF,DESC2,TEXT);
STR := LSTR;
END;
PN:=P(PROP2[LSTR,WORDONE]);
INIT_BUFO(04);
REPLACE PO:PO BY NAMEIN(PN,17)
," "
,PROP2[LSTR,DUPSALLOWED] FOR 1 DIGITS
," "
,PROP2[LSTR,DUPSFIRST] FOR 1 DIGITS
," "
,PROP2[LSTR,DUPSLAST] FOR 1 DIGITS
," "
,PROP2[LSTR,KEYCHANGEALLOW] FOR 1 DIGITS
," "
,PROP2[LSTR,SUBSETF] FOR 1 DIGITS
," "
,PROP2[LSTR,WHERELIST] FOR 4 DIGITS
," "
,PROP2[LSTR,WHERELISTSZ] FOR 3 DIGITS
," "
,PROP2[LSTR,KEYCOUNT] FOR 2 DIGITS
," "
,PROP2[LSTR,KEYDATACOUNT] FOR 2 DIGITS
," "
,PROP2[LSTR,SUBTYPEF] FOR 2 DIGITS;
WRITE_BUFO;
IF WL:=PROP2[LSTR,WHERELIST]^=0
THEN BEGIN
INIT_BUFO(08);
REPLACE PO:PO BY SEQ:=1 FOR 4 DIGITS
," "
," ";
IX:=0;
PW:=P(DESC2[WL]);
WHILE OP:=REAL(PW,2) ISNT 4"000A"
DO BEGIN
PW:=*+2;
CASE OP.[15:04]
OF BEGIN
00: %
CASE OP.[11:12]
OF BEGIN
15: REPLACE PO:PO BY "( ";
16: REPLACE PO:PO BY " )";
11: REPLACE PO:PO BY " LT ";
32: REPLACE PO:PO BY " LE ";
22: REPLACE PO:PO BY " EQ ";
33: REPLACE PO:PO BY " NE ";
34: REPLACE PO:PO BY " GE ";
21: REPLACE PO:PO BY " GT ";
31: BEGIN
WRITE_BUFO;
INIT_BUFO(08);
REPLACE PO:PO BY (SEQ:=*+1) FOR 4 DIGITS
," ";
REPLACE PO:PO BY "O ";
END;
30: BEGIN
WRITE_BUFO;
INIT_BUFO(08);
REPLACE PO:PO BY (SEQ:=*+1) FOR 4 DIGITS
," ";
REPLACE PO:PO BY "E ";
END;
24: REPLACE PO:PO BY " NOT ";
10: REPLACE PO:PO BY " LB";
ELSE:
REPLACE PO:PO BY OP.[11:12] FOR * DIGITS;
END; % Case
01: %
PN:=FLD_NAMES[FLD_NAME_IX[OP.[11:12]]];
IF OFFSET(PO)>40
THEN REPLACE PO:PO BY "C ";
REPLACE PO:PO BY PN+1 FOR REAL(PN,1)
," " FOR 40-REAL(PN,1);
PW:=*+2;
02: %
PW:=*+2;
03: %
;
04: %
;
09: %
IF OP.[11:12]=1
THEN REPLACE PO:PO BY "TRUE"
ELSE REPLACE PO:PO BY "FALSE";
10: %
LEN:=OP.[11:12];
REPLACE PO:PO BY "K '"
,PW FOR LEN
,"'"
," " FOR 38-LEN;
IF LEN MOD 2 = 1
THEN LEN:=*+1;
PW:=*+LEN;
11: %
PW:=*+2;
LEN:=OP.[11:12];
REPLACE PO:PO BY "K "
,PW FOR LEN
," " FOR 40-LEN;
IF LEN MOD 2 = 1
THEN LEN:=*+1;
PW:=*+LEN;
12: %
;
ELSE: %
;
END; % Case
IF READLOCK(FALSE,WB)
THEN BEGIN
WRITE_BUFO;
INIT_BUFO(08);
REPLACE PO:PO BY (SEQ:=*+1) FOR 4 DIGITS
," ";
END;
END; % While
WRITE_BUFO;
END;
%
KNODE:=DESC2[PROP2[LSTR,KEYNODE]];
KDNODE:=DESC2[PROP2[LSTR,KEYDATANODE]];
IF KNODE.BLOCKF^=0
THEN BEGIN
READPROP(KNODE.BLOCKF,DESC3);
KEYTOP:=LISTEND[KNODE];
IX:=0;
WHILE IX:=*+1 <= KEYTOP
DO BEGIN
KITEM:=LISTELEMENT3[KNODE,IX];
INIT_BUFO(05);
REPLACE PO:PO BY IX FOR 3 DIGITS
," "
,KITEM.[11:12] FOR 3 DIGITS
," "
,KITEM.[39:12] FOR 5 DIGITS
," "
,KITEM.[27:16] FOR 5 DIGITS
," "
,KITEM.[46:01] FOR 1 DIGITS
," "
,KITEM.[45:06] FOR 2 DIGITS;
WRITE_BUFO;
END;
END;
%
IF KDNODE.BLOCKF^=0
THEN BEGIN
READPROP(KDNODE.BLOCKF,DESC3);
KEYTOP:=LISTEND[KDNODE];
IX:=0;
WHILE IX:=*+1 <= KEYTOP
DO BEGIN
KITEM:=LISTELEMENT3[KDNODE,IX];
INIT_BUFO(06);
REPLACE PO:PO BY IX FOR 3 DIGITS
," "
,KITEM.[11:12] FOR 3 DIGITS
," "
,KITEM.[39:12] FOR 5 DIGITS
," "
,KITEM.[27:16] FOR 5 DIGITS
," "
,KITEM.[46:01] FOR 1 DIGITS
," "
,KITEM.[45:06] FOR 2 DIGITS;
WRITE_BUFO;
END;
END;
END;
END GET_INFO_SET;
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
PROCEDURE GET_INFO_DATASET;
BEGIN
REAL I
,LN
,SN
,LTOP
,SETS
,DBTOP
;
ARRAY REFERENCE DESC[0]
,DESC2[0]
,TEXT[0]
;
POINTER PN
;
IF LDBB
THEN BEGIN
READPROP(LDBSTRUCTURE.BLOCKF,DESC2);
LTOP := LISTEND2[LDBSTRUCTURE];
I := 0;
WHILE I := * + 1 <= LTOP
DO BEGIN
DSSTRUCTURE := LISTELEMENT2[LDBSTRUCTURE,I];
READPROP(DSSTRUCTURE.BLOCKF,DESC );
% P(PROP[DSSTRUCTURE,WORDONE])
END;
SETS := PROP[DSSTRUCTURE,SETSF];
LDBSETSB := SETS = SETSLIST;
SETLIST := IF LDBSETSB THEN DSSTRUCTURE ELSE 0;
DSSTRUCTURE := % SET UP TO POINT AT ACTUAL DB PROPS
DBLISTELEMENT[DBNODE,PROP[DSSTRUCTURE,STRUCTURENUM]];
READPROP(DSSTRUCTURE.BLOCKF,DESC);
IF SETS = SETSALL OR SETS = SETSEMPTY
THEN SETLIST := DSSTRUCTURE;
END
ELSE BEGIN % NOT SPECIFIED LDB
DBTOP := DBLISTEND[DBNODE];
SN := 0;
WHILE SN := * + 1 <= DBTOP
DO BEGIN
DSSTRUCTURE := DBLISTELEMENT[DBNODE,SN];
READPROP(DSSTRUCTURE.BLOCKF, DESC);
READPROPTEXT(DSSTRUCTURE.BLOCKF,DESC,TEXT);
I := PROP[DSSTRUCTURE,TYPEF];
INIT_BUFO(02);
PN:=P(PROP[DSSTRUCTURE,WORDONE]);
REPLACE PO:PO BY NAMEIN(PN,17)
," ";
PN:=P(TEXT[PROP[DSSTRUCTURE,DESCTEXT]]);
REPLACE PO:PO BY NAMEIN(PN,40)
," "
,PROP[DSSTRUCTURE,SUBTYPEF] FOR 2 DIGITS
," "
," " % BDOTIMIZ
," "
,PROP[DSSTRUCTURE,ITEMNUM] FOR 5 DIGITS;
%
SETLIST := DSSTRUCTURE;
%
IF PROP[DSSTRUCTURE,TYPEF] = DATASET
THEN BEGIN
WRITE_BUFO;
GET_INFO_DATASET_ITEMS(DSSTRUCTURE
,PROP[DSSTRUCTURE,RESTARTDATASETF]=1);
GET_INFO_SET;
END;
END;
END;
END GET_INFO_DATASET;
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
PROCEDURE GET_INFO_RDS;
BEGIN
REAL I
,RDSSN,STR,LTOP
;
POINTER Q
;
ARRAY REFERENCE DESC[0]
,DESC2[0]
;
REPLACE RDSNAME BY " " FOR 18;
REPLACE LDBRDSNAME BY " " FOR 18;
RDSSN := DBPROP[DBNODE,RESTARTDATASETSN];
STR := DBLISTELEMENT[DBNODE,RDSSN];
READPROP(STR.BLOCKF,DESC);
REPLACE RDSNAME BY Q:= P(PROP[STR,WORDONE]) FOR (REAL(Q,1)+1);
IF LDBB
THEN BEGIN
READPROP(LDBSTRUCTURE.BLOCKF, DESC);
LTOP := LISTEND[LDBSTRUCTURE];
I := 0;
WHILE I := * + 1 <= LTOP
DO BEGIN
STR := LISTELEMENT[LDBSTRUCTURE,I];
READPROP(STR.BLOCKF, DESC2);
IF PROP2[STR,STRUCTURENUM] = RDSSN
THEN BEGIN
REPLACE LDBRDSNAME BY
Q := P(PROP2[STR,NAMEOFFSET]) FOR
(REAL(Q,1)+1);
IF RDSNAME NEQ LDBRDSNAME FOR 18
THEN REPLACE RDSNAME BY LDBRDSNAME FOR 18;
END;
END;
END;
END GET_INFO_RDS;
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%% OUTER BLOCK %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
OPEN(INFO_FILE);
%
GET_INFO_DB;
GET_INFO_DATASET;
%
CLOSE(INFO_FILE,CRUNCH);
%
END.

--
This email has been checked for viruses by Avast antivirus software. https://www.avast.com/antivirus

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)

From Andrew@21:1/5 to TKosfeld on Fri Jun 17 22:37:33 2022

TKosfeld wrote:

On 6/17/2022 2:53 PM, Tom Schaefer wrote:

A colleague asked me if I knew anybody that might have this program so
I said I would ask.

He is looking for a program (I presume it was an example) to list all
the fields in a dataset by reading the Description file.

Does anyone have access to those notes? I suspect things may have
changed, but if anyone has it, they would be here.

Regards,

Tom Schaefer

   BEGIN
   DEFINE P                =POINTER#
         ,B                =BOOLEAN#
         %
         ,NAMEIN(PX,LX)    =PX+1 FOR MIN(LX,REAL(PX,1))
                            ," " FOR LX-REAL(PX,1)#
         ,PRECISION(X)     =((FIRSTONE(SCALERIGHTF(X,12))-1).[8:7]+1)#
         %
         ,INIT_BUFO(X)     =BEGIN
                            REPLACE PO:=P(BUFO) BY " " FOR 108;
                            REPLACE PO:PO BY X FOR 2 DIGITS
                                            ," ";
                            END#
         ,WRITE_BUFO       =WRITE(INFO_FILE,18,BUFO)#
         %
         ,BLOCKF           =[47:16]#      % BLOCK FIELD OF NODE
         ,LISTF            =[31:16]#      % LIST FIELD OF NODE
         ,PROPF            =[15:16]#      % PROP FIELD OF NODE
         %
         ,DBLISTEND[N]     =DBDESC[(N).LISTF]#
         ,LISTEND[N]       =DESC [(N).LISTF]#
         ,LISTEND2[N]      =DESC2 [(N).LISTF]#
         %
         ,DBPROP[N,F]      =DBDESC[(N).PROPF + F]#
         ,PROP[N,F]        =DESC [(N).PROPF + F]#
         ,PROP2[N,F]       =DESC2 [(N).PROPF + F]#
         ,PROP3[N,F]       =DESC3 [(N).PROPF + F]#
         %
         ,DBLISTELEMENT[N,I]
                           =DBDESC[(N).LISTF + I]#
         ,LISTELEMENT[N,I] =DESC [(N).LISTF + I]#
         ,LISTELEMENT2[N,I]=DESC2 [(N).LISTF + I]#
         ,LISTELEMENT3[N,I]=DESC3 [(N).LISTF + I]#
         %
         ,NAMEOFFSET       =2# % OFFSET TO THE NAME OF RESTART DS
         ;
   FILE INFO_FILE
          (KIND      =PACK
          ,MAXRECSIZE=18
          ,BLOCKSIZE =540
          ,FRAMESIZE =48
          ,NEWFILE   =TRUE
          ,FILEUSE   =OUT
          )
       ;
   REAL DBNODE                    % DATA BASE NODE
       ,DSSTRUCTURE               % STR. NODE OF DATASET
       ,LDBSTRUCTURE              % NODE OF LDB
       ,SETLIST                   % NODE TO LIST OF SETS
       ;
   BOOLEAN LDBB                   % LOGICAL DB IN SPEC.
          ,LDBSETSB               % SET ID'S ARE IN LDB
          ;
   ARRAY REFERENCE DBDESC[0]      % DBNODE BUFFER
                  ;
   ARRAY BUFO[0:17]
        ,FLD_NAME_IX[0:1023]
        ;
   EBCDIC ARRAY RDSNAME[0:17]     % RESTART DATA SET
               ,FLD_NAMES[0:9999]
               ,LDBRDSNAME[0:17] % RESTART DATA SET ON LDB LIST
               ;
   POINTER PO
          ,PFN
          ;
   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   PROCEDURE OVERLAYERR;
   FORWARD;
   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
$INCLUDE PROPERTIES = "DATABASE/59189/PROPERTIES" 20000000-26999999
$INCLUDE PROPERTIES = "DATABASE/59189/PROPERTIES" 28000000-29999999
$INCLUDE PROPERTIES = "DATABASE/59189/PROPERTIES" 33800000-33999999
   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   PROCEDURE OVERLAYERR;
   BEGIN
   DISPLAY("FATAL ERROR");
   END OF OVERLAYERR;
   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   PROCEDURE GET_INFO_DB;
   BEGIN
   REAL LN
       ,LEN
       ,LDBTOP
       ,LDBNODE
       ;
   EBCDIC ARRAY WK[0:255]
               ;
   POINTER PWK
          ;
   ARRAY REFERENCE DESC[0]
                  ,DESC2[0]
                  ;
   %
   DASOPEN;
   %
   INIT_BUFO(01);
   REPLACE PWK:=WK BY DASDL.TITLE;
   IF PWK="*"
   THEN REPLACE PO:PO BY "*"
                        ," " FOR 17
   ELSE BEGIN
        PWK:=*+1;
        REPLACE PO:PO BY PWK:PWK FOR LEN:17 UNTIL=")"
                        ," " FOR LEN+1;
        END;
   PWK:=*+1;
   IF PWK="DESCRIPTION/"
   THEN PWK:=*+12;
   REPLACE PO:PO BY PWK:PWK FOR LEN:17 WHILE IN ALPHA
                   ," " FOR LEN+1;
   IF PWK=" ON "
   THEN REPLACE PO:PO BY PWK+4 FOR LEN:17 WHILE IN ALPHA
                        ," " FOR LEN+1
   ELSE REPLACE PO:PO BY "DISK"
                        ," " FOR 14;
   REPLACE PWK:=WK BY DASDL.HOSTNAME;
   REPLACE PO:PO BY PWK FOR LEN:17 WHILE IN ALPHA
                   ," " FOR LEN+1;
   WRITE_BUFO;
   %
   READPROP(0,DESC);
   DBNODE:=DESC[DBNODELOC];
   LOCKPROP(DBNODE.BLOCKF,DBDESC);
   %
   IF LDBB            % SET UP LOGICAL DB
   THEN BEGIN
        LDBNODE := DBDESC[DBPROP[DBNODE,LOGICALDATABASENODE]];
        READPROP(LDBNODE.BLOCKF,DESC);
        LDBTOP := LISTEND[LDBNODE];
        LN := 0;
        WHILE LN := * + 1 <= LDBTOP
        DO BEGIN
           LDBSTRUCTURE := LISTELEMENT[LDBNODE,LN];
           IF LDBSTRUCTURE.LISTF NEQ 4"0000"
           THEN BEGIN
                READPROP(LDBSTRUCTURE.BLOCKF,DESC2);
                % P(PROP2[LDBSTRUCTURE,WORDONE])
                END;
           END;
        END;
   END GET_INFO_DB;
   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   PROCEDURE GET_INFO_DATASET_ITEMS(DSSTRUCTURE,RDS);
   VALUE   DSSTRUCTURE,RDS;
   REAL    DSSTRUCTURE;
   BOOLEAN RDS;
   BEGIN
   REAL I
       ,J
       ,T
       ,IT
       ,LV
       ,ITEM
       ,ITEMNODE
       ,ITEMTOP
       ,DEPENDITEM
       ;
   ARRAY REFERENCE DESC[0]
                  ;
   POINTER PN
          ;
   %
   PFN:=FLD_NAMES;
   REPLACE FLD_NAME_IX BY 0 FOR SIZE(FLD_NAME_IX) WORDS;
   %
   READPROP(DSSTRUCTURE.BLOCKF, DESC);
   ITEMNODE := DESC[PROP[DSSTRUCTURE,DATAITEMNODE]];
   READPROP(ITEMNODE.BLOCKF, DESC);
   ITEMTOP := LISTEND[ITEMNODE];
   IT := 0;
   WHILE IT := * + 1 <= ITEMTOP
   DO BEGIN
      ITEM := LISTELEMENT[ITEMNODE,IT];
      T := PROP[ITEM,TYPEF];
      IF T >= TYP
      THEN BEGIN
           INIT_BUFO(03);
           PN:=P(PROP[ITEM,WORDONE]);
           REPLACE PO:PO BY PROP[ITEM,ITEMNUM] FOR 3 DIGITS
                           ," "
                           ,PROP[ITEM,LEVELF] FOR 2 DIGITS
                           ," ";
           CASE T
           OF BEGIN
               GRP: REPLACE PO:PO BY "GRP ";
              BOLN: REPLACE PO:PO BY "BOLN"
               FLD: REPLACE PO:PO BY "FLD ";
              ALPH: REPLACE PO:PO BY "ALPH";
              DECI: REPLACE PO:PO BY "DECI"
              DECF: REPLACE PO:PO BY "DECF";
              BINI: REPLACE PO:PO BY "BINI"
              BINF: REPLACE PO:PO BY "BINF";
              BFLT: IF RDS
                    THEN BEGIN
                         REPLACE PO:PO BY "XXXX";
                         PROP[ITEM,DECLAREDLENGTH]:=6;
                         PROP[ITEM,SIGNF]:=0;
                         END
                    ELSE IF PROP[ITEM,RSNFLD]=1
                         THEN REPLACE PO:PO BY "RSN "
                         ELSE REPLACE PO:PO BY "BFLT"
              ELSE: REPLACE PO:PO BY T FOR 4 DIGITS
              END;
           REPLACE PO:PO BY " "
                           ,PROP[ITEM,DECLAREDLENGTH] FOR 5 DIGITS
                           ," "
                           ,PROP[ITEM,SCALEFACTOR] FOR 2 DIGITS
                           ," "
                           ,PROP[ITEM,SIGNF] FOR 1 DIGITS
                           ," "
                           ,PROP[ITEM,TOTALSZ] FOR 5 DIGITS
                           ," "
                           ,PROP[ITEM,REQUIREDF] FOR 1 DIGITS
                           ," "
                           ,PROP[ITEM,NUMSUBSCRIPTS] FOR 3 DIGITS
                           ," ";
           IF PROP[ITEM,VFTYPE]^=0
           THEN REPLACE PO:PO BY PROP[ITEM,VFTYPE] FOR 2 DIGITS
                                ," "
           ELSE REPLACE PO:PO BY "   ";
           IF B(PROP[ITEM,OCCURSF])
           THEN REPLACE PO:PO BY PROP[ITEM,OCCURSMAX] FOR 5 DIGITS
                                ," "
           ELSE REPLACE PO:PO BY "      ";
%         IF PROP[ITEM,OCCURSTYPE] = OCCDEPENDING
%         THEN BEGIN
%              A[DEPENDSC] := 1;
%              DEPENDITEM := LISTELEMENT[ITEMNODE,PROP[ITEM,
%                OCCURSVARIABLE]];
%              REPLACE PTEMP BY P(PROP[DEPENDITEM,WORDONE]) FOR
%                (REAL(P(PROP[DEPENDITEM,WORDONE]),1)+1);
%              END
%         ELSE A[DEPENDSC] := 0;
           REPLACE PO BY NAMEIN(PN,30);
           WRITE_BUFO;
           %
           FLD_NAME_IX[PROP[ITEM,ITEMNUM]]:=OFFSET(PFN);
           REPLACE PFN:PFN BY PN FOR REAL(PN,1)+1;
           END;
      END;
   END GET_INFO_DATASET_ITEMS;
   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   PROCEDURE GET_INFO_SET;
   BEGIN
   REAL I
       ,IX
       ,OP
       ,WL
       ,LEN
       ,SEQ
       ,STR
       ,LSTR
       ,KITEM
       ,SETTOP
       ,KNODE
       ,KDNODE
       ,KEYTOP
       ;
   BOOLEAN WB
          ;
   ARRAY REFERENCE DESC [0]
                  ,DESC2[0]
                  ,DESC3[0]
                  ,TEXT [0]
                  ;
   POINTER PN
          ,PW
          ;
   %
   READPROP(SETLIST.BLOCKF, DESC);
   SETTOP := IF SETLIST IS 0 THEN 0 ELSE LISTEND[SETLIST];
   I := 0;
   WHILE I := * + 1 <=SETTOP
   DO BEGIN
      IF LDBSETSB
      THEN BEGIN
           LSTR := LISTELEMENT[SETLIST,I];
           READPROP(LSTR.BLOCKF,DESC2);
           STR := DBLISTELEMENT[DBNODE,PROP2[LSTR,STRUCTURENUM]];
           END
      ELSE BEGIN
           LSTR := DBLISTELEMENT[DBNODE,LISTELEMENT[SETLIST,I]];
           READPROP(LSTR.BLOCKF, DESC2);
           READPROPTEXT(LSTR.BLOCKF,DESC2,TEXT);
           STR := LSTR;
           END;
      PN:=P(PROP2[LSTR,WORDONE]);
      INIT_BUFO(04);
      REPLACE PO:PO BY NAMEIN(PN,17)
                      ," "
                      ,PROP2[LSTR,DUPSALLOWED] FOR 1 DIGITS
                      ," "
                      ,PROP2[LSTR,DUPSFIRST] FOR 1 DIGITS
                      ," "
                      ,PROP2[LSTR,DUPSLAST] FOR 1 DIGITS
                      ," "
                      ,PROP2[LSTR,KEYCHANGEALLOW] FOR 1 DIGITS
                      ," "
                      ,PROP2[LSTR,SUBSETF] FOR 1 DIGITS
                      ," "
                      ,PROP2[LSTR,WHERELIST] FOR 4 DIGITS
                      ," "
                      ,PROP2[LSTR,WHERELISTSZ] FOR 3 DIGITS
                      ," "
                      ,PROP2[LSTR,KEYCOUNT] FOR 2 DIGITS
                      ," "
                      ,PROP2[LSTR,KEYDATACOUNT] FOR 2 DIGITS
                      ," "
                      ,PROP2[LSTR,SUBTYPEF] FOR 2 DIGITS;
      WRITE_BUFO;
      IF WL:=PROP2[LSTR,WHERELIST]^=0
      THEN BEGIN
           INIT_BUFO(08);
           REPLACE PO:PO BY SEQ:=1 FOR 4 DIGITS
                           ," "
                           ," ";
           IX:=0;
           PW:=P(DESC2[WL]);
           WHILE OP:=REAL(PW,2) ISNT 4"000A"
           DO BEGIN
              PW:=*+2;
              CASE OP.[15:04]
              OF BEGIN
                 00: %
                     CASE OP.[11:12]
                     OF BEGIN
                        15: REPLACE PO:PO BY "( ";
                        16: REPLACE PO:PO BY " )";
                        11: REPLACE PO:PO BY " LT ";
                        32: REPLACE PO:PO BY " LE ";
                        22: REPLACE PO:PO BY " EQ ";
                        33: REPLACE PO:PO BY " NE ";
                        34: REPLACE PO:PO BY " GE ";
                        21: REPLACE PO:PO BY " GT ";
                        31: BEGIN
                            WRITE_BUFO;
                            INIT_BUFO(08);
                            REPLACE PO:PO BY (SEQ:=*+1) FOR 4 DIGITS
                                            ," ";
                            REPLACE PO:PO BY "O ";
                            END;
                        30: BEGIN
                            WRITE_BUFO;
                            INIT_BUFO(08);
                            REPLACE PO:PO BY (SEQ:=*+1) FOR 4 DIGITS
                                            ," ";
                            REPLACE PO:PO BY "E ";
                            END;
                        24: REPLACE PO:PO BY " NOT ";
                        10: REPLACE PO:PO BY " LB";
                        ELSE:
                            REPLACE PO:PO BY OP.[11:12] FOR * DIGITS;
                        END; % Case
                 01: %
                     PN:=FLD_NAMES[FLD_NAME_IX[OP.[11:12]]];
                     IF OFFSET(PO)>40
                     THEN REPLACE PO:PO BY "C ";
                     REPLACE PO:PO BY PN+1 FOR REAL(PN,1)
                                     ," " FOR 40-REAL(PN,1);
                     PW:=*+2;
                 02: %
                     PW:=*+2;
                 03: %
                     ;
                 04: %
                     ;
                 09: %
                     IF OP.[11:12]=1
                     THEN REPLACE PO:PO BY "TRUE"
                     ELSE REPLACE PO:PO BY "FALSE";
                 10: %
                     LEN:=OP.[11:12];
                     REPLACE PO:PO BY "K '"
                                     ,PW FOR LEN
                                     ,"'"
                                     ," " FOR 38-LEN;
                     IF LEN MOD 2 = 1
                     THEN LEN:=*+1;
                     PW:=*+LEN;
                 11: %
                     PW:=*+2;
                     LEN:=OP.[11:12];
                     REPLACE PO:PO BY "K "
                                     ,PW FOR LEN
                                     ," " FOR 40-LEN;
                     IF LEN MOD 2 = 1
                     THEN LEN:=*+1;
                     PW:=*+LEN;
                 12: %
                     ;
                 ELSE: %
                     ;
                 END; % Case
              IF READLOCK(FALSE,WB)
              THEN BEGIN
                   WRITE_BUFO;
                   INIT_BUFO(08);
                   REPLACE PO:PO BY (SEQ:=*+1) FOR 4 DIGITS
                                   ," ";
                   END;
              END; % While
           WRITE_BUFO;
           END;
      %
      KNODE:=DESC2[PROP2[LSTR,KEYNODE]];
      KDNODE:=DESC2[PROP2[LSTR,KEYDATANODE]];
      IF KNODE.BLOCKF^=0
      THEN BEGIN
           READPROP(KNODE.BLOCKF,DESC3);
           KEYTOP:=LISTEND[KNODE];
           IX:=0;
           WHILE IX:=*+1 <= KEYTOP
           DO BEGIN
              KITEM:=LISTELEMENT3[KNODE,IX];
              INIT_BUFO(05);
              REPLACE PO:PO BY IX FOR 3 DIGITS
                              ," "
                              ,KITEM.[11:12] FOR 3 DIGITS
                              ," "
                              ,KITEM.[39:12] FOR 5 DIGITS
                              ," "
                              ,KITEM.[27:16] FOR 5 DIGITS
                              ," "
                              ,KITEM.[46:01] FOR 1 DIGITS
                              ," "
                              ,KITEM.[45:06] FOR 2 DIGITS;
              WRITE_BUFO;
              END;
           END;
      %
      IF KDNODE.BLOCKF^=0
      THEN BEGIN
           READPROP(KDNODE.BLOCKF,DESC3);
           KEYTOP:=LISTEND[KDNODE];
           IX:=0;
           WHILE IX:=*+1 <= KEYTOP
           DO BEGIN
              KITEM:=LISTELEMENT3[KDNODE,IX];
              INIT_BUFO(06);
              REPLACE PO:PO BY IX FOR 3 DIGITS
                              ," "
                              ,KITEM.[11:12] FOR 3 DIGITS
                              ," "
                              ,KITEM.[39:12] FOR 5 DIGITS
                              ," "
                              ,KITEM.[27:16] FOR 5 DIGITS
                              ," "
                              ,KITEM.[46:01] FOR 1 DIGITS
                              ," "
                              ,KITEM.[45:06] FOR 2 DIGITS;
              WRITE_BUFO;
              END;
           END;
      END;
   END GET_INFO_SET;
   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   PROCEDURE GET_INFO_DATASET;
   BEGIN
   REAL I
       ,LN
       ,SN
       ,LTOP
       ,SETS
       ,DBTOP
       ;
   ARRAY REFERENCE DESC[0]
                  ,DESC2[0]
                  ,TEXT[0]
                  ;
   POINTER PN
          ;
   IF LDBB
   THEN BEGIN
        READPROP(LDBSTRUCTURE.BLOCKF,DESC2);
        LTOP := LISTEND2[LDBSTRUCTURE];
        I := 0;
        WHILE I := * + 1 <= LTOP
        DO BEGIN
           DSSTRUCTURE := LISTELEMENT2[LDBSTRUCTURE,I];
           READPROP(DSSTRUCTURE.BLOCKF,DESC );
           % P(PROP[DSSTRUCTURE,WORDONE])
           END;
        SETS := PROP[DSSTRUCTURE,SETSF];
        LDBSETSB := SETS = SETSLIST;
        SETLIST := IF LDBSETSB THEN DSSTRUCTURE ELSE 0;
        DSSTRUCTURE :=            % SET UP TO POINT AT ACTUAL DB PROPS
          DBLISTELEMENT[DBNODE,PROP[DSSTRUCTURE,STRUCTURENUM]];
        READPROP(DSSTRUCTURE.BLOCKF,DESC);
        IF SETS = SETSALL OR SETS = SETSEMPTY
        THEN SETLIST := DSSTRUCTURE;
        END
   ELSE BEGIN               % NOT SPECIFIED LDB
        DBTOP := DBLISTEND[DBNODE];
        SN := 0;
        WHILE SN := * + 1 <= DBTOP
        DO BEGIN
           DSSTRUCTURE := DBLISTELEMENT[DBNODE,SN];
           READPROP(DSSTRUCTURE.BLOCKF, DESC);
           READPROPTEXT(DSSTRUCTURE.BLOCKF,DESC,TEXT);
           I := PROP[DSSTRUCTURE,TYPEF];
           INIT_BUFO(02);
           PN:=P(PROP[DSSTRUCTURE,WORDONE]);
           REPLACE PO:PO BY NAMEIN(PN,17)
                           ," ";
           PN:=P(TEXT[PROP[DSSTRUCTURE,DESCTEXT]]);
           REPLACE PO:PO BY NAMEIN(PN,40)
                           ," "
                           ,PROP[DSSTRUCTURE,SUBTYPEF] FOR 2 DIGITS
                           ," "
                           ," " % BDOTIMIZ
                           ," "
                           ,PROP[DSSTRUCTURE,ITEMNUM] FOR 5 DIGITS;
           %
           SETLIST := DSSTRUCTURE;
           %
           IF PROP[DSSTRUCTURE,TYPEF] = DATASET
           THEN BEGIN
                WRITE_BUFO;
                GET_INFO_DATASET_ITEMS(DSSTRUCTURE
                        ,PROP[DSSTRUCTURE,RESTARTDATASETF]=1);
                GET_INFO_SET;
                END;
           END;
        END;
   END GET_INFO_DATASET;
   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   PROCEDURE GET_INFO_RDS;
   BEGIN
   REAL I
       ,RDSSN,STR,LTOP
       ;
   POINTER Q
          ;
   ARRAY REFERENCE DESC[0]
                  ,DESC2[0]
                  ;
   REPLACE RDSNAME BY " " FOR 18;
   REPLACE LDBRDSNAME BY " " FOR 18;
   RDSSN := DBPROP[DBNODE,RESTARTDATASETSN];
   STR := DBLISTELEMENT[DBNODE,RDSSN];
   READPROP(STR.BLOCKF,DESC);
   REPLACE RDSNAME BY Q:= P(PROP[STR,WORDONE]) FOR (REAL(Q,1)+1);
   IF LDBB
   THEN BEGIN
        READPROP(LDBSTRUCTURE.BLOCKF, DESC);
        LTOP := LISTEND[LDBSTRUCTURE];
        I := 0;
        WHILE I := * + 1 <= LTOP
        DO BEGIN
           STR := LISTELEMENT[LDBSTRUCTURE,I];
           READPROP(STR.BLOCKF, DESC2);
           IF PROP2[STR,STRUCTURENUM] = RDSSN
           THEN BEGIN
                 REPLACE LDBRDSNAME BY
                  Q := P(PROP2[STR,NAMEOFFSET]) FOR
                       (REAL(Q,1)+1);
                IF RDSNAME NEQ LDBRDSNAME FOR 18
                THEN REPLACE RDSNAME BY LDBRDSNAME FOR 18;
                END;
           END;
        END;
   END GET_INFO_RDS;
   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   %%%%%%%%%%%%%%%%%%%%% OUTER BLOCK %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
   %
   OPEN(INFO_FILE);
   %
   GET_INFO_DB;
   GET_INFO_DATASET;
   %
   CLOSE(INFO_FILE,CRUNCH);
   %
   END.

Your .sig says: This email has been checked for viruses by Avast
antivirus software.
https://www.avast.com/antivirus
For that to make sense, your Avast should have verified that source code.

--
This mail has been tested by https://RKIvirus.com/ and has been found to contain Covid-19. Disinfect after reading.

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)

From TKosfeld@21:1/5 to Andrew on Fri Jun 17 18:28:03 2022

On 6/17/2022 5:37 PM, Andrew wrote:

TKosfeld wrote:

On 6/17/2022 2:53 PM, Tom Schaefer wrote:

A colleague asked me if I knew anybody that might have this program
so I said I would ask.

He is looking for a program (I presume it was an example) to list all
the fields in a dataset by reading the Description file.

Does anyone have access to those notes? I suspect things may have
changed, but if anyone has it, they would be here.

Regards,

Tom Schaefer

    BEGIN
    DEFINE P                =POINTER#
          ,B                =BOOLEAN#
          %
          ,NAMEIN(PX,LX)    =PX+1 FOR MIN(LX,REAL(PX,1))
                             ," " FOR LX-REAL(PX,1)#
          ,PRECISION(X)     =((FIRSTONE(SCALERIGHTF(X,12))-1).[8:7]+1)#
          %
          ,INIT_BUFO(X)     =BEGIN
                             REPLACE PO:=P(BUFO) BY " " FOR 108;
                             REPLACE PO:PO BY X FOR 2 DIGITS
                                             ," ";
                             END#
          ,WRITE_BUFO       =WRITE(INFO_FILE,18,BUFO)#
          %
          ,BLOCKF           =[47:16]#      % BLOCK FIELD OF NODE
          ,LISTF            =[31:16]#      % LIST FIELD OF NODE
          ,PROPF            =[15:16]#      % PROP FIELD OF NODE
          %
          ,DBLISTEND[N]     =DBDESC[(N).LISTF]#
          ,LISTEND[N]       =DESC [(N).LISTF]#
          ,LISTEND2[N]      =DESC2 [(N).LISTF]#
          %
          ,DBPROP[N,F]      =DBDESC[(N).PROPF + F]#
          ,PROP[N,F]        =DESC [(N).PROPF + F]#
          ,PROP2[N,F]       =DESC2 [(N).PROPF + F]#
          ,PROP3[N,F]       =DESC3 [(N).PROPF + F]#
          %
          ,DBLISTELEMENT[N,I]
                            =DBDESC[(N).LISTF + I]#
          ,LISTELEMENT[N,I] =DESC [(N).LISTF + I]#
          ,LISTELEMENT2[N,I]=DESC2 [(N).LISTF + I]#
          ,LISTELEMENT3[N,I]=DESC3 [(N).LISTF + I]#
          %
          ,NAMEOFFSET       =2# % OFFSET TO THE NAME OF RESTART DS
          ;
    FILE INFO_FILE
           (KIND      =PACK
           ,MAXRECSIZE=18
           ,BLOCKSIZE =540
           ,FRAMESIZE =48
           ,NEWFILE   =TRUE
           ,FILEUSE   =OUT
           )
        ;
    REAL DBNODE                    % DATA BASE NODE
        ,DSSTRUCTURE               % STR. NODE OF DATASET
        ,LDBSTRUCTURE              % NODE OF LDB
        ,SETLIST                   % NODE TO LIST OF SETS
        ;
    BOOLEAN LDBB                   % LOGICAL DB IN SPEC.
           ,LDBSETSB               % SET ID'S ARE IN LDB
           ;
    ARRAY REFERENCE DBDESC[0]      % DBNODE BUFFER
                   ;
    ARRAY BUFO[0:17]
         ,FLD_NAME_IX[0:1023]
         ;
    EBCDIC ARRAY RDSNAME[0:17]     % RESTART DATA SET
                ,FLD_NAMES[0:9999]
                ,LDBRDSNAME[0:17] % RESTART DATA SET ON LDB LIST
                ;
    POINTER PO
           ,PFN
           ;
    %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% >>     PROCEDURE OVERLAYERR;
    FORWARD;
    %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% >>   $INCLUDE PROPERTIES = "DATABASE/59189/PROPERTIES" 20000000-26999999
  $INCLUDE PROPERTIES = "DATABASE/59189/PROPERTIES" 28000000-29999999
  $INCLUDE PROPERTIES = "DATABASE/59189/PROPERTIES" 33800000-33999999
    %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% >>     PROCEDURE OVERLAYERR;
    BEGIN
    DISPLAY("FATAL ERROR");
    END OF OVERLAYERR;
    %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% >>     PROCEDURE GET_INFO_DB;
    BEGIN
    REAL LN
        ,LEN
        ,LDBTOP
        ,LDBNODE
        ;
    EBCDIC ARRAY WK[0:255]
                ;
    POINTER PWK
           ;
    ARRAY REFERENCE DESC[0]
                   ,DESC2[0]
                   ;
    %
    DASOPEN;
    %
    INIT_BUFO(01);
    REPLACE PWK:=WK BY DASDL.TITLE;
    IF PWK="*"
    THEN REPLACE PO:PO BY "*"
                         ," " FOR 17
    ELSE BEGIN
         PWK:=*+1;
         REPLACE PO:PO BY PWK:PWK FOR LEN:17 UNTIL=")"
                         ," " FOR LEN+1;
         END;
    PWK:=*+1;
    IF PWK="DESCRIPTION/"
    THEN PWK:=*+12;
    REPLACE PO:PO BY PWK:PWK FOR LEN:17 WHILE IN ALPHA
                    ," " FOR LEN+1;
    IF PWK=" ON "
    THEN REPLACE PO:PO BY PWK+4 FOR LEN:17 WHILE IN ALPHA
                         ," " FOR LEN+1
    ELSE REPLACE PO:PO BY "DISK"
                         ," " FOR 14;
    REPLACE PWK:=WK BY DASDL.HOSTNAME;
    REPLACE PO:PO BY PWK FOR LEN:17 WHILE IN ALPHA
                    ," " FOR LEN+1;
    WRITE_BUFO;
    %
    READPROP(0,DESC);
    DBNODE:=DESC[DBNODELOC];
    LOCKPROP(DBNODE.BLOCKF,DBDESC);
    %
    IF LDBB            % SET UP LOGICAL DB
    THEN BEGIN
         LDBNODE := DBDESC[DBPROP[DBNODE,LOGICALDATABASENODE]];
         READPROP(LDBNODE.BLOCKF,DESC);
         LDBTOP := LISTEND[LDBNODE];
         LN := 0;
         WHILE LN := * + 1 <= LDBTOP
         DO BEGIN
            LDBSTRUCTURE := LISTELEMENT[LDBNODE,LN];
            IF LDBSTRUCTURE.LISTF NEQ 4"0000"
            THEN BEGIN
                 READPROP(LDBSTRUCTURE.BLOCKF,DESC2);
                 % P(PROP2[LDBSTRUCTURE,WORDONE])
                 END;
            END;
         END;
    END GET_INFO_DB;
    %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% >>     PROCEDURE GET_INFO_DATASET_ITEMS(DSSTRUCTURE,RDS);
    VALUE   DSSTRUCTURE,RDS;
    REAL    DSSTRUCTURE;
    BOOLEAN RDS;
    BEGIN
    REAL I
        ,J
        ,T
        ,IT
        ,LV
        ,ITEM
        ,ITEMNODE
        ,ITEMTOP
        ,DEPENDITEM
        ;
    ARRAY REFERENCE DESC[0]
                   ;
    POINTER PN
           ;
    %
    PFN:=FLD_NAMES;
    REPLACE FLD_NAME_IX BY 0 FOR SIZE(FLD_NAME_IX) WORDS;
    %
    READPROP(DSSTRUCTURE.BLOCKF, DESC);
    ITEMNODE := DESC[PROP[DSSTRUCTURE,DATAITEMNODE]];
    READPROP(ITEMNODE.BLOCKF, DESC);
    ITEMTOP := LISTEND[ITEMNODE];
    IT := 0;
    WHILE IT := * + 1 <= ITEMTOP
    DO BEGIN
       ITEM := LISTELEMENT[ITEMNODE,IT];
       T := PROP[ITEM,TYPEF];
       IF T >= TYP
       THEN BEGIN
            INIT_BUFO(03);
            PN:=P(PROP[ITEM,WORDONE]);
            REPLACE PO:PO BY PROP[ITEM,ITEMNUM] FOR 3 DIGITS
                            ," "
                            ,PROP[ITEM,LEVELF] FOR 2 DIGITS
                            ," ";
            CASE T
            OF BEGIN
                GRP: REPLACE PO:PO BY "GRP ";
               BOLN: REPLACE PO:PO BY "BOLN"
                FLD: REPLACE PO:PO BY "FLD ";
               ALPH: REPLACE PO:PO BY "ALPH";
               DECI: REPLACE PO:PO BY "DECI"
               DECF: REPLACE PO:PO BY "DECF";
               BINI: REPLACE PO:PO BY "BINI"
               BINF: REPLACE PO:PO BY "BINF";
               BFLT: IF RDS
                     THEN BEGIN
                          REPLACE PO:PO BY "XXXX"; >>                           PROP[ITEM,DECLAREDLENGTH]:=6;
                          PROP[ITEM,SIGNF]:=0;
                          END
                     ELSE IF PROP[ITEM,RSNFLD]=1
                          THEN REPLACE PO:PO BY "RSN "
                          ELSE REPLACE PO:PO BY "BFLT"
               ELSE: REPLACE PO:PO BY T FOR 4 DIGITS
               END;
            REPLACE PO:PO BY " "
                            ,PROP[ITEM,DECLAREDLENGTH] FOR 5 DIGITS
                            ," "
                            ,PROP[ITEM,SCALEFACTOR] FOR 2 DIGITS
                            ," "
                            ,PROP[ITEM,SIGNF] FOR 1 DIGITS
                            ," "
                            ,PROP[ITEM,TOTALSZ] FOR 5 DIGITS
                            ," "
                            ,PROP[ITEM,REQUIREDF] FOR 1 DIGITS
                            ," "
                            ,PROP[ITEM,NUMSUBSCRIPTS] FOR 3 DIGITS
                            ," ";
            IF PROP[ITEM,VFTYPE]^=0
            THEN REPLACE PO:PO BY PROP[ITEM,VFTYPE] FOR 2 DIGITS >>                                  ," "
            ELSE REPLACE PO:PO BY "   ";
            IF B(PROP[ITEM,OCCURSF])
            THEN REPLACE PO:PO BY PROP[ITEM,OCCURSMAX] FOR 5 DIGITS
                                 ," "
            ELSE REPLACE PO:PO BY "      ";
  %         IF PROP[ITEM,OCCURSTYPE] = OCCDEPENDING
  %         THEN BEGIN
  %              A[DEPENDSC] := 1;
  %              DEPENDITEM := LISTELEMENT[ITEMNODE,PROP[ITEM,
  %                OCCURSVARIABLE]];
  %              REPLACE PTEMP BY P(PROP[DEPENDITEM,WORDONE]) FOR
  %                (REAL(P(PROP[DEPENDITEM,WORDONE]),1)+1); >>   %              END
  %         ELSE A[DEPENDSC] := 0;
            REPLACE PO BY NAMEIN(PN,30);
            WRITE_BUFO;
            %
            FLD_NAME_IX[PROP[ITEM,ITEMNUM]]:=OFFSET(PFN);
            REPLACE PFN:PFN BY PN FOR REAL(PN,1)+1;
            END;
       END;
    END GET_INFO_DATASET_ITEMS;
    %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% >>     PROCEDURE GET_INFO_SET;
    BEGIN
    REAL I
        ,IX
        ,OP
        ,WL
        ,LEN
        ,SEQ
        ,STR
        ,LSTR
        ,KITEM
        ,SETTOP
        ,KNODE
        ,KDNODE
        ,KEYTOP
        ;
    BOOLEAN WB
           ;
    ARRAY REFERENCE DESC [0]
                   ,DESC2[0]
                   ,DESC3[0]
                   ,TEXT [0]
                   ;
    POINTER PN
           ,PW
           ;
    %
    READPROP(SETLIST.BLOCKF, DESC);
    SETTOP := IF SETLIST IS 0 THEN 0 ELSE LISTEND[SETLIST];
    I := 0;
    WHILE I := * + 1 <=SETTOP
    DO BEGIN
       IF LDBSETSB
       THEN BEGIN
            LSTR := LISTELEMENT[SETLIST,I];
            READPROP(LSTR.BLOCKF,DESC2);
            STR := DBLISTELEMENT[DBNODE,PROP2[LSTR,STRUCTURENUM]];
            END
       ELSE BEGIN
            LSTR := DBLISTELEMENT[DBNODE,LISTELEMENT[SETLIST,I]]; >>             READPROP(LSTR.BLOCKF, DESC2);
            READPROPTEXT(LSTR.BLOCKF,DESC2,TEXT);
            STR := LSTR;
            END;
       PN:=P(PROP2[LSTR,WORDONE]);
       INIT_BUFO(04);
       REPLACE PO:PO BY NAMEIN(PN,17)
                       ," "
                       ,PROP2[LSTR,DUPSALLOWED] FOR 1 DIGITS
                       ," "
                       ,PROP2[LSTR,DUPSFIRST] FOR 1 DIGITS
                       ," "
                       ,PROP2[LSTR,DUPSLAST] FOR 1 DIGITS
                       ," "
                       ,PROP2[LSTR,KEYCHANGEALLOW] FOR 1 DIGITS
                       ," "
                       ,PROP2[LSTR,SUBSETF] FOR 1 DIGITS
                       ," "
                       ,PROP2[LSTR,WHERELIST] FOR 4 DIGITS
                       ," "
                       ,PROP2[LSTR,WHERELISTSZ] FOR 3 DIGITS
                       ," "
                       ,PROP2[LSTR,KEYCOUNT] FOR 2 DIGITS
                       ," "
                       ,PROP2[LSTR,KEYDATACOUNT] FOR 2 DIGITS
                       ," "
                       ,PROP2[LSTR,SUBTYPEF] FOR 2 DIGITS;
       WRITE_BUFO;
       IF WL:=PROP2[LSTR,WHERELIST]^=0
       THEN BEGIN
            INIT_BUFO(08);
            REPLACE PO:PO BY SEQ:=1 FOR 4 DIGITS
                            ," "
                            ," ";
            IX:=0;
            PW:=P(DESC2[WL]);
            WHILE OP:=REAL(PW,2) ISNT 4"000A"
            DO BEGIN
               PW:=*+2;
               CASE OP.[15:04]
               OF BEGIN
                  00: %
                      CASE OP.[11:12]
                      OF BEGIN
                         15: REPLACE PO:PO BY "( ";
                         16: REPLACE PO:PO BY " )"; >>                          11: REPLACE PO:PO BY " LT ";
                         32: REPLACE PO:PO BY " LE ";
                         22: REPLACE PO:PO BY " EQ ";
                         33: REPLACE PO:PO BY " NE ";
                         34: REPLACE PO:PO BY " GE ";
                         21: REPLACE PO:PO BY " GT ";
                         31: BEGIN
                             WRITE_BUFO;
                             INIT_BUFO(08);
                             REPLACE PO:PO BY (SEQ:=*+1) FOR 4 DIGITS
                                             ," ";
                             REPLACE PO:PO BY "O ";
                             END;
                         30: BEGIN
                             WRITE_BUFO;
                             INIT_BUFO(08);
                             REPLACE PO:PO BY (SEQ:=*+1) FOR 4 DIGITS
                                             ," ";
                             REPLACE PO:PO BY "E ";
                             END;
                         24: REPLACE PO:PO BY " NOT ";
                         10: REPLACE PO:PO BY " LB"; >>                          ELSE:
                             REPLACE PO:PO BY OP.[11:12] FOR * DIGITS;
                         END; % Case
                  01: %
                      PN:=FLD_NAMES[FLD_NAME_IX[OP.[11:12]]];
                      IF OFFSET(PO)>40
                      THEN REPLACE PO:PO BY "C ";
                      REPLACE PO:PO BY PN+1 FOR REAL(PN,1)
                                      ," " FOR 40-REAL(PN,1);
                      PW:=*+2;
                  02: %
                      PW:=*+2;
                  03: %
                      ;
                  04: %
                      ;
                  09: %
                      IF OP.[11:12]=1
                      THEN REPLACE PO:PO BY "TRUE"
                      ELSE REPLACE PO:PO BY "FALSE";
                  10: %
                      LEN:=OP.[11:12];
                      REPLACE PO:PO BY "K '"
                                      ,PW FOR LEN
                                      ,"'"
                                      ," " FOR 38-LEN;
                      IF LEN MOD 2 = 1
                      THEN LEN:=*+1;
                      PW:=*+LEN;
                  11: %
                      PW:=*+2;
                      LEN:=OP.[11:12];
                      REPLACE PO:PO BY "K "
                                      ,PW FOR LEN
                                      ," " FOR 40-LEN;
                      IF LEN MOD 2 = 1
                      THEN LEN:=*+1;
                      PW:=*+LEN;
                  12: %
                      ;
                  ELSE: %
                      ;
                  END; % Case
               IF READLOCK(FALSE,WB)
               THEN BEGIN
                    WRITE_BUFO;
                    INIT_BUFO(08);
                    REPLACE PO:PO BY (SEQ:=*+1) FOR 4 DIGITS
                                    ," "; >>                     END;
               END; % While
            WRITE_BUFO;
            END;
       %
       KNODE:=DESC2[PROP2[LSTR,KEYNODE]];
       KDNODE:=DESC2[PROP2[LSTR,KEYDATANODE]];
       IF KNODE.BLOCKF^=0
       THEN BEGIN
            READPROP(KNODE.BLOCKF,DESC3);
            KEYTOP:=LISTEND[KNODE];
            IX:=0;
            WHILE IX:=*+1 <= KEYTOP
            DO BEGIN
               KITEM:=LISTELEMENT3[KNODE,IX];
               INIT_BUFO(05);
               REPLACE PO:PO BY IX FOR 3 DIGITS
                               ," "
                               ,KITEM.[11:12] FOR 3 DIGITS
                               ," "
                               ,KITEM.[39:12] FOR 5 DIGITS
                               ," "
                               ,KITEM.[27:16] FOR 5 DIGITS
                               ," "
                               ,KITEM.[46:01] FOR 1 DIGITS
                               ," "
                               ,KITEM.[45:06] FOR 2 DIGITS;
               WRITE_BUFO;
               END;
            END;
       %
       IF KDNODE.BLOCKF^=0
       THEN BEGIN
            READPROP(KDNODE.BLOCKF,DESC3);
            KEYTOP:=LISTEND[KDNODE];
            IX:=0;
            WHILE IX:=*+1 <= KEYTOP
            DO BEGIN
               KITEM:=LISTELEMENT3[KDNODE,IX];
               INIT_BUFO(06);
               REPLACE PO:PO BY IX FOR 3 DIGITS
                               ," "
                               ,KITEM.[11:12] FOR 3 DIGITS
                               ," "
                               ,KITEM.[39:12] FOR 5 DIGITS
                               ," "
                               ,KITEM.[27:16] FOR 5 DIGITS
                               ," "
                               ,KITEM.[46:01] FOR 1 DIGITS
                               ," "
                               ,KITEM.[45:06] FOR 2 DIGITS;
               WRITE_BUFO;
               END;
            END;
       END;
    END GET_INFO_SET;
    %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% >>     PROCEDURE GET_INFO_DATASET;
    BEGIN
    REAL I
        ,LN
        ,SN
        ,LTOP
        ,SETS
        ,DBTOP
        ;
    ARRAY REFERENCE DESC[0]
                   ,DESC2[0]
                   ,TEXT[0]
                   ;
    POINTER PN
           ;
    IF LDBB
    THEN BEGIN
         READPROP(LDBSTRUCTURE.BLOCKF,DESC2);
         LTOP := LISTEND2[LDBSTRUCTURE];
         I := 0;
         WHILE I := * + 1 <= LTOP
         DO BEGIN
            DSSTRUCTURE := LISTELEMENT2[LDBSTRUCTURE,I];
            READPROP(DSSTRUCTURE.BLOCKF,DESC );
            % P(PROP[DSSTRUCTURE,WORDONE])
            END;
         SETS := PROP[DSSTRUCTURE,SETSF];
         LDBSETSB := SETS = SETSLIST;
         SETLIST := IF LDBSETSB THEN DSSTRUCTURE ELSE 0;
         DSSTRUCTURE :=            % SET UP TO POINT AT ACTUAL DB PROPS
           DBLISTELEMENT[DBNODE,PROP[DSSTRUCTURE,STRUCTURENUM]]; >>          READPROP(DSSTRUCTURE.BLOCKF,DESC);
         IF SETS = SETSALL OR SETS = SETSEMPTY
         THEN SETLIST := DSSTRUCTURE;
         END
    ELSE BEGIN               % NOT SPECIFIED LDB
         DBTOP := DBLISTEND[DBNODE];
         SN := 0;
         WHILE SN := * + 1 <= DBTOP
         DO BEGIN
            DSSTRUCTURE := DBLISTELEMENT[DBNODE,SN];
            READPROP(DSSTRUCTURE.BLOCKF, DESC);
            READPROPTEXT(DSSTRUCTURE.BLOCKF,DESC,TEXT);
            I := PROP[DSSTRUCTURE,TYPEF];
            INIT_BUFO(02);
            PN:=P(PROP[DSSTRUCTURE,WORDONE]);
            REPLACE PO:PO BY NAMEIN(PN,17)
                            ," ";
            PN:=P(TEXT[PROP[DSSTRUCTURE,DESCTEXT]]);
            REPLACE PO:PO BY NAMEIN(PN,40)
                            ," "
                            ,PROP[DSSTRUCTURE,SUBTYPEF] FOR 2 DIGITS
                            ," "
                            ," " % BDOTIMIZ
                            ," "
                            ,PROP[DSSTRUCTURE,ITEMNUM] FOR 5 DIGITS;
            %
            SETLIST := DSSTRUCTURE;
            %
            IF PROP[DSSTRUCTURE,TYPEF] = DATASET
            THEN BEGIN
                 WRITE_BUFO;
                 GET_INFO_DATASET_ITEMS(DSSTRUCTURE
                         ,PROP[DSSTRUCTURE,RESTARTDATASETF]=1);
                 GET_INFO_SET;
                 END;
            END;
         END;
    END GET_INFO_DATASET;
    %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% >>     PROCEDURE GET_INFO_RDS;
    BEGIN
    REAL I
        ,RDSSN,STR,LTOP
        ;
    POINTER Q
           ;
    ARRAY REFERENCE DESC[0]
                   ,DESC2[0]
                   ;
    REPLACE RDSNAME BY " " FOR 18;
    REPLACE LDBRDSNAME BY " " FOR 18;
    RDSSN := DBPROP[DBNODE,RESTARTDATASETSN];
    STR := DBLISTELEMENT[DBNODE,RDSSN];
    READPROP(STR.BLOCKF,DESC);
    REPLACE RDSNAME BY Q:= P(PROP[STR,WORDONE]) FOR (REAL(Q,1)+1);
    IF LDBB
    THEN BEGIN
         READPROP(LDBSTRUCTURE.BLOCKF, DESC);
         LTOP := LISTEND[LDBSTRUCTURE];
         I := 0;
         WHILE I := * + 1 <= LTOP
         DO BEGIN
            STR := LISTELEMENT[LDBSTRUCTURE,I];
            READPROP(STR.BLOCKF, DESC2);
            IF PROP2[STR,STRUCTURENUM] = RDSSN
            THEN BEGIN
                  REPLACE LDBRDSNAME BY
                   Q := P(PROP2[STR,NAMEOFFSET]) FOR
                        (REAL(Q,1)+1);
                 IF RDSNAME NEQ LDBRDSNAME FOR 18
                 THEN REPLACE RDSNAME BY LDBRDSNAME FOR 18; >>                  END;
            END;
         END;
    END GET_INFO_RDS;
    %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% >>     %%%%%%%%%%%%%%%%%%%%% OUTER BLOCK %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% >>     %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% >>     %
    OPEN(INFO_FILE);
    %
    GET_INFO_DB;
    GET_INFO_DATASET;
    %
    CLOSE(INFO_FILE,CRUNCH);
    %
    END.

Your .sig says: This email has been checked for viruses by Avast
antivirus software.
https://www.avast.com/antivirus
For that to make sense, your Avast should have verified that source code.

Who knows, maybe avast has a algol compiler build in.

--
This email has been checked for viruses by Avast antivirus software. https://www.avast.com/antivirus

--- SoupGate-Win32 v1.05
* Origin: fsxNet Usenet Gateway (21:1/5)

Sysop:	Keyop
Location:	Huddersfield, West Yorkshire, UK
Users:	546
Nodes:	16 (2 / 14)
Uptime:	38:15:22
Calls:	10,392
Files:	14,064
Messages:	6,417,169

Program from Unisys Advanced DMSII Class to list dataset fields

Who's Online

System Info