;"QZEZ709", AUTHOR: John F. Backus Version 3.0  (12/02/1998)
; An MPE/iX POWERHOUSE (COGNOS) QUIZ 7.09 CODE DEVELOPMENT TOOL.
;              Courtesy of Beechglen Development, Inc.
; The user accepts full responsibility for use of this software.
; This code is released as freeware.  In no circumstances shall
; Beechglen Development be held responsible for its use.
;Known limitations:
; 1. Some limits are hard coded such as the total # of items
;    that can be reported.  One could study the code and make
;    the appropriate adjustments.
; 2. Subitems are only correctly processed to 3 level deep.  Ones
;    that are defined any further levels down will require manual
;    correction to the code that is generated.  ALL subitems that
;    are 2 or more levels deep are displayed on the screen as ".."
; 3. Quiz only allows reporting the 1st occurence of an array and
;    so only the 1st is presented and output.
; 4. You must change the hardcoded 'RUN QUIZ' statement in this code.
;Recommendations:  Drop into Quiz, then do a "use thiscode nolist"
; NOTE:  QZEZ709 is made available to anyone for their free usage
;        given that the author's name appear in the comments and in
;        the programs's displayed banner.  No guarantees or
;        warranties of any kind are expressed or implied.  Those
;        who use this code assume any and all associated risks that
;        may arise from the usa of this code or its output.
; QZREPORT requires that the Powerhouse dictionary have defined in
; it: (DIRECT) FILE STD80, REC STD80, ELE DATA-LINE-80 of X(80)
; TWO file equations are issued, one for LP and one for ldev #
; 122, ldev # 122 was a printing device at company XYZ.  Adjust
; this number accordingly for your department's needs.
;STEP  purge all workfiles and display the program banner
:PURGE Z709XX00
:PURGE Z709XX01
:PURGE Z709XX02
:PURGE Z709XX03
:PURGE Z709XX04
:PURGE Z709XX05
:PURGE Z709XX06
:PURGE Z709XX07
:PURGE Z709XX08
:PURGE Z709XX09
;build a workfile and set some file equations to printer devices
:BUILD Z709XX02;REC=-80,1,F,ASCII;DISC=2000
:FILE QZEZ709X;DEV=122,9,1
:FILE QZEZ709Y;DEV=LP,9,1
DISP " "
DISP "QZEZ709  Version 3.0         (Author:  John F. Backus)"
DISP "                     (Courtesy of Beechglen Development, Inc.)"
DISP " "
DISP " Purpose: To print items, 1 per line, vertically down"
DISP " the screen.  To get a quick look at the data in order to"
DISP " facilitate debugging, etc.   Format is useful, like QUERY, "
DISP " only this allows access to subfiles!."
DISP " "
DISP "  IF the file requested is a keyed file, you will be prompted "
DISP "    to enter a value for the first key defined in the file."
DISP " "
DISP "  If you enter SORT or SELECT criteria, enter complete"
DISP "   and valid QUIZ SORT &/or SELECT commands... for example:"
DISP " "
DISP "SELECT IF ORDER-STATUS = 'N'   ...   SORT ON ORDER-NBR "
DISP "   where ORDER-STATUS and ORDER-NBR are valid item names."
DISP " "
;STEP  REQUEST USER input:  filename, # records desired,
;         output destination, select statement, sort statement
; capture this information in the form of quiz DEFINE statements
; and place these into a flat file for later quiz pass usage.
CAN CLE
SET DEF
DEF FN1 CHA*25=PARM PROMPT &
  "Enter filename or *subfilename?  (Def = *GENSUB) ->"
DEF FN2 CHA*25= FN1 IF FN1 NE " " ELS "*GENSUB"
DEF RPL1 NUM*1=PARM PROMPT &    ;RPL1 = # OF REC COMPLEXES TO REPORT
 "Set rep lim to? ... #0=One  #1=10 #2=100  #3=10,000 (default #0)->"
DEF RPL2 CHA*70=&
 "DEF RPL3 CHA*26='SET REP LIM 1'" IF RPL1=0                   &
    ELS "DEF RPL3 CHA*26='SET REP LIM 10'" IF RPL1=1           &
      ELS "DEF RPL3 CHA*26='SET REP LIM 100'" IF RPL1=2        &
        ELS "DEF RPL3 CHA*26='SET REP LIM 10000'" IF RPL1=3    &
          ELS "DEF RPL3 CHA*26='SET REP LIM 1'"
