REXX Sample: Manipulate the Data Contained in FILE3
Jump to navigation
Jump to search
/************************ REXX ******************************/ /* */ /* DISCLAIMER - THIS EXAMPLE IS PRESENTED AS AN */ /* ILLUSTRATION OF HOW TSO REXX CAN BE USED */ /* TO MANIPULATE THE DATA CONTAINED IN FILE3 */ /* OF AN ESO ORDER. */ /* */ /* THIS CODE IS PROVIDED FREE OF CHARGE. THE CODE IS NOT */ /* WARRANTED AND IS PROVIDED "AS IS". IBM IS UNDER NO */ /* OBLIGATION TO MAINTAIN, CORRECT, UPDATE, CHANGE, MODIFY, */ /* OR OTHERWISE SUPPORT THIS PROGRAM. IBM MAKES NO */ /* REPRESENTATION AND GIVES NO WARRANTY AS TO INFRINGEMENT */ /* OF PATENTS OR COPYRIGHTS RELATING TO THIS MATERIAL. */ /* */ /* IBM OWNS THE COPYRIGHT IN THIS CODE. */ /************************************************************/ /* (BEGINHELP:) /*--------------------------------------------------------------------*/ Copyright: (C) Copyright IBM Corporation, 1993 Classification: IBM External Use - Example Software FUNCTION: This REXX exec is provided to search and sort the data included on File 3 of an ESO order. It also provides the ability to generate SMP/E receive and exclude MCS statements to aid in the selective installation of PTFs. INTERACTIVE EXECUTION: Use standard REXX exec execution syntax from ISPF Option 6, and respond to the prompts. During execution, you will be prompted for: DATASET INFORMATION (The dataset that contains File 3.) PROFILE Sort/Search Arguments (See PROSORT and PROSEARCH below) PTF Search Arguments (See PTFSEARCH below) SMP/E INFORMATION (Build Select or Exclude MCS Statements) BATCH EXECUTION: Input: Syntax: ESOSIT {<File_3_DSN>} {,command_line_options} Command Line Options: PROSORT, PROSEARCH, PTFSEARCH, OVERRIDE, SMP, PAGE, EXCLUDE PROSORT =PRODUCT, FMID, SERVICE, DESCRIPTION or ASIS (leave alone) or NONE (skip this section) DEFAULT=ASIS PROSEARCH=PRODUCT(value), FMID(value), SERVICE(value), DESCRIPTION(value) PTFSEARCH=PTF(value), FMID(value), ISSUE(value), UPE, UCL, SPE, HIP, ACT, AO, DEL, DEP, DOC, EC, EXR, FUL, IOG, MSG, MVS, PRP PAGE =value Output: Return Codes: -2 = ABEND -1 = user cancelled 0 = successful completion 1 = no data found for search criteria (internal only) Called by: User or Batch Calls: ALLOCATE FREE EXECIO References: None Datasets: ESOSIT.PUTpppp.DATEdddd(ThhmmssO) /* output */ ESOSIT.PUTpppp.DATEdddd(ThhmmssR) /* receive stmts */ Description: This REXX EXEC allows a user to selectively install PTFs shipped via ESO. It also provides for sorting and searching of a customer's profile and the shipped PTFs. This can be accomplished via the command line inputs for batch operations or by way of terminal input. The information is stored in the output dataset listed above. if SMP/E MCS statements are built, they will be stored in the receive dataset also listed above. The following abbreviations and codes have been used to identify the special conditions: ABBR EXPLANATION UPE UNRESOLVED PTF-IN-ERROR (PE) UCL CONTAINS UCLIN SPE CONTAINS SYSTEM PROGRAMMING ENHANCEMENT HIP CONTAINS IDENTIFIED HIGH IMPACT PERVASIVE(HIPER) PTFS ACT CONTAINS ++HOLD FOR ACTION AO CONTAINS ++HOLD FOR AO DEL CONTAINS ++HOLD FOR DELETE DEP CONTAINS ++HOLD FOR DEPENDENCY DOC CONTAINS ++HOLD FOR DOC EC CONTAINS ++HOLD FOR EC EXR CONTAINS ++HOLD FOR EXRF FUL CONTAINS ++HOLD FOR FULLGEN IOG CONTAINS ++HOLD FOR IOGEN MSG CONTAINS ++HOLD FOR MSGSKEL MVS CONTAINS ++HOLD FOR MVSCP PRP PE RESOLVING PTF (ENDHELP:) (BEGINCHANGE:) PROGRAMMING ACTIVITY CODE PROJ # REL DATE PROGRAMMER DESCRIPTION ---- ------ --- ------ ------------ ---------------------------------- $00= 479320 280 930526: JJ STANFORD ORIGINAL CODE AND UNIT TEST 930707: TL THORPE IMPLEMENTED RADIX SORT 930901: JJ RIBNIKER ALLOW MAXIMUM CHAR F3 DSN (ENDCHANGE:) %PAGE */ /*E*//* PAGE EJECT COMMENTS */ address 'TSO'; /* SET UP ENVIRONMENT */ 'MAKEBUF'; /* CREATE NEW BUFFER */ 'NEWSTACK'; /* CREATE NEW STACK */ signal on ERROR; /* IF ERROR THEN GOTO ERROR ROUTINE */ hesl='0000'; /* HIGHEST EFFECTIVE SERVICE LEVEL INIT */ order_num='000000'; /* ESO ORDER NUMBER INIT */ sit_exec_level='930901'; /* MY INTERNAL LEVEL INIT */ f3_exec_level='000000'; /* FILE 3'S EXEC LEVEL INIT */ f3_profile.=''; /* FILE 3 PROFILE ARRAY INIT */ f3_ptf.=''; /* FILE 3 PTF ARRAY INIT */ f3_profile.0=0; /* FILE 3 PROFILE ARRAY INIT */ f3_ptf.0=0; /* FILE 3 PTF ARRAY INIT */ batch=0; /* INIT */ irc=0; /* INIT */ rerun=0; /* INIT */ rerun_ok=1; /* INIT */ cmd_line_options.=''; /* INIT */ cmd_line_options.override=0; /* INIT */ cmd_line_options.prosort=''; /* INIT */ cmd_line_options.prosearch.=''; /* INIT */ cmd_line_options.prosearch.prosearch=''; /* INIT */ cmd_line_options.prosearch.description=''; /* INIT */ cmd_line_options.prosearch.product=''; /* INIT */ cmd_line_options.prosearch.fmid=''; /* INIT */ cmd_line_options.prosearch.service=''; /* INIT */ cmd_line_options.ptfsearch.ptfsearch=''; /* INIT */ cmd_line_options.ptfsearch.ptf=''; /* INIT */ cmd_line_options.ptfsearch.prp=''; /* INIT */ cmd_line_options.ptfsearch.fmid=''; /* INIT */ cmd_line_options.ptfsearch.issue=''; /* INIT */ cmd_line_options.receive_stmts=0; /* RECEIVE INIT */ cmd_line_options.select_or_exclude='S'; /* INIT to SELECT */ page_length=24; /* INIT */ output_lines=0; /* NUMBER OF LINES WRITTEN OUT ... INIT */ arg f3dsn ',' cmd_options; /* GET CMD LINE */ /* PARSE COMMAND LINE */ if f3dsn='/C' then /* display changes */ call CHANGES else nop if f3dsn='?' then /* HELP */ call HELP /* HELP */ else if f3dsn='' & cmd_options^='' then /* FORGOT THE F3 DNS */ do say "ESOSIT: MISSING FILE 3 DATASET NAME."; irc=-2; /* ABEND */ end; /* F3DSN='' & .. */ if irc=0 then if cmd_options^='' then /* CMD LINE OPTIONS */ do batch=1; /* BATCH JOB */ do index=1 to words(cmd_options); /* FOR ALL KEYWORDS */ /* PARSE CMD LINE OPTIONS A WORD AT A TIME */ parse value word(cmd_options,index) with keyword'='keyword_value; select when keyword='PROSORT' then /* PROFILE SORT */ cmd_line_options.prosort=, cmd_line_options.prosort||' '||keyword_value; /* TACK IT ON */ when keyword='PROSEARCH' then /* PROFILE SEARCH */ do /* PARSE OUT THE SEARCH ARGUMENT AND IT'S VALUE */ parse var keyword_value search_arg'('search_arg_value')'; cmd_line_options.prosearch.prosearch=, cmd_line_options.prosearch.prosearch, ||' '||search_arg; /* TACK IT ON */ interpret "CMD_LINE_OPTIONS.PROSEARCH.", ||value(search_arg), ||"=", ||value(, "CMD_LINE_OPTIONS.PROSEARCH.", ||value(search_arg)), ||" ", ||search_arg_value; /* TACK IT ON */ end; /* WHEN PROSEARCH */ when keyword='PTFSEARCH' then /* PTF SEARCH */ do /* PARSE OUT THE SEARCH ARGUMENT AND IT'S VALUE */ parse var keyword_value search_arg'('search_arg_value')'; cmd_line_options.ptfsearch.ptfsearch=, cmd_line_options.ptfsearch.ptfsearch, ||' '||search_arg; /* TACK IT ON */ interpret "CMD_LINE_OPTIONS.PTFSEARCH.", ||value(search_arg), ||"=", ||value(, "CMD_LINE_OPTIONS.PTFSEARCH.", ||value(search_arg)), ||" ", ||search_arg_value; /* TACK IT ON */ end; /* WHEN PTFSEARCH */ when keyword='OVERRIDE' then /* DISREGARD EXEC LEVEL */ cmd_line_options.override=1; /* SET TO TRUE */ when keyword='SMP' then /* BUILD SMP RECEIVE STMTS */ cmd_line_options.receive_stmts=1; /* SET TO TRUE */ when keyword='EXCLUDE' then /* set to exclude not select */ cmd_line_options.select_or_exclude='E'; /* EXCLUDE */ when keyword='PAGE' then /* PAGE LENGTH SETTING */ do if ^datatype(keyword_value,'W') then /* INVALID OR BLANK PAGE LENGTH */ do say "INVALID PAGE LENGTH:" keyword_value; /* FYI */ say "PAGE LENGTH REMAINS 24."; /* FYI */ end /* DATATYPE */ else /* OK */ page_length=keyword_value; /* SET */ end; /* WHEN PAGE */ otherwise /* UNKNOWN KEYWORD */ do say "ESOSIT: UKNOWN COMMAND LINE OPTION:" keyword; irc=-2; end; /* OTHERWISE */ end; /* SELECT */ end; /* DO WHILE KEYWORD */ end; /* IF CMD_OPTIONS */ if cmd_line_options.prosort='' then /* DEFAULT TO NONE */ cmd_line_options.prosort='ASIS'; if irc=0 & ^rerun then /* IF CMD LINE STUFF OK THEN */ do say "EXPANDED SERVICE OPTION SELECTIVE INSTALL EXEC"; /* HELLO */ say "EXEC LEVEL:" sit_exec_level; /* FYI */ say ""; /* GIVE US A SPACE */ /* WE ALLOW USER TO REPEAT SEARCH AS OFTEN AS THEY WOULD LIKE. WE NEED TO RESET THE VARIABLES FOR EACH REPEATED RUN. */ do while rerun_ok & irc>=0 parse value GET_F3_DSN(f3dsn) with irc f3dsn .; /* GET THE DSN */ if irc=0 then /* ALL OKEY */ do irc=READ_F3_DSN(); /* READ FILE 3 */ if irc=0 then /* ALL OKEY */ do if sit_exec_level<f3_exec_level then /* EXEC OUT OF DATE */ do say ""; /* SPACE */ say "***** ATTENTION!! ATTENTION!! ******"; say ""; /* SPACE */ say "***************************************"; say "* THERE IS A UPDATED VERSION OF THIS *"; say "* EXEC AVAILABLE. PLEASE OBTAIN A *"; say "* NEW EXEC AS SOON AS POSSIBLE. *"; say "* *"; say "***************************************"; say ""; /* SPACE */ say "CURRENT EXEC LEVEL IS:" sit_exec_level; /* CURRENT */ say "FILE 3 INDICATED EXEC LEVEL IS:" f3_exec_level; /* F3 */ say ""; /* SPACE */ if ^cmd_line_options.override then /* IF NOT OVERRIDED */ do if ^batch then /* INTERACTIVE */ do say "DO YOU WISH TO CONTINUE? (y/N)"; /* CHOOSE */ say ""; /* SPACE */ pull user_choice .; /* GET CHOICE */ if user_choice^='Y' then /* UNLESS YES */ irc=-1; /* USER CANCELLED */ end; /* ^BATCH */ else /* BATCH */ irc=-2; /* ABEND FOR SAFETY */ end; /* IF ^OVERRIDE */ else /* OVERRIDE */ do say "OVERRIDE OPTION ACCEPTED. CONTINUING..."; /* FYI */ say ""; /* SPACE */ end; /* ELSE OVERRIDE */ end; /* IF EXEC LEVEL */ if irc=0 then /* ALL OKEY */ do parse value time() with hh':'mm':'ss; /* PARSE OUT DATE */ work_dsn='ESOSIT.PUT'hesl'.DATE', ||right(date('S'),4)'(T'hh||mm||ss'O)'; /* INIT */ say "ALL OUTPUT FOR THIS RUN WILL BE STORED IN "work_dsn"."; say ""; /* GIVE US A SPACE */ /* INIT LOG FILE */ signal off ERROR; /* TURN OFF CHECKING */ "ALLOCATE DA("work_dsn") F(WORKFILE) MOD DIR(5)", "RELEASE TRACKS SPACE(10,50) DSORG(PO) RECFM(F,B)", "LRECL(80) BLKSIZE(6160)"; /* ALLOCATE */ src=rc; /* SAVE THE RC */ signal on ERROR; /* TURN ON CHECKING */ if src^=0 then /* WE HAD A PROBLEM */ do irc=-2; say "ESOSIT: ERROR ALLOCATING" work_dsn". RC: "src; end; /* IF RC^=0 */ receive_dsn='ESOSIT.PUT'hesl'.DATE', ||right(date('S'),4)'(T'||hh||mm||ss'R)'; /* INIT */ call LOG_IT('EXPANDED SERVICE OPTIONS PACKAGE', 'SELECTIVE INSTALL EXEC'); /* HELLO */ call LOG_IT(' '); /* SPACE */ call LOG_IT('ESO ORDER NUMBER -------------------------:', order_num); call LOG_IT('HIGHEST EFFECTIVE SERVICE LEVEL ----------:', hesl); call LOG_IT('CURRENT EXEC LEVEL -----------------------:', sit_exec_level); call LOG_IT('AVAILABLE EXEC LEVEL ---------------------:', f3_exec_level); call LOG_IT('PAGE LENGTH ------------------------------:', page_length); call LOG_IT('FILE 3 DATASET NAME :', f3dsn); call LOG_IT(' '); /* SPACE */ call LOG_IT('COMMAND LINE OPTIONS:'); call LOG_IT(' '); /* SPACE */ do index=1 to words(cmd_options) /* LIST ALL OPTIONS */ call LOG_IT(word(cmd_options,index)); end; /* DO INDEX */ call LOG_IT(' '); /* SPACE */ if rerun then /* IT'S A RERUN */ do call LOG_IT('THIS IS AN ADDITIONAL RUN. PROFILE', 'SECTION HAS BEEN BYPASSED.'); call LOG_IT(' '); /* SPACE */ end; /* RERUN */ /* PROCESS THE PROFILE SECTION ONLY IF NOT A RERUN */ if irc=0 & ^rerun then /* ALL OKEY */ irc=PROCESS_PROFILE(); if irc=0 then /* ALL OKEY */ irc=PROCESS_PTF(); /* PROCESS THE PTF SECTION */ /* WE DO NO MORE LOGGING BECAUSE WE COULD HAVE ALREADY CLOSED THE WORKFILE IN BUILD_RECEIVE_DS */ signal off ERROR; /* TURN OFF CHECKING */ "EXECIO 0 DISKW WORKFILE (FINIS"; /* CLOSE FILE */ src=rc; /* SAVE RC */ signal on ERROR; /* TURN ON CHECKING */ if src^=0 then /* WE HAD A PROBLEM */ do irc=-2; say "ESOSIT: ERROR CLOSING" work_dsn". RC: "src; end; /* IF RC^=0 */ /* TIDY UP */ signal off ERROR; /* TURN OFF CHECKING */ "FREE F(WORKFILE)"; /* REMOVE ALLOC FOR WORK_DSN */ src=rc; /* SAVE RC */ signal on ERROR; /* TURN ON CHECKING */ if src^=0 then /* WE HAD A PROBLEM */ do irc=-2; say "ESOSIT: ERROR FREEING" work_dsn". RC: "src; end; /* IF RC^=0 */ end; /* IF IRC=0 */ end; /* IF IRC=0 */ end; /* IF IRC=0 */ /* BROWSE OUTPUT */ if irc=0 & ^batch then address ispexec 'BROWSE DATASET('work_dsn')'; /* PROMPT FOR RERUN */ if ^batch & irc>=0 then do say "DO YOU WISH TO REPEAT SEARCH WITH DIFFERENT ARGUMENTS? (y/N)"; pull user_choice; if user_choice^='Y' then rerun_ok=0; /* DONE */ else /* YES */ do rerun=1; f3_profile.=''; /* FILE 3 PROFILE ARRAY INIT */ f3_ptf.=''; /* FILE 3 PTF ARRAY INIT */ f3_profile.0=0; /* FILE 3 PROFILE ARRAY INIT */ f3_ptf.0=0; /* FILE 3 PTF ARRAY INIT */ end /* ELSE */ end /* ^BATCH */ else rerun_ok=0 end; /* IF IRC=0 */ end; /* RERUN_OK */ signal off ERROR; /* TURN OFF CHECKING */ 'DELSTACK'; /* DELETE STACK */ 'DROPBUF'; /* DROP THE BUFFER */ say "ESOSIT: COMPLETED WITH RC:" irc; /* FYI */ EXIT(irc); /* END PROGRAM */ /*E*/ GET_F3_DSN:procedure expose batch; /* PROMPT FOR THE DATASET NAME WHERE FILE 3 IS LOCATED. MAKE SURE IT IS A VALID DSN. */ irc=0; /* INIT */ ok=0; /* INIT TO FALSE */ arg f3dsn; /* OPTION */ if f3dsn^='' then /* USER SUPPLIED IT */ supplied=1 /* USER SUPPLIED IS TRUE */ else /* USER DIDN'T */ supplied=0; /* SET TO FALSE */ do while ^ok if ^batch & ^supplied then /* NOT ENTERED ON CMD LINE */ do say "PLEASE ENTER THE DATASET NAME WHERE THE FILE 3", "PACKING LIST DATA IS LOCATED"; say "(NOTE: USAGE AGAINST THE TAPE IS UNSUPPORTED.)";/* DISCLAIM */ say ""; /* SPACE */ /* PROMPT FOR DSN */ say "(<?> FOR HELP, </C> FOR CHANGES, OR <ENTER> TO EXIT):"; say ""; /* SPACE */ pull f3dsn .; /* GET DSN */ end; /* IF F3DSN */ if f3dsn='' then /* IF ENTER THEN QUIT */ do irc=-1; ok=1; /* EXIT LOOP */ end /* IF F3DSN */ else if f3dsn='?' then /* HELP */ call HELP /* HELP */ else if f3dsn='/C' then call CHANGES else do signal off ERROR; /* TURN OFF CHECKING */ estate=strip(SYSDSN(f3dsn)); /* STATE THE FILE */ signal on ERROR; /* TURN ON CHECKING */ if estate='OK' then /* IT EXISTS */ do signal off ERROR; /* TURN OFF CHECKING */ "ALLOCATE DA("f3dsn") F(FILE3) SHR REUS"; /* ALLOC */ src=rc; /* SAVE THE RC */ signal on ERROR; /* TURN ON CHECKING */ if src^=0 then /* WE HAD A PROBLEM */ do irc=-2; say "ESOSIT: ERROR ALLOCATING" f3dsn". RC: "src; end; /* IF RC^=0 */ ok=1; /* WE'RE OK */ end; /* IF SYSDSN */ else /* IT DOESN'T EXIST */ do say estate; /* TELL USER WHAT'S WRONG */ say ""; /* GIVE US A SPACE */ supplied=0; /* IF THE SUPPLIED NAME BLEW, PROMPT FOR NEW */ if batch then do irc=-2; /* ABEND, FILE NOT FOUND */ ok=1; /* GET OUT OF LOOP */ end; /* IF BATCH */ end; /* ELSE */ end; /* ELSE */ end; /* WHILE */ RETURN(irc f3dsn); /* GET_F3_DSN */ /*E*/ LOG_IT: procedure expose work_dsn output_lines irc; /* THIS PROCEDURE WRITES OUTPUT TO THE WORK_DSN. CODING WAS SETUP TO MODIFY IRC HERE INSTEAD OF CHECKING FOR A RETURN CODE AFTER THE CALLING ROUTINE. THIS SAVES ON DUPLICATE CODE AND SHORT CIRCUITS WHERE WE HAVE A LOT OF CALLS TO THIS PROCEDURE IN ONE PLACE. */ parse arg msg; /* GRAB THE MSG */ if irc=0 then do push msg; /* PUT THE MESSAGE ON */ signal off ERROR; /* TURN OFF CHECKING */ "EXECIO 1 DISKW WORKFILE"; /*WRITE IT */ if rc=0 then output_lines=output_lines+1 /* INCREMENT */ else /* IT BOMBED */ irc=-2 signal on ERROR; /* TURN ON CHECKING */ end; /* IRC=0 */ return; /* LOG_IT */ /*E*/ READ_F3_DSN: procedure expose hesl f3_profile. f3_ptf. f3_exec_level, order_num f3dsn; /* THIS ROUTINE READS FILE 3 AND BREAKS IT UP INTO ITS NECESSARY COMPONENTS. WE SCAN THRU THE FILE LOOKING FOR ITEMS. LOCATIONS ARE: ORDER =ESO ORDER NUMBER HESL =HIGHEST EFFECT SERVICE LEVEL EXEC =EXEC LEVEL PROFILE_BEGIN=LOOKING FOR BEGINNING OF PRODUCT PROFILE PROFILE =PRODUCT PROFILE PTF_BEGIN =LOOKING FOR BEGINNING OF PTF LIST PTF =PTF LIST END =END OF PTF LIST AND ANY IMPORTANT DATA */ f3_order=''; /* INIT */ f3_hesl=''; /* INIT */ f3_execm=''; /* INIT */ f3_execd=''; /* INIT */ f3_execy=''; /* INIT */ say "PROCESSING" f3dsn "..."; /* FYI */ location='ORDER'; /* TOP OF FILE */ /* READ AND QUEUE UP FILE 3 CONTENTS */ signal off ERROR; /* TURN OFF CHECKING */ "EXECIO * DISKR FILE3 (FINIS"; /* READ IT */ src=rc; /* SAVE THE RC */ signal on ERROR; /* TURN ON CHECKING */ if src^=0 then /* WE HAD A PROBLEM */ do irc=-2; say "ESOSIT: ERROR READING" f3dsn". RC: "src; end; /* IF RC^=0 */ signal off ERROR; /* TURN OFF CHECKING */ "FREE F(FILE3)"; /* REMOVE ALLOC FOR FILE 3 */ src=rc; /* SAVE THE RC */ signal on ERROR; /* TURN ON CHECKING */ if src^=0 then /* WE HAD A PROBLEM */ do irc=-2; say "ESOSIT: ERROR FREEING" f3dsn". RC: "src; end; /* IF RC^=0 */ n=queued(); /* HOW MANY LINES */ do n; /* FOR N LINES DO */ pull line; /* GET A LINE */ line=strip(line); /* STIP THE BLANKS */ select when location='ORDER' then do parse var line . 'ORDER# 'f3_order'.';/* GRAB ORDER NUM BER */ if f3_order^='' then /* IF WE HAVE SOMETHING */ /* AND IT LOOKS LIKE AN ORDER NUM */ if datatype(f3_order,'A') & length(f3_order)=8 then do order_num=f3_order; /* SET IT */ location='HESL'; /* CHANGE LOCATION */ end; /* IF DATATYPE DO */ end; /* WHEN LOCATION='ORDER' */ when location='HESL' then do parse var line . 'SERVICE LEVEL' . ' IS 'f3_hesl'.';/* GRAB HESL */ if f3_hesl^='' then /* IF WE HAVE SOMETHING */ /* AND IT LOOKS LIKE AN HESL NUM */ if (datatype(f3_hesl,'W') & length(f3_hesl)=4) , | (f3_hesl = 'SMCC') then do hesl=f3_hesl; /* SET IT */ location='EXEC'; /* CHANGE LOCATION */ end; /* IF DATATYPE DO */ end; /* WHEN LOCATION='HESL' */ when location='EXEC' then do parse var line . 'EXEC LEVEL' . ' IS: 'f3_execm'/'f3_execd'/', f3_execy'.'; /* GRAB EXEC */ if f3_execm^='' & f3_execd^='' &, f3_execy^='' then /* IF WE HAVE SOMETHING */ /* AND IT LOOKS LIKE A EXEC NUM */ if datatype(f3_execm,'W') &, datatype(f3_execd,'W') &, datatype(f3_execy,'W') &, length(f3_execm)=2 &, length(f3_execd)=2 &, length(f3_execy)=2 then do f3_exec_level=f3_execy||f3_execm||f3_execd; /* SET IT */ location='PROFILE_BEGIN'; /* CHANGE LOCATION */ end; /* IF DATATYPE DO */ end; /* WHEN LOCATION='EXEC' */ when location='PROFILE_BEGIN', | location='PTF_BEGIN' then do if left(line,7)='-------' then /* BEGINING OF PROFILE/PTF */ if location='PROFILE_BEGIN' then location='PROFILE'; /* CHANGE LOCATION */ else /* HAS TO BE PTF_BEGIN */ location='PTF'; /* CHANGE LOCATION */ end; /* WHEN LOCATION='PROFILE_BEGIN' | ... */ when location='PROFILE' then do if left(line,7)='-------' then /* END OF PROFILE */ location='PTF_BEGIN'; /* CHANGE LOCATION */ else /* DATA */ do counter=(f3_profile.0)+1; /* BUMP UP COUNTER */ f3_profile.counter=line; /* ADD TO ARRAY */ f3_profile.0=counter; /* INCREMENT ARRAY */ end; /* ELSE */ end; /* WHEN LOCATION='PROFILE' */ when location='PTF' then do if left(line,7)='-------' then /* END OF PTF */ location='END'; /* CHANGE LOCATION */ else /* DATA */ do counter=(f3_ptf.0)+1; /* BUMP UP COUNTER */ f3_ptf.counter=line; /* ADD TO ARRAY */ f3_ptf.0=counter; /* INCREMENT ARRAY */ end; /* ELSE */ end; /* WHEN LOCATION='PTF' */ when location='END' then nop; /* DO NOTHING */ otherwise /* SHOULD NEVER HAPPEN */ /* SOME TYPE OF ERROR */ end; /* SELECT */ end; /* DO N */ if location^='END' then /* WE DIDN'T READ FILE 3 CORRECTLY */ do say "ESOSIT: ERROR READING FILE 3. FORMAT SYNTACTICALLY INCORRECT."; say "ESOSIT: LOOKING FOR" location "BUT NEVER FOUND IT."; irc=-2; /* ABEND */ end; /* DO */ else /* LOCATION='PTF' */ do say "PROCESSING COMPLETE FOR" f3dsn; /* FYI */ irc=0; /* ALL IS WELL */ end; /* ELSE */ RETURN(irc); /* F3_READ_DSN */ /*E*/ PROCESS_PROFILE:procedure expose f3_profile. work_dsn batch, cmd_line_options. output_lines page_length; /* THIS PROCEDURE PROCESSES THE PROFILE */ irc=0; /* INIT */ answer_ok=0; /* INIT */ keyword=''; /* INIT */ remainder=''; /* INIT */ valid_sort_fields='PRODUCTFMIDSERVICEDESCRIPTIONASISNONE'; /* INIT */ sort_fields=''; /* INIT */ sort_field_array.=''; /* INIT */ sort_field_array.0=0; /* INIT */ /* PROMPT USER IF NECESSARY FOR SORT PARMS */ do while ^answer_ok if ^batch then /* INTERACTIVE */ do say "ENTER SORT FIELDS FOR PROFILE INFORMATION:"; /* PROMPT */ say "(PRODUCT, FMID, SERVICE, DESCRIPTION) OR ", "ASIS (LEAVE ALONE) OR NONE (SKIP THIS SECTION)"; /* CHOICES*/ pull user_choice; /* GET ANSWER */ end /* ^BATCH */ else /* BATCH */ user_choice=cmd_line_options.prosort; /* SET */ parse var user_choice keyword remainder; /* PARSE IT */ do while keyword^='' if pos(keyword,valid_sort_fields)^=0 then /* IF VALID */ do sort_fields=sort_fields||" "||keyword /* ADD */ parse var remainder keyword remainder answer_ok=1; /* SET TO TRUE */ end; /* IF POS */ else /* INVALID KEYWORD */ do say keyword "IS AN INVALID PROFILE SORT FIELD.", " PLEASE REENTER."; /* FYI */ keyword=''; /* EXIT THIS LOOP */ if batch then do irc=-2; /* ERROR IF IN BATCH */ answer_ok=1; /* TO GET OUT OF LOOP */ end; /* IF BATCH */ else /* INTERACTIVE */ answer_ok=0; /* JUST IN CASE WE HAD SOME GOOD CHOICES */ end; /* ELSE */ end; /* DO WHILE REMAINDER */ end; /* DO WHILE ^ANSWER_OK */ if irc=0 then do call LOG_IT('PROFILE SORT FIELDS ARE:' sort_fields); /* FYI */ call LOG_IT(' '); /* SPACE */ if sort_fields^='NONE' then /* THEY WANT TO SEE THE PROFILE */ do /* PROMPT USER IF NECESSARY FOR SEARCH */ if ^batch then /* INTERACTIVE */ do say "DO YOU WISH TO SEARCH FOR SPECIFIC ITEMS", "IN YOUR PROFILE? (y/N)"; /* ASK */ pull user_choice .; /* GET ANSWER */ end; /* THEY WANT TO LIMIT PROFILE / SEARCH IS FOR BATCH */ if user_choice='Y' | cmd_line_options.prosearch.prosearch^='' then /* SEARCH ON PROFILE FIELDS */ irc=SEARCH_PROFILE(); if sort_fields^='ASIS' then /* SEE IT RAW */ do if irc=0 then /* ALL OK */ do /* BUILD SORT ARRAY */ do index=1 to words(sort_fields); counter=(sort_field_array.0)+1; /* BUMP COUNTER */ sort_field_array.counter=word(sort_fields,index);/* ASSIGN */ sort_field_array.0=counter; /* BUMP ARRAY */ end; /* DO INDEX */ /* CLEAR SORT COLUMNS FOR THIS SORT */ call clear_sort_cols /* LOAD SORT COLUMNS FOR THIS SORT */ do index=1 to sort_field_array.0 /* SELECT COLUMN TO SORT ON */ parse value PROFILE_COLUMN_DEFINE(sort_field_array.index), with irc col collength .; /* GET INFO */ first_sort_col = col last_sort_col = col + collength - 1 if sort_field_array.index = 'SERVICE' then sort_seq = 'D' else sort_seq = 'A' if irc=0 then call LOAD_SORT_COLS(first_sort_col, last_sort_col, sort_seq); end /* SORT SELECTED ON PROFILE */ if irc=0 then call RADIXSORT('F3_PROFILE'); end; /* IRC */ end; /* ASIS */ if irc=0 then /* COULD BE SET IN SEARCH */ do call WRITE_OUT_PROFILE_HEADER; /* WRITE OUT HDR */ do index=1 to f3_profile.0 /* FOR ALL ELEMENTS */ if (output_lines // page_length = 0) &, /* at pg length */ index^=1 then /* TIME TO WRITE HDR */ call WRITE_OUT_PROFILE_HEADER; /* WRITE IT */ call LOG_IT(f3_profile.index); /* WRITE OUT THE PROFILE */ end; /* DO INDEX */ call LOG_IT(' '); /* SPACE */ end; /* IRC */ end; /* NONE */ end; /* IRC */ RETURN(irc); /*E*/ PROCESS_PTF:procedure expose f3_ptf. work_dsn cmd_line_options. batch, output_lines page_length receive_dsn rerun; /* THIS ROUTINE PROCESSES THE PTF/INDICATOR SECTION OF FILE 3 */ irc=0; /* INIT */ /* if we are doing a rerun, it is a given that the user wants to search for PTFs, so automatically default to this */ if rerun then user_choice2='Y' /* INIT */ else user_choice2='N'; /* INIT */ if ^batch & ^rerun then /* INTERACTIVE */ do say "DO YOU WISH TO SEARCH FOR SPECIFIC", "PTFS? (y/N)"; /* ASK */ pull user_choice2 .; /* GET ANSWER */ end /* ^BATCH */ /* THEY WANT TO LIMIT PTFS / SEARCH IS FOR BATCH / RERUN ALWAYS */ if user_choice2='Y' |, cmd_line_options.ptfsearch.ptfsearch^='' then /* SEARCH FOR PTFS */ irc=SEARCH_PTF(); /* SEARCH FOR PTFS */ else RETURN(irc); if irc=0 then do call clear_sort_cols /* SELECT COLUMN TO SORT ON (major sort sequence first) */ parse value PTF_COLUMN_DEFINE('ISSUE'), with irc col collength .; /* GET INFO */ first_sort_col = col last_sort_col = col + collength - 1 call load_sort_cols(first_sort_col, last_sort_col 'A'); /* SELECT COLUMN TO SORT ON (minor sort sequence last) */ parse value PTF_COLUMN_DEFINE('PTF'), with irc col collength .; /* GET INFO */ first_sort_col = col last_sort_col = col + collength - 1 call load_sort_cols(first_sort_col, last_sort_col 'A'); /* SORT SELECTED ON PTF */ if irc=0 then call RADIXSORT('F3_PTF'); /* SORT */ if irc=0 then /* COULD BE SET IN SEARCH */ do call WRITE_OUT_PTF_HEADER; /* WRITE IT OUT */ do index=1 to f3_ptf.0 /* FOR ALL ELEMENTS */ if (output_lines // page_length = 0) &, /* at page length */ index^=1 then /* TIME TO WRITE HDR */ call WRITE_OUT_PTF_HEADER; /* WRITE IT */ call LOG_IT(f3_ptf.index); /* WRITE OUT THE PROFILE */ end; /* DO INDEX */ call LOG_IT(' '); /* SPACE */ if irc=0 then /* ALLES GUT */ do /* IF INTERACTIVE AND WE SEARCHED ON PTFS THEN PROMPT */ if ^batch & user_choice2='Y' then do say "DO YOU WISH TO BUILD SMP/E MCS STATEMENTS FOR", "THE SELECTED PTFS? (y/N)"; /* ASK */ pull user_choice .; /* GET ANSWER */ end; /* ^BATCH */ if user_choice='Y' | cmd_line_options.receive_stmts then irc=BUILD_RECEIVE_DS(); /* BUILD US SOME RECEIVE STMTS */ end; /* IRC */ end; /* IRC */ end; /* IRC */ RETURN(irc); /*E*/ RadixSort:procedure expose ascdsc. sort_cols. f3_ptf. f3_profile., SortArray. IndexArray. bucket. sort_col /******************************************************************/ /* Use the RADIX sort to speed up sort. The radix sort makes one */ /* pass of the data for every column that is to be sorted starting*/ /* with the least significant column. NOTE: Once the data has been*/ /* moved to the work array, only pointers to the data are moved. */ /******************************************************************/ parse arg array_name .; say 'Loading sort work ...' call load_sort_array(array_name); /* load to sort work array */ do colptr = sort_cols.0 to 1 by -1 /* one pass per column */ sort_col=sort_cols.colptr sort_seq=ascdsc.colptr /* determine next column to sort */ say 'sorting column' sort_col '...' call init_radix_buckets /* clear sort bucket pointers */ call load_radix_buckets /* sort the current column */ call load_sort_index_array /* reload the index array as they*/ end /* are now sorted */ say 'Restoring' array_name 'array ...' call load_sorted_array(array_name); /* put the sorted array back*/ RETURN /*E*/ clear_sort_cols:procedure expose sort_cols. /******************************************************************/ /* CLEAR_SORT_COLS: */ /******************************************************************/ sort_cols.0 = 0 RETURN /*E*/ load_sort_cols:procedure expose sort_cols. ascdsc. /******************************************************************/ /******************************************************************/ /* Load the columns that the sort will check. */ /******************************************************************/ parse arg first_sort_col last_sort_col sort_seq .; do colptr = first_sort_col to last_sort_col sort_cols.0 = sort_cols.0 + 1 wptr = sort_cols.0 sort_cols.wptr = colptr ascdsc.wptr = sort_seq end ascdsc.0 = sort_cols.0 RETURN /*E*/ load_sort_array:procedure expose f3_ptf. f3_profile. SortArray., IndexArray. /******************************************************************/ /******************************************************************/ /* copy the sort array to the sort work array */ /******************************************************************/ parse arg array_name .; if array_name = 'F3_PTF' then do sort_size = f3_ptf.0 do wptr = 1 to sort_size SortArray.wptr = f3_ptf.wptr IndexArray.wptr = wptr end end else do sort_size = f3_profile.0 do wptr = 1 to sort_size SortArray.wptr = f3_profile.wptr IndexArray.wptr = wptr end end SortArray.0 = sort_size IndexArray.0 = sort_size RETURN /*E*/ init_radix_buckets:procedure expose bucket. /******************************************************************/ /* need to clear the radix buckets when we sort a new column */ /******************************************************************/ do wptr = 0 to 255 bucket.wptr.0 = 0 end RETURN /*E*/ load_RADIX_buckets:procedure expose IndexArray. SortArray. , bucket. sort_col /******************************************************************/ /* This is where the real sort occurs. Just figure out the hex val*/ /* of the character in the column for the next record and add the */ /* pointer for the record to the bucket with the hex value. */ /******************************************************************/ do entry = 1 to SortArray.0 IndexP = IndexArray.entry /* get index to next rec */ charP = substr(SortArray.IndexP,sort_col,1) /* get char in col*/ buckPtr=C2D(charP) /* determine bucket */ location = bucket.buckPtr.0 + 1 /* increment array loc */ bucket.buckPtr.0 = location bucket.buckPtr.location = IndexP /* add index to rec at */ /* end of bucket */ end RETURN /*E*/ load_SORT_index_array:procedure expose sort_seq IndexArray. bucket. /******************************************************************/ /* go thru the buckets and reload the index array for next pass. */ /******************************************************************/ if sort_seq = 'A' then /* are we descending or ascending */ do ip1 = 0 ip2 = 255 ip3 = 1 end else do ip1 = 255 ip2 = 0 ip3 = -1 end aptr = 0 DO i = ip1 to ip2 by ip3 do j = 1 to bucket.i.0 aptr = aptr + 1 IndexArray.Aptr = bucket.i.j end end if aptr ^= IndexArray.0 then do say 'SORT ERROR: sort_index_array count inequality' end RETURN /*E*/ load_sorted_array:procedure expose f3_ptf. f3_profile. SortArray., IndexArray. /******************************************************************/ /* move sorted array back to input array */ /******************************************************************/ parse arg array_name .; if array_name = 'F3_PTF' then DO WPTR = 1 to SortArray.0 IndexP = IndexArray.wptr f3_ptf.wptr = SortArray.IndexP end else DO WPTR = 1 to SortArray.0 IndexP = IndexArray.wptr f3_profile.wptr = SortArray.IndexP end RETURN /*E*/ SEARCH_PROFILE:procedure expose f3_profile. work_dsn cmd_line_options., output_lines batch; /* THIS PROCEDURE FINDS ALL MATCHING DESCRIPTIONS */ irc=0; /* INIT */ f3_new_profile.=''; /* INIT */ f3_new_profile.0=0; /* INIT */ counter=0; /* INIT */ answer_ok=0; /* INIT */ keyword=''; /* INIT */ remainder=''; /* INIT */ valid_search_fields='PRODUCTFMIDSERVICEDESCRIPTIONASISNONE';/* INIT */ search_fields=''; /* INIT */ /* PROMPT USER IF NECESSARY FOR SEARCH PARMS */ do while ^answer_ok if ^batch then /* INTERACTIVE */ do say "DNTER SEARCH FIELDS FOR PROFILE INFORMATION:"; /* PROMPT */ say "(PRODUCT, FMID, SERVICE, DESCRIPTION)"; /* CHOICES*/ pull user_choice; /* GET ANSWER */ end /* ^BATCH */ else user_choice=cmd_line_options.prosearch.prosearch; /* SET */ parse var user_choice keyword remainder; /* PARSE IT */ do while keyword^='' if pos(keyword,valid_search_fields)^=0 then /* IF VALID */ do search_fields=search_fields||" "||keyword /* ADD */ parse var remainder keyword remainder answer_ok=1; /* SET TO TRUE */ end; /* IF POS */ else /* INVALID KEYWORD */ do say keyword "IS AN INVALID SEARCH FIELD. PLEASE REENTER." keyword=''; /* EXIT THIS LOOP */ if batch then do irc=-2; /* ERROR IF IN BATCH */ answer_ok=1; /* TO GET OUT OF LOOP */ end; /* IF BATCH */ else /* INTERACTIVE */ answer_ok=0; /* JUST IN CASE WE HAD SOME GOOD CHOICES */ end; /* ELSE */ end; /* DO WHILE REMAINDER */ end; /* DO WHILE ^ANSWER_OK */ call LOG_IT('PROFILE SEARCH FIELDS ARE:' search_fields); /* FYI */ call LOG_IT(' '); /* SPACE */ do index=1 to words(search_fields) /* PROCESS THEM */ if irc=0 then /* ALL OK */ do f3_new_profile.0=0; /* RESET */ needle=word(search_fields,index); /* DEFINE */ parse value PROFILE_COLUMN_DEFINE(needle), with irc col collength .; /* GET INFO */ if irc=0 then select when needle='DESCRIPTION' then do if ^batch then /* INTERACTIVE */ do say "ENTER SEARCH DESCRIPTION (UP TO", collength "CHARACTERS):" /* ASK */ pull user_choice; /* CHOICE */ end /* ^BATCH */ else /* BATCH */ user_choice=cmd_line_options.prosearch.description; /* SET */ user_choice=strip(substr(user_choice,1,collength)); call LOG_IT('DESCRIPTION SEARCH FOR:' user_choice); /* FYI */ end; /* DESCRIPTION */ when needle='PRODUCT' then do if ^batch then /* INTERACTIVE */ do say "ENTER" collength "DIGIT PRODUCT NUMBER (XXXX-YYY):"; pull user_choice; /* CHOICE */ end /* ^BATCH */ else /* BATCH */ user_choice=cmd_line_options.prosearch.product; /* SET */ user_choice=strip(substr(user_choice,1,collength)); call LOG_IT('PRODUCT SEARCH FOR:' user_choice); /* FYI */ end; /* DESCRIPTION */ when needle='FMID' then do if ^batch then /* INTERACTIVE */ do say "ENTER" collength "DIGIT FMID NUMBER (AAANNNN):"; pull user_choice; /* CHOICE */ end /* ^BATCH */ else /* BATCH */ user_choice=cmd_line_options.prosearch.fmid; /* SET */ user_choice=strip(substr(user_choice,1,collength)); call LOG_IT('FMID SEARCH FOR:' user_choice); /* FYI */ end; /* DESCRIPTION */ when needle='SERVICE' then do if ^batch then /* INTERACTIVE */ do say "ENTER Y OR N FOR APPLIED SERVICE:"; /* ASK */ pull user_choice; /* CHOICE */ end /* ^BATCH */ else /* BATCH */ user_choice=cmd_line_options.prosearch.service; /* SET */ user_choice=strip(substr(user_choice,1,collength)); call LOG_IT('SERVICE SEARCH FOR:' user_choice); /* FYI */ end; /* DESCRIPTION */ otherwise /* THIS CANNOT HAPPEN */ end; /* SELECT */ do index2=1 to f3_profile.0 /* SEARCH THE ARRAY */ haystack=substr(f3_profile.index2,col,collength); if pos(user_choice,haystack)^=0 then /* FOUND A MATCH */ do counter=(f3_new_profile.0)+1; /* BUMP UP COUNTER */ f3_new_profile.counter=f3_profile.index2;/* ADD 2 ARRAY */ f3_new_profile.0=counter; /* INCREMENT ARRAY */ end; /* IF MATCH */ end; /* DO INDEX2 */ if f3_new_profile.0>0 then /* COPY NEW PROFILE OVER OLD ONE */ do index2=0 to f3_new_profile.0 /* COPY INCLUDING COUNTER */ f3_profile.index2=f3_new_profile.index2;/* FROM NEW TO OLD */ end /* DO INDEX2 */ else /* NO MATCHES */ do say '*** NO ENTRIES SATISFYING SEARCH CRITERIA ***'; call LOG_IT('*** NO ENTRIES SATISFYING SEARCH CRITERIA ***'); call LOG_IT(' '); /* SPACE */ irc=1; end; /* ELSE */ end; /* IRC=0 */ end; /* DO INDEX*/ call LOG_IT(' '); /* SPACE */ RETURN(irc); /*E*/ SEARCH_PTF:procedure expose f3_ptf. work_dsn cmd_line_options., output_lines batch; /* THIS PROCEDURE FINDS ALL MATCHING FIELDS */ irc=0; /* INIT */ f3_new_ptf.=''; /* INIT */ f3_new_ptf.0=0; /* INIT */ counter=0; /* INIT */ answer_ok=0; /* INIT */ keyword=''; /* INIT */ remainder=''; /* INIT */ valid_search_fields='PTFFMIDISSUEUPEUCLSPEHIPACTAODEL', 'DEPDOCECEXRFULIOGMSGMVSPRP'; /* INIT */ search_fields=''; /* INIT */ prplist=''; /* INIT */ prparray.=''; /* INIT */ prparray.0=0; /* INIT */ /* PROMPT USER IF NECESSARY FOR SEARCH PARMS */ do while ^answer_ok if ^batch then /* INTERACTIVE */ do say "ENTER A SEARCH ARGUMENT OF:"; say "PTF (you will be prompted for a PTF number)"; say "FMID (you will be prompted for an FMID)"; say "ISSUE (you will be prompted for an ISSUE number)"; say " OR"; say "ENTER A SEARCH FIELD ABBREVIATION", "FOR PTF INFORMATION:"; /* PROMPT */ say ""; say " ABBR EXPLANATION"; say ""; say " UPE UNRESOLVED PTF-IN-ERROR (PE)"; say " UCL CONTAINS UCLIN"; say " SPE CONTAINS SYSTEM PROGRAMMING ENHANCEMENT"; say " HIP CONTAINS IDENTIFIED HIGH IMPACT", "PERVASIVE(HIPER) PTFS"; say ""; say " ACT CONTAINS ++HOLD FOR ACTION"; say " AO CONTAINS ++HOLD FOR AO"; say " DEL CONTAINS ++HOLD FOR DELETE"; say " DEP CONTAINS ++HOLD FOR DEPENDENCY"; say " DOC CONTAINS ++HOLD FOR DOC"; say " EC CONTAINS ++HOLD FOR EC"; say " EXR CONTAINS ++HOLD FOR EXRF"; say " FUL CONTAINS ++HOLD FOR FULLGEN"; say " IOG CONTAINS ++HOLD FOR IOGEN"; say " MSG CONTAINS ++HOLD FOR MSGSKEL"; say " MVS CONTAINS ++HOLD FOR MVSCP"; say ""; say " PRP PE RESOLVING PTF"; pull user_choice; /* GET ANSWER */ end /* ^BATCH */ else user_choice=cmd_line_options.ptfsearch.ptfsearch; /* SET */ parse var user_choice keyword remainder; /* PARSE IT */ do while keyword^='' if pos(keyword,valid_search_fields)^=0 then /* IF VALID */ do search_fields=search_fields||" "||keyword; /* ADD */ parse var remainder keyword remainder; answer_ok=1; /* SET TO TRUE */ end; /* IF POS */ else /* INVALID KEYWORD */ do say keyword "IS AN INVALID SEARCH FIELD. PLEASE REENTER."; keyword=''; /* EXIT THIS LOOP */ if batch then do irc=-2; /* ERROR IF IN BATCH */ answer_ok=1; /* TO GET OUT OF LOOP */ end; /* IF BATCH */ else /* INTERACTIVE */ answer_ok=0; /* JUST IN CASE WE HAD SOME GOOD CHOICES */ end; /* ELSE */ end; /* DO WHILE REMAINDER */ end; /* DO WHILE ^ANSWER_OK */ call LOG_IT('PTF SEARCH FIELDS ARE:' search_fields); /* FYI */ call LOG_IT(' '); /* SPACE */ do index=1 to words(search_fields) /* PROCESS THEM */ if irc=0 then /* ALL OK */ do f3_new_ptf.0=0; /* RESET */ needle=word(search_fields,index); /* DEFINE */ parse value PTF_COLUMN_DEFINE(needle), with irc col collength .; /* GET INFO */ if irc=0 then select when needle='PTF' then do if ^batch then /* INTERACTIVE */ do say "ENTER" collength "DIGIT PTF NUMBER (AANNNNN):";/* ASK */ pull user_choice; /* CHOICE */ end /* ^BATCH */ else /* BATCH */ user_choice=cmd_line_options.ptfsearch.ptf; /* SET */ user_choice=strip(substr(user_choice,1,collength)); call LOG_IT('PTF SEARCH FOR:' user_choice); /* FYI */ end; /* DESCRIPTION */ when needle='PRP' then do call LOG_IT('INDICATOR SEARCH FOR: PRP'); /* * SPECIAL CONDITION * WE CHECK TO SEE IF IT'S NON-BLANK */ end; /* DESCRIPTION */ when needle='FMID' then do if ^batch then /* INTERACTIVE */ do say "ENTER" collength "DIGIT FMID NUMBER (AAANNNN):";/* ASK */ pull user_choice; /* CHOICE */ end /* ^BATCH */ else /* BATCH */ user_choice=cmd_line_options.ptfsearch.fmid; /* SET */ user_choice=strip(substr(user_choice,1,collength)); call LOG_IT('FMID SEARCH FOR:' user_choice); /* FYI */ end; /* DESCRIPTION */ when needle='ISSUE' then do if ^batch then /* INTERACTIVE */ do say "ENTER" collength "DIGIT ISSUE NUMBER:"; /* ASK */ pull user_choice; /* CHOICE */ end /* ^BATCH */ else /* BATCH */ user_choice=cmd_line_options.ptfsearch.issue; /* SET */ user_choice=strip(substr(user_choice,1,collength)); call LOG_IT('ISSUE SEARCH FOR:' user_choice); /* FYI */ end; /* DESCRIPTION */ otherwise /* INDICATOR */ do call LOG_IT('INDICATOR SEARCH FOR:' needle); user_choice='X'; /* DEFAULT */ end; /* OTHERWISE */ end; /* SELECT */ /* HERE WE SEARCH FOR ALL ENTRIES MATCHING THE SEARCH CRITERIA. WE THEN SCAN THIS NEW LIST AND BUILD A LIST OF ALL PRPS. ALL OLD RECORDS NOT MEETING SEARCH CRITERIA ARE DISCARDED. THIS IS DONE MULTIPLE TIMES UNTIL ALL SEARCH CRITERIA IS EXHAUSTED. WE THEN SCAN THE FINAL ARRAY AND COPY OVER ANY PRP'S THAT ARE STILL NEEDED. THIS IS DONE BECAUSE THE CUSTOMER NEEDS TO HAVE THE PRP PRESENT IN ORDER TO GET INSTALLABLE SERVICE. */ do index2=1 to f3_ptf.0 /* SEARCH THE ARRAY */ haystack=substr(f3_ptf.index2,col,collength); if needle^='PRP' then found_it=(pos(user_choice,haystack)^=0) else found_it=(haystack^=''); /* NON-BLANK FIELD */ if found_it then do counter=(f3_new_ptf.0)+1; /* BUMP UP COUNTER */ f3_new_ptf.counter=f3_ptf.index2; /* ADD TO ARRAY */ f3_new_ptf.0=counter; /* INCREMENT ARRAY */ end; /* IF MATCH */ end; /* DO INDEX2 */ /* BUILD LIST OF PRPS */ parse value PTF_COLUMN_DEFINE('PRP'), with irc col collength .; /* GET INFO */ do index2=1 to f3_new_ptf.0 prp=substr(f3_new_ptf.index2,col,collength); /* GET PRP */ if prp^='' then /* GOT A PRP */ prplist=prplist||' '||prp; /* ADD THE PRP */ end; /* INDEX2 */ /* COPY OVER ALL NEEDED PRPS TO PRPARRAY. MAKE SURE THERE ARE NO DUPLICATES */ if prplist^='' then /* WE HAVE PRPS */ do index2=1 to f3_ptf.0 /* LOOK FOR PRP IN ORIGINAL LIST */ found=find(prplist,word(f3_ptf.index2,1)); if found>0 then do /* SEE IF IT'S ALREADY IN OUR LIST (DUP) */ prpfound=0; /* RESET */ do index3=1 to prparray.0 /* FOR ALL SAVED PRPS */ if word(prparray.index3,1)=word(f3_ptf.index2,1) then /*DUP */ prpfound=1; end; /* INDEX3 */ if ^prpfound then /* ADD IT */ do counter=(prparray.0)+1; /* BUMP UP COUNTER */ prparray.counter=f3_ptf.index2; /* ADD TO ARRAY */ prparray.0=counter; /* INCREMENT ARRAY */ end; /* ^PRPFOUND */ end; /* IF FOUND >0 */ end; /* INDEX2 */ if f3_new_ptf.0>0 then /* COPY NEW PTF ARRAY OVER OLD ONE */ do index2=0 to f3_new_ptf.0 /* COPY INCLUDING COUNTER */ f3_ptf.index2=f3_new_ptf.index2; /* FROM NEW TO OLD */ end /* DO INDEX2 */ else /* NO MATCHES */ do say '*** NO ENTRIES SATISFYING SEARCH CRITERIA ***'; call LOG_IT('*** NO ENTRIES SATISFYING SEARCH CRITERIA ***'); call LOG_IT(' '); /* SPACE */ irc=1; end; /* ELSE */ end; /* IRC=0 */ end; /* DO INDEX*/ /* DETERMINE IF ANY OF THE SAVED PRP'S NEED TO BE COPIED OVER */ if irc=0 & prparray.0>0 then /* WE HAVE SOME HITS */ do parse value PTF_COLUMN_DEFINE('PRP'), with irc col collength .; /* GET INFO */ do index=1 to f3_ptf.0 /* FOR ALL IN ARRAY */ prp=substr(f3_ptf.index,col,collength); /* GET PRP */ if prp^='' then /* GOT A PRP */ do index2=1 to prparray.0 /* FOR ALL SAVED PRPS */ if prp=word(prparray.index2,1) then /* HIT */ do counter=(f3_ptf.0)+1; /* BUMP UP COUNTER */ f3_ptf.counter=prparray.index2; /* ADD TO ARRAY */ f3_ptf.0=counter; /* INCREMENT ARRAY */ end; /* IF MATCH */ end; /* INDEX2 */ end; /* INDEX1 */ end; /* IF IRC */ call LOG_IT(' '); /* SPACE */ RETURN(irc); /*E*/ PROFILE_COLUMN_DEFINE:procedure; /* THIS PROCEDURE RETURNS COLUMN DEFS. DONE HERE BECAUSE OF UNTIDINESS OF DUPLICATE CODE */ irc=0; /* INIT */ col=0; /* INIT */ collength=0; /* INIT */ arg column .; /* GET NAME */ select when column='PRODUCT' then do col=1; collength=8; end; when column='FMID' then do col=14; collength=7; end; when column='SERVICE' then do col=29; collength=1; end; when column='DESCRIPTION' then do col=36; collength=28; end; otherwise do say "ESOSIT: PROFILE COLUMN" column "NOT FOUND."; irc=-2; end; /* OTHERWISE */ end; /* SELECT */ RETURN(irc col collength); /* PROFILE_COLUMN_DEFINE */ /*E*/ PTF_COLUMN_DEFINE:procedure; /* THIS PROCEDURE RETURNS COLUMN DEFS. DONE HERE BECAUSE OF UNTIDINESS OF DUPLICATE CODE */ irc=0; /* INIT */ col=0; /* INIT */ collength=0; /* INIT */ arg column .; /* GET NAME */ select when column='PTF' then do col=1; collength=7; end; when column='FMID' then do col=9; collength=7; end; when column='ISSUE' then do col=18; collength=4; end; when column='UPE' then do col=28; collength=1; end; when column='UCL' then do col=31; collength=1; end; when column='SPE' then do col=34; collength=1; end; when column='HIP' then do col=37; collength=1; end; when column='ACT' then do col=42; collength=1; end; when column='AO' then do col=44; collength=1; end; when column='DEL' then do col=46; collength=1; end; when column='DEP' then do col=48; collength=1; end; when column='DOC' then do col=50; collength=1; end; when column='EC' then do col=52; collength=1; end; when column='EXR' then do col=54; collength=1; end; when column='FUL' then do col=56; collength=1; end; when column='IOG' then do col=58; collength=1; end; when column='MSG' then do col=60; collength=1; end; when column='MVS' then do col=62; collength=1; end; when column='PRP' then do col=66; collength=7; end; otherwise do say "ESOSIT: PTF COLUMN" column "NOT FOUND."; irc=-2; end; /* OTHERWISE */ end; /* SELECT */ RETURN(irc col collength); /* PTF_COLUMN_DEFINE */ /*E*/ BUILD_RECEIVE_DS:procedure expose f3_ptf. receive_dsn work_dsn batch, cmd_line_options.; /* THIS PROCEDURE WILL CONTRUCT SMP/E RECEIVE MCS STATEMENTS USING F3_PTF. IT WILL BE STORED IN RECEIVE_DSN. IF WE GET HERE WE KNOW THAT F3_PTF.0^=0 */ irc=0; /* INIT */ receive_stmts.=''; /* INIT */ receive_stmts.1=' SET BOUNDARY (GLOBAL).'; /* INIT */ receive_stmts.0=1; /* INIT */ user_choice='S'; /* init to Select */ /* IF INTERACTIVE AND WE SEARCHED ON PTFS THEN PROMPT */ if ^batch then do say "DO YOU WISH TO SELECT OR EXCLUDE", "THE SELECTED PTFS? (S/e)"; /* ASK */ pull user_choice .; /* GET ANSWER */ end; /* ^BATCH */ else user_choice=cmd_line_options.select_or_exclude; /* set to parms */ if user_choice='E' then /* EXCLUDE */ select_or_exclude='EXCLUDE' /* SET */ else /* set to defualt */ select_or_exclude='SELECT'; /* SET */ /* CLOSE WORK FILE SO WE CAN WRITE OUT THE RECEIVE INFORMATION */ signal off ERROR; /* TURN OFF CHECKING */ 'EXECIO 0 DISKW WORKFILE (FINIS' src=rc; /* SAVE THE RC */ signal on ERROR; /* TURN ON CHECKING */ if src^=0 then /* WE HAD A PROBLEM */ do irc=-2; say "ESOSIT: ERROR CLOSING" work_dsn" IN ORDER TO BUILD", "SMP RECEIVE STATEMENTS. RC:" src; end; /* IF RC^=0 */ /* INIT RECEIVE DS */ signal off ERROR; /* TURN OFF CHECKING */ "ALLOCATE DA("receive_dsn") MOD F(RFILE) DIR(5) RELEASE", "TRACKS SPACE(10,50) DSORG(PO) RECFM(F,B) LRECL(80)", "BLKSIZE(6160)"; /* ALLOCATE */ src=rc; /* SAVE THE RC */ signal on ERROR; /* TURN ON CHECKING */ if src^=0 then /* WE HAD A PROBLEM */ do irc=-2; say "ESOSIT: ERROR ALLOCATING" receive_dsn". RC: "src; end; /* IF RC^=0 */ if irc=0 then /* ALL OK */ do say "ALL RECEIVE STATEMENTS WILL BE STORED IN "receive_dsn"."; /*FYI */ say ""; /* GIVE US A SPACE */ parse value PTF_COLUMN_DEFINE('ISSUE'), with irc col collength .; /* GET INFO */ first_sort_col = col last_sort_col = col + collength - 1 call clear_sort_cols call load_sort_cols(first_sort_col, last_sort_col 'A'); /* SORT ON ISSUE */ if irc=0 then call RADIXSORT('F3_PTF'); /* SORT */ /* WE NOW KNOW THAT ALL ISSUES ARE IN ORDER. WE'LL CHECK EACH ONE AND BUILD A SEPARATE SMP/E RECEIVE MCS STATEMENT FOR EACH. THE RECEIVE STATEMENTS HAVE TO BE CREATED IN A CERTAIN WAY (COLUMN SPECIFIC). THIS IS THE REASON FOR THE POSITIONING. DUPLICATE ENTRIES ARE FIRST IDENTIFIED. LATER WE SKIP OVER DUPS. */ if irc=0 then do needle=''; /* INIT */ duplicates=''; /* INIT */ do index=1 to f3_ptf.0 if needle=word(f3_ptf.index,1) then /* IF THE SAME */ duplicates=duplicates||' '||index /* ADD TO DUP LIST */ else needle=word(f3_ptf.index,1); /* DIFF SO ASSIGN NEW NEEDLE */ end; /* INDEX */ old_needle=''; /* INIT */ do index=1 to f3_ptf.0 /* FOR ALL PTFS */ if find(duplicates,index) > 0 then /* IF ENTRY IS DUP */ iterate; needle=word(f3_ptf.index,3); /* SEARCH KEY */ if needle=old_needle then /* SAME ISSUE */ do /* ADD ANOTHER SYSMOD-ID */ counter=(receive_stmts.0)+1; /* INCR */ receive_stmts.counter=copies(' ',18), ||word(f3_ptf.index,1); receive_stmts.0=counter; /* BUMP */ end else /* DIFFERENT ISSUES */ do if old_needle^='' then /* NOT FIRST TIME THRU */ do counter=receive_stmts.0; /* SET */ /* TERMINATE */ receive_stmts.counter=receive_stmts.counter||').'; end; /* IF NEEDLE^='' */ counter=(receive_stmts.0)+1; /* SET */ receive_stmts.counter=' RECEIVE'; counter=counter+1; /* SET */ if needle='SMCCOR' then /* SPECIAL CASE */ receive_stmts.counter=copies(' ',9), ||'SOURCEID(SMCCOR)' /* SMCCOR IS THE SOURCEID */ else receive_stmts.counter=copies(' ',9), ||'SOURCEID(PUT'needle')'; counter=counter+1; /* SET */ receive_stmts.counter=copies(' ',9), ||'HOLDDATA'; counter=counter+1; /* SET */ receive_stmts.counter=copies(' ',9), ||select_or_exclude||'('; counter=counter+1; /* SET */ receive_stmts.counter=copies(' ',18), ||word(f3_ptf.index,1); /* BEGIN RCV STMT */ receive_stmts.0=counter; /* SET */ old_needle=needle; /* SET */ end; /* ELSE */ end; /* DO INDEX */ end; /* DO IRC */ /* TERMINATE RECEIVE */ counter=receive_stmts.0; /* SET */ receive_stmts.counter=receive_stmts.counter||').'; /* TERMINATE */ /* WRITE OUT TO DS, CLOSE, AND FREE */ signal off ERROR; /* TURN OFF CHECKING */ "EXECIO" receive_stmts.0 "DISKW RFILE", "(STEM RECEIVE_STMTS. FINIS"; /* WRITE IT */ src=rc; /* SAVE THE RC */ signal on ERROR; /* TURN ON CHECKING */ if src^=0 then /* WE HAD A PROBLEM */ do irc=-2; say "ESOSIT: ERROR CLOSING" receive_dsn". RC: "src; end; /* IF RC^=0 */ signal off ERROR; /* TURN OFF CHECKING */ "FREE F(RFILE)"; /* REMOVE ALLOC FOR FILE 3 */ signal on ERROR; /* TURN ON CHECKING */ src=rc; /* SAVE THE RC */ if src^=0 then /* WE HAD A PROBLEM */ do irc=-2; say "ESOSIT: ERROR FREEING" receive_dsn". RC: "src; end; /* IF RC^=0 */ end; /* IF IRC=0 */ RETURN(irc); /* BUILD RECEIVE DS */ /*E*/ WRITE_OUT_PROFILE_HEADER:procedure expose work_dsn output_lines; /* THIS PROCEDURE WILL WRITE OUT THE PROFILE HEADER */ irc=0; /* PREP */ /* RECREATE HEADER */ header=, " PRODUCT FMIDS SERVICE DESCRIPTION", " V, R, M"; /* WRITE OUT HEADER */ call LOG_IT(' '); /* SPACE */ call LOG_IT(header); /* WRITE OUT THE HEADER */ call LOG_IT(' '); /* SPACE */ return; /* WRITE OUT PROFILE HEADER */ /*E*/ WRITE_OUT_PTF_HEADER:procedure expose work_dsn output_lines; /* THIS PROCEDURE WILL WRITE OUT THE PTF HEADER */ irc=0; /* PREP */ /* RECREATE HEADER */ header1=, " U U S H A A D D D E E F I M M", " P"; header2=, " P C P I C O E E O C X U O S V", " R APAR"; header3=, "PTF FMID ISSUE E L E P T L P C R L G G S", " P FIXED"; /* WRITE OUT HEADER */ call LOG_IT(' '); /* SPACE */ call LOG_IT(header1); /* WRITE OUT THE HEADER */ call LOG_IT(header2); /* WRITE OUT THE HEADER */ call LOG_IT(header3); /* WRITE OUT THE HEADER */ call LOG_IT(' '); /* SPACE */ return; /* WRITE OUT PTF HEADER */ /*E*/ HELP:procedure; /* TYPE TEXT BETWEEN '(BEGINHELP:)' AND '(ENDHELP:)' FLAGS. NOTE THE HELPS MUST APPEAR BEFORE THIS SUBROUTINE! */ found = 0; /* INIT */ do line = 1 by 1 /* START AT TOP OF FILE */ if found then if index(translate(sourceline(line)),"(ENDHELP:)")<>0 then exit; else say sourceline(line); else if index(translate(sourceline(line)),"(BEGINHELP:)")<>0 then found = 1; end; EXIT(0); /* END OF HELP STUFF */ /*E*/ CHANGES:procedure; /* TYPE TEXT BETWEEN '(BEGINCHANGE:)' AND '(ENDCHANGE:)' FLAGS. NOTE THE HELPS MUST APPEAR BEFORE THIS SUBROUTINE! */ found = 0; /* INIT */ do line = 1 by 1 /* START AT TOP OF FILE */ if found then if index(translate(sourceline(line)),"(ENDCHANGE:)")<>0 then exit; else say sourceline(line); else if index(translate(sourceline(line)),"(BEGINCHANGE:)")<>0 then found = 1; end; EXIT(0); /* END OF CHANGE STUFF */ /*E*/ ERROR: /* CLEAN UP IN THE EVENT OF AN ERROR */ say 'ESOSIT: ERROR' rc 'IN LINE' sigl':'errortext(rc); say sourceline(sigl); signal off ERROR; /* TURN OFF CHECKING */ 'FREE ALL'; /* FREE ALL DYNAMICALLY ALLOCATED DS'S */ 'DELSTACK'; /* DELETE STACK */ 'DROPBUF'; /* DROP THE BUFFER */ exit -2; /* FORCE ABEND */ return;