;"QZEZ729", AUTHOR: John F. Backus Version 3.0 (12/02/1998) ; An MPE/iX POWERHOUSE (COGNOS) QUIZ 7.29 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. There exists in this ; version (qzez729) commented code that if exchanged for the code ; that is not commented out, will present and output the ; occurences that are greater than 1 (up to a max of 24). ; 4. You must change the hardcoded 'RUN QUIZ' statement in this code. ;Recommendations: Drop into Quiz, then do a "use thiscode nolist" ; NOTE: QZEZ729 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) ; Define the file as either DIRECT. ; 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 Z729XX00 :PURGE Z729XX01 :PURGE Z729XX02 :PURGE Z729XX03 :PURGE Z729XX04 :PURGE Z729XX05 :PURGE Z729XX06 :PURGE Z729XX07 :PURGE Z729XX08 :PURGE Z729XX09 ;build a workfile and set some file equations to printer devices :BUILD Z729XX02;REC=-80,1,F,ASCII;DISC=2000 :FILE QZEZ729X;DEV=122,9,1 :FILE QZEZ729Y;DEV=LP,9,1 DISP " " DISP "QZEZ729 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 QZEZ729X'" & IF OD1=1 & ELS "DEF OD3 CHA*50='SET REP DEV PRIN NAME QZEZ729Y'" & 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 Z729XX00 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 Z729XX00, 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 Z729XX00 NOL DEF SHOWSTMNT CHA*20="SHOW ITEMS" DEF EXITSTMNT CHA*20="EXIT" SET REP DEV DISC NAME Z729XX01 REP ACCSTMNT SKI SHOWSTMNT SKI EXITSTMNT GO ; ;STEP using the use file Z729XX01 having the quiz statements ; necessary to derive quiz output of the file's items, run a ; subprocess of quiz using Z729XX01 as input, direct the output ; to the 80 byte file built earlier called Z729XX02. ; :RUN QUIZ.PH729C.COGNOS;INFO="AUTO=Z729XX01";STDLIST=Z729XX02 :PURGE QUIZSAVE,TEMP ; ;STEP there is no such file called Z729XX02 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=Z729XX02 ; ;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*" & AND DATA-LINE-80[1:3] <> "* *") 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 Z729XX03 REP KEYX SKI FILEX NOREP " " GO ; :FILE STD80=Z729XX02 ;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 Z729XX00 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*" & AND DATA-LINE-80[1:3] NE "* *") ) DEFINE NODUPS-RECORD CHA*78 = DATA-LINE-80[1:78] REPORT TAB 001 NODUPS-RECORD SET REPORT DEVICE DISC NAME Z729XX04 SET NODUP NOST NOBL NOHEAD NOVERIFY REP LIM 2000 PAG LEN 0 WID 80 GO ; ;****************************************************************** ; TO HAVE ONLY THE 1st occurence of any arrayed item be displayed ; and hence reported, use the following code instead of the code ; that follows this commented out section of code (30 lines) ; this will report to screen "arrayeditem (01)" instead of a list ; of all of the arrayed items as in "arrayeditem (01)...(nn)". Quiz ; does not allow reporting any but the 1st occurence? :FILE STD80=Z729XX04 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 Z729XX05 SET REP LIM 2000 PAG LEN 0 WID 80 NOHEAD NOSTAT NOVERIFY NOBLANKS GO ;****************************************************************** ;:FILE STD80=Z729XX04 ;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 DLP1-002 CHA*2 = DLP1 IF OCCUR-N GE 02 ELS " " ;DEF DLP1-003 CHA*2 = DLP1 IF OCCUR-N GE 03 ELS " " ;DEF DLP1-004 CHA*2 = DLP1 IF OCCUR-N GE 04 ELS " " ;DEF DLP1-005 CHA*2 = DLP1 IF OCCUR-N GE 05 ELS " " ;DEF DLP1-006 CHA*2 = DLP1 IF OCCUR-N GE 06 ELS " " ;DEF DLP1-007 CHA*2 = DLP1 IF OCCUR-N GE 07 ELS " " ;DEF DLP1-008 CHA*2 = DLP1 IF OCCUR-N GE 08 ELS " " ;DEF DLP1-009 CHA*2 = DLP1 IF OCCUR-N GE 09 ELS " " ;DEF DLP1-010 CHA*2 = DLP1 IF OCCUR-N GE 10 ELS " " ;DEF DLP1-011 CHA*2 = DLP1 IF OCCUR-N GE 11 ELS " " ;DEF DLP1-012 CHA*2 = DLP1 IF OCCUR-N GE 12 ELS " " ;DEF DLP1-013 CHA*2 = DLP1 IF OCCUR-N GE 13 ELS " " ;DEF DLP1-014 CHA*2 = DLP1 IF OCCUR-N GE 14 ELS " " ;DEF DLP1-015 CHA*2 = DLP1 IF OCCUR-N GE 15 ELS " " ;DEF DLP1-016 CHA*2 = DLP1 IF OCCUR-N GE 16 ELS " " ;DEF DLP1-017 CHA*2 = DLP1 IF OCCUR-N GE 17 ELS " " ;DEF DLP1-018 CHA*2 = DLP1 IF OCCUR-N GE 18 ELS " " ;DEF DLP1-019 CHA*2 = DLP1 IF OCCUR-N GE 19 ELS " " ;DEF DLP1-020 CHA*2 = DLP1 IF OCCUR-N GE 20 ELS " " ;DEF DLP1-021 CHA*2 = DLP1 IF OCCUR-N GE 21 ELS " " ;DEF DLP1-022 CHA*2 = DLP1 IF OCCUR-N GE 22 ELS " " ;DEF DLP1-023 CHA*2 = DLP1 IF OCCUR-N GE 23 ELS " " ;DEF DLP1-024 CHA*2 = DLP1 IF OCCUR-N GE 24 ELS " " ;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 DLP2-002 CHA*32 = PACK(DLP2[1:(L-PAREN - 1)] & ; + "(" + "02" + ")") IF L-PAREN GE 0 AND OCCUR-N GE 02 ELS " " ;DEF DLP2-003 CHA*32 = PACK(DLP2[1:(L-PAREN - 1)] & ; + "(" + "03" + ")") IF L-PAREN GE 0 AND OCCUR-N GE 03 ELS " " ;DEF DLP2-004 CHA*32 = PACK(DLP2[1:(L-PAREN - 1)] & ; + "(" + "04" + ")") IF L-PAREN GE 0 AND OCCUR-N GE 04 ELS " " ;DEF DLP2-005 CHA*32 = PACK(DLP2[1:(L-PAREN - 1)] & ; + "(" + "05" + ")") IF L-PAREN GE 0 AND OCCUR-N GE 05 ELS " " ;DEF DLP2-006 CHA*32 = PACK(DLP2[1:(L-PAREN - 1)] & ; + "(" + "06" + ")") IF L-PAREN GE 0 AND OCCUR-N GE 06 ELS " " ;DEF DLP2-007 CHA*32 = PACK(DLP2[1:(L-PAREN - 1)] & ; + "(" + "07" + ")") IF L-PAREN GE 0 AND OCCUR-N GE 07 ELS " " ;DEF DLP2-008 CHA*32 = PACK(DLP2[1:(L-PAREN - 1)] & ; + "(" + "08" + ")") IF L-PAREN GE 0 AND OCCUR-N GE 08 ELS " " ;DEF DLP2-009 CHA*32 = PACK(DLP2[1:(L-PAREN - 1)] & ; + "(" + "09" + ")") IF L-PAREN GE 0 AND OCCUR-N GE 09 ELS " " ;DEF DLP2-010 CHA*32 = PACK(DLP2[1:(L-PAREN - 1)] & ; + "(" + "10" + ")") IF L-PAREN GE 0 AND OCCUR-N GE 10 ELS " " ;DEF DLP2-011 CHA*32 = PACK(DLP2[1:(L-PAREN - 1)] & ; + "(" + "11" + ")") IF L-PAREN GE 0 AND OCCUR-N GE 11 ELS " " ;DEF DLP2-012 CHA*32 = PACK(DLP2[1:(L-PAREN - 1)] & ; + "(" + "12" + ")") IF L-PAREN GE 0 AND OCCUR-N GE 12 ELS " " ;DEF DLP2-013 CHA*32 = PACK(DLP2[1:(L-PAREN - 1)] & ; + "(" + "13" + ")") IF L-PAREN GE 0 AND OCCUR-N GE 13 ELS " " ;DEF DLP2-014 CHA*32 = PACK(DLP2[1:(L-PAREN - 1)] & ; + "(" + "14" + ")") IF L-PAREN GE 0 AND OCCUR-N GE 14 ELS " " ;DEF DLP2-015 CHA*32 = PACK(DLP2[1:(L-PAREN - 1)] & ; + "(" + "15" + ")") IF L-PAREN GE 0 AND OCCUR-N GE 15 ELS " " ;DEF DLP2-016 CHA*32 = PACK(DLP2[1:(L-PAREN - 1)] & ; + "(" + "16" + ")") IF L-PAREN GE 0 AND OCCUR-N GE 16 ELS " " ;DEF DLP2-017 CHA*32 = PACK(DLP2[1:(L-PAREN - 1)] & ; + "(" + "17" + ")") IF L-PAREN GE 0 AND OCCUR-N GE 17 ELS " " ;DEF DLP2-018 CHA*32 = PACK(DLP2[1:(L-PAREN - 1)] & ; + "(" + "18" + ")") IF L-PAREN GE 0 AND OCCUR-N GE 18 ELS " " ;DEF DLP2-019 CHA*32 = PACK(DLP2[1:(L-PAREN - 1)] & ; + "(" + "19" + ")") IF L-PAREN GE 0 AND OCCUR-N GE 19 ELS " " ;DEF DLP2-020 CHA*32 = PACK(DLP2[1:(L-PAREN - 1)] & ; + "(" + "20" + ")") IF L-PAREN GE 0 AND OCCUR-N GE 20 ELS " " ;DEF DLP2-021 CHA*32 = PACK(DLP2[1:(L-PAREN - 1)] & ; + "(" + "21" + ")") IF L-PAREN GE 0 AND OCCUR-N GE 21 ELS " " ;DEF DLP2-022 CHA*32 = PACK(DLP2[1:(L-PAREN - 1)] & ; + "(" + "22" + ")") IF L-PAREN GE 0 AND OCCUR-N GE 22 ELS " " ;DEF DLP2-023 CHA*32 = PACK(DLP2[1:(L-PAREN - 1)] & ; + "(" + "23" + ")") IF L-PAREN GE 0 AND OCCUR-N GE 23 ELS " " ;DEF DLP2-024 CHA*32 = PACK(DLP2[1:(L-PAREN - 1)] & ; + "(" + "24" + ")") IF L-PAREN GE 0 AND OCCUR-N GE 24 ELS " " ;DEF DLP3-001 CHA*6 = DLP3 IF OCCUR-N GE 01 ELS DLP3 ;DEF DLP3-002 CHA*6 = DLP3 IF OCCUR-N GE 02 ELS " " ;DEF DLP3-003 CHA*6 = DLP3 IF OCCUR-N GE 03 ELS " " ;DEF DLP3-004 CHA*6 = DLP3 IF OCCUR-N GE 04 ELS " " ;DEF DLP3-005 CHA*6 = DLP3 IF OCCUR-N GE 05 ELS " " ;DEF DLP3-006 CHA*6 = DLP3 IF OCCUR-N GE 06 ELS " " ;DEF DLP3-007 CHA*6 = DLP3 IF OCCUR-N GE 07 ELS " " ;DEF DLP3-008 CHA*6 = DLP3 IF OCCUR-N GE 08 ELS " " ;DEF DLP3-009 CHA*6 = DLP3 IF OCCUR-N GE 09 ELS " " ;DEF DLP3-010 CHA*6 = DLP3 IF OCCUR-N GE 10 ELS " " ;DEF DLP3-011 CHA*6 = DLP3 IF OCCUR-N GE 11 ELS " " ;DEF DLP3-012 CHA*6 = DLP3 IF OCCUR-N GE 12 ELS " " ;DEF DLP3-013 CHA*6 = DLP3 IF OCCUR-N GE 13 ELS " " ;DEF DLP3-014 CHA*6 = DLP3 IF OCCUR-N GE 14 ELS " " ;DEF DLP3-015 CHA*6 = DLP3 IF OCCUR-N GE 15 ELS " " ;DEF DLP3-016 CHA*6 = DLP3 IF OCCUR-N GE 16 ELS " " ;DEF DLP3-017 CHA*6 = DLP3 IF OCCUR-N GE 17 ELS " " ;DEF DLP3-018 CHA*6 = DLP3 IF OCCUR-N GE 18 ELS " " ;DEF DLP3-019 CHA*6 = DLP3 IF OCCUR-N GE 19 ELS " " ;DEF DLP3-020 CHA*6 = DLP3 IF OCCUR-N GE 20 ELS " " ;DEF DLP3-021 CHA*6 = DLP3 IF OCCUR-N GE 21 ELS " " ;DEF DLP3-022 CHA*6 = DLP3 IF OCCUR-N GE 22 ELS " " ;DEF DLP3-023 CHA*6 = DLP3 IF OCCUR-N GE 23 ELS " " ;DEF DLP3-024 CHA*6 = DLP3 IF OCCUR-N GE 24 ELS " " ;DEF DLP4-001 CHA*37= DLP4 IF OCCUR-N GE 01 ELS DLP4 ;DEF DLP4-002 CHA*37= DLP4 IF OCCUR-N GE 02 ELS " " ;DEF DLP4-003 CHA*37= DLP4 IF OCCUR-N GE 03 ELS " " ;DEF DLP4-004 CHA*37= DLP4 IF OCCUR-N GE 04 ELS " " ;DEF DLP4-005 CHA*37= DLP4 IF OCCUR-N GE 05 ELS " " ;DEF DLP4-006 CHA*37= DLP4 IF OCCUR-N GE 06 ELS " " ;DEF DLP4-007 CHA*37= DLP4 IF OCCUR-N GE 07 ELS " " ;DEF DLP4-008 CHA*37= DLP4 IF OCCUR-N GE 08 ELS " " ;DEF DLP4-009 CHA*37= DLP4 IF OCCUR-N GE 09 ELS " " ;DEF DLP4-010 CHA*37= DLP4 IF OCCUR-N GE 10 ELS " " ;DEF DLP4-011 CHA*37= DLP4 IF OCCUR-N GE 11 ELS " " ;DEF DLP4-012 CHA*37= DLP4 IF OCCUR-N GE 12 ELS " " ;DEF DLP4-013 CHA*37= DLP4 IF OCCUR-N GE 13 ELS " " ;DEF DLP4-014 CHA*37= DLP4 IF OCCUR-N GE 14 ELS " " ;DEF DLP4-015 CHA*37= DLP4 IF OCCUR-N GE 15 ELS " " ;DEF DLP4-016 CHA*37= DLP4 IF OCCUR-N GE 16 ELS " " ;DEF DLP4-017 CHA*37= DLP4 IF OCCUR-N GE 17 ELS " " ;DEF DLP4-018 CHA*37= DLP4 IF OCCUR-N GE 18 ELS " " ;DEF DLP4-019 CHA*37= DLP4 IF OCCUR-N GE 19 ELS " " ;DEF DLP4-020 CHA*37= DLP4 IF OCCUR-N GE 20 ELS " " ;DEF DLP4-021 CHA*37= DLP4 IF OCCUR-N GE 21 ELS " " ;DEF DLP4-022 CHA*37= DLP4 IF OCCUR-N GE 22 ELS " " ;DEF DLP4-023 CHA*37= DLP4 IF OCCUR-N GE 23 ELS " " ;DEF DLP4-024 CHA*37= DLP4 IF OCCUR-N GE 24 ELS " " ;DEF DLPA-001 CHA*78 = DLP1-001 + DLP2-001 + DLP3-001 + DLP4-001 ;DEF DLPA-002 CHA*78 = DLP1-002 + DLP2-002 + DLP3-002 + DLP4-002 ;DEF DLPA-003 CHA*78 = DLP1-003 + DLP2-003 + DLP3-003 + DLP4-003 ;DEF DLPA-004 CHA*78 = DLP1-004 + DLP2-004 + DLP3-004 + DLP4-004 ;DEF DLPA-005 CHA*78 = DLP1-005 + DLP2-005 + DLP3-005 + DLP4-005 ;DEF DLPA-006 CHA*78 = DLP1-006 + DLP2-006 + DLP3-006 + DLP4-006 ;DEF DLPA-007 CHA*78 = DLP1-007 + DLP2-007 + DLP3-007 + DLP4-007 ;DEF DLPA-008 CHA*78 = DLP1-008 + DLP2-008 + DLP3-008 + DLP4-008 ;DEF DLPA-009 CHA*78 = DLP1-009 + DLP2-009 + DLP3-009 + DLP4-009 ;DEF DLPA-010 CHA*78 = DLP1-010 + DLP2-010 + DLP3-010 + DLP4-010 ;DEF DLPA-011 CHA*78 = DLP1-011 + DLP2-011 + DLP3-011 + DLP4-011 ;DEF DLPA-012 CHA*78 = DLP1-012 + DLP2-012 + DLP3-012 + DLP4-012 ;DEF DLPA-013 CHA*78 = DLP1-013 + DLP2-013 + DLP3-013 + DLP4-013 ;DEF DLPA-014 CHA*78 = DLP1-014 + DLP2-014 + DLP3-014 + DLP4-014 ;DEF DLPA-015 CHA*78 = DLP1-015 + DLP2-015 + DLP3-015 + DLP4-015 ;DEF DLPA-016 CHA*78 = DLP1-016 + DLP2-016 + DLP3-016 + DLP4-016 ;DEF DLPA-017 CHA*78 = DLP1-017 + DLP2-017 + DLP3-017 + DLP4-017 ;DEF DLPA-018 CHA*78 = DLP1-018 + DLP2-018 + DLP3-018 + DLP4-018 ;DEF DLPA-019 CHA*78 = DLP1-019 + DLP2-019 + DLP3-019 + DLP4-019 ;DEF DLPA-020 CHA*78 = DLP1-020 + DLP2-020 + DLP3-020 + DLP4-020 ;DEF DLPA-021 CHA*78 = DLP1-021 + DLP2-021 + DLP3-021 + DLP4-021 ;DEF DLPA-022 CHA*78 = DLP1-022 + DLP2-022 + DLP3-022 + DLP4-022 ;DEF DLPA-023 CHA*78 = DLP1-023 + DLP2-023 + DLP3-023 + DLP4-023 ;DEF DLPA-024 CHA*78 = DLP1-024 + DLP2-024 + DLP3-024 + DLP4-024 ;REPORT TAB 001 DLPA-001 SKI 1 & ; TAB 001 DLPA-002 SKI 1 & ; TAB 001 DLPA-003 SKI 1 & ; TAB 001 DLPA-004 SKI 1 & ; TAB 001 DLPA-005 SKI 1 & ; TAB 001 DLPA-006 SKI 1 & ; TAB 001 DLPA-007 SKI 1 & ; TAB 001 DLPA-008 SKI 1 & ; TAB 001 DLPA-009 SKI 1 & ; TAB 001 DLPA-010 SKI 1 & ; TAB 001 DLPA-011 SKI 1 & ; TAB 001 DLPA-012 SKI 1 & ; TAB 001 DLPA-013 SKI 1 & ; TAB 001 DLPA-014 SKI 1 & ; TAB 001 DLPA-015 SKI 1 & ; TAB 001 DLPA-016 SKI 1 & ; TAB 001 DLPA-017 SKI 1 & ; TAB 001 DLPA-018 SKI 1 & ; TAB 001 DLPA-019 SKI 1 & ; TAB 001 DLPA-020 SKI 1 & ; TAB 001 DLPA-021 SKI 1 & ; TAB 001 DLPA-022 SKI 1 & ; TAB 001 DLPA-023 SKI 1 & ; TAB 001 DLPA-024 ;SET REPORT DEVICE DISC NAME Z729XX05 ;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=Z729XX05 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" & AND DATA-LINE-80[1:3] NE "* *") & OR (DATA-LINE-80[1:1] = "*" AND DATA-LINE-80[1:3] NE "*W*" & AND DATA-LINE-80[1:3] NE "* *") 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 Z729XX06 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 *Z729XX06 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 *Z729XX06 DISP "'*' = 'indexed' '.' = 'subitem' '_' = 'redefined'" DISP "ARRAYED ITEMS WILL HAVE ONLY THE FIRST OCCURENCE REPORTED." DISP "See code notes on how to adjust code to output occurences > 1" DISP " " DISP "You can now choose the item #'s that you want to report." 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 " " DISP "(Note: If you mess up, just break, abort and start over.)" 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 Z729XX07 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 *Z729XX06 USE Z729XX07 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 Z729XX08 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 Z729XX00 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 *Z729XX08 USE Z729XX00 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 Z729XX09." DISP "Z729XX09 utilizes the 'use' file Z729XX03." 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 Z729XX03 NOL" & SKI 2 SZ3 & SKI 2 SO3 & SKI 2 "PAG HEA " "'QZEZ729 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 Z729XX09 GO ; ;STEP now 'use' the code file then cleanup workfiles! ; USE Z729XX09 NOL ;DO NOT PURGE Z729XX03 & Z729XX09 ; :PURGE Z729XX00 :PURGE Z729XX01 :PURGE Z729XX02 :PURGE Z729XX04 :PURGE Z729XX05 :PURGE Z729XX06 :PURGE Z729XX07 :PURGE Z729XX08 :RESET QZEZ729X :RESET QZEZ729Y :RESET STD80