DEF OD1 NUM*1=PARM PROMPT &
  "Print on?  ...  #0=CRT  #1=122   #2=LP? (default #0)->"
DEF OD2 CHA*70=                                                &
 "DEF OD3 CHA*50='SET REP DEV TERM PAG WID 80 LEN 0'"          &
  IF OD1=0                                                     &
    ELS "DEF OD3 CHA*50='SET REP DEV PRIN NAME QZEZ709X'"      &
     IF OD1=1                                                  &
       ELS "DEF OD3 CHA*50='SET REP DEV PRIN NAME QZEZ709Y'"   &
         IF OD1=2                                              &
           ELS "DEF OD3 CHA*50='SET REP DEV TERM PAG WID 80 LEN 0'"
DEF SZ1 CHA*56 = PARM PROMPT &
  "Enter SELECT command (up to 56 bytes) or CR if not to be done->"
DEF SZ2 CHA*78=PAC("DEF SZ3 CHA*70=" + "'" + SZ1 + "'") &
  IF SZ1 NE " " ELS "DEF SZ3 CHA*40=';( a SELECT was not requested )'"
DEF SO1 CHA*56 = PARM PROMPT &
  "Enter SORT command (up to 56 bytes) or CR if not to be done->"
DEF SO2 CHA*78=PAC("DEF SO3 CHA*70=" + "'" + SO1 + "'") &
  IF SO1 NE " " ELS "DEF SO3 CHA*40=';( a SORT was not requested )'"
DEF MODE1 NUM*1=PARM PROMPT &
 "Output format?  #0=Item,value   #1=Item,desc,,value  (default #0)->"
DEF MODE2 CHA*70=                                              &
 "DEF MODE3 NUM*1 = 0" IF MODE1=0                              &
    ELS "DEF MODE3 NUM*16 = 1" IF MODE1=1                      &
      ELS "DEF MODE3 NUM*1= 0"
DEF IGNOR1 CHA*1 = PARM PROMPT &
  "Ignore all subitems and redefined items? (Default = N)->" &
  UPSHIFT ON ERRORS REPROMPT 2 TIMES
DEF IGNOR2 CHA*70 = "DEF IGNOR2 CHA*1='Y'" &
  IF IGNOR1 = "Y" ELSE "DEF IGNOR2 CHA*1='N'"
SET NOBL NOHE NOST NODUP NOVE NOWAR PAG WID 80 LEN 0 REP LIM 1
SET REP DEV DISC NAME Z709XX00
REP "DEF ACCSTMNT CHA*34='ACC" FN2 "'" SKI OD2 SKI &
    RPL2 SKI SZ2 SKI SO2 SKI MODE2 SKI IGNOR2
GO
;STEP  using data in the use file Z709XX00, specifically the
;      defined item accstmnt, create another usefile containing
;      the necessary data to give a quiz show of the file's items.
CAN CLE
SET NOBL NOHE NOST NODUP PAG WID 80 LEN 0
USE Z709XX00 NOL
DEF SHOWSTMNT CHA*20="SHOW ITEMS"
DEF EXITSTMNT CHA*20="EXIT"
SET REP DEV DISC NAME Z709XX01
REP ACCSTMNT SKI SHOWSTMNT SKI EXITSTMNT
GO
;
;STEP using the use file Z709XX01 having the quiz statements
;     necessary to derive quiz output of the file's items, run a
;     subprocess of quiz using Z709XX01 as input, direct the output
;     to the 80 byte file built earlier called Z709XX02.
;
:RUN QUIZ.PH709E.COGNOS;INFO="AUTO=Z709XX01";STDLIST=Z709XX02
:PURGE QUIZSAVE,TEMP
;
;STEP there is no such file called Z709XX02 in the dictionary,
;     but by convention we have previously defined a file called
;     STD80 which has one element: DATA-LINE-80 which we can 'file
;     equate' to allow processing of any 80 byte file.
;
:FILE STD80=Z709XX02
;
;STEP access the show items output file and 'pick off' the record
;     that is the 1st keyed item and create a quiz
;     definition that is a valid CHOOSE statement for that key.
;     Also created a defined item whose value is the filename
;
ACC STD80
SEL IF DATA-LINE-80[41:4] = "TYPE"                                  &
  OR (DATA-LINE-80[1:1]="*" AND DATA-LINE-80[1:3] <> "*W*")
