;"QZREP709", AUTHOR: John F. Backus Version 3.0 (12/02/1998) ; An MPE/iX, POWERHOUSE (COGNOS) QUIZ 7.09 DEVELOPMENT TOOL. ; Courtesy of Beechglen Development, Inc. ; The user accepts full responsibility for use of this software. ; NOTE: QZREP709 is made available to anyone for their free usage ; given that the name of Beechglen Development, Inc. and the ; name of the author: John F. Backus remain in code & banner. ; This code is released as freeware. In no circumstances shall ; Beechglen Development be held responsible for its use. ; QZREP709 requires that the PowerHouse dictionary have defined in ; it: (DIRECT) FILE STD220, REC STD220, ELE DATA-LINE-220 of X(220) ;Recommendations: Drop into Quiz, then do a "use thiscode nolist" ; QZREP709 requires that the Powerhouse dictionary have defined in ; it: (DIRECT) FILE STD220, REC STD220, ELE DATA-LINE-220 of X(220) ; known QZREP709 limitations: ; 1. only the first 24 occurences of arrayed items are reported ; 2. identically named items (multiple file access), are not ; qualified in output with the 'of filename' qualifier. ; 3. when a Numeric item has > 12 output positions, QUIZ's SHOW ITEMS ; statement produces an output picture like "^^^^^^^^^^^^..." ; which indicates a number of 13 to NN bytes. A typical large ; number, Integer Signed Size 8, allows 18 positions plus a sign. ; when this code encounters "^^^^^^^^^^^..." we will check ; the value of the Powerhouse value SIGNONACCOUNT and set ; the value of HUGE-NBR-DEFAULT-SIZE to be NN accordingly per ; whatever hardcoded account names are found. If the account ; is not found in the quiz code's case structure, then we assume ; an integer signed size 8 item and default the field length ; to an output size of 19 (see string "HUGE-NUMBER" in code). if ; the # is > 19 in actual length, then this creates an error. ; 4. A maximum of 999 ACCESSED items can be handled ; 5. data conversion errors are reported when the TAB values exceed ; 999. items can be shown with TAB values past what is realistic ; (such as up to 132 or 220 byte values), as in TAB 377. ; 6. Subitems are only correctly processed to 3 levels 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 ".." ; 7. This code, by default display up to 24 occurences of any ; arrayed items as individual items to be selected. There exists ; a section of code in this program that can be swapped in (the ; default code being swapped out--uncomment/comment out code) ; to have only the FIRST occurence of any arrayed item presented. ; Look for the string 'TO HAVE ONLY THE' in the code ; 8. You must change the hardcoded 'RUN QUIZ' statement in this code. :PURGE Z709SH00 :PURGE Z709SH01 :PURGE Z709SH02 :PURGE Z709SH03 :PURGE Z709SH04 :PURGE Z709SH05 :PURGE Z709SH05 :PURGE Z709SH06 :PURGE Z709SH07 :PURGE Z709SH08 :PURGE Z709SH09 :PURGE Z709SH10 :PURGE Z709SH11 :PURGE Z709SH12 :PURGE Z709SH66 :PURGE Z709SH77 :PURGE Z709SH99 ;make Z709sh02 max file length = 2 times largest file's # of items :BUILD Z709SH02;REC=-220,1,F,ASCII;DISC=2000 DISP "QZREP709 Version 3.0 (Author: John F. Backus)" DISP " (Courtesy of Beechglen Development, Inc.)" DISP " " DISP " QZREP709 creates 3 files: Z709SH11, Z709SH12, and Z709DLIM." DISP " These can be utilized as a shortcut in code development." DISP " Z709SH11 = a QUIZ 'usefile' for the file Z709SH12." DISP " Z709SH12 = QUIZ or QTP source, creates a report or subfile." DISP " Z709SH66 = a QTP 'usefile', available for Z709SH99." DISP " Z709SH99 = QTP source, creates an ascii delimitted file." DISP " QZREP709 will now ask you a few questions." DISP " You will be able to answer them by basing your answers" DISP " upon the data shown and upon your knowledge of POWERHOUSE." DISP " If a question asked no longer applies to your task at hand," DISP " just ignore it by pressing CR (carriage return)." DISP " " CAN CLE SET DEF DISP "You may now use a MAX of 200 characters to define file access." DISP " Here are three examples showing valid access information:" DISP " ->ORDERS ... ->*ORDSUB ... ->*ORDSUB LINK TO INVENTORY-MASTER" DISP " " ;200 since some QZREP709 versions utilize a 200 byte file DEF FN1 CHA*200=PARM PROMPT & "(?) Enter filename or *subfilename?->" ON ERRORS REPROMPT 2 TIMES DEF AX CHA*218 = PACK("DEF AX CHA*204='ACC " + FN1 + "'") REP AX SET NOBL NOHE NOST NODUP NOVE NOWAR PAG WID 220 LEN 0 REP LIM 1 SET REP DEV DISC NAME Z709SH00 GO ;STEP using Z709SH00's DEFd access statement, create a usefile ; having data necessary to give a quiz show items of the file CAN CLE SET DEF USE Z709SH00 NOL DEF SHOWSTMNT CHA*10="SHOW ITEMS" DEF EXITSTMNT CHA*04="EXIT" SET REP DEV DISC NAME Z709SH01 SET NOBL NOHE NOST NODUP NOWAR REP LIM 1 PAG WID 220 LEN 0 REP AX SKI SHOWSTMNT SKI EXITSTMNT GO ;STEP using the use file qzxxshw1 having the quiz statements ; necessary to derive quiz output of the file's items, run a ; subprocess of quiz using qzxxshw1 as input, direct the output ; to the 220 byte file built earlier called qzxxshw2. :RUN QUIZ.PH709E.COGNOS;INFO="AUTO=Z709SH01";STDLIST=Z709SH02 :PURGE QUIZSAVE,TEMP ;STEP there is no such file called qzxxshw2 in the dictionary, ; but by convention we have previously DEFd a file called ; STD220 which has one element: DATA-LINE-220 which we can 'file ; equate' to allow processing of any 220 byte file. :FILE STD220=Z709SH02 ;remove duplicate records created by redirect Quiz output now. Also ;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... ACC STD220 DEF IGNOR2 CHA*1 = PARM PROMPT & "(?) Ignore all subitems and redefined items (N) (Y/N)->" & UPSHIFT ON ERRORS REPROMPT 2 TIMES DEF REJECT-RECORD CHA*1 = & "Y" IF ((DATA-LINE-220[3:1] = "." & OR DATA-LINE-220[3:1] = "_") & AND IGNOR2 = "Y") & ELSE "N" SEL IF ( (DATA-LINE-220[2:1]=" " AND DATA-LINE-220[3:1] NE " " & AND DATA-LINE-220[1:3] NE "Q U") & AND (REJECT-RECORD = "N") & OR (DATA-LINE-220[1:1] = "*" & AND DATA-LINE-220[1:3] NE "*W*") ) DEF DATA-LINE-78 CHA*78 = DATA-LINE-220 SET REPORT DEVICE DISC NAME Z709SH03 SET PAG LEN 0 WID 220 NOHEAD NOSTAT NOVERIFY SET NOBL NOST NODUP REP LIM 2000 ;NODUP VERY VERY IMPORTANT HERE! REP TAB 001 DATA-LINE-78 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) ;:FILE STD220=Z709SH03 ;SET DEF ;CAN CLE ;ACC STD220 ;DEF DLP1 CHA*2 = DATA-LINE-220[1:2] ;DEF DLP2 CHA*31 = DATA-LINE-220[3:31] ;Quiz 7.09 allows 31 byte names ;DEF DLP3 CHA*6 = DATA-LINE-220[32:6] ;DEF DLP4 CHA*37 = DATA-LINE-220[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 Z709SH04 ;SET REP LIM 2000 PAG LEN 0 WID 220 NOHEAD NOSTAT NOVERIFY NOBLANKS ;GO ; ;****************************************************************** :FILE STD220=Z709SH03 SET DEF CAN CLE ACC STD220 DEF DLP1 CHA*2 = DATA-LINE-220[1:2] DEF DLP2 CHA*31 = DATA-LINE-220[3:31] DEF DLP3 CHA*6 = DATA-LINE-220[32:6] DEF DLP4 CHA*37 = DATA-LINE-220[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 Z709SH04 SET REP LIM 2000 PAG LEN 0 WID 220 NOHEAD NOSTAT NOVERIFY NOBLANKS GO ; ;STEP now accessing our 'expanded' list of items, create a ; subfile having DEFd items equal to the item-names and ; the item-descriptions. also assign a sequential item nbr :FILE STD220=Z709SH04 SET DEF CAN CLE ACC STD220 SEL IF (DATA-LINE-220[2:1]=" " AND DATA-LINE-220[3:1] NE " " & AND DATA-LINE-220[1:3] NE "Q U") & OR (DATA-LINE-220[1:1] = "*" AND DATA-LINE-220[1:3] NE "*W*") DEF IT# NUM*3 = 1 ;this here basically limits # items to 999 DEF ITX CHA*1 = "." & IF DATA-LINE-220[3:1] = "." & ELS "*" IF DATA-LINE-220[1:1] = "*" & ELS "_" IF DATA-LINE-220[3:1] = "_" DEF ITN CHA*36 = DATA-LINE-220[3:36] IF DATA-LINE-220[3:1] NE "." & AND DATA-LINE-220[3:1] NE "_" & ELSE DATA-LINE-220[4:35] IF DATA-LINE-220[3:1] EQ "." & ;a sub item OR DATA-LINE-220[3:1] EQ "_" ;redefined item DEF ITD CHA*37 = DATA-LINE-220[41:37] SET SUBFILE NAME Z709SH05 KEEP SET NOBL NOST NODUP REP LIM 2000 ;NODUP VERY VERY IMPORTANT HERE! REP SUMM IT# SUBTOTAL ITX ITN ITD GO ; ;STEP access the subfile and report the info to the screen ; CAN CLE SET DEF ACC *Z709SH05 DEF IT#2 CHAR*3 = ASCII(IT#,3) INIT HEAD TAB 1 "### Item Name" TAB 41 "### Item Name" & SKI TAB 1 "--- ---------" TAB 41 "--- ---------" DEF REP-LINE CHA*39 = PACK(IT#2 + ITX + ITN) REP TAB 1 REP-LINE 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 accept from the user the item nbrs desired. Then parse the ; data the user entered to create a large select statement CAN CLE SET DEF ACC *Z709SH05 DISP "Multi file linkage may present items having the same name." DISP "The code generated by QZREP709 will require the addition of" DISP "the 'OF FILENAME' qualifier for non-uniquely named items." DISP "'*' = 'indexed' '.' = 'subitem' '_' = 'redefined'" DISP "ARRAYED ITEMS WILL HAVE ONLY THE FIRST 24 OCCURENCES REPORTED." DISP "If necessary, adjust QZREP709's output to get occurences > 24." DISP " " DISP "Using the list of items above, choose the items that you want" DISP "to have reported. They will be reported in the order that" DISP "you enter them. NOTE: LEADING ZEROES (0's) ARE REQUIRED." DISP "Up to 49, 3-digit #'s can be included or excluded. To select" DISP "all of the #'s, press 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 "(Note: If you mess up, just break, abort and start over.)" DISP " " ;3 * 49 = 147 plus (possible ',') 48 = 195 plus '+' or '-' char =196 DEF SX1 CHA*196 = 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 I31 CHA*3 = SX1[122:3] IF SX1[122:3] NE ' ' ELS '0' DEF I32 CHA*3 = SX1[126:3] IF SX1[126:3] NE ' ' ELS '0' DEF I33 CHA*3 = SX1[130:3] IF SX1[130:3] NE ' ' ELS '0' DEF I34 CHA*3 = SX1[134:3] IF SX1[134:3] NE ' ' ELS '0' DEF I35 CHA*3 = SX1[138:3] IF SX1[138:3] NE ' ' ELS '0' DEF I36 CHA*3 = SX1[142:3] IF SX1[142:3] NE ' ' ELS '0' DEF I37 CHA*3 = SX1[146:3] IF SX1[146:3] NE ' ' ELS '0' DEF I38 CHA*3 = SX1[150:3] IF SX1[150:3] NE ' ' ELS '0' DEF I39 CHA*3 = SX1[154:3] IF SX1[154:3] NE ' ' ELS '0' DEF I40 CHA*3 = SX1[158:3] IF SX1[158:3] NE ' ' ELS '0' DEF I41 CHA*3 = SX1[162:3] IF SX1[162:3] NE ' ' ELS '0' DEF I42 CHA*3 = SX1[166:3] IF SX1[166:3] NE ' ' ELS '0' DEF I43 CHA*3 = SX1[170:3] IF SX1[170:3] NE ' ' ELS '0' DEF I44 CHA*3 = SX1[174:3] IF SX1[174:3] NE ' ' ELS '0' DEF I45 CHA*3 = SX1[178:3] IF SX1[178:3] NE ' ' ELS '0' DEF I46 CHA*3 = SX1[182:3] IF SX1[182:3] NE ' ' ELS '0' DEF I47 CHA*3 = SX1[186:3] IF SX1[186:3] NE ' ' ELS '0' DEF I48 CHA*3 = SX1[190:3] IF SX1[190:3] NE ' ' ELS '0' DEF I49 CHA*3 = SX1[194:3] IF SX1[194: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 SX8 CHA*70=PAC(" OR IT#= " + I31 + " OR IT#= " + I32 & + " OR IT#= " + I33 + " OR IT#= " + I34 + " OR IT#= " + I35 + " &") & IF SX1[1:1] = "+" & ELS PAC("AND IT#<>" + I31 + " AND IT#<>" + I32 + & " AND IT#<>" + I33 + " AND IT#<>" + I34 + " AND IT#<>" + I35 + " &") & IF SX1[1:1] = "-" ELS " " DEF SX9 CHA*70=PAC(" OR IT#= " + I36 + " OR IT#= " + I37 & + " OR IT#= " + I38 + " OR IT#= " + I39 + " OR IT#= " + I40 + " &") & IF SX1[1:1] = "+" & ELS PAC("AND IT#<>" + I36 + " AND IT#<>" + I37 + & " AND IT#<>" + I38 + " AND IT#<>" + I39 + " AND IT#<>" + I40 + " &") & IF SX1[1:1] = "-" ELS " " DEF SX10 CHA*70=PAC(" OR IT#= " + I41 + " OR IT#= " + I42 & + " OR IT#= " + I43 + " OR IT#= " + I44 + " OR IT#= " + I45 + " &") & IF SX1[1:1] = "+" & ELS PAC("AND IT#<>" + I41 + " AND IT#<>" + I42 + & " AND IT#<>" + I43 + " AND IT#<>" + I44 + " AND IT#<>" + I45 + " &") & IF SX1[1:1] = "-" ELS " " DEF SX11 CHA*70=PAC(" OR IT#= " + I46 + " OR IT#= " + I47 & + " OR IT#= " + I48 + " OR IT#= " + I49) & IF SX1[1:1] = "+" & ELS PAC("AND IT#<>" + I46 + " AND IT#<>" + I47 + & " AND IT#<>" + I48 + " AND IT#<>" + I49) & IF SX1[1:1] = "-" ELS " " DEF SX1-P1 CHA*20 = "DEF SX1 CHA*196 = &" DEF SX1-P2 CHA*198 = PACK("'" + SX1 + "'") REP SX2 SKI SX3 SKI SX4 SKI SX5 SKI SX6 SKI SX7 SKI & SX8 SKI SX9 SKI SX10 SKI SX11 SKI SX1-P1 SKI SX1-P2 SET REP DEV DISC NAME Z709SH06 LIMIT 8 SET NOWAR NOHE NOST NODUP NOVER PAG LEN 0 WID 220 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 ACC *Z709SH05 USE Z709SH06 NOL DEF A-IT# CHA*3 = ASCII(IT#,3) DEF SEL-REQUEST CHA*1 = "Y" IF SX1 NE " " ELSE "N" DEF REP-SEQ NUM*3 = & 1 IF A-IT#=SX1[1:3] AND SEL-REQUEST = "Y" & ELS 2 IF A-IT#=SX1[5:3] AND SEL-REQUEST = "Y" & ELS 3 IF A-IT#=SX1[9:3] AND SEL-REQUEST = "Y" & ELS 4 IF A-IT#=SX1[13:3] AND SEL-REQUEST = "Y" & ELS 5 IF A-IT#=SX1[17:3] AND SEL-REQUEST = "Y" & ELS 6 IF A-IT#=SX1[21:3] AND SEL-REQUEST = "Y" & ELS 7 IF A-IT#=SX1[25:3] AND SEL-REQUEST = "Y" & ELS 8 IF A-IT#=SX1[29:3] AND SEL-REQUEST = "Y" & ELS 9 IF A-IT#=SX1[33:3] AND SEL-REQUEST = "Y" & ELS 10 IF A-IT#=SX1[37:3] AND SEL-REQUEST = "Y" & ELS 11 IF A-IT#=SX1[41:3] AND SEL-REQUEST = "Y" & ELS 12 IF A-IT#=SX1[45:3] AND SEL-REQUEST = "Y" & ELS 13 IF A-IT#=SX1[49:3] AND SEL-REQUEST = "Y" & ELS 14 IF A-IT#=SX1[53:3] AND SEL-REQUEST = "Y" & ELS 15 IF A-IT#=SX1[57:3] AND SEL-REQUEST = "Y" & ELS 16 IF A-IT#=SX1[61:3] AND SEL-REQUEST = "Y" & ELS 17 IF A-IT#=SX1[65:3] AND SEL-REQUEST = "Y" & ELS 18 IF A-IT#=SX1[69:3] AND SEL-REQUEST = "Y" & ELS 19 IF A-IT#=SX1[73:3] AND SEL-REQUEST = "Y" & ELS 20 IF A-IT#=SX1[77:3] AND SEL-REQUEST = "Y" & ELS 21 IF A-IT#=SX1[81:3] AND SEL-REQUEST = "Y" & ELS 22 IF A-IT#=SX1[85:3] AND SEL-REQUEST = "Y" & ELS 23 IF A-IT#=SX1[89:3] AND SEL-REQUEST = "Y" & ELS 24 IF A-IT#=SX1[93:3] AND SEL-REQUEST = "Y" & ELS 25 IF A-IT#=SX1[97:3] AND SEL-REQUEST = "Y" & ELS 26 IF A-IT#=SX1[101:3] AND SEL-REQUEST = "Y" & ELS 27 IF A-IT#=SX1[105:3] AND SEL-REQUEST = "Y" & ELS 28 IF A-IT#=SX1[109:3] AND SEL-REQUEST = "Y" & ELS 29 IF A-IT#=SX1[113:3] AND SEL-REQUEST = "Y" & ELS 30 IF A-IT#=SX1[117:3] AND SEL-REQUEST = "Y" & ELS 31 IF A-IT#=SX1[121:3] AND SEL-REQUEST = "Y" & ELS 32 IF A-IT#=SX1[125:3] AND SEL-REQUEST = "Y" & ELS 33 IF A-IT#=SX1[129:3] AND SEL-REQUEST = "Y" & ELS 34 IF A-IT#=SX1[133:3] AND SEL-REQUEST = "Y" & ELS 35 IF A-IT#=SX1[137:3] AND SEL-REQUEST = "Y" & ELS 36 IF A-IT#=SX1[141:3] AND SEL-REQUEST = "Y" & ELS 37 IF A-IT#=SX1[145:3] AND SEL-REQUEST = "Y" & ELS 38 IF A-IT#=SX1[149:3] AND SEL-REQUEST = "Y" & ELS 39 IF A-IT#=SX1[153:3] AND SEL-REQUEST = "Y" & ELS 40 IF A-IT#=SX1[157:3] AND SEL-REQUEST = "Y" & ELS 41 IF A-IT#=SX1[161:3] AND SEL-REQUEST = "Y" & ELS 42 IF A-IT#=SX1[165:3] AND SEL-REQUEST = "Y" & ELS 43 IF A-IT#=SX1[169:3] AND SEL-REQUEST = "Y" & ELS 44 IF A-IT#=SX1[173:3] AND SEL-REQUEST = "Y" & ELS 45 IF A-IT#=SX1[177:3] AND SEL-REQUEST = "Y" & ELS 46 IF A-IT#=SX1[181:3] AND SEL-REQUEST = "Y" & ELS 47 IF A-IT#=SX1[185:3] AND SEL-REQUEST = "Y" & ELS 48 IF A-IT#=SX1[189:3] AND SEL-REQUEST = "Y" & ELS 49 IF A-IT#=SX1[193:3] AND SEL-REQUEST = "Y" & ELS NCONVERT(A-IT#) SORT ON REP-SEQ SET SUBF NAME Z709SH07 KEEP SET REP LIM 2000 NOWAR NOSTA REP SUMM REP-SEQ ITN ITD GO CAN CLE SET DEF ACC *Z709SH07 REPORT DEFINE CNT-CHA-ITEMS NUM*6 = 1 IF ITD[1:1] = "C" ELS 0 DEFINE CNT-NUM-ITEMS NUM*6 = 1 IF ITD[1:1] <> "C" ELS 0 FIN FOO "DEF LAST-REQ-ITEM NUM*3 =" REP-SEQ & SKI 2 "DEF CNT-CHA-ITEMS NUM*3 =" CNT-CHA-ITEMS SUBTOTAL & SKI 2 "DEF CNT-NUM-ITEMS NUM*3 =" CNT-NUM-ITEMS SUBTOTAL SET NOBL NOHE NOST NODUP NOVE NOWAR PAG WID 78 LEN 0 REP LIM 2000 SET REP DEV DISC NAME Z709SH08 GO CAN CLE SET DEF ACC *Z709SH07 ;quiz show items output picture begins in byte 23 of ITD DEF R-ITD CHA*15=ITD[37:1] + ITD[36:1] + ITD[35:1] + ITD[34:1] & +ITD[33:1] + ITD[32:1] + ITD[31:1] + ITD[30:1] & +ITD[29:1] + ITD[28:1] + ITD[27:1] + ITD[26:1] & +ITD[25:1] + ITD[24:1] + ITD[23:1] IF ITD[1:1] <> "C" DEF R-ITD-CARET-1 NUM*6 = 1 IF ITD[23:1] = "^" AND ITD[1:1] <> "C" DEF R-ITD-CARET-2 NUM*6 = 1 IF ITD[24:1] = "^" AND ITD[1:1] <> "C" DEF R-ITD-CARET-3 NUM*6 = 1 IF ITD[25:1] = "^" AND ITD[1:1] <> "C" DEF R-ITD-CARET-4 NUM*6 = 1 IF ITD[26:1] = "^" AND ITD[1:1] <> "C" DEF R-ITD-CARET-5 NUM*6 = 1 IF ITD[27:1] = "^" AND ITD[1:1] <> "C" DEF R-ITD-CARET-6 NUM*6 = 1 IF ITD[28:1] = "^" AND ITD[1:1] <> "C" DEF R-ITD-CARET-7 NUM*6 = 1 IF ITD[29:1] = "^" AND ITD[1:1] <> "C" DEF R-ITD-CARET-8 NUM*6 = 1 IF ITD[30:1] = "^" AND ITD[1:1] <> "C" DEF R-ITD-CARET-9 NUM*6 = 1 IF ITD[31:1] = "^" AND ITD[1:1] <> "C" DEF R-ITD-CARET-10 NUM*6 = 1 IF ITD[32:1] = "^" AND ITD[1:1] <> "C" DEF R-ITD-CARET-11 NUM*6 = 1 IF ITD[33:1] = "^" AND ITD[1:1] <> "C" DEF R-ITD-CARET-12 NUM*6 = 1 IF ITD[34:1] = "^" AND ITD[1:1] <> "C" DEF R-ITD-CARET-13 NUM*6 = 1 IF ITD[35:1] = "^" AND ITD[1:1] <> "C" DEF R-ITD-CARET-14 NUM*6 = 1 IF ITD[36:1] = "^" AND ITD[1:1] <> "C" DEF R-ITD-CARET-15 NUM*6 = 1 IF ITD[37:1] = "^" AND ITD[1:1] <> "C" DEF NONC-CARETS-ONLY NUM*6 = & (R-ITD-CARET-1 + R-ITD-CARET-2 + R-ITD-CARET-3 + R-ITD-CARET-4 & +R-ITD-CARET-5 + R-ITD-CARET-6 + R-ITD-CARET-7 + R-ITD-CARET-8 & +R-ITD-CARET-9 + R-ITD-CARET-10 + R-ITD-CARET-11 + R-ITD-CARET-12 & +R-ITD-CARET-13 + R-ITD-CARET-14 + R-ITD-CARET-15) IF ITD[1:1]<> "C" DEF NONC-#TRAILSPACES NUM*2 = & 15 IF ITD[1:1] <> "C" AND R-ITD[01:15]=" " ELSE & 14 IF ITD[1:1] <> "C" AND R-ITD[01:14]=" " ELSE & 13 IF ITD[1:1] <> "C" AND R-ITD[01:13]=" " ELSE & 12 IF ITD[1:1] <> "C" AND R-ITD[01:12]=" " ELSE & 11 IF ITD[1:1] <> "C" AND R-ITD[01:11]=" " ELSE & 10 IF ITD[1:1] <> "C" AND R-ITD[01:10]=" " ELSE & 9 IF ITD[1:1] <> "C" AND R-ITD[01:09]=" " ELSE & 8 IF ITD[1:1] <> "C" AND R-ITD[01:08]=" " ELSE & 7 IF ITD[1:1] <> "C" AND R-ITD[01:07]=" " ELSE & 6 IF ITD[1:1] <> "C" AND R-ITD[01:06]=" " ELSE & 5 IF ITD[1:1] <> "C" AND R-ITD[01:05]=" " ELSE & 4 IF ITD[1:1] <> "C" AND R-ITD[01:04]=" " ELSE & 3 IF ITD[1:1] <> "C" AND R-ITD[01:03]=" " ELSE & 2 IF ITD[1:1] <> "C" AND R-ITD[01:02]=" " ELSE & 1 IF ITD[1:1] <> "C" AND R-ITD[01:01]=" " ELSE 0 DEF NONC-NOTRAILSP NUM*2= (15 - NONC-#TRAILSPACES) IF ITD[1:1] <> "C" DEF DATE-08-1 NUM*6 = INDEX(ITD,"YYYY/MM/DD") IF ITD[1:1] = "D" DEF DATE-08-2 NUM*6 = INDEX(ITD,"YYYYMMDD") IF ITD[1:1] = "D" DEF DATE-06-1 NUM*6 = INDEX(ITD,"YY/MM/DD") IF ITD[1:1] = "D" DEF DATE-06-2 NUM*6 = INDEX(ITD,"MM/DD/YY") IF ITD[1:1] = "D" DEF DATE-06-3 NUM*6 = INDEX(ITD,"DD/MM/YY") IF ITD[1:1] = "D" DEF DATE-06-4 NUM*6 = INDEX(ITD,"YYYY/MM") IF ITD[1:1] = "D" DEF DATE-06-5 NUM*6 = INDEX(ITD,"YYYY/DD") IF ITD[1:1] = "D" DEF DATE-06-6 NUM*6 = INDEX(ITD,"YYYYMM") IF ITD[1:1] = "D" DEF DATE-06-7 NUM*6 = INDEX(ITD,"YYYYDD") IF ITD[1:1] = "D" DEF DATE-06-8 NUM*6 = INDEX(ITD,"DDYYYY") IF ITD[1:1] = "D" DEF DATE-06-9 NUM*6 = INDEX(ITD,"MMYYYY") IF ITD[1:1] = "D" DEF DATE-05-1 NUM*6 = INDEX(ITD,"DDD/YY") IF ITD[1:1] = "D" DEF DATE-05-2 NUM*6 = INDEX(ITD,"YY/DDD") IF ITD[1:1] = "D" DEF DATE-04-1 NUM*6 = INDEX(ITD,"MM/DD") IF ITD[1:1] = "D" DEF DATE-04-2 NUM*6 = INDEX(ITD,"DD/MM") IF ITD[1:1] = "D" DEF DATE-04-3 NUM*6 = INDEX(ITD,"YYYY") IF ITD[1:1] = "D" DEF DATE-04-4 NUM*6 = INDEX(ITD,"MMDD") IF ITD[1:1] = "D" DEF DATE-03-1 NUM*6 = INDEX(ITD,"DDD") IF ITD[1:1] = "D" DEF DATE-02-1 NUM*6 = INDEX(ITD,"YY") IF ITD[1:1] = "D" DEF DATE-02-2 NUM*6 = INDEX(ITD,"MM") IF ITD[1:1] = "D" DEF DATE-02-3 NUM*6 = INDEX(ITD,"DD") IF ITD[1:1] = "D" DEF DATE-DIGITS-ONLY NUM*2 =& 08 IF DATE-08-1 <> 0 AND ITD[1:1] = "D" ELS & 08 IF DATE-08-2 <> 0 AND ITD[1:1] = "D" ELS & 06 IF DATE-06-1 <> 0 AND ITD[1:1] = "D" ELS & 06 IF DATE-06-2 <> 0 AND ITD[1:1] = "D" ELS & 06 IF DATE-06-3 <> 0 AND ITD[1:1] = "D" ELS & 06 IF DATE-06-4 <> 0 AND ITD[1:1] = "D" ELS & 06 IF DATE-06-5 <> 0 AND ITD[1:1] = "D" ELS & 06 IF DATE-06-6 <> 0 AND ITD[1:1] = "D" ELS & 06 IF DATE-06-7 <> 0 AND ITD[1:1] = "D" ELS & 06 IF DATE-06-8 <> 0 AND ITD[1:1] = "D" ELS & 06 IF DATE-06-9 <> 0 AND ITD[1:1] = "D" ELS & 05 IF DATE-05-1 <> 0 AND ITD[1:1] = "D" ELS & 05 IF DATE-05-2 <> 0 AND ITD[1:1] = "D" ELS & 04 IF DATE-04-1 <> 0 AND ITD[1:1] = "D" ELS & 04 IF DATE-04-2 <> 0 AND ITD[1:1] = "D" ELS & 04 IF DATE-04-3 <> 0 AND ITD[1:1] = "D" ELS & 04 IF DATE-04-4 <> 0 AND ITD[1:1] = "D" ELS & 03 IF DATE-03-1 <> 0 AND ITD[1:1] = "D" ELS & 02 IF DATE-02-1 <> 0 AND ITD[1:1] = "D" ELS & 02 IF DATE-02-2 <> 0 AND ITD[1:1] = "D" ELS & 02 IF DATE-02-3 <> 0 AND ITD[1:1] = "D" ELS 0 ;quiz show items output has a limitation in actually telling us the ;number of positions when number get really large as in the case of ;integer size 6 and integer size 8, in this case we will assume the ;largest case of integer size 8, which is 19 positions (18 + sign) ;HUGE-NUMBER-1 allows us to 'override' or 'bypass' other x-CNT data DEF HUGE-NUMBER-1 NUM*6 = INDEX(ITD,"...") IF ITD[1:1] = "N" DEF X-SIGNONACCOUNT CHA*8 = SIGNONACCOUNT DEF HUGE-NBR-DEFAULT-SIZE NUM*6 = CASE OF X-SIGNONACCOUNT & WHEN "ACCOUNT1" THEN 16 & WHEN "ACCOUNT2" THEN 16 & DEFAULT 19 DEF R-ITEM-LGTH NUM*4 = & HUGE-NBR-DEFAULT-SIZE IF HUGE-NUMBER-1 <> 0 AND ITD[1:1] = "N" ELS & NCONV(ITD[25:4]) IF ITD[1:1] = "C" AND ITD[29:1] EQ ")" ELS & NCONV(ITD[25:3]) IF ITD[1:1] = "C" AND ITD[28:1] EQ ")" ELS & NCONV(ITD[25:2]) IF ITD[1:1] = "C" AND ITD[27:1] EQ ")" ELS & NCONV(ITD[25:1]) IF ITD[1:1] = "C" AND ITD[26:1] EQ ")" ELS & (NONC-NOTRAILSP) IF ITD[1:1] <> "C" DEF R-FLD-LGTHS-TOT NUM*6 = R-ITEM-LGTH DEF D-ITEM-LGTH NUM*4 = & 19 IF HUGE-NUMBER-1 <> 0 AND ITD[1:1] = "N" ELS & DATE-DIGITS-ONLY IF ITD[1:1] = "D" ELS & NCONV(ITD[25:4]) IF ITD[1:1] = "C" AND ITD[29:1] EQ ")" ELS & NCONV(ITD[25:3]) IF ITD[1:1] = "C" AND ITD[28:1] EQ ")" ELS & NCONV(ITD[25:2]) IF ITD[1:1] = "C" AND ITD[27:1] EQ ")" ELS & NCONV(ITD[25:1]) IF ITD[1:1] = "C" AND ITD[26:1] EQ ")" ELS & (NONC-CARETS-ONLY) IF ITD[1:1] <> "C" DEF D-FLD-LGTHS-TOT NUM*6 = D-ITEM-LGTH REP SUMM REP-SEQ ITN R-ITEM-LGTH R-FLD-LGTHS-TOT SUBTOTAL & D-ITEM-LGTH D-FLD-LGTHS-TOT SUBTOTAL ITD R-ITD & NONC-CARETS-ONLY NONC-#TRAILSPACES NONC-NOTRAILSP & DATE-DIGITS-ONLY HUGE-NUMBER-1 SET SUBF NAME Z709SH09 KEEP SET REP LIM 2000 NOSTA NOVER NOWAR GO CAN CLE SET DEF ACC *Z709SH09 USE Z709SH08 NOL SEL IF REP-SEQ = LAST-REQ-ITEM DEF R-O-L-L CHA*4 = ASCII(R-FLD-LGTHS-TOT & ;lengths if displayed + ((REP-SEQ * 1) - 1) & ;for tildes (~) + 2) ;for the two BEGENDs ; tildes (~) DEF R-O-L-L-N NUM*4 = NCONVERT(R-O-L-L) DEF R-ASSURE-EVEN-BYTE NUM*1 = MOD(R-O-L-L-N,2) ;either 0 or 1 DEF R-O-L-WIDTH NUM*4 = R-O-L-L-N + R-ASSURE-EVEN-BYTE DEF D-O-L-L CHA*4 = ASCII(D-FLD-LGTHS-TOT & ;lengths if displayed + ((REP-SEQ * 1) - 1) & ;for tildes (~) + 2) ;for the two BEGENDs ; tildes (~) DEF D-O-L-L-N NUM*4 = NCONVERT(D-O-L-L) DEF D-ASSURE-EVEN-BYTE NUM*1 = MOD(D-O-L-L-N,2) ;either 0 or 1 DEF D-O-L-WIDTH NUM*4 = D-O-L-L-N + D-ASSURE-EVEN-BYTE REPORT FIN FOO "DEF LAST-REQ-ITEM NUM*3 =" REP-SEQ & SKI 2 "DEF CNT-CHA-ITEMS NUM*3 =" CNT-CHA-ITEMS & SKI 2 "DEF CNT-NUM-ITEMS NUM*3 =" CNT-NUM-ITEMS & SKI 2 "DEF R-O-L-L-N NUM*4 =" R-O-L-L-N & SKI 2 "DEF R-ASSURE-EVEN-BYTE NUM*4 =" R-ASSURE-EVEN-BYTE & SKI 2 "DEF R-O-L-WIDTH NUM*4 =" R-O-L-WIDTH & SKI 2 "DEF D-O-L-L-N NUM*4 =" D-O-L-L-N & SKI 2 "DEF D-ASSURE-EVEN-BYTE NUM*4 =" D-ASSURE-EVEN-BYTE & SKI 2 "DEF D-O-L-WIDTH NUM*4 =" D-O-L-WIDTH SET NOBL NOHE NOST NODUP NOVE NOWAR PAG WID 78 LEN 0 REP LIM 2000 SET REP DEV DISC NAME Z709SH77 GO SET DEF CAN CLE ACC *Z709SH09 DISP "QUIZ Subfile QTP Subfile QUIZ Report" DISP "----------- ------------ -----------" DISP "REP SUM & SUBF Z709SUBF INCL & REP &" DISP " ITEMnn & ITEMnn, & TAB nnn ITEMnn &" DISP " ITEMnn & ITEMnn, & TAB nnn ITEMnn &" DISP " ITEMnn ITEMnn TAB nnn ITEMnn " DISP " " DISP "SET SUBF NAME... SET PROC LIM 10 SET REP DEV PRINT..." DISP " " DISP " (Want an undelimited flat ASCII file of 264 bytes or less?" DISP " To do so, choose the Quiz Report option and reply 0 to " DISP " the spacing request. Then modify the final output file" DISP " (Z709SH12), and add: 'SET NOHEAD PAGE LENGTH 0 WIDTH 264'" DISP " and change 'PRINTER NAME LP' TO 'DISK NAME XXXXname " DISP " The width value can be adjusted LOWER as desired.) " DISP " " DEF SUBFILE-FORMAT CHA*1 = PARM PROMPT & "(?) Subfile format (Y) or Report format (N)? (Y/N)->" & UPSHIFT ON ERRORS REPROMPT 2 TIMES DEF SUBFILE-TYPE CHA*1 = PARM PROMPT & "(?) Use QUIZ (Y) or QTP (N) subfile format? (Y/N)->" & UPSHIFT ON ERRORS REPROMPT 2 TIMES DEF IS-COMPRESSED CHA*1 = PARM PROMPT & "(?) Use a compressed (220 byte) output record? (Y/N)->" & UPSHIFT ON ERRORS REPROMPT 2 TIMES DEF SPACING NUM*2 = PARM PROMPT & "(?) Place how many spaces between each report column?->" & ON ERRORS REPROMPT 2 TIMES DEF SPACING-TOT NUM*4 = SPACING DEF SEL-SEQ NUM*4 = 1 REP SUMM REP-SEQ ITN ITD SPACING SPACING-TOT SUBT & R-ITEM-LGTH R-FLD-LGTHS-TOT D-ITEM-LGTH D-FLD-LGTHS-TOT & IS-COMPRESSED SUBFILE-FORMAT SUBFILE-TYPE SEL-SEQ SUBTOTAL SET SUBF NAME Z709SH10 KEEP SET REP LIM 2000 NOSTA NOVER NOWAR GO ;now create a usefile containing any DEFs for arrayed items :PURGE Z709SH11 CAN CLE SET DEF ACC *Z709SH10 USE Z709SH08 NOLIST ; has DEFd item 'last-req-item' DEF A-R-ITEM-LGTH CHA*4 = ASCII(R-ITEM-LGTH) DEF FIRST-L-PAREN NUM*2 = INDEX(ITN,"(") DEF FIRST-R-PAREN NUM*2 = INDEX(ITN,")") DEF L-PAREN NUM*2 = FIRST-L-PAREN IF FIRST-L-PAREN GT 0 ELS 0 DEF R-PAREN NUM*2 = FIRST-R-PAREN IF FIRST-R-PAREN GT 0 ELS 0 DEF OCCUR-A CHA*3 = ITN[(L-PAREN + 1):R-PAREN - (L-PAREN + 1)] & IF L-PAREN GT 0 AND R-PAREN GT 0 DEF OCCUR-N NUM*3 = NCONVERT(OCCUR-A) IF OCCUR-A <> " " DEF TYPEDATA CHA*4 = "NUM*" IF ITD[1:1] = "N" OR ITD[1:1] = "D" & ELS "CHA*" IF ITD[1:1] = "C" DEF DEF-STAT CHA*78 = & PACK("DEF " + ITN[1:(L-PAREN - 2)] + "-" + OCCUR-A & + TYPEDATA + A-R-ITEM-LGTH + " = " + ITN) & IF L-PAREN GT 0 AND SUBFILE-FORMAT = "Y" ELS " " REP DEF-STAT SET REP DEV DISC NAME Z709SH11 SET PAG WID 220 LENG 0 REP LIM 2000 NOSTA NOWAR NOVER NOBLANKS NOHEAD GO SET DEF CAN CLE SET DEF CAN CLE ACC *Z709SH10 USE Z709SH00 NOL USE Z709SH08 NOL DEF TAB-VALUE NUM*3 = 1 IF REP-SEQ = 1 ELS & (R-FLD-LGTHS-TOT - R-ITEM-LGTH) + (SPACING-TOT - SPACING) + 1 DEF A-TAB-VALUE CHA*3 = ASCII(TAB-VALUE,3) DEF SPC-REP CHA*61 = " " DEF SPC-QUIZSUB CHA*32 = " " DEF SPC-QTPSUB CHA*14 = " " DEF REP-STAT CHA*77 = & "REPORT SUMMARY & ;" + SPC-QUIZSUB + "IS OS DEC" & IF SUBFILE-FORMAT EQ "Y" AND SUBFILE-TYPE EQ "Y" & ELS "SUBFILE Z709SUBF KEEP INCLUDE & ;" + SPC-QTPSUB + & "IS OS DEC" & IF SUBFILE-FORMAT EQ "Y" AND SUBFILE-TYPE NE "Y" & ELS "REPORT " + SPC-REP + "&" & IF SUBFILE-FORMAT NE "Y" DEF ITDX CHA*15 = " " + ITD[7:15] DEF FIRST-L-PAREN NUM*2 = INDEX(ITN,"(") DEF FIRST-R-PAREN NUM*2 = INDEX(ITN,")") DEF L-PAREN NUM*2 = FIRST-L-PAREN IF FIRST-L-PAREN GT 0 ELS 0 DEF R-PAREN NUM*2 = FIRST-R-PAREN IF FIRST-R-PAREN GT 0 ELS 0 DEF OCCUR-A CHA*3 = ITN[(L-PAREN + 1):R-PAREN - (L-PAREN + 1)] & IF L-PAREN GT 0 AND R-PAREN GT 0 DEF OCCUR-N NUM*3 = NCONVERT(OCCUR-A) IF OCCUR-A <> " " DEF ITN2 CHA*32 = PACK(ITN[1:(L-PAREN - 2)] & + "-" + OCCUR-A) IF L-PAREN GT 0 AND SUBFILE-FORMAT = "Y" ELS ITN DEF DATE-08-1 NUM*6 = INDEX(ITD,"YYYY/MM/DD") IF ITD[1:1] = "D" DEF DATE-08-2 NUM*6 = INDEX(ITD,"YYYYMMDD") IF ITD[1:1] = "D" DEF DATE-06-1 NUM*6 = INDEX(ITD,"YY/MM/DD") IF ITD[1:1] = "D" DEF DATE-06-2 NUM*6 = INDEX(ITD,"MM/DD/YY") IF ITD[1:1] = "D" DEF DATE-06-3 NUM*6 = INDEX(ITD,"DD/MM/YY") IF ITD[1:1] = "D" DEF DATE-06-4 NUM*6 = INDEX(ITD,"YYYY/MM") IF ITD[1:1] = "D" DEF DATE-06-5 NUM*6 = INDEX(ITD,"YYYY/DD") IF ITD[1:1] = "D" DEF DATE-06-6 NUM*6 = INDEX(ITD,"YYYYMM") IF ITD[1:1] = "D" DEF DATE-06-7 NUM*6 = INDEX(ITD,"YYYYDD") IF ITD[1:1] = "D" DEF DATE-06-8 NUM*6 = INDEX(ITD,"DDYYYY") IF ITD[1:1] = "D" DEF DATE-06-9 NUM*6 = INDEX(ITD,"MMYYYY") IF ITD[1:1] = "D" DEF DATE-05-1 NUM*6 = INDEX(ITD,"DDD/YY") IF ITD[1:1] = "D" DEF DATE-05-2 NUM*6 = INDEX(ITD,"YY/DDD") IF ITD[1:1] = "D" DEF DATE-04-1 NUM*6 = INDEX(ITD,"MM/DD") IF ITD[1:1] = "D" DEF DATE-04-2 NUM*6 = INDEX(ITD,"DD/MM") IF ITD[1:1] = "D" DEF DATE-04-3 NUM*6 = INDEX(ITD,"YYYY") IF ITD[1:1] = "D" DEF DATE-04-4 NUM*6 = INDEX(ITD,"MMDD") IF ITD[1:1] = "D" DEF DATE-03-1 NUM*6 = INDEX(ITD,"DDD") IF ITD[1:1] = "D" DEF DATE-02-1 NUM*6 = INDEX(ITD,"YY") IF ITD[1:1] = "D" DEF DATE-02-2 NUM*6 = INDEX(ITD,"MM") IF ITD[1:1] = "D" DEF DATE-02-3 NUM*6 = INDEX(ITD,"DD") IF ITD[1:1] = "D" DEF DATE-FORMAT CHA*8 = & "YYYYMMDD" IF DATE-08-1 <> 0 AND ITD[1:1] = "D" ELS & "YYYYMMDD" IF DATE-08-2 <> 0 AND ITD[1:1] = "D" ELS & "YYMMDD" IF DATE-06-1 <> 0 AND ITD[1:1] = "D" ELS & "MMDDYY" IF DATE-06-2 <> 0 AND ITD[1:1] = "D" ELS & "DDMMYY" IF DATE-06-3 <> 0 AND ITD[1:1] = "D" ELS & "YYYYMM" IF DATE-06-4 <> 0 AND ITD[1:1] = "D" ELS & "YYYYDD" IF DATE-06-5 <> 0 AND ITD[1:1] = "D" ELS & "YYYYMM" IF DATE-06-6 <> 0 AND ITD[1:1] = "D" ELS & "YYYYDD" IF DATE-06-7 <> 0 AND ITD[1:1] = "D" ELS & "DDYYYY" IF DATE-06-8 <> 0 AND ITD[1:1] = "D" ELS & "MMYYYY" IF DATE-06-9 <> 0 AND ITD[1:1] = "D" ELS & "DDDYY" IF DATE-05-1 <> 0 AND ITD[1:1] = "D" ELS & "YYDDD" IF DATE-05-2 <> 0 AND ITD[1:1] = "D" ELS & "MMDD" IF DATE-04-1 <> 0 AND ITD[1:1] = "D" ELS & "DDMM" IF DATE-04-2 <> 0 AND ITD[1:1] = "D" ELS & "YYYY" IF DATE-04-3 <> 0 AND ITD[1:1] = "D" ELS & "MMDD" IF DATE-04-4 <> 0 AND ITD[1:1] = "D" ELS & "DDD" IF DATE-03-1 <> 0 AND ITD[1:1] = "D" ELS & "YY" IF DATE-02-1 <> 0 AND ITD[1:1] = "D" ELS & "MM" IF DATE-02-2 <> 0 AND ITD[1:1] = "D" ELS & "DD" IF DATE-02-3 <> 0 AND ITD[1:1] = "D" ELS " " DEF DATE-SEPARATOR CHA*7 = & "SEP '/'" IF DATE-08-1 <> 0 AND ITD[1:1] = "D" ELS & "SEP '/'" IF DATE-08-2 <> 0 AND ITD[1:1] = "D" ELS & "SEP '/'" IF DATE-06-1 <> 0 AND ITD[1:1] = "D" ELS & "SEP '/'" IF DATE-06-2 <> 0 AND ITD[1:1] = "D" ELS & "SEP '/'" IF DATE-06-3 <> 0 AND ITD[1:1] = "D" ELS & "SEP '/'" IF DATE-06-4 <> 0 AND ITD[1:1] = "D" ELS & "SEP '/'" IF DATE-06-5 <> 0 AND ITD[1:1] = "D" ELS & "SEP '/'" IF DATE-06-6 <> 0 AND ITD[1:1] = "D" ELS & " " IF DATE-06-7 <> 0 AND ITD[1:1] = "D" ELS & " " IF DATE-06-8 <> 0 AND ITD[1:1] = "D" ELS & " " IF DATE-06-9 <> 0 AND ITD[1:1] = "D" ELS & "SEP '/'" IF DATE-05-1 <> 0 AND ITD[1:1] = "D" ELS & "SEP '/'" IF DATE-05-2 <> 0 AND ITD[1:1] = "D" ELS & "SEP '/'" IF DATE-04-1 <> 0 AND ITD[1:1] = "D" ELS & "SEP '/'" IF DATE-04-2 <> 0 AND ITD[1:1] = "D" ELS & " " IF DATE-04-3 <> 0 AND ITD[1:1] = "D" ELS & " " IF DATE-04-4 <> 0 AND ITD[1:1] = "D" ELS & " " IF DATE-03-1 <> 0 AND ITD[1:1] = "D" ELS & " " IF DATE-02-1 <> 0 AND ITD[1:1] = "D" ELS & " " IF DATE-02-2 <> 0 AND ITD[1:1] = "D" ELS & " " IF DATE-02-3 <> 0 AND ITD[1:1] = "D" ELS " " DEF HUGE-NUMBER-1 NUM*6 = INDEX(ITD,"...") IF ITD[1:1] = "N" DEF PIC-OR-FORMAT CHA*20 = & ("PIC " + '"' + ITD[23:R-ITEM-LGTH] + '"') & IF ITD[1:1] = "N" AND HUGE-NUMBER-1 = 0 & ELSE ("FOR " + DATE-FORMAT + DATE-SEPARATOR) & IF ITD[1:1] = "D" AND HUGE-NUMBER-1 = 0 & ELSE " " DEF INPUT-SCALE NUM*2 = NCONVERT(ZEROFILL(ITD[8:2])) DEF OUTPUT-SCALE NUM*2 = NCONVERT(ZEROFILL(ITD[14:2])) DEF DECIMAL-SCALE NUM*2 = NCONVERT(ZEROFILL(ITD[19:2])) DEF ATT CHA*09 = ";Scaling?" & IF INPUT-SCALE <> 0 OR OUTPUT-SCALE <> 0 OR DECIMAL-SCALE <> 0 & ELS " ;Size?" IF HUGE-NUMBER-1 <> 0 DEF TAB-STAT CHA*78= & (" " +"TAB " +A-TAB-VALUE + " " +ITN2 +PIC-OR-FORMAT +" &" & + ATT) & IF REP-SEQ NE LAST-REQ-ITEM AND SUBFILE-FORMAT NE "Y" & ELS (" " + "TAB " + A-TAB-VALUE + " " +ITN2 + PIC-OR-FORMAT & + ATT) & IF REP-SEQ EQ LAST-REQ-ITEM AND SUBFILE-FORMAT NE "Y" & ELS (ITN2 + " &" + " ;" + ITD[22:12] + ITDX) & IF REP-SEQ NE LAST-REQ-ITEM AND SUBFILE-FORMAT EQ "Y" & AND SUBFILE-TYPE = "Y" & ELS (ITN2 + " ;" + ITD[22:12] + ITDX) & IF REP-SEQ EQ LAST-REQ-ITEM AND SUBFILE-FORMAT EQ "Y" & AND SUBFILE-TYPE = "Y" & ELS (ITN2 + "," + " &" + ";" + ITD[22:12] + ITDX) & IF REP-SEQ NE LAST-REQ-ITEM AND SUBFILE-FORMAT EQ "Y" & AND SUBFILE-TYPE NE "Y" & ELS (ITN2 + " ;" + ITD[22:12] + ITDX) & IF REP-SEQ EQ LAST-REQ-ITEM AND SUBFILE-FORMAT EQ "Y" & AND SUBFILE-TYPE NE "Y" DEF INIT-HEAD CHA*70 = PACK("INITIAL HEADING " + "'&" + " k2S'" + & " SKIP PAGE ") IF IS-COMPRESSED = "Y" ELS " " DEF REP-DEV-STAT CHA*70 = & "SET REPORT DEVICE PRINTER NAME LP" IF SUBFILE-FORMAT NE "Y" & ELS "SET SUBFILE NAME Z709SUBF KEEP" & IF SUBFILE-FORMAT EQ "Y" AND SUBFILE-TYPE = "Y" ELS " " & IF SUBFILE-FORMAT EQ "Y" AND SUBFILE-TYPE NE "Y" DEF REP-LIM-STAT CHA*20 = & "SET REPORT LIMIT 10" IF SUBFILE-FORMAT NE "Y" & ELS "SET REPORT LIMIT 10" & IF SUBFILE-FORMAT EQ "Y" AND SUBFILE-TYPE = "Y" & ELS "SET PROCESS LIMIT 10" & IF SUBFILE-FORMAT EQ "Y" AND SUBFILE-TYPE NE "Y" DEF PAG-WID-STAT CHA*18 = & "SET PAGE WIDTH 220" IF IS-COMPRESSED = "Y" ELS " " PAG HEA TAB 1 AX SKI 2 TAB 1 "USE Z709SH11 NOLIST" SKI 2 & TAB 1 INIT-HEAD SKI 2 TAB 1 REP-STAT SKI REP TAB 001 TAB-STAT FIN FOO SKI 2 TAB 1 REP-DEV-STAT SKI TAB 1 REP-LIM-STAT & SKI TAB 1 PAG-WID-STAT SKI TAB 1 "GO" SET REP DEV DISC NAME Z709SH12 SET PAG WID 220 LENG 0 REP LIM 2000 NOSTA NOWAR NOVER GO ;now create a usefile containing qtp source code to create an ;ascii delimited file of the items the user selected ;Length may be rounded up to assure even byte output file ;Length calculated using a 1 character delimitter ;ALSO, there will be an extraneous " + " just to the right of the ;"(" in the 'end result' file's PACK statement and also one at ;the end of the PACK statement IF the last item is Character ;ALSO, NUMERIC FIELDS OF VALUE SAY 8 BYTES = 1234 WILL BE OUTPUT ;AS '1234' AND NOT '0001234'. IF YOU NEED LEAD ZEROES YOU WILL ;NEED TO ADD THE 2ND PARAMETER TO EACH OF THE ASCII FUNCTIONS AS IN ;ASCII(x-NumItem,7) INSTEAD OF DEFAULT ASCII(x-NumItem)! CAN CLE SET DEF ACC *Z709SH10 & LINK TO RECORD(SEL-SEQ) OF *Z709SH10 ALIAS Z709SH88 OPT USE Z709SH00 NOL USE Z709SH77 NOL ;A DELIMITER VALUE ASSIGNED TO BEGEND CAUSES A BLANK BEGINNING AND ;ENDING COLUMN IN EXCEL UPLOADED SPREADSHEETS. SINCE EXCEL IS THE ;MOST FREQUENTLY USED PROGRAM WITH THESE DELMITTED FILES WE WILL ;ASSIGN A NULL VALUE TO 'BEGEND' SO AS NOT TO GET THESE BLANK ;COLUMNS. 'BEGEND' MIGHT PROVE USEFUL FOR SOME OTHER FILE SYSTEM ;AND SO WE LEAVE THE CODE IN PLACE. THE USER CAN ASSIGN A VALUE ;TO 'BEGEND' MANUALLY IF IT IS SO DESIRED. DEF DEF-BEGEND CHA*72 = "DEF BEGEND CHA*1 = ''" DEF DEF-CDELIM CHA*72 = "DEF CDELIM CHA*1 = '~'" DEF DEF-NDELIM CHA*72 = "DEF NDELIM CHA*1 = '~'" DEF DEF-C2NDEL CHA*72 = "DEF C2NDEL CHA*1 = '~'" DEF DEF-N2CDEL CHA*72 = "DEF N2CDEL CHA*1 = '~'" DEF XD CHA*06 = & "NDELIM " IF ITD OF Z709SH10[1:1]<>"C" & AND ITD OF Z709SH88[1:1]<>"C" & ELS "CDELIM" IF ITD OF Z709SH10[1:1]="C" & AND ITD OF Z709SH88[1:1]="C" & ELS "N2CDEL" IF ITD OF Z709SH10[1:1]<>"C" & AND ITD OF Z709SH88[1:1]="C" & ELS "C2NDEL" IF ITD OF Z709SH10[1:1]="C" & AND ITD OF Z709SH88[1:1]<>"C" DEF LC CHA*2 = " &" IF RECORD Z709SH88 EXISTS ELSE " ;" DEF X-ITN CHA * 72 = & PACK("DEF O-L CHA*" + ASCII(D-O-L-WIDTH) + "= PACK( " & +"BEGEND " + " + "+'ASCII('+TRUNC(ITN) +")" + " + BEGEND" + ")") & IF ITD OF Z709SH10[1:1]<>"C" AND SEL-SEQ OF Z709SH10 = 1 & AND NOT RECORD Z709SH88 EXISTS & ELS PACK("DEF O-L CHA*" + ASCII(D-O-L-WIDTH) + "=PACK( " & + "BEGEND " + " + " + TRUNC(ITN) + " + " + " BEGEND" + ")") & IF ITD OF Z709SH10[1:1]="C" AND SEL-SEQ OF Z709SH10 = 1 & AND NOT RECORD Z709SH88 EXISTS & ELS PACK("DEF O-L CHA*" + ASCII(D-O-L-WIDTH) + "= PACK( " & + "BEGEND" + " + " + 'ASCII(' + TRUNC(ITN) + ')' + " + " & + TRUNC(XD) + " + " + LC) & IF ITD OF Z709SH10[1:1]<>"C" AND SEL-SEQ OF Z709SH10 = 1 & AND RECORD Z709SH88 EXISTS & ELS PACK("DEF O-L CHA*" + ASCII(D-O-L-WIDTH) + "= PACK( " & + "BEGEND" + " + " + TRUNC(ITN) + " + " + TRUNC(XD) + " + " + LC) & IF ITD OF Z709SH10[1:1]="C" AND SEL-SEQ OF Z709SH10 = 1 & AND RECORD Z709SH88 EXISTS & ELS PACK('ASCII(' + TRUNC(ITN) + ')'+" + "+TRUNC(XD)+" + " +LC) & IF ITD OF Z709SH10[1:1]<>"C" AND RECORD Z709SH88 EXISTS & ELS PACK(TRUNC(ITN) + " + " + TRUNC(XD) + " + " + LC) & IF ITD OF Z709SH10[1:1]="C" AND RECORD Z709SH88 EXISTS & ELS PACK('ASCII(' + TRUNC(ITN) + ')' + ")") & IF ITD OF Z709SH10[1:1]<>"C" AND NOT RECORD Z709SH88 EXISTS & ELS PACK(TRUNC(ITN) + " + " + " BEGEND" + ")") & IF ITD OF Z709SH10[1:1]="C" AND NOT RECORD Z709SH88 EXISTS PAG HEA TAB 001 AX SKIP 2 & TAB 1 DEF-BEGEND SKI 1 & TAB 1 DEF-CDELIM SKI 1 & TAB 1 DEF-NDELIM SKI 1 & TAB 1 DEF-C2NDEL SKI 1 & TAB 1 DEF-N2CDEL SKI 2 REP TAB 003 X-ITN FIN FOO & SKI 2 TAB 1 "SUBFILE Z709DLIM KEEP NODICTIONARY INCLUDE O-L" & SKI 2 TAB 1 "SET LOCK FILE UPDATE" & SKI 2 TAB 1 "SET PROCESS LIMIT 10" SKI TAB 1 "GO" SET REP DEV DISC NAME Z709SH99 SET PAG WID 220 LENG 0 REP LIM 2000 NOSTA NOWAR NOVER GO CAN CLE SET DEF ;CREATE A 'USEFILE' AVAILABLE FOR USE WITH THE QTP CODE FOUND IN ;'Z709SH99'. THIS USEFILE, 'Z709SH66', CONSISTS OF ONE DEFD ITEM ;CALLED 'C-L' WHICH IS THE NAME OF EACH ITEM SEPARATED BY "," ;WE ASSUME THAT THE DATA WIDTH CALCULATED FOR C-L IS LARGE ENOUGH TO ;HOLD ALL OF THE COLUMN NAMES DELIMITED BY ",". IF IT IS NOT, SOME ;MODIFICATIONS WILL NEED TO BE MADE TO ADJUST FOR THIS. ACC *Z709SH10 & LINK TO RECORD(SEL-SEQ OF Z709SH10) OF *Z709SH10 ALIAS Z709SH88 OPT USE Z709SH00 NOL USE Z709SH77 NOL DEF XD CHA*10 = "CDELIM " DEF LC CHA*2 = " &" IF RECORD Z709SH88 EXISTS ELSE " ;" DEF X-ITN CHA * 72 = & PACK("DEF C-L CHA*" + ASCII(D-O-L-WIDTH) + "= PACK( " & + "BEGEND " + " + '" + TRUNC(ITN) + "' + BEGEND" + ")") & IF ITD OF Z709SH10[1:1]<>"C" AND SEL-SEQ OF Z709SH10 = 1 & AND NOT RECORD Z709SH88 EXISTS & ELS PACK("DEF C-L CHA*" + ASCII(D-O-L-WIDTH) + "=PACK( " & + "BEGEND " + " + '" + TRUNC(ITN) + "' + " + " BEGEND" + ")") & IF ITD OF Z709SH10[1:1]="C" AND SEL-SEQ OF Z709SH10 = 1 & AND NOT RECORD Z709SH88 EXISTS & ELS PACK("DEF C-L CHA*" + ASCII(D-O-L-WIDTH) + "= PACK( " & + "BEGEND" + " + '" + TRUNC(ITN) + "'" + " + " & + TRUNC(XD) + " + " + LC) & IF ITD OF Z709SH10[1:1]<>"C" AND SEL-SEQ OF Z709SH10 = 1 & AND RECORD Z709SH88 EXISTS & ELS PACK("DEF C-L CHA*" + ASCII(D-O-L-WIDTH) + "= PACK( " & +"BEGEND" +" + '" + TRUNC(ITN) + "' + " + TRUNC(XD) + " + " + LC) & IF ITD OF Z709SH10[1:1]="C" AND SEL-SEQ OF Z709SH10 = 1 & AND RECORD Z709SH88 EXISTS & ELS PACK("'" + TRUNC(ITN) + "'" + " + " +TRUNC(XD) + " + " + LC) & IF ITD OF Z709SH10[1:1]<>"C" AND RECORD Z709SH88 EXISTS & ELS PACK("'" + TRUNC(ITN) + "' + " + TRUNC(XD) + " + " + LC) & IF ITD OF Z709SH10[1:1]="C" AND RECORD Z709SH88 EXISTS & ELS PACK("'" + TRUNC(ITN) + "'" + ")") & IF ITD OF Z709SH10[1:1]<>"C" AND NOT RECORD Z709SH88 EXISTS & ELS PACK("'" + TRUNC(ITN) + "' + " + " BEGEND" + ")") & IF ITD OF Z709SH10[1:1]="C" AND NOT RECORD Z709SH88 EXISTS PAG HEA TAB 1 ";place all AFTER Z709SH99's SUBFILE STAT" SKI 1 & TAB 1 ";Warn: column title lengths may exceed Def C-L width!" SKI 1 & TAB 1 ";Length rounded up to assure even byte output file" SKI 1 & TAB 1 ";Length calc based upon a delimitter length of 1." SKI 2 REP TAB 003 X-ITN FIN FOO & SKI 2 TAB 1 "SUBF Z709DLIM ALIAS ZZ KEEP AT INIT NODICT INCLUDE C-L" SET REP DEV DISC NAME Z709SH66 SET PAG WID 220 LENG 0 REP LIM 2000 NOBLA NOSTA NOWAR NOVER GO CAN CLE SET DEF :FILE STD220=Z709SH12 ACC STD220 PAG HEA & "The file Z709SH12 has been created for you, it contains" SKI & "the following records:" SKIP 2 REP ALL SET PAG WID 258 LENG 0 REP LIM 2000 NOSTA NOWAR NOVER GO :PURGE Z709SH00 :PURGE Z709SH01 :PURGE Z709SH02 :PURGE Z709SH03 :PURGE Z709SH04 :PURGE Z709SH05 :PURGE Z709SH05 :PURGE Z709SH06 :PURGE Z709SH07 :PURGE Z709SH08 :PURGE Z709SH09 :PURGE Z709SH10 :PURGE Z709SH77 :PURGE QUIZSAVE,TEMP :RESET STD220 CAN CLE SET DEF