REXX Sample: Manipulate the Data Contained in FILE3

From OS2World.Com Wiki
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;