DEF KEYX CHA*70=PAC("CHOO " + DATA-LINE-80[3:18] + "PARM PROMPT ")  &
  IF DATA-LINE-80[1:1] = "*"
DEF FILEX CHA*70=PAC("DEF FILEX CHA*16 = " +     &
  "'" + DATA-LINE-80[1:16] + "'" ) IF DATA-LINE-80[41:4] = "TYPE"
SET NOBL NOHE NOST NODUP NOVE NOWAR PAG WID 80 LEN 0 REP LIM 2 ;LIM 2!
SET REP DEV DISC NAME Z709XX03
REP KEYX SKI FILEX
NOREP " "
GO
;
:FILE STD80=Z709XX02
;we must remove duplicate records created by quiz output now
;to prevent duplicate 'expanded' arrayed item later.  Also, since
;we often are not interested in subitems or redefined items (as in
;creating a QTP subfile for use in reloading a dataset), let us give
;the user the chance to ignore these...
SET DEF
CAN CLE
ACC STD80
USE Z709XX00 NOL
DEF REJECT-RECORD CHA*1 =                                           &
  "Y" IF  ((DATA-LINE-80[3:1] = "."                                 &
            OR DATA-LINE-80[3:1] = "_")                             &
           AND IGNOR2 = "Y")                                        &
      ELSE "N"
SEL IF ( (DATA-LINE-80[2:1]=" " AND DATA-LINE-80[3:1] NE " "        &
          AND DATA-LINE-80[1:3] NE "Q U")                           &
          AND (REJECT-RECORD = "N")                                 &
          OR (DATA-LINE-80[1:1] = "*"                               &
              AND DATA-LINE-80[1:3] NE "*W*") )
DEFINE NODUPS-RECORD CHA*78 = DATA-LINE-80[1:78]
REPORT TAB 001 NODUPS-RECORD
SET REPORT DEVICE DISC NAME Z709XX04
SET NODUP NOST NOBL NOHEAD NOVERIFY REP LIM 2000 PAG LEN 0 WID 80
GO
;
:FILE STD80=Z709XX04
SET DEF
CAN CLE
ACC STD80
DEF DLP1 CHA*2  = DATA-LINE-80[1:2]
DEF DLP2 CHA*31 = DATA-LINE-80[3:31] ;Quiz 7.09 allows 31 byte names
DEF DLP3 CHA*6  = DATA-LINE-80[32:6]
DEF DLP4 CHA*37 = DATA-LINE-80[41:37]
DEF FIRST-L-PAREN NUM*2 = INDEX(DLP2,"(")
DEF FIRST-R-PAREN NUM*2 = INDEX(DLP2,")")
DEF L-PAREN NUM*2 = FIRST-L-PAREN IF FIRST-L-PAREN LT 41 ELS 0
DEF R-PAREN NUM*2 = FIRST-R-PAREN IF FIRST-R-PAREN LT 41 ELS 0
DEF OCCUR-A CHA*4 = DLP2[(L-PAREN + 1):R-PAREN - (L-PAREN + 1)]   &
  IF L-PAREN GT 0 AND R-PAREN GT 0
DEF OCCUR-N NUM*4 = NCONVERT(OCCUR-A) IF OCCUR-A <> " "
DEF DLP1-001 CHA*2 = DLP1 IF OCCUR-N GE 01 ELS DLP1
DEF DLP2-001 CHA*32 = PACK(DLP2[1:(L-PAREN - 1)]                 &
  + "(" + "01" + ")") IF L-PAREN GE 0 AND OCCUR-N GE 01 ELS DLP2
DEF DLP3-001 CHA*6 = DLP3 IF OCCUR-N GE 01 ELS DLP3
DEF DLP4-001 CHA*37= DLP4 IF OCCUR-N GE 01 ELS DLP4
DEF DLPA-001 CHA*78 = DLP1-001  + DLP2-001 + DLP3-001 + DLP4-001
REPORT TAB 001 DLPA-001 SKI 1
SET REPORT DEVICE DISC NAME Z709XX05
SET REP LIM 2000 PAG LEN 0 WID 80 NOHEAD NOSTAT NOVERIFY NOBLANKS
GO
;
;STEP now accessing our 'expanded' list of items, create a
;     subfile having defined items equal to the item-names and
;     the item-descriptions. also assign a sequential item nbr
:FILE STD80=Z709XX05
SET DEF
CAN CLE
ACC STD80
SEL IF   (DATA-LINE-80[2:1]=" " AND DATA-LINE-80[3:1] NE " "  &
          AND DATA-LINE-80[1:3] NE "Q U")                     &
      OR (DATA-LINE-80[1:1] = "*" AND DATA-LINE-80[1:3] NE "*W*")
DEF IT# NUM*3 = 1  ;this here basically limits # items to 999
DEF ITX CHA*2 = ".."                                                &
  IF DATA-LINE-80[3:2] = ".."                                       &
  ELS " ." IF DATA-LINE-80[3:1] = "."                               &
  ELS " _" IF DATA-LINE-80[3:1] = "_"                               &
  ELS " *" IF DATA-LINE-80[1:1] = "*"
;DEF ITN CHA*24 = DATA-LINE-80[3:36]
DEF ITN CHA*24 = DATA-LINE-80[3:36] IF  DATA-LINE-80[3:1] NE "."    &
                                    AND DATA-LINE-80[3:1] NE "_"    &
  ELSE DATA-LINE-80[6:33] IF DATA-LINE-80[3:3] EQ "..." & ;subsubsub
  ELSE DATA-LINE-80[5:34] IF DATA-LINE-80[3:2] EQ ".." & ;subsub item
  ELSE DATA-LINE-80[4:35] IF DATA-LINE-80[3:1] EQ "."  & ;a sub item
                          OR DATA-LINE-80[3:1] EQ "_" ;redefined item
DEF ITD CHA*37 = DATA-LINE-80[41:37]
SET SUBFILE NAME Z709XX06 KEEP
SET NOBL NOST NODUP REP LIM 2000
REP SUMM IT# SUBTOTAL ITX ITN ITD
GO
;
;
;STEP access the subfile and report the info to the screen
;
CAN CLE
SET DEF
ACC *Z709XX06
DEF IT#2 CHAR*3 = ASCII(IT#,3)
INIT HEAD TAB 1 "###  Item Name" TAB 41 "###  Item Name" &
      SKI TAB 1 "---  ---------" TAB 41 "---  ---------"
REP TAB 1 IT#2 TAB 4 ITX TAB 6 ITN
SET REP DEV TERM LIMIT 2000 PAG LEN 0 WID 40 IMAGES 2 NOST
;set rep lim to a value twice the schema's largest file's # items
GO
;
;STEP having displayed information to user, accept from the
;     user the item nbrs desired.  Then parse the user entered
;     data such that one can create a large select statement
;     definition to be placed in a quiz use file.
CAN CLE
SET DEF
ACC *Z709XX06
DISP "'*' = 'indexed'     '.' = 'subitem'      '_' = 'redefined'"
DISP "ARRAYED ITEMS WILL HAVE ONLY THE FIRST OCCURENCE REPORTED."
DISP " "
DISP "You can now choose the items that you wish to have reported."
DISP "Up to 30 #'s can be included OR excluded.  To select all #'s, "
DISP "just press carriage return to the prompt.  You designate "
DISP "inclusion or exclusion by entering a '+' or '-' in the very"
DISP "first character entered ('+' = 'include' , '-' = 'exclude')."
DISP "Examples:  +001,002,009,010,011  or   -005,012,044,045,046"
DISP " "
DISP "ENTER #'s CAREFULLY and DO NOT USE ANY INTERVENING SPACES."
DISP "LEADING '+' or '-' IS REQUIRED.  YOU GET ALL #'s IF NOT USED."
DISP " "
DEF SX1 CHA*120 = PARM PROMPT &
  "->"  ON ERRORS REPROMPT 2 TIMES
DEF I1  CHA*3 = SX1[2:3]  IF SX1[2:3]  NE ' ' ELS '0'
DEF I2  CHA*3 = SX1[6:3]  IF SX1[6:3]  NE ' ' ELS '0'
DEF I3  CHA*3 = SX1[10:3] IF SX1[10:3] NE ' ' ELS '0'
DEF I4  CHA*3 = SX1[14:3] IF SX1[14:3] NE ' ' ELS '0'
DEF I5  CHA*3 = SX1[18:3] IF SX1[18:3] NE ' ' ELS '0'
DEF I6  CHA*3 = SX1[22:3] IF SX1[22:3] NE ' ' ELS '0'
DEF I7  CHA*3 = SX1[26:3] IF SX1[26:3] NE ' ' ELS '0'
DEF I8  CHA*3 = SX1[30:3] IF SX1[30:3] NE ' ' ELS '0'
DEF I9  CHA*3 = SX1[34:3] IF SX1[34:3] NE ' ' ELS '0'
DEF I10 CHA*3 = SX1[38:3] IF SX1[38:3] NE ' ' ELS '0'
DEF I11 CHA*3 = SX1[42:3] IF SX1[42:3] NE ' ' ELS '0'
DEF I12 CHA*3 = SX1[46:3] IF SX1[46:3] NE ' ' ELS '0'
DEF I13 CHA*3 = SX1[50:3] IF SX1[50:3] NE ' ' ELS '0'
DEF I14 CHA*3 = SX1[54:3] IF SX1[54:3] NE ' ' ELS '0'
DEF I15 CHA*3 = SX1[58:3] IF SX1[58:3] NE ' ' ELS '0'
DEF I16 CHA*3 = SX1[62:3] IF SX1[62:3] NE ' ' ELS '0'
DEF I17 CHA*3 = SX1[66:3] IF SX1[66:3] NE ' ' ELS '0'
DEF I18 CHA*3 = SX1[70:3] IF SX1[70:3] NE ' ' ELS '0'
DEF I19 CHA*3 = SX1[74:3] IF SX1[74:3] NE ' ' ELS '0'
DEF I20 CHA*3 = SX1[78:3] IF SX1[78:3] NE ' ' ELS '0'
DEF I21 CHA*3 = SX1[82:3] IF SX1[82:3] NE ' ' ELS '0'
DEF I22 CHA*3 = SX1[86:3] IF SX1[86:3] NE ' ' ELS '0'
DEF I23 CHA*3 = SX1[90:3] IF SX1[90:3] NE ' ' ELS '0'
DEF I24 CHA*3 = SX1[94:3] IF SX1[94:3] NE ' ' ELS '0'
DEF I25 CHA*3 = SX1[98:3] IF SX1[98:3] NE ' ' ELS '0'
DEF I26 CHA*3 = SX1[102:3] IF SX1[102:3] NE ' ' ELS '0'
DEF I27 CHA*3 = SX1[106:3] IF SX1[106:3] NE ' ' ELS '0'
DEF I28 CHA*3 = SX1[110:3] IF SX1[110:3] NE ' ' ELS '0'
DEF I29 CHA*3 = SX1[114:3] IF SX1[114:3] NE ' ' ELS '0'
DEF I30 CHA*3 = SX1[118:3] IF SX1[118:3] NE ' ' ELS '0'
DEF SX2 CHA*70=PAC("SEL IF IT# = " + I1 + " OR IT# = " + I2 +      &
" OR IT# = " + I3 + " OR IT# = " + I4 + " OR IT# = " + I5 + " &")  &
    IF SX1[1:1]  = "+"  &
  ELS PAC("SEL IF IT#<>" + I1 + " AND IT#<>" + I2 +      &
  " AND IT#<>" + I3 + " AND IT#<>" + I4 + " AND IT#<>" + I5 + " &") &
    IF SX1[1:1]  = "-" ELS " "
DEF SX3 CHA*70=PAC(" OR IT# = " + I6 + " OR IT# = " + I7 +          &
" OR IT# = " + I8 + " OR IT# = " + I9 + " OR IT# = " + I10 + " &")  &
    IF SX1[1:1]  = "+"  &
  ELS PAC("AND IT#<>" + I6 + " AND IT#<>" + I7 +      &
  " AND IT#<>" + I8 + " AND IT#<>" + I9 + " AND IT#<>" + I10 + " &") &
    IF SX1[1:1]  = "-" ELS " "
DEF SX4 CHA*70=PAC(" OR IT# = " + I11 + " OR IT# = " + I12  + &
" OR IT# = " + I13 + " OR IT# = " + I14 + " OR IT# = " + I15 + " &") &
    IF SX1[1:1]  = "+"  &
  ELS PAC("AND IT#<>" + I11 + " AND IT#<>" + I12 +      &
  " AND IT#<>" + I13 + " AND IT#<>" + I14 + " AND IT#<>" + I15 + " &") &
    IF SX1[1:1]  = "-" ELS " "
DEF SX5 CHA*70=PAC(" OR IT# = " + I16 + " OR IT# = " + I17      &
+ " OR IT# = " + I18 + " OR IT# = " + I19 + " OR IT# = " + I20 +  &
    " &" ) IF SX1[1:1]  = "+"  &
  ELS PAC("AND IT#<>" + I16 + " AND IT#<>" + I17 +      &
  " AND IT#<>" + I18 + " AND IT#<>" + I19 + " AND IT#<>" + I20 + " &") &
    IF SX1[1:1]  = "-" ELS " "
DEF SX6 CHA*70=PAC(" OR IT# = " + I21 + " OR IT# = " + I22  + &
" OR IT# = " + I23 + " OR IT# = " + I24 + " OR IT# = " + I25 + " &") &
    IF SX1[1:1]  = "+"  &
  ELS PAC("AND IT#<>" + I21 + " AND IT#<>" + I22 +      &
  " AND IT#<>" + I23 + " AND IT#<>" + I24 + " AND IT#<>" + I25 + " &") &
    IF SX1[1:1]  = "-" ELS " "
DEF SX7 CHA*70=PAC(" OR IT# = " + I26 + " OR IT# = " + I27      &
+ " OR IT# = " + I28 + " OR IT# = " + I29 + " OR IT# = " + I30) &
    IF SX1[1:1]  = "+"  &
  ELS PAC("AND IT#<>" + I26 + " AND IT#<>" + I27 +      &
  " AND IT#<>" + I28 + " AND IT#<>" + I29 + " AND IT#<>" + I30) &
    IF SX1[1:1]  = "-" ELS " "
DEF SX1-P1 CHA*20 = "DEF SX1 CHA*122 = &"
DEF SX1-P2 CHA*122 = PACK("'" + SX1 + "'")
REP SX2 SKI SX3 SKI SX4 SKI SX5 SKI SX6 SKI SX7 SKI SX1-P1 SKI SX1-P2
SET REP DEV DISC NAME Z709XX07 LIMIT 8
SET NOWAR NOHE NOST NODUP NOVER PAG LEN 0 WID 124
GO
;
;STEP  now pass back at the original subfile containing all of
;      the items in the file(or subfile) and use the use file
;      just created to select only the items the user requested
;      and report those items and affiliated data to a subfile.
CAN CLE
SET DEF
SET NOWARN NOSTAT
ACC *Z709XX06
USE Z709XX07 NOL
DEF ITNX CHA*24 = ITN[1:24] &
  IF ITN[1:1] NE "." AND ITN[1:1] NE "_" &
  ELSE ITN[2:24] IF ITN[2:1] NE "." AND ITN[2:1] NE "_" &
  ELSE ITN[3:24] IF ITN[3:1] NE "." AND ITN[3:1] NE "_"
SET SUBFILE NAME Z709XX08 KEEP
SET REP LIM 2000
REP SUMM IT# ITNX ITD
GO
;
;STEP now access the subfile containing the items the user
;     expressed interest in and use the usefile Z709XX00 to
;     pick up quiz set,sort,& select definitions,filename, etc.
;     Now using all this data create quiz source code which
;     will create the desired report.
CAN CLE
SET DEF
ACC *Z709XX08
USE Z709XX00 NOL
;
DEF A-IT# CHA*3 = ASCII(IT#,3)
DEF REP#0 CHA*11="TAB 1 " + "'" + A-IT# + "'"
DEF REP#1 CHA*38="TAB 5 " + "'" + ITNX + "'"
DEF REP#2 CHA*70="TAB 22 " + "'" + ITD + "'" + " SKI &"        &
  IF MODE3=1 ELS " " IF MODE3=0
DEF REP#3 CHA*48="TAB 1 " + ITNX + " SKI 2 &"  &
  IF MODE3= 1 ELS "TAB 30 " + ITNX + "    SKI 1 &"  IF MODE3=0
DEF HDP#0 CHA*80=PAC("TAB 1 " + "'IT#'"       &
  + "TAB 5 " + "'NAME'  &")  IF MODE3=1       &
  ELS PAC("TAB 1 " + "'IT#'" + "TAB 5 " + "'NAME'" + " TAB 30 "  &
  + "'VALUE'  &") IF MODE3=0
DEF HDP#1 CHA*80=PAC("TAB 22 " + "'TYPE' " + "& ")             &
  IF MODE3= 1 ELS ";"  IF MODE3=0
DEF HDP#2 CHA*80=PAC("TAB 29 " + "'SCALE' " + &
  "TAB 35 " + "'IS...OS' " + "TAB 44 " + "'PICTURE' " + "TAB 62 " &
  + "'(actual value) ->'" + "&") IF MODE3=1 ELS ";" IF MODE3=0
DEF HDP#3 CHA*80=PAC("SKI " + "TAB 1 " + "'---' " +  &
  "TAB 5 " + "'----' " +  &
  "TAB 22 " + "'----' " + " &")  IF MODE3=1 ELS PAC("SKI " +   &
  "TAB 1 " + "'---' " +  &
  "TAB 5 " + "'----' " + "TAB 30 " + "'-----'  SKI &") IF MODE3=0
DEF HDP#4 CHA*80=PAC("TAB 22 " + "'----' " + "TAB 29 " +        &
"'-----'"+"TAB 35 " + "'-------' "+"TAB 44 " + "'-------' SKI 2 &") &
  IF MODE3= 1 ELS ";"  IF MODE3=0
DEFINE HDP#5 CHA*78 =                                               &
 ("TAB 30 " + "'         1         2         3         4         5'" &
  + "SKI &") &
  IF MODE3= 0 ELSE                                                  &
  ("TAB 1" +   "'         1         2         3         4"          &
    + "         5         6'" + "SKI &")
DEFINE HDP#6 CHA*78 =                                               &
("TAB 30"+"'12345678901234567890123456789012345678901234567890'" &
   + " SKI 2")   &
  IF MODE3= 0 ELSE                                                  &
  ("TAB 1 " + "'1234567890123456789012345678901234567890"           &
  + "1234567890123456789012345'" + "SKI 2")
DEF REQUESTOR CHA*26 = &
PAC("'" + SIGNONUSER + " " + SIGNONGROUP + " " + SIGNONACCOUNT + "'")
;
DISP " "
DISP "The code generated can be found in Z709XX09."
DISP "Z709XX09 utilizes the 'use' file Z709XX03."
DISP " "
DISP "If prompted, please enter the record(s) key value(s)..."
DISP "If you are not concerned with a particular key value just"
DISP "enter CR and when asked if you want the whole file chosen"
DISP "just reply with a Y for yes."
DISP " "
INIT HEAD &
 "CAN CLE" SKI   "SET DEFAULT"         &
 SKI  ACCSTMNT SKI OD3 SKI RPL3        &
 SKI "USE Z709XX03 NOL"                &
 SKI 2 SZ3                             &
 SKI 2 SO3                             &
 SKI 2 "PAG HEA "    "'QZEZ709 of:'"     "FILEX &"                 &
 SKI "','"  "'Requestor:'"   REQUESTOR   "'"  SYSTIME  "'"   " &"  &
 SKI "'"  SYSDATE  "'"  "'Page Nbr:'"  "'" SYSPAGE "'"  "SKI 2 &"  &
 SKI TAB 1 "' "    SZ3    "' &"     &
 SKI TAB 1 "' "    SO3    "' &"     &
 SKI "SKI 2 & "                        &
 SKI HDP#0 SKI HDP#1 SKI HDP#2 SKI HDP#3 &
 SKI HDP#4 SKI HDP#5 SKI HDP#6 SKI 3 &
 "REPORT SKIP 2 &" SKI 3
;
REP REP#0 REP#1 " & " REP#2 REP#3 SKI 3
FIN FOO SKI                             &
  "'" "End of record # " "'"   "COUNT"     &
  SKI "GO"
;
SET BLANKS NOHE NOST NODUP PAG WID 90 LEN 0 REP LIM 2000
SET REP DEV DISC NAME Z709XX09
GO
;
;STEP now 'use' the code file then cleanup workfiles!
;
USE Z709XX09 NOL   ;DO NOT PURGE Z709XX03 & Z709XX09
;
:PURGE Z709XX00
:PURGE Z709XX01
:PURGE Z709XX02
:PURGE Z709XX04
:PURGE Z709XX05
:PURGE Z709XX06
:PURGE Z709XX07
:PURGE Z709XX08
:RESET QZEZ709X
:RESET QZEZ709Y
:RESET STD80