       IDENTIFICATION DIVISION.                                         
       PROGRAM-ID.       CSR03827.                                      
COB303 DATE-WRITTEN.     JAN  29, 2007.                                 
       DATE-COMPILED.                                                   
                                                                        
      ******************************************************************        
      ***              SOUTH CAROLINA ELECTRIC & GAS                   *        
      *                                                                *        
      ******************************************************************        
      *                 P R O G R A M  S U M M A R Y                   *        
      *                                                                *        
      *  THIS PROCEDURE IS CALLED FROM PANEL212 WHITE CROSS PLUS       *        
      *  PANEL TO RETRIEVE WHITE CROSS PLUS INFORMATION FOR AN ACCOUNT *        
      ******************************************************************        
      *                                                                *        
      *                     PROGRAM MODIFICATION LOG                   *        
      *                                                                *        
      *    DATE    INITIALS   COMMENTS                                 *        
      *  --------  --------   ---------------------------------------  *        
      *  01/29/07  SS82048    INITIALLY CODED FOR CML 32547            *        
T36932*  05/09/08  SV85244    INCREASED NAME AND ADDRESS FIELD LENGTH  *        
A01849*  01/18/10  VV94890    FIX TO INCREASE HOUSE NO FROM 5 TO 15CHAR*        
P00793*  06/22/15  HA7A338    ADD LOGIC TO RETRIEVE FREEFORM ADDRESS   *        
P00793*                       BASED ON ADDRESS FORMAT CODE             *        
      ******************************************************************        
      ******************************************************************        
      *                                                                *        
      *                ---- BASIC SEQUENCE STRUCTURE ----              *        
      *                                                                *        
      *  0000 - 0999  MAIN CONTROL PATH AND INITIALIZATION             *        
      *  1000 - 1999  INPUT PROCESSING CONTROL PATH                    *        
      *  2000 - 2999  OUTPUT PROCESSING CONTROL PATH                   *        
      *  3000 - 4999  NOT USED                                         *        
      *  5000 - 5999  COMMON PROGRAM MODULES                           *        
      *  6000 - 6999  COMMON SYSTEM MODULES                            *        
      *  7000 - 7999  INPUT MODULES                                    *        
      *  8000 - 8999  OUTPUT MODULES                                   *        
      *  9000 - 9999  TERMINATION,ABEND, MESSAGING MODULES             *        
      *                                                                *        
      ******************************************************************        
                                                                        
       ENVIRONMENT DIVISION.                                            
       DATA DIVISION.                                                   
       WORKING-STORAGE SECTION.                                         

MSQ002  01 MFA-CSRERLOG.
MSQ002    05 ARG-5 PIC X(255).
MSQ002    05 ARG-6 PIC X(255).
MSQ002    05 ARG-7 PIC X(447).

MSQ017 01 MFA-PROGRAM-ID PIC X(8) VALUE 'CSR03827'.
MSQ017     COPY MFASQLM.
                                                                        
      ******************************************************************        
      *    DB2 INCLUDES                                                *        
      ******************************************************************        
                                                                        
           EXEC SQL                                                             
              INCLUDE SQLCA                                                     
           END-EXEC.                                                            
                                                                        
      ****************************                                              
      * WO - CSS_WH_CROSS_PLUS   *                                              
      ****************************                                              
           EXEC SQL                                                             
               INCLUDE TBWCPLUS                                                 
           END-EXEC.                                                            
                                                                        
      ****************************                                              
      * WP - CSS_WH_CROSS_PATNT  *                                              
      ****************************                                              
           EXEC SQL                                                             
               INCLUDE TBWCPPAT                                                 
           END-EXEC.                                                            
                                                                        
      ****************************                                              
      * WJ - CSS_WH_CROSS_SSN    *                                              
      ****************************                                              
           EXEC SQL                                                             
               INCLUDE TBWCPSSN                                                 
           END-EXEC.                                                            
                                                                        
      ****************************                                              
      * PY - CSS_PHYSICIAN       *                                              
      ****************************                                              
           EXEC SQL                                                             
               INCLUDE TBPHYSN                                                  
           END-EXEC.                                                            
                                                                        
      ****************************                                              
      * PA - CSS_PHYSICIAN_ATTR  *                                              
      ****************************                                              
           EXEC SQL                                                             
               INCLUDE TBPHYADD                                                 
           END-EXEC.                                                            
                                                                        
      ****************************                                              
      * DQ - CSS_NAME            *                                              
      ****************************                                              
           EXEC SQL                                                             
               INCLUDE TBNAME                                                   
           END-EXEC.                                                            
                                                                        
      ****************************                                              
      * DY - CSS_ADDR_FORMATTED  *                                              
      ****************************                                              
           EXEC SQL                                                             
               INCLUDE TBADRFMT                                                 
           END-EXEC.                                                            
                                                                        
P00793****************************                                              
P00793* DZ - CSS_ADDR_FREEFORM   *                                              
P00793****************************                                              
P00793     EXEC SQL                                                             
P00793         INCLUDE TBADRFRE                                                 
P00793     END-EXEC.                                                            
P00793                                                                  
P00793****************************                                              
P00793* A4 - CSS_ZIP_CODE        *                                              
P00793****************************                                              
P00793     EXEC SQL                                                             
P00793         INCLUDE TBZIPCD                                                  
P00793     END-EXEC.                                                            
P00793                                                                  
      ******************************************************************        
                                                                        
      *    COBOL WORKING STORAGE COPY BOOKS                            *        
      ******************************************************************        
                                                                        
      *--------< CONTAINS THE COBOL EQUATES NEEDED FOR USING THE >              
      *--------< SYBASE OPEN SERVER FOR CICS FACILITIES.         >              
      *    COPY SYGWCOB.                                                        
                                                                        
      *--------< ADDED TO SUPPORT CICS RPCS >                                   
      *    COPY SYDBCOB.                                                        
                                                                        
      *--------<COMMON SYSTEM AREA >                                            
           COPY CCA00001.                                                       
                                                                        
      *--------< ERROR HANDLING >                                               
      *    COPY CWS00010.                                                       
                                                                        
           EXEC SQL                                                             
              INCLUDE CWSX0010                                                  
           END-EXEC.                                                            
      *--------< ERROR WORK AREA - SUPPORTS ONLINE/CSR JOURNALS >               
           COPY CWS00027.                                                       
      *--------< SUPPORTS DB2 AND SQL ERROR CHECKING >                          
           COPY CWS00303.                                                       
                                                                        
                                                                        
                                                                        
       01  WS-MISC.                                                     
           05 WS-ACCOUNT-NO            PIC X(13).                       
           05 WS-ACCOUNT-NO-NUM REDEFINES WS-ACCOUNT-NO                 
                                       PIC 9(13).                       
COB305     05 WS-ACCOUNT-NO-COMP3        PIC S9(13)V COMP-3 VALUE 0.            
           05 WS-SELECT-RETURN-CODE    PIC S9(9) COMP.                  
           05 PROGRAM-NAME             PIC X(08) VALUE 'CSR03827'.      
           05  WS-SQLSTATE             PIC X(5).                        
           05  WS-ADDRESS.                                              
               10  WS-ADDRESS-X        OCCURS 50 TIMES                  
                                       INDEXED BY WS-ADD-SUB.           
                   15  FILLER          PIC X.                           
           05  WS-ADD-SUB-CNT          PIC 99 VALUE 1.                  
           05  WS-LENGTH               PIC S9(4).                       
           05  WS-MAX-SZ               PIC S9(4).                       
           05  WS-PHY-SUFFIX           PIC X(03) VALUE SPACES.          
           05  WS-PHY-PREFIX           PIC X(09) VALUE SPACES.          
           05  WS-PHY-FIRST-NAME       PIC X(15) VALUE SPACES.          
           05  WS-PHY-MIDDLE-NAME      PIC X(15) VALUE SPACES.          
T36932     05  WS-PHY-LAST-NAME        PIC X(40) VALUE SPACES.          
           05  WS-PTNT-SUFFIX          PIC X(03) VALUE SPACES.          
           05  WS-PTNT-PREFIX          PIC X(09) VALUE SPACES.          
           05  WS-PTNT-FIRST-NAME      PIC X(15) VALUE SPACES.          
           05  WS-PTNT-MIDDLE-NAME     PIC X(15) VALUE SPACES.          
T36932     05  WS-PTNT-LAST-NAME       PIC X(40) VALUE SPACES.          
           05  WS-DURATION             PIC S9(09)V COMP-3 VALUE 0.      
           05  WS-EXPIRATION-DT.                                        
               10  WS-MONTH1           PIC 9(02).                       
               10  FILLER              PIC 9(01).                       
               10  WS-DAY1             PIC 9(02).                       
               10  FILLER              PIC 9(01).                       
               10  WS-YEAR1            PIC 9(04).                       
           05  WS-EFFECTIVE-DT.                                         
               10 WS-MONTH2            PIC 9(02).                       
               10 FILLER               PIC X(01).                       
               10 WS-DAY2              PIC 9(02).                       
               10 FILLER               PIC X(01).                       
               10 WS-YEAR2             PIC 9(04).                       
           05  WS-CAL-YEAR             PIC S9(02).                      
           05  WS-CAL-MONTH            PIC S9(02).                      
                                                                        
       01  SWITCHES.                                                    
           05  ALL-DONE-SW             PIC X(01) VALUE 'N'.             
               88 NOT-ALL-DONE                   VALUE 'N'.             
               88 ALL-DONE                       VALUE 'Y'.             
           05  SEND-DONE-SW            PIC X(01) VALUE 'Y'.             
               88 SEND-DONE-ERROR                VALUE 'N'.             
               88 SEND-DONE-OK                   VALUE 'Y'.             
      *                                                                         
HPCCDM*    EJECT                                                                
      *                                                                         
       01  GTT-MISC-FIELDS.                                             
            05  GTT-NAME                PIC X(26)                       
                                        VALUE 'SESSION.CSR03827_R1'.    
            05  GTT-ROW.                                                
                49 GTT-ROW-LEN          PIC S9(04) COMP.                
                49 GTT-ROW-CHAR         PIC X(1024).                    
            05  GTT-SQLCODE             PIC S9(9) COMP.                 
       01  FILLER                      PIC X(11) VALUE 'PARM FIELDS'.   
                                                                        
       01  COUNTER-FIELDS.                                              
           05  CTR-COLUMN              PIC S9(9) COMP VALUE 1.          
           05  CTR-ROWS                PIC S9(9) COMP VALUE 0.          
           05  WS-ROW-COUNT            PIC S9(9) COMP VALUE 0.          
                                                                        
       01  WS-PROGRAM-FLAGS.                                            
           05  WS-PTNT-OTHRACCT        PIC X(01) VALUE 'N'.             
                                                                        
       01  WORK-FIELDS.                                                 
           05  MAX-LENGTH-PARM         PIC S9(9) COMP.                  
           05  WRKLEN1                 PIC S9(9) COMP.                  
           05  WRKLEN2                 PIC S9(9) COMP.                  
           05  WRK-DONE-STATUS         PIC S9(9) COMP.                  
           05  WS-FROM.                                                 
               10  WS-FROM-X           OCCURS 51 TIMES PIC X.           
                                                                        
       01  FILLER  PIC X(32) VALUE 'THIS IS THE ROW RETURN AREA.'.      
                                                                        
       01  WS-HOLD-DATE.                                                
           05  WS-HOLD-DATE-YY     PIC X(04).                           
           05  FILLER              PIC X(01).                           
           05  WS-HOLD-DATE-MM     PIC X(02).                           
           05  FILLER              PIC X(01).                           
           05  WS-HOLD-DATE-DD     PIC X(02).                           
                                                                        
       01  WS-WORK-DATE.                                                
           05  WS-WORK-DATE-MM     PIC X(02).                           
           05  FILLER              PIC X(01) VALUE '/'.                 
           05  WS-WORK-DATE-DD     PIC X(02).                           
           05  FILLER              PIC X(01) VALUE '/'.                 
           05  WS-WORK-DATE-YY     PIC X(04).                           
                                                                        
       01  TDS-RETURN-FIELDS.                                           
           05  RS-RETURN-CODE      PIC S9(9) COMP VALUE +0.             
                                                                        
       01  CSRERLOG-P.                                                  
           10  S-SP-NAME                 PIC X(18) VALUE SPACES.        
           10  S-SQLCODE                 PIC S9(9) COMP VALUE 0.        
           10  S-SQLSTATE                PIC X(5)  VALUE ' '.           
           10  S-TABLE-NAME              PIC X(18) VALUE SPACES.        
           10  S-HOST-VARIABLES.                                        
               49  S-HOST-VARIABLES-L    PIC S9(4) USAGE COMP.          
               49  S-HOST-VARIABLES-V    PIC X(255).                    
           10  S-SQL-STATEMENT.                                         
               49  S-SQL-STATEMENT-L     PIC S9(4) USAGE COMP.          
               49  S-SQL-STATEMENT-V     PIC X(255).                    
           10  S-SQL-DESCRIPTION.                                       
               49  S-SQL-DESCRIPTION-L   PIC S9(4) USAGE COMP.          
               49  S-SQL-DESCRIPTION-V   PIC X(255).                    
           10  WS-ABEND-SQLERRMC.                                       
               49  WS-ABEND-SQLERRMC-L   PIC S9(4) USAGE COMP.          
               49  WS-ABEND-SQLERRMC-V   PIC X(255).                    
                                                                        
       01  GTT-RETURN-FIELDS.                                           
           05  S-RETURN-CODE       PIC S9(9) COMP VALUE 0.              
           05  S-STATUS-CD         PIC X(01) VALUE SPACES.              
           05  S-EXPIRATION-DT     PIC X(10) VALUE SPACES.              
           05  S-EFFECTIVE-DT      PIC X(10) VALUE SPACES.              
           05  S-PTNT-SSN          PIC X(09) VALUE SPACES.              
           05  S-PTNT-PREFIX       PIC X(09) VALUE SPACES.              
           05  S-PTNT-FIRST-NAME   PIC X(15) VALUE SPACES.              
           05  S-PTNT-MIDDLE-NAME  PIC X(15) VALUE SPACES.              
T36932     05  S-PTNT-LAST-NAME    PIC X(40) VALUE SPACES.              
           05  S-PTNT-SUFFIX       PIC X(03) VALUE SPACES.              
           05  S-PTNT-DOB          PIC X(10) VALUE SPACES.              
           05  S-PTNT-PHONE        PIC X(10) VALUE SPACES.              
           05  S-RELATIONSHIP      PIC X(15) VALUE SPACES.              
           05  S-MED-COND-CODE     PIC X(02) VALUE SPACES.              
           05  S-MED-COND-DESC     PIC X(100) VALUE SPACES.             
           05  S-AMBULANCE-FL      PIC X(01) VALUE SPACES.              
           05  S-PTNT-ASSIST-FL    PIC X(01) VALUE SPACES.              
           05  S-MED-LICENCE-NO    PIC X(09) VALUE SPACES.              
           05  S-MED-LIC-STATE-CD  PIC X(02) VALUE SPACES.              
           05  S-PHY-PREFIX        PIC X(09) VALUE SPACES.              
           05  S-PHY-FIRST-NAME    PIC X(15) VALUE SPACES.              
           05  S-PHY-MIDDLE-NAME   PIC X(15) VALUE SPACES.              
T36932     05  S-PHY-LAST-NAME     PIC X(40) VALUE SPACES.              
           05  S-PHY-SUFFIX        PIC X(03) VALUE SPACES.              
           05  S-ADDRESS-ID        PIC S9(13)V COMP-3 VALUE 0.          
           05  S-DURATION          PIC S9(09)V COMP-3 VALUE 0.          
           05  S-COMMENT           PIC X(255) VALUE SPACES.             
           05  S-APPLICATION-ID    PIC S9(09) COMP  VALUE 0.            
           05  S-PHYSICIAN-ID      PIC S9(09) COMP  VALUE 0.            
           05  S-HCP-EXTN          PIC X(6)   VALUE SPACES.             
           05  S-HCP-PHONE         PIC X(10)  VALUE SPACES.             
A01849     05  S-HOUSE-NO          PIC X(15)  VALUE SPACES.             
           05  S-ADDR-PREFIX-1     PIC X(3)   VALUE SPACES.             
           05  S-ADDR-PREFIX-2     PIC X(2)   VALUE SPACES.             
T36932     05  S-STREET-NAME       PIC X(30)  VALUE SPACES.             
           05  S-STREET-LOCATION-1 PIC X(4)   VALUE SPACES.             
T36932     05  S-STREET-LOCATION-2 PIC X(11)   VALUE SPACES.            
           05  S-STREET-SUFFIX     PIC X(4)   VALUE SPACES.             
           05  S-ADDRESS-OVERFLOW  PIC X(35)  VALUE SPACES.             
           05  S-ZIP-CODE          PIC X(5)   VALUE SPACES.             
           05  S-ZIP-CODE-PLU-FOUR PIC X(4)   VALUE SPACES.             
           05  S-ZIP-CODE-TOKEN    PIC X(1)   VALUE SPACES.             
           05  S-ADDR-SUFFIX       PIC X(2)   VALUE SPACES.             
           05  S-PTNT-NAME-ID      PIC S9(13)V COMP-3 VALUE 0.          
           05  S-PTNT-OTHRACCT-ACTV PIC X(01) VALUE SPACES.             
P00793     05  S-CITY              PIC X(26)  VALUE SPACES.             
P00793     05  S-STATE             PIC X(02)  VALUE SPACES.             
P00793     05  S-ADDRESS-FORMAT    PIC X(01)  VALUE SPACES.             
P00793     05  S-ADDR-FF-STREET    PIC X(55)  VALUE SPACES.             
P00793     05  S-ADDR-FF-CITY-STATE PIC X(30)  VALUE SPACES.            
P00793     05  S-ADDR-FF-ZIP-CODE  PIC X(09)  VALUE SPACES.             
P00793     05  S-ADDR-FF-OVERFLOW  PIC X(35)  VALUE SPACES.             
      *                                                                         
HPCCDM*    EJECT                                                                
      ******************************************************************        
      *                                                                *        
      *  CURSOR DECLARATION FOR THE CSS_WH_CROSS_PLUS TABLE.           *        
      *                                                                *        
      ******************************************************************        
           EXEC SQL                                                     
             DECLARE WH_CROSS_PLUS_CRSR CURSOR FOR                      
             SELECT WO.APPLICATION_ID                                   
                   ,WO.NAME_ID                                          
                   ,WO.PHYSICIAN_ID                                     
                   ,WO.STATUS_CD                                        
                   ,WO.DATE_TRANS                                       
                   ,COALESCE(CIS.CHAR2$DATE(WO.EFFECTIVE_DT, 'USA'),' ')        
                   ,COALESCE(CIS.CHAR2$DATE(
           WO.EXPIRATION_DT, 'USA'),' ')             
                   ,WO.COMMENT                                          
                   ,WO.ADDRESS_ID                                       
                   ,WO.MED_COND_CODE                                    
                   ,WO.MEDICAL_COND_DESC                                
                   ,WO.AMBULANCE_FL                                     
                   ,WO.PATIENT_ASSIST_FL                                
                   ,WO.PATIENT_RELATION                                 
                   ,WO.PATIENT_PH_NO                                    
               FROM CSS_WH_CROSS_PLUS WO                                
              WHERE WO.ACCOUNT_NO    = :WO-ACCOUNT-NO                   
              FOR READ ONLY                                            
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ004
MFA-TR* MSQ029
MFA-TR*    EXEC SQL                                                             
MFA-TR*      DECLARE WH_CROSS_PLUS_CRSR CURSOR FOR                              
MFA-TR*      SELECT WO.APPLICATION_ID                                           
MFA-TR*            ,WO.NAME_ID                                                  
MFA-TR*            ,WO.PHYSICIAN_ID                                             
MFA-TR*            ,WO.STATUS_CD                                                
MFA-TR*            ,WO.DATE_TRANS                                               
MFA-TR*            ,IFNULL(CHAR(WO.EFFECTIVE_DT, USA),' ')                      
MFA-TR*            ,IFNULL(CHAR(WO.EXPIRATION_DT, USA),' ')                     
MFA-TR*            ,WO.COMMENT                                                  
MFA-TR*            ,WO.ADDRESS_ID                                               
MFA-TR*            ,WO.MED_COND_CODE                                            
MFA-TR*            ,WO.MEDICAL_COND_DESC                                        
MFA-TR*            ,WO.AMBULANCE_FL                                             
MFA-TR*            ,WO.PATIENT_ASSIST_FL                                        
MFA-TR*            ,WO.PATIENT_RELATION                                         
MFA-TR*            ,WO.PATIENT_PH_NO                                            
MFA-TR*        FROM CSS_WH_CROSS_PLUS WO                                        
MFA-TR*       WHERE WO.ACCOUNT_NO    = :WO-ACCOUNT-NO                           
MFA-TR*       FOR FETCH ONLY                                                    
MFA-TR*    END-EXEC.                                                            
      *                                                                         
                                                                        
       LINKAGE SECTION.                                                 
       01  I-ACCOUNT-NO         PIC X(13).                              
       PROCEDURE DIVISION USING I-ACCOUNT-NO.                           
      *                                                                         
      ******************************************************************        
      * 0000-MAINLINE                                                  *        
      *     CALLS 0100-INITIALIZE                                      *        
      *           1000-PROCESS-INPUT                                   *        
      *           2000-PROCESS-OUTPUT                                  *        
      *           9999-END-PROGRAM                                     *        
      *                                                                *        
      *     CONTROLS THE MAIN PATH OF THE PROGRAM                      *        
      ******************************************************************        
                                                                        
       0000-MAINLINE.                                                   
           PERFORM 0100-INITIALIZE     THRU 0100-EXIT.                  
           PERFORM 1000-PROCESS-INPUT  THRU 1000-EXIT.                  
           PERFORM 2000-PROCESS-OUTPUT THRU 2000-EXIT.                  
           PERFORM 9999-END-PROGRAM    THRU 9999-EXIT.                  
       0000-EXIT.                                                       
           EXIT.                                                        
                                                                        
      ******************************************************************        
      * 0100-INITIALIZE                                                *        
      *     CALLS 9000-SEND-ERROR-RESULT                               *        
      *           9900-SQL-ERROR-ROUTINE                               *        
      *                                                                *        
      *     CALLED FROM 0000-MAINLINE                                  *        
      *                                                                *        
      *     1. RESET DB2 ERROR HANDLERS                                *        
      *     2. ESTABLISH GATEWAY ENVIRONMENT (TDINIT)                  *        
      *     3. ACCEPT CLIENT REQUEST/ESTABLISH SNA HANDLE (TDACCEPT)   *        
      *     4. DETERMINE IF CLIENT HAS SENT AN RPC PARAMETER (TDRESULT)*        
      *                                                                *        
      ******************************************************************        
                                                                        
       0100-INITIALIZE.                                                 
                                                                        
           MOVE '0100'          TO ACTIVE-PARAGRAPH.                    
                                                                        
           EXEC SQL WHENEVER SQLWARNING CONTINUE END-EXEC.              
           EXEC SQL WHENEVER SQLERROR   CONTINUE END-EXEC.              
           EXEC SQL WHENEVER NOT FOUND  CONTINUE END-EXEC.              
                                                                        
                                                                        
           PERFORM 0100A-DECLARE-GTT     THRU 0100A-EXIT.               
           EXEC SQL                                                     
               DECLARE C1 CURSOR  FOR                        
               SELECT                                                   
                   RETURN_CODE                                          
                  ,STATUS_CD                                            
                  ,EXPIRATION_DT                                        
                  ,EFFECTIVE_DT                                         
                  ,LTRIM(RTRIM(PTNT_SSN))                AS PTNT_SSN           
                  ,LTRIM(RTRIM(PTNT_PREFIX))             AS PTNT_PREFIX        
                  ,LTRIM(RTRIM(PTNT_FIRST_NAME))         AS 
           PTNT_FIRST_NAME    
                  ,LTRIM(RTRIM(PTNT_MIDDLE_NAME))        AS 
           PTNT_MIDDLE_NAME   
                  ,LTRIM(RTRIM(PTNT_LAST_NAME))          AS 
           PTNT_LAST_NAME     
                  ,LTRIM(RTRIM(PTNT_SUFFIX))             AS PTNT_SUFFIX        
                  ,PTNT_DOB                                             
                  ,PTNT_PHONE                                           
                  ,LTRIM(RTRIM(RELATIONSHIP))            AS RELATIONSHIP       
                  ,MED_COND_CODE                                        
                  ,LTRIM(RTRIM(MED_COND_DESC))           AS 
           MED_COND_DESC      
                  ,AMBULANCE_FL                                         
                  ,PTNT_ASSIST_FL                                       
                  ,LTRIM(RTRIM(MED_LICENCE_NO))          AS 
           MED_LICENCE_NO     
                  ,MED_LIC_STATE_CD                                     
                  ,LTRIM(RTRIM(PHY_PREFIX))              AS PHY_PREFIX         
                  ,LTRIM(RTRIM(PHY_FIRST_NAME))          AS 
           PHY_FIRST_NAME     
                  ,LTRIM(RTRIM(PHY_MIDDLE_NAME))         AS 
           PHY_MIDDLE_NAME    
                  ,LTRIM(RTRIM(PHY_LAST_NAME))           AS 
           PHY_LAST_NAME      
                  ,LTRIM(RTRIM(PHY_SUFFIX))              AS PHY_SUFFIX         
                  ,ADDRESS_ID                                           
                  ,DURATION                                             
                  ,LTRIM(RTRIM(COMMENT))            AS COMMENT                 
                  ,APPLICATION_ID                                       
                  ,PHYSICIAN_ID                                         
                  ,LTRIM(RTRIM(HCP_EXTN))           AS HCP_EXTN                
                  ,LTRIM(RTRIM(HCP_PHONE))          AS HCP_PHONE               
                  ,LTRIM(RTRIM(HOUSE_NO))           AS HOUSE_NO                
                  ,LTRIM(RTRIM(ADDR_PREFIX_1))      AS ADDR_PREFIX_1           
                  ,LTRIM(RTRIM(ADDR_PREFIX_2))      AS ADDR_PREFIX_2           
                  ,LTRIM(RTRIM(STREET_NAME))        AS STREET_NAME             
                  ,LTRIM(RTRIM(STREET_LOCATION_1))  AS STREET_LOCATION_1       
                  ,LTRIM(RTRIM(STREET_LOCATION_2))  AS STREET_LOCATION_2       
                  ,LTRIM(RTRIM(STREET_SUFFIX))      AS STREET_SUFFIX           
                  ,LTRIM(RTRIM(ADDR_OVERFLO))       AS ADDR_OVERFLO            
                  ,LTRIM(RTRIM(ZIP_CODE))           AS ZIP_CODE                
                  ,LTRIM(RTRIM(ZIP_CODE_PLUS_FOUR)) AS 
           ZIP_CODE_PLUS_FOUR      
                  ,LTRIM(RTRIM(ZIP_CODE_TOKEN))     AS ZIP_CODE_TOKEN          
                  ,LTRIM(RTRIM(ADDR_SUFFIX))        AS ADDR_SUFFIX             
                  ,PTNT_NAME_ID                                         
                  ,PTNT_OTHRACCT_ACTV                                   
                  ,LTRIM(RTRIM(CITY))               AS CITY                    
                  ,LTRIM(RTRIM(STATE))              AS STATE                   
                  ,LTRIM(RTRIM(ADDRESS_FORMAT))     AS ADDRESS_FORMAT          
                  ,LTRIM(RTRIM(ADDR_FF_STREET))     AS ADDR_FF_STREET          
                  ,LTRIM(RTRIM(ADDR_FF_CITY_STATE)) AS 
           ADDR_FF_CITY_STATE      
                  ,LTRIM(RTRIM(ADDR_FF_ZIP_CODE))   AS ADDR_FF_ZIP_CODE        
                  ,LTRIM(RTRIM(ADDR_FF_OVERFLOW))   AS ADDR_FF_OVERFLOW        
               FROM                                                     
                   #CSR03827_R1                                  
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ029
MFA-TR* MSQ049
MFA-TR*    EXEC SQL                                                             
MFA-TR*        DECLARE C1 CURSOR WITH RETURN FOR                                
MFA-TR*        SELECT                                                           
MFA-TR*            RETURN_CODE                                                  
MFA-TR*           ,STATUS_CD                                                    
MFA-TR*           ,EXPIRATION_DT                                                
MFA-TR*           ,EFFECTIVE_DT                                                 
MFA-TR*           ,STRIP(PTNT_SSN)                AS PTNT_SSN                   
MFA-TR*           ,STRIP(PTNT_PREFIX)             AS PTNT_PREFIX                
MFA-TR*           ,STRIP(PTNT_FIRST_NAME)         AS PTNT_FIRST_NAME            
MFA-TR*           ,STRIP(PTNT_MIDDLE_NAME)        AS PTNT_MIDDLE_NAME           
MFA-TR*           ,STRIP(PTNT_LAST_NAME)          AS PTNT_LAST_NAME             
MFA-TR*           ,STRIP(PTNT_SUFFIX)             AS PTNT_SUFFIX                
MFA-TR*           ,PTNT_DOB                                                     
MFA-TR*           ,PTNT_PHONE                                                   
MFA-TR*           ,STRIP(RELATIONSHIP)            AS RELATIONSHIP               
MFA-TR*           ,MED_COND_CODE                                                
MFA-TR*           ,STRIP(MED_COND_DESC)           AS MED_COND_DESC              
MFA-TR*           ,AMBULANCE_FL                                                 
MFA-TR*           ,PTNT_ASSIST_FL                                               
MFA-TR*           ,STRIP(MED_LICENCE_NO)          AS MED_LICENCE_NO             
MFA-TR*           ,MED_LIC_STATE_CD                                             
MFA-TR*           ,STRIP(PHY_PREFIX)              AS PHY_PREFIX                 
MFA-TR*           ,STRIP(PHY_FIRST_NAME)          AS PHY_FIRST_NAME             
MFA-TR*           ,STRIP(PHY_MIDDLE_NAME)         AS PHY_MIDDLE_NAME            
MFA-TR*           ,STRIP(PHY_LAST_NAME)           AS PHY_LAST_NAME              
MFA-TR*           ,STRIP(PHY_SUFFIX)              AS PHY_SUFFIX                 
MFA-TR*           ,ADDRESS_ID                                                   
MFA-TR*           ,DURATION                                                     
MFA-TR*           ,STRIP(COMMENT)            AS COMMENT                         
MFA-TR*           ,APPLICATION_ID                                               
MFA-TR*           ,PHYSICIAN_ID                                                 
MFA-TR*           ,STRIP(HCP_EXTN)           AS HCP_EXTN                        
MFA-TR*           ,STRIP(HCP_PHONE)          AS HCP_PHONE                       
MFA-TR*           ,STRIP(HOUSE_NO)           AS HOUSE_NO                        
MFA-TR*           ,STRIP(ADDR_PREFIX_1)      AS ADDR_PREFIX_1                   
MFA-TR*           ,STRIP(ADDR_PREFIX_2)      AS ADDR_PREFIX_2                   
MFA-TR*           ,STRIP(STREET_NAME)        AS STREET_NAME                     
MFA-TR*           ,STRIP(STREET_LOCATION_1)  AS STREET_LOCATION_1               
MFA-TR*           ,STRIP(STREET_LOCATION_2)  AS STREET_LOCATION_2               
MFA-TR*           ,STRIP(STREET_SUFFIX)      AS STREET_SUFFIX                   
MFA-TR*           ,STRIP(ADDR_OVERFLO)       AS ADDR_OVERFLO                    
MFA-TR*           ,STRIP(ZIP_CODE)           AS ZIP_CODE                        
MFA-TR*           ,STRIP(ZIP_CODE_PLUS_FOUR) AS ZIP_CODE_PLUS_FOUR              
MFA-TR*           ,STRIP(ZIP_CODE_TOKEN)     AS ZIP_CODE_TOKEN                  
MFA-TR*           ,STRIP(ADDR_SUFFIX)        AS ADDR_SUFFIX                     
MFA-TR*           ,PTNT_NAME_ID                                                 
MFA-TR*           ,PTNT_OTHRACCT_ACTV                                           
MFA-TR*           ,STRIP(CITY)               AS CITY                            
MFA-TR*           ,STRIP(STATE)              AS STATE                           
MFA-TR*           ,STRIP(ADDRESS_FORMAT)     AS ADDRESS_FORMAT                  
MFA-TR*           ,STRIP(ADDR_FF_STREET)     AS ADDR_FF_STREET                  
MFA-TR*           ,STRIP(ADDR_FF_CITY_STATE) AS ADDR_FF_CITY_STATE              
MFA-TR*           ,STRIP(ADDR_FF_ZIP_CODE)   AS ADDR_FF_ZIP_CODE                
MFA-TR*           ,STRIP(ADDR_FF_OVERFLOW)   AS ADDR_FF_OVERFLOW                
MFA-TR*        FROM                                                             
MFA-TR*            SESSION.CSR03827_R1                                          
MFA-TR*    END-EXEC.                                                            
       0100-EXIT.                                                       
           EXIT.                                                        
                                                                        
      ******************************************************************        
      *0100A-DECLARE-GTT.                                                       
      ******************************************************************        
       0100A-DECLARE-GTT.                                               
      *                                                                         
            MOVE 'DECLARE GLOBAL TEMPORARY TABLE CSR03827_R1'           
                                          TO S-SQL-STATEMENT-V.         
            EXEC SQL
              CALL CIS.DROP_TEMP_TABLE('#CSR03827_R1')
            END-EXEC
            EXEC SQL
              CREATE TABLE #CSR03827_R1
               (                                                       
                   RETURN_CODE                    INT               
                  ,STATUS_CD CHAR(01)  COLLATE LATIN1_GENERAL_100_BIN2          
                  ,EXPIRATION_DT CHAR(10)  COLLATE 
                                 LATIN1_GENERAL_100_BIN2              
                  ,EFFECTIVE_DT CHAR(10)  COLLATE 
                                 LATIN1_GENERAL_100_BIN2              
                  ,PTNT_SSN CHAR(09)  COLLATE LATIN1_GENERAL_100_BIN2           
                  ,PTNT_PREFIX CHAR(09)  COLLATE LATIN1_GENERAL_100_BIN2        
                  ,PTNT_FIRST_NAME CHAR(15)  COLLATE 
                                 LATIN1_GENERAL_100_BIN2              
                  ,PTNT_MIDDLE_NAME CHAR(15)  COLLATE 
                                 LATIN1_GENERAL_100_BIN2              
T36932            ,PTNT_LAST_NAME CHAR(40)  COLLATE 
                                 LATIN1_GENERAL_100_BIN2              
                  ,PTNT_SUFFIX CHAR(03)  COLLATE LATIN1_GENERAL_100_BIN2        
                  ,PTNT_DOB CHAR(10)  COLLATE LATIN1_GENERAL_100_BIN2           
                  ,PTNT_PHONE CHAR(10)  COLLATE LATIN1_GENERAL_100_BIN2         
                  ,RELATIONSHIP CHAR(15)  COLLATE 
                                 LATIN1_GENERAL_100_BIN2              
                  ,MED_COND_CODE CHAR(02)  COLLATE 
                                 LATIN1_GENERAL_100_BIN2              
                  ,MED_COND_DESC CHAR(100)  COLLATE 
                                 LATIN1_GENERAL_100_BIN2             
                  ,AMBULANCE_FL CHAR(01)  COLLATE 
                                 LATIN1_GENERAL_100_BIN2              
                  ,PTNT_ASSIST_FL CHAR(01)  COLLATE 
                                 LATIN1_GENERAL_100_BIN2              
                  ,MED_LICENCE_NO CHAR(09)  COLLATE 
                                 LATIN1_GENERAL_100_BIN2              
                  ,MED_LIC_STATE_CD CHAR(02)  COLLATE 
                                 LATIN1_GENERAL_100_BIN2              
                  ,PHY_PREFIX CHAR(09)  COLLATE LATIN1_GENERAL_100_BIN2         
                  ,PHY_FIRST_NAME CHAR(15)  COLLATE 
                                 LATIN1_GENERAL_100_BIN2              
                  ,PHY_MIDDLE_NAME CHAR(15)  COLLATE 
                                 LATIN1_GENERAL_100_BIN2              
T36932            ,PHY_LAST_NAME CHAR(40)  COLLATE 
                                 LATIN1_GENERAL_100_BIN2              
                  ,PHY_SUFFIX CHAR(09)  COLLATE LATIN1_GENERAL_100_BIN2         
                  ,ADDRESS_ID                     DECIMAL(13,0)         
                  ,DURATION                       DECIMAL(9,0)          
                  ,COMMENT CHAR(255)  COLLATE LATIN1_GENERAL_100_BIN2           
                  ,APPLICATION_ID                 INT               
                  ,PHYSICIAN_ID                   INT               
                  ,HCP_EXTN CHAR(6)  COLLATE LATIN1_GENERAL_100_BIN2            
                  ,HCP_PHONE CHAR(10)  COLLATE LATIN1_GENERAL_100_BIN2          
T36932            ,HOUSE_NO CHAR(15)  COLLATE LATIN1_GENERAL_100_BIN2           
                  ,ADDR_PREFIX_1 CHAR(3)  COLLATE 
                                 LATIN1_GENERAL_100_BIN2               
                  ,ADDR_PREFIX_2 CHAR(2)  COLLATE 
                                 LATIN1_GENERAL_100_BIN2               
T36932            ,STREET_NAME CHAR(30)  COLLATE LATIN1_GENERAL_100_BIN2        
                  ,STREET_LOCATION_1 CHAR(4)  COLLATE 
                                 LATIN1_GENERAL_100_BIN2               
T36932            ,STREET_LOCATION_2 CHAR(11)  COLLATE 
                                 LATIN1_GENERAL_100_BIN2              
                  ,STREET_SUFFIX CHAR(4)  COLLATE 
                                 LATIN1_GENERAL_100_BIN2               
                  ,ADDR_OVERFLO CHAR(35)  COLLATE 
                                 LATIN1_GENERAL_100_BIN2              
                  ,ZIP_CODE CHAR(5)  COLLATE LATIN1_GENERAL_100_BIN2            
                  ,ZIP_CODE_PLUS_FOUR CHAR(4)  COLLATE 
                                 LATIN1_GENERAL_100_BIN2               
                  ,ZIP_CODE_TOKEN CHAR(1)  COLLATE 
                                 LATIN1_GENERAL_100_BIN2               
                  ,ADDR_SUFFIX CHAR(2)  COLLATE LATIN1_GENERAL_100_BIN2         
                  ,PTNT_NAME_ID                   DECIMAL(13,0)         
                  ,PTNT_OTHRACCT_ACTV CHAR(1)  COLLATE 
                                 LATIN1_GENERAL_100_BIN2               
                  ,CITY CHAR(26)  COLLATE LATIN1_GENERAL_100_BIN2              
                  ,STATE CHAR(02)  COLLATE LATIN1_GENERAL_100_BIN2              
                  ,ADDRESS_FORMAT CHAR(01)  COLLATE 
                                 LATIN1_GENERAL_100_BIN2              
                  ,ADDR_FF_STREET CHAR(55)  COLLATE 
                                 LATIN1_GENERAL_100_BIN2              
                  ,ADDR_FF_CITY_STATE CHAR(30)  COLLATE 
                                 LATIN1_GENERAL_100_BIN2              
                  ,ADDR_FF_ZIP_CODE CHAR(09)  COLLATE 
                                 LATIN1_GENERAL_100_BIN2              
                  ,ADDR_FF_OVERFLOW CHAR(35)  COLLATE 
                                 LATIN1_GENERAL_100_BIN2              
                )
            END-EXEC.                                                   

MSQ017     CALL "MFASQLCA"
MSQ017       USING SQLCA, BY VALUE MFA-PROGRAM-ID, "0", "0", "0",
MSQ017       BY REFERENCE MFSQLMESSAGETEXT
MSQ017     END-CALL

      *                                                                         
            MOVE SQLSTATE                 TO WS-SQLSTATE.               
            MOVE SQLCODE                  TO WS-ACTIVE-RETURN-CODE      
      *                                                                         
            IF WS-SQLSTATE = '42710'                                    
               PERFORM 8000A-DELETE-GTT-ROWS                            
                                          THRU 8000A-EXIT               
            ELSE                                                        
               IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL               
                  CONTINUE                                              
               ELSE                                                     
                 MOVE WS-ACTIVE-RETURN-CODE TO RS-RETURN-CODE           
                 MOVE PROGRAM-NAME       TO ABEND-PROGRAM               
                 MOVE SQLCODE            TO ABEND-SQLCODE               
                 MOVE SQLSTATE           TO ABEND-SQLSTATE              
                 MOVE '0100A'            TO ACTIVE-PARAGRAPH            
                 MOVE 'DECLARE GTT'      TO ABEND-FUNCTION              
                 MOVE SPACES             TO ABEND-SQL-PREDICATES        
                                            ABEND-TABLES                
                 MOVE 'CSR03827_R1'      TO TABLE-1                     
                 MOVE SPACES             TO TABLE-ELEMENT-1             
                 MOVE SPACES             TO HOSTVAR-ELEMENT-1           
                 PERFORM 9900-SQL-ERROR-ROUTINE                         
                                         THRU  9900-EXIT                
              END-IF                                                    
           END-IF.                                                      
      *                                                                         
       0100A-EXIT.                                                      
            EXIT.                                                       
      ******************************************************************        
      * 1000-PROCESS-INPUT                                             *        
      *     CALLS 1100-RECEIVE-PARMS                                   *        
      *                                                                *        
      *     CALLED FROM 0000-MAINLINE                                  *        
      *                                                                *        
      *     1. RECEIVE PARMS.                                          *        
      ******************************************************************        
                                                                        
       1000-PROCESS-INPUT.                                              
      *                                                                         
           MOVE I-ACCOUNT-NO          TO WS-ACCOUNT-NO                  
           MOVE WS-ACCOUNT-NO-NUM     TO WS-ACCOUNT-NO-COMP3            
           MOVE WS-ACCOUNT-NO-COMP3   TO WO-ACCOUNT-NO.                 
      *                                                                         
       1000-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ******************************************************************        
      * 2000-PROCESS-OUTPUT.                                           *        
      *     CALLS 2100-DESCRIBE-RESULT                                 *        
      *           2200-BUILD-RESULT-AT                                 *        
      *     CALLED FROM 0000-MAINLINE                                 *         
      *                                                                *        
      *      SETS UP PARAMETERS TO BE RETURNED, POPULATES THE PARMS    *        
      *      AND SENDS THEM BACK                                       *        
      ******************************************************************        
      *                                                                         
       2000-PROCESS-OUTPUT.                                             
      *                                                                         
           MOVE '2000'                           TO ACTIVE-PARAGRAPH.   
           PERFORM 7000-OPEN-WCPLUS-CRSR  THRU 7000-EXIT                
           PERFORM 7010-FETCH-WCPLUS-CRSR THRU 7010-EXIT                
           IF  WS-ACTIVE-RETURN-CODE = NOT-FOUND                        
               MOVE WS-ACTIVE-RETURN-CODE       TO RS-RETURN-CODE       
               MOVE    ZEROES                   TO WO-ADDRESS-ID        
                                                   WO-NAME-ID           
               PERFORM 2100-MOVE-RESULT         THRU 2100-EXIT          
               PERFORM 8100-SEND-RESULT         THRU 8100-EXIT          
           ELSE                                                         
               PERFORM 2010-PROCESS-WCPLUS-CRSR THRU 2010-EXIT          
                 UNTIL WS-ACTIVE-RETURN-CODE = NOT-FOUND                
           END-IF                                                       
           PERFORM 7020-CLOSE-WCPLUS-CRSR THRU 7020-EXIT.               
                                                                        
       2000-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ******************************************************************        
      *2100-MOVE-RESULT.                                                        
      ******************************************************************        
      *                                                                         
       2100-MOVE-RESULT.                                                
      *                                                                         
           MOVE RS-RETURN-CODE        TO S-RETURN-CODE                  
           MOVE WO-STATUS-CD          TO S-STATUS-CD                    
           MOVE WO-EXPIRATION-DT      TO S-EXPIRATION-DT                
           MOVE WO-EFFECTIVE-DT       TO S-EFFECTIVE-DT                 
           MOVE WJ-SSN                TO S-PTNT-SSN                     
           MOVE WS-PTNT-PREFIX        TO S-PTNT-PREFIX                  
           MOVE WS-PTNT-FIRST-NAME    TO S-PTNT-FIRST-NAME              
           MOVE WS-PTNT-MIDDLE-NAME   TO S-PTNT-MIDDLE-NAME             
           MOVE WS-PTNT-LAST-NAME     TO S-PTNT-LAST-NAME               
           MOVE WS-PTNT-SUFFIX        TO S-PTNT-SUFFIX                  
           MOVE WP-PATIENT-DOB        TO S-PTNT-DOB                     
           MOVE WO-PATIENT-PH-NO      TO S-PTNT-PHONE                   
           MOVE WO-PATIENT-RELATION   TO S-RELATIONSHIP                 
           MOVE WO-MED-COND-CODE      TO S-MED-COND-CODE                
           MOVE WO-MEDICAL-COND-DESC-TEXT                               
                                      TO S-MED-COND-DESC                
           MOVE WO-AMBULANCE-FL       TO S-AMBULANCE-FL                 
           MOVE WO-PATIENT-ASSIST-FL  TO S-PTNT-ASSIST-FL               
           MOVE PY-MED-LICENSE-NO     TO S-MED-LICENCE-NO               
           MOVE PY-MED-LIC-STATE-CD   TO S-MED-LIC-STATE-CD             
           MOVE WS-PHY-PREFIX         TO S-PHY-PREFIX                   
           MOVE WS-PHY-FIRST-NAME     TO S-PHY-FIRST-NAME               
           MOVE WS-PHY-MIDDLE-NAME    TO S-PHY-MIDDLE-NAME              
           MOVE WS-PHY-LAST-NAME      TO S-PHY-LAST-NAME                
           MOVE WS-PHY-SUFFIX         TO S-PHY-SUFFIX                   
           MOVE WO-ADDRESS-ID         TO S-ADDRESS-ID.                  
           MOVE WS-DURATION           TO S-DURATION.                    
           MOVE WO-COMMENT-TEXT       TO S-COMMENT.                     
           MOVE WO-APPLICATION-ID     TO S-APPLICATION-ID.              
           MOVE WO-PHYSICIAN-ID       TO S-PHYSICIAN-ID.                
           MOVE PA-EXTENSION-NO       TO S-HCP-EXTN.                    
           MOVE PA-PHONE-NO           TO S-HCP-PHONE.                   
           MOVE DY-HOUSE-NO           TO S-HOUSE-NO.                    
           MOVE DY-ADDR-PREFIX-1      TO S-ADDR-PREFIX-1.               
           MOVE DY-ADDR-PREFIX-2      TO S-ADDR-PREFIX-2.               
           MOVE DY-STREET-NAME        TO S-STREET-NAME.                 
           MOVE DY-STREET-LOCATION-1  TO S-STREET-LOCATION-1.           
           MOVE DY-STREET-LOCATION-2  TO S-STREET-LOCATION-2.           
           MOVE DY-STREET-SUFFIX      TO S-STREET-SUFFIX.               
           MOVE DY-ADDRESS-OVERFLOW   TO S-ADDRESS-OVERFLOW.            
           MOVE DY-ZIP-CODE           TO S-ZIP-CODE.                    
           MOVE DY-ZIP-CODE-PLUS-FOUR TO S-ZIP-CODE-PLU-FOUR.           
           MOVE DY-ZIP-CODE-TOKEN     TO S-ZIP-CODE-TOKEN.              
           MOVE DY-ADDR-SUFFIX        TO S-ADDR-SUFFIX.                 
           MOVE WO-NAME-ID            TO S-PTNT-NAME-ID.                
           MOVE WS-PTNT-OTHRACCT      TO S-PTNT-OTHRACCT-ACTV.          
           MOVE A4-TOWN               TO S-CITY.                        
           MOVE A4-STATE              TO S-STATE.                       
           MOVE PA-ADDRESS-FORMAT     TO S-ADDRESS-FORMAT.              
           MOVE DZ-ADDR-STREET        TO S-ADDR-FF-STREET.              
           MOVE DZ-ADDR-CITY-STATE    TO S-ADDR-FF-CITY-STATE.          
           MOVE DZ-ADDR-ZIP-CODE      TO S-ADDR-FF-ZIP-CODE.            
           MOVE DZ-ADDRESS-OVERFLOW   TO S-ADDR-FF-OVERFLOW.            
      *                                                                         
       2100-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ******************************************************************        
      *    2010-PROCESS-WCPLUS-CRSR.                                   *        
      *                                                                *        
      *    CALLED FROM 2000-PROCESS-OUTPUT                             *        
      *                                                                *        
      *    OPENS AND CLOSES THE AT CURSOR                              *        
      ******************************************************************        
       2010-PROCESS-WCPLUS-CRSR.                                        
      *                                                                         
           MOVE '2010'       TO ACTIVE-PARAGRAPH.                       
           INITIALIZE    WS-PTNT-OTHRACCT.                              
      * USE PATIENT NAME-ID TO GET PATIENT NAME AND SSN                         
           MOVE WO-NAME-ID   TO DQ-NAME-ID                              
                                WJ-NAME-ID                              
                                WP-NAME-ID                              
           PERFORM 7050-SELECT-SSN                                      
              THRU 7050-EXIT                                            
           PERFORM 7060-SELECT-PTNT                                     
              THRU 7060-EXIT                                            
           IF WO-STATUS-CD = 'I' OR 'D'                                 
              PERFORM 7065-SELECT-PTNT-OTHRACCT                         
                 THRU 7065-EXIT                                         
           END-IF                                                       
           IF  WO-EXPIRATION-DT > SPACES                                
           AND WO-EFFECTIVE-DT  > SPACES                                
               MOVE WO-EXPIRATION-DT  TO  WS-EXPIRATION-DT              
               MOVE WO-EFFECTIVE-DT   TO  WS-EFFECTIVE-DT               
               COMPUTE WS-CAL-YEAR  = WS-YEAR1  - WS-YEAR2              
               COMPUTE WS-CAL-MONTH = WS-MONTH1 - WS-MONTH2             
               COMPUTE WS-DURATION                                      
                     = ((WS-CAL-YEAR * 12) + WS-CAL-MONTH)              
           ELSE                                                         
               MOVE ZEROES            TO WS-DURATION                    
           END-IF                                                       
           PERFORM 7030-GET-NAME                                        
              THRU 7030-EXIT                                            
           MOVE DQ-TITLE-PREFIX       TO WS-PTNT-PREFIX                 
           MOVE DQ-FIRST-NAME         TO WS-PTNT-FIRST-NAME             
           MOVE DQ-MIDDLE-NAME        TO WS-PTNT-MIDDLE-NAME            
           MOVE DQ-LAST-NAME          TO WS-PTNT-LAST-NAME              
           MOVE DQ-TITLE-SUFFIX-1     TO WS-PTNT-SUFFIX                 
           PERFORM 2020-GET-PHYSICIAN-DETAILS                           
              THRU 2020-EXIT                                            
           PERFORM 2100-MOVE-RESULT                                     
              THRU 2100-EXIT                                            
           PERFORM 8100-SEND-RESULT         THRU 8100-EXIT              
           INITIALIZE WO-MEDICAL-COND-DESC                              
                      WO-COMMENT                                        
           PERFORM 7010-FETCH-WCPLUS-CRSR THRU 7010-EXIT.               
      *                                                                         
       2010-EXIT.                                                       
           EXIT.                                                        
                                                                        
       2020-GET-PHYSICIAN-DETAILS.                                      
      *                                                                         
           MOVE WO-PHYSICIAN-ID  TO PY-PHYSICIAN-ID                     
                                    PA-PHYSICIAN-ID                     
           MOVE WO-ADDRESS-ID    TO PA-ADDRESS-ID                       
                                    DY-ADDRESS-ID                       
                                    DZ-ADDRESS-ID                       
           PERFORM 7040-GET-PHYSICIAN                                   
              THRU 7040-EXIT                                            
           MOVE PY-NAME-ID       TO DQ-NAME-ID                          
           PERFORM 7030-GET-NAME                                        
              THRU 7030-EXIT                                            
           MOVE DQ-TITLE-PREFIX  TO WS-PHY-PREFIX                       
           MOVE DQ-FIRST-NAME    TO WS-PHY-FIRST-NAME                   
           MOVE DQ-MIDDLE-NAME   TO WS-PHY-MIDDLE-NAME                  
           MOVE DQ-LAST-NAME     TO WS-PHY-LAST-NAME                    
           MOVE DQ-TITLE-SUFFIX-1 TO WS-PHY-SUFFIX.                     
           IF  DY-ADDRESS-ID > 0 AND (PA-ADDRESS-FORMAT ='A'            
           OR  PA-ADDRESS-FORMAT =' ')                                  
               PERFORM 7080-GET-ADDRESS-FIELDS                          
                  THRU 7080-EXIT                                        
           ELSE                                                         
               MOVE SPACES   TO                                         
                             DY-HOUSE-NO                                
                             DY-ADDR-PREFIX-1                           
                             DY-ADDR-PREFIX-2                           
                             DY-STREET-NAME                             
                             DY-STREET-LOCATION-1                       
                             DY-STREET-LOCATION-2                       
                             DY-STREET-SUFFIX                           
                             DY-ADDRESS-OVERFLOW                        
                             DY-ZIP-CODE                                
                             DY-ZIP-CODE-PLUS-FOUR                      
                             DY-ZIP-CODE-TOKEN                          
                             DY-ADDR-SUFFIX                             
                             A4-TOWN                                    
                             A4-STATE                                   
           END-IF.                                                      
           IF  DZ-ADDRESS-ID > 0 AND PA-ADDRESS-FORMAT ='B'             
               PERFORM 7090-GET-FF-ADDRESS-FIELDS                       
                  THRU 7090-EXIT                                        
           ELSE                                                         
               MOVE SPACES   TO                                         
                             DZ-ADDR-STREET                             
                             DZ-ADDR-CITY-STATE                         
                             DZ-ADDR-ZIP-CODE                           
                             DZ-ADDRESS-OVERFLOW                        
           END-IF.                                                      
      *                                                                         
       2020-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ******************************************************************        
      *  OPEN THE CURSOR DECLARED FOR WHITE CROSS PLUS                 *        
      ******************************************************************        
       7000-OPEN-WCPLUS-CRSR.                                           
      *                                                                         
           MOVE '7000'                          TO ACTIVE-PARAGRAPH.    
           EXEC SQL                                                     
               OPEN WH_CROSS_PLUS_CRSR                                  
           END-EXEC.                                                    

MSQ017     CALL "MFASQLCA"
MSQ017       USING SQLCA, BY VALUE MFA-PROGRAM-ID, "0", "0", "0",
MSQ017       BY REFERENCE MFSQLMESSAGETEXT
MSQ017     END-CALL

      *                                                                         
           MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE.                       
      *                                                                         
           IF  WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL              
               CONTINUE                                                 
           ELSE                                                         
               MOVE WS-ACTIVE-RETURN-CODE   TO RS-RETURN-CODE           
               MOVE 'CSR03827'              TO ABEND-PROGRAM            
               MOVE '7000'                  TO ACTIVE-PARAGRAPH         
               MOVE 'OPEN'                  TO ABEND-FUNCTION           
               MOVE 'CSS_WH_CROSS_PLUS'     TO TABLE-1                  
               MOVE 'ACCOUNT_NO '           TO TABLE-ELEMENT-1          
               MOVE WO-ACCOUNT-NO           TO HOSTVAR-ELEMENT-1        
               PERFORM 9000-SEND-ERROR-RESULT  THRU 9000-EXIT           
               PERFORM 9900-SQL-ERROR-ROUTINE  THRU 9900-EXIT           
           END-IF.                                                      
      *                                                                         
       7000-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ******************************************************************        
      *  FETCH THE CURSOR DECLARED FOR WHITE CROSS PLUS  *                      
      ******************************************************************        
       7010-FETCH-WCPLUS-CRSR.                                          
      *                                                                         
           EXEC SQL                                                     
               FETCH WH_CROSS_PLUS_CRSR                                 
               INTO :WO-APPLICATION-ID                                  
                   ,:WO-NAME-ID                                         
                   ,:WO-PHYSICIAN-ID                                    
                   ,:WO-STATUS-CD                                       
                   ,:WO-DATE-TRANS                                      
                   ,:WO-EFFECTIVE-DT                                    
                   ,:WO-EXPIRATION-DT                                   
                   ,:WO-COMMENT                                         
                   ,:WO-ADDRESS-ID                                      
                   ,:WO-MED-COND-CODE                                   
                   ,:WO-MEDICAL-COND-DESC                               
                   ,:WO-AMBULANCE-FL                                    
                   ,:WO-PATIENT-ASSIST-FL                               
                   ,:WO-PATIENT-RELATION                                
                   ,:WO-PATIENT-PH-NO                                   
           END-EXEC.                                                    

MSQ017     CALL "MFASQLCA"
MSQ017       USING SQLCA, BY VALUE MFA-PROGRAM-ID, "0", "0", "0",
MSQ017       BY REFERENCE MFSQLMESSAGETEXT
MSQ017     END-CALL

      *                                                                         
           MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE.                       
      *                                                                         
           IF  WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL OR           
                                           NOT-FOUND                    
               CONTINUE                                                 
           ELSE                                                         
               MOVE WS-ACTIVE-RETURN-CODE   TO RS-RETURN-CODE           
               MOVE 'CSR03827'              TO ABEND-PROGRAM            
               MOVE '7010'                  TO ACTIVE-PARAGRAPH         
               MOVE 'FETCH'                 TO ABEND-FUNCTION           
               MOVE 'CSS_WH_CROSS_PLUS'     TO TABLE-1                  
               MOVE 'ACCOUNT_NO '           TO TABLE-ELEMENT-1          
               MOVE WO-ACCOUNT-NO           TO HOSTVAR-ELEMENT-1        
               PERFORM 9000-SEND-ERROR-RESULT  THRU 9000-EXIT           
               PERFORM 9900-SQL-ERROR-ROUTINE  THRU 9900-EXIT           
           END-IF.                                                      
      *                                                                         
       7010-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ******************************************************************        
      *  CLOSE THE CURSOR DECLARED FOR WHITE CROSS PLUS  *                      
      ******************************************************************        
       7020-CLOSE-WCPLUS-CRSR.                                          
      *                                                                         
           EXEC SQL                                                     
               CLOSE WH_CROSS_PLUS_CRSR                                 
           END-EXEC.                                                    

MSQ017     CALL "MFASQLCA"
MSQ017       USING SQLCA, BY VALUE MFA-PROGRAM-ID, "0", "0", "0",
MSQ017       BY REFERENCE MFSQLMESSAGETEXT
MSQ017     END-CALL

      *                                                                         
           MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE.                       
      *                                                                         
           IF  WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL              
               CONTINUE                                                 
           ELSE                                                         
               MOVE WS-ACTIVE-RETURN-CODE   TO RS-RETURN-CODE           
               MOVE 'CSR03827'              TO ABEND-PROGRAM            
               MOVE '7020'                  TO ACTIVE-PARAGRAPH         
               MOVE 'CLOSE'                 TO ABEND-FUNCTION           
               MOVE 'CSS_WH_CROSS_PLUS'     TO TABLE-1                  
               MOVE 'ACCOUNT_NO '           TO TABLE-ELEMENT-1          
               MOVE WO-ACCOUNT-NO           TO HOSTVAR-ELEMENT-1        
               PERFORM 9000-SEND-ERROR-RESULT  THRU 9000-EXIT           
               PERFORM 9900-SQL-ERROR-ROUTINE  THRU 9900-EXIT           
           END-IF.                                                      
      *                                                                         
       7020-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
       7030-GET-NAME.                                                   
      *                                                                         
                                                                        
           EXEC SQL                                                     
      *                                                                         
             SELECT  FIRST_NAME                                         
                   , MIDDLE_NAME                                        
                   , LAST_NAME                                          
                   , TITLE_PREFIX                                       
                   , TITLE_SUFFIX_1                                     
               INTO :DQ-FIRST-NAME                                      
                   ,:DQ-MIDDLE-NAME                                     
                   ,:DQ-LAST-NAME                                       
                   ,:DQ-TITLE-PREFIX                                    
                   ,:DQ-TITLE-SUFFIX-1                                  
               FROM CSS_NAME                                            
              WHERE NAME_ID = :DQ-NAME-ID                               
      *                                                                         
           END-EXEC.                                                    

MSQ017     CALL "MFASQLCA"
MSQ017       USING SQLCA, BY VALUE MFA-PROGRAM-ID, "0", "0", "0",
MSQ017       BY REFERENCE MFSQLMESSAGETEXT
MSQ017     END-CALL

      *                                                                         
           MOVE SQLCODE                TO WS-ACTIVE-RETURN-CODE         
      *                                                                         
           IF  WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL              
           OR  NOT-FOUND                                                
               IF  WS-ACTIVE-RETURN-CODE = NOT-FOUND                    
                   MOVE SPACES         TO DQ-FIRST-NAME                 
                                          DQ-MIDDLE-NAME                
                                          DQ-LAST-NAME                  
                                          DQ-TITLE-PREFIX               
                                          DQ-TITLE-SUFFIX-1             
               END-IF                                                   
           ELSE                                                         
              MOVE WS-ACTIVE-RETURN-CODE   TO RS-RETURN-CODE            
              MOVE PROGRAM-NAME        TO ABEND-PROGRAM                 
              MOVE '7030'              TO ACTIVE-PARAGRAPH              
              MOVE 'SELECT'            TO ABEND-FUNCTION                
              MOVE 'CSS_NAME'          TO TABLE-1                       
              MOVE 'ACCOUNT_NO'        TO TABLE-ELEMENT-1               
              MOVE WO-ACCOUNT-NO       TO HOSTVAR-ELEMENT-1             
              MOVE 'NAME_ID'           TO TABLE-ELEMENT-2               
              MOVE DQ-NAME-ID          TO HOSTVAR-ELEMENT-2             
              PERFORM 9000-SEND-ERROR-RESULT  THRU 9000-EXIT            
              PERFORM 9900-SQL-ERROR-ROUTINE  THRU 9900-EXIT            
           END-IF.                                                      
      *                                                                         
       7030-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
       7040-GET-PHYSICIAN.                                              
      *                                                                         
           EXEC SQL                                                     
      *                                                                         
             SELECT  PY.MED_LIC_STATE_CD                                
                   , PY.MED_LICENSE_NO                                  
                   , PY.NAME_ID                                         
                   , PA.EXTENSION_NO                                    
                   , PA.PHONE_NO                                        
                   , PA.ADDRESS_FORMAT                                  
               INTO :PY-MED-LIC-STATE-CD                                
                   ,:PY-MED-LICENSE-NO                                  
                   ,:PY-NAME-ID                                         
                   ,:PA-EXTENSION-NO                                    
                   ,:PA-PHONE-NO                                        
                   ,:PA-ADDRESS-FORMAT                                  
               FROM CSS_PHYSICIAN PY                                    
                   ,CSS_PHYSICIAN_ATTR PA                               
              WHERE PY.PHYSICIAN_ID = :PY-PHYSICIAN-ID                  
                AND PY.PHYSICIAN_ID = PA.PHYSICIAN_ID                   
                AND PA.ADDRESS_ID   = :PA-ADDRESS-ID                    
      *                                                                         
           END-EXEC.                                                    

MSQ017     CALL "MFASQLCA"
MSQ017       USING SQLCA, BY VALUE MFA-PROGRAM-ID, "0", "0", "0",
MSQ017       BY REFERENCE MFSQLMESSAGETEXT
MSQ017     END-CALL

      *                                                                         
           MOVE SQLCODE                TO WS-ACTIVE-RETURN-CODE.        
      *                                                                         
           IF  WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL              
               CONTINUE                                                 
           ELSE                                                         
              MOVE WS-ACTIVE-RETURN-CODE TO RS-RETURN-CODE              
              MOVE PROGRAM-NAME         TO ABEND-PROGRAM                
              MOVE '7040'               TO ACTIVE-PARAGRAPH             
              MOVE 'SELECT'             TO ABEND-FUNCTION               
              MOVE 'CSS_PHYSICIAN'      TO TABLE-1                      
              MOVE 'CSS_PHYSICIAN_ATTR' TO TABLE-1                      
              MOVE 'ACCOUNT_NO'         TO TABLE-ELEMENT-1              
              MOVE WO-ACCOUNT-NO        TO HOSTVAR-ELEMENT-1            
              MOVE 'PHYSICIAN_ID'       TO TABLE-ELEMENT-2              
              MOVE PY-PHYSICIAN-ID      TO HOSTVAR-ELEMENT-2            
              MOVE 'ADDRESS_ID'         TO TABLE-ELEMENT-3              
              MOVE PA-ADDRESS-ID        TO HOSTVAR-ELEMENT-3            
              PERFORM 9000-SEND-ERROR-RESULT  THRU 9000-EXIT            
              PERFORM 9900-SQL-ERROR-ROUTINE  THRU 9900-EXIT            
           END-IF.                                                      
      *                                                                         
       7040-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
       7050-SELECT-SSN.                                                 
                                                                        
                                                                        
           EXEC SQL                                                     
      *                                                                         
             SELECT SSN                                                 
               INTO :WJ-SSN                                             
               FROM CSS_WH_CROSS_SSN                                    
              WHERE NAME_ID = :WJ-NAME-ID                               
      *                                                                         
           END-EXEC.                                                    

MSQ017     CALL "MFASQLCA"
MSQ017       USING SQLCA, BY VALUE MFA-PROGRAM-ID, "0", "0", "0",
MSQ017       BY REFERENCE MFSQLMESSAGETEXT
MSQ017     END-CALL

      *                                                                         
           MOVE SQLCODE                TO WS-ACTIVE-RETURN-CODE         
      *                                                                         
           IF  WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL              
               CONTINUE                                                 
           ELSE                                                         
              IF WS-ACTIVE-RETURN-CODE EQUAL NOT-FOUND                  
                 MOVE SPACES TO WJ-SSN                                  
              ELSE                                                      
                 MOVE WS-ACTIVE-RETURN-CODE TO RS-RETURN-CODE           
                 MOVE PROGRAM-NAME        TO ABEND-PROGRAM              
                 MOVE '7050'              TO ACTIVE-PARAGRAPH           
                 MOVE 'SELECT'            TO ABEND-FUNCTION             
                 MOVE 'CSS_WH_CROSS_SSN'  TO TABLE-1                    
                 MOVE 'ACCOUNT_NO'        TO TABLE-ELEMENT-1            
                 MOVE WO-ACCOUNT-NO       TO HOSTVAR-ELEMENT-1          
                 MOVE 'NAME_ID'           TO TABLE-ELEMENT-2            
                 MOVE WJ-NAME-ID          TO HOSTVAR-ELEMENT-2          
                 PERFORM 9000-SEND-ERROR-RESULT  THRU 9000-EXIT         
                 PERFORM 9900-SQL-ERROR-ROUTINE  THRU 9900-EXIT         
             END-IF                                                     
           END-IF.                                                      
      *                                                                         
       7050-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
       7060-SELECT-PTNT.                                                
                                                                        
                                                                        
           EXEC SQL                                                     
      *                                                                         
             SELECT COALESCE(CIS.CHAR2$DATE(PATIENT_DOB, 'USA'),' ')            
               INTO :WP-PATIENT-DOB                                     
               FROM CSS_WH_CROSS_PATNT                                  
              WHERE NAME_ID = :WP-NAME-ID                               
      *                                                                         
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ029
MFA-TR*    EXEC SQL                                                             
MFA-TR*                                                                         
MFA-TR*      SELECT IFNULL(CHAR(PATIENT_DOB, USA),' ')                          
MFA-TR*        INTO :WP-PATIENT-DOB                                             
MFA-TR*        FROM CSS_WH_CROSS_PATNT                                          
MFA-TR*       WHERE NAME_ID = :WP-NAME-ID                                       
MFA-TR*                                                                         
MFA-TR*    END-EXEC.                                                            

MSQ017     CALL "MFASQLCA"
MSQ017       USING SQLCA, BY VALUE MFA-PROGRAM-ID, "0", "0", "0",
MSQ017       BY REFERENCE MFSQLMESSAGETEXT
MSQ017     END-CALL

      *                                                                         
           MOVE SQLCODE                TO WS-ACTIVE-RETURN-CODE         
      *                                                                         
           IF  WS-ACTIVE-RETURN-CODE EQUAL SUCCESSFUL-CALL              
               CONTINUE                                                 
           ELSE                                                         
               MOVE WS-ACTIVE-RETURN-CODE TO RS-RETURN-CODE             
               MOVE PROGRAM-NAME          TO ABEND-PROGRAM              
               MOVE '7060'                TO ACTIVE-PARAGRAPH           
               MOVE 'SELECT'              TO ABEND-FUNCTION             
               MOVE 'CSS_WH_CROSS_PATNT'  TO TABLE-1                    
               MOVE 'ACCOUNT_NO'          TO TABLE-ELEMENT-1            
               MOVE WO-ACCOUNT-NO         TO HOSTVAR-ELEMENT-1          
               MOVE 'NAME_ID'             TO TABLE-ELEMENT-2            
               MOVE WP-NAME-ID            TO HOSTVAR-ELEMENT-2          
               PERFORM 9000-SEND-ERROR-RESULT  THRU 9000-EXIT           
               PERFORM 9900-SQL-ERROR-ROUTINE  THRU 9900-EXIT           
           END-IF.                                                      
      *                                                                         
       7060-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
       7065-SELECT-PTNT-OTHRACCT.                                       
      *                                                                 15024666
           EXEC SQL                                                     
              SELECT TOP(1) 'Y'                                                
                 INTO :WS-PTNT-OTHRACCT                                 
              FROM CSS_WH_CROSS_PLUS                                    
              WHERE NAME_ID = :WO-NAME-ID                               
                 AND ACCOUNT_NO <> :WO-ACCOUNT-NO                       
                 AND STATUS_CD = 'A'                                    
                                                    
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ020
MFA-TR*    EXEC SQL                                                     15024669
MFA-TR*       SELECT 'Y'                                                15024670
MFA-TR*          INTO :WS-PTNT-OTHRACCT                                 15024671
MFA-TR*       FROM CSS_WH_CROSS_PLUS                                    15024672
MFA-TR*       WHERE NAME_ID = :WO-NAME-ID                               15024673
MFA-TR*          AND ACCOUNT_NO <> :WO-ACCOUNT-NO                               
MFA-TR*          AND STATUS_CD = 'A'                                            
MFA-TR*          FETCH FIRST ROW ONLY                                           
MFA-TR*    END-EXEC.                                                    15024674

MSQ017     CALL "MFASQLCA"
MSQ017       USING SQLCA, BY VALUE MFA-PROGRAM-ID, "0", "0", "0",
MSQ017       BY REFERENCE MFSQLMESSAGETEXT
MSQ017     END-CALL

                                                                        
           MOVE SQLCODE                   TO WS-ACTIVE-RETURN-CODE.     
           IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL OR NOT-FOUND      
               NEXT SENTENCE                                            
           ELSE                                                         
               MOVE WS-ACTIVE-RETURN-CODE TO RS-RETURN-CODE             
               MOVE PROGRAM-NAME          TO ABEND-PROGRAM              
               MOVE '7065'                TO ACTIVE-PARAGRAPH           
               MOVE 'SELECT'              TO ABEND-FUNCTION             
               MOVE 'CSS_WH_CROSS_PLUS'   TO TABLE-1                    
               MOVE 'ACCOUNT_NO'          TO TABLE-ELEMENT-1            
               MOVE WO-ACCOUNT-NO         TO HOSTVAR-ELEMENT-1          
               MOVE 'NAME_ID'             TO TABLE-ELEMENT-2            
               MOVE WO-NAME-ID            TO HOSTVAR-ELEMENT-2          
               PERFORM 9000-SEND-ERROR-RESULT  THRU 9000-EXIT           
               PERFORM 9900-SQL-ERROR-ROUTINE  THRU 9900-EXIT           
           END-IF.                                                      
      *                                                                 15025201
       7065-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
       7080-GET-ADDRESS-FIELDS.                                         
      *                                                                         
           MOVE '7080'                        TO ACTIVE-PARAGRAPH.      
                                                                        
           EXEC SQL                                                     
               SELECT  DY.HOUSE_NO                                      
                      ,DY.ADDR_PREFIX_1                                 
                      ,DY.ADDR_PREFIX_2                                 
                      ,DY.STREET_NAME                                   
                      ,DY.STREET_LOCATION_1                             
                      ,DY.STREET_LOCATION_2                             
                      ,DY.STREET_SUFFIX                                 
                      ,DY.ADDRESS_OVERFLOW                              
                      ,DY.ZIP_CODE                                      
                      ,DY.ZIP_CODE_PLUS_FOUR                            
                      ,DY.ZIP_CODE_TOKEN                                
                      ,DY.ADDR_SUFFIX                                   
                      ,A4.TOWN                                          
                      ,A4.STATE                                         
                 INTO :DY-HOUSE-NO                                      
                     ,:DY-ADDR-PREFIX-1                                 
                     ,:DY-ADDR-PREFIX-2                                 
                     ,:DY-STREET-NAME                                   
                     ,:DY-STREET-LOCATION-1                             
                     ,:DY-STREET-LOCATION-2                             
                     ,:DY-STREET-SUFFIX                                 
                     ,:DY-ADDRESS-OVERFLOW                              
                     ,:DY-ZIP-CODE                                      
                     ,:DY-ZIP-CODE-PLUS-FOUR                            
                     ,:DY-ZIP-CODE-TOKEN                                
                     ,:DY-ADDR-SUFFIX                                   
                     ,:A4-TOWN                                          
                     ,:A4-STATE                                         
                 FROM CSS_ADDR_FORMATTED DY                             
                     ,CSS_ZIP_CODE       A4                             
                WHERE DY.ADDRESS_ID     = :DY-ADDRESS-ID                
                  AND DY.ZIP_CODE       = A4.ZIP_CODE                   
                  AND DY.ZIP_CODE_TOKEN = A4.ZIP_CODE_TOKEN             
           END-EXEC.                                                    

MSQ017     CALL "MFASQLCA"
MSQ017       USING SQLCA, BY VALUE MFA-PROGRAM-ID, "0", "0", "0",
MSQ017       BY REFERENCE MFSQLMESSAGETEXT
MSQ017     END-CALL

      *                                                                         
           MOVE SQLCODE                     TO WS-ACTIVE-RETURN-CODE    
                                                                        
           IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                   
              CONTINUE                                                  
           ELSE                                                         
              MOVE WS-ACTIVE-RETURN-CODE      TO RS-RETURN-CODE         
              MOVE PROGRAM-NAME               TO ABEND-PROGRAM          
              MOVE '7080'                     TO ACTIVE-PARAGRAPH       
              MOVE 'SELECT'                   TO ABEND-FUNCTION         
              MOVE 'CSS_ADDR_FORMATTED'       TO TABLE-1                
              MOVE 'ADDRESS_ID'               TO TABLE-ELEMENT-1        
              MOVE DY-ADDRESS-ID              TO HOSTVAR-ELEMENT-1      
              MOVE 'ACCOUNT_NO'               TO TABLE-ELEMENT-2        
              MOVE WO-ACCOUNT-NO              TO HOSTVAR-ELEMENT-2      
              PERFORM 9000-SEND-ERROR-RESULT        THRU 9000-EXIT      
              PERFORM 9900-SQL-ERROR-ROUTINE        THRU 9900-EXIT      
           END-IF.                                                      
      *                                                                         
       7080-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
       7090-GET-FF-ADDRESS-FIELDS.                                      
      *                                                                         
           MOVE '7090'                        TO ACTIVE-PARAGRAPH.      
                                                                        
           EXEC SQL                                                     
               SELECT  ADDR_STREET                                      
                      ,ADDR_CITY_STATE                                  
                      ,ADDR_ZIP_CODE                                    
                      ,ADDRESS_OVERFLOW                                 
                 INTO :DZ-ADDR-STREET                                   
                     ,:DZ-ADDR-CITY-STATE                               
                     ,:DZ-ADDR-ZIP-CODE                                 
                     ,:DZ-ADDRESS-OVERFLOW                              
                 FROM CSS_ADDR_FREEFORM                                 
                WHERE ADDRESS_ID = :DZ-ADDRESS-ID                       
           END-EXEC.                                                    

MSQ017     CALL "MFASQLCA"
MSQ017       USING SQLCA, BY VALUE MFA-PROGRAM-ID, "0", "0", "0",
MSQ017       BY REFERENCE MFSQLMESSAGETEXT
MSQ017     END-CALL

      *                                                                         
           MOVE SQLCODE                     TO WS-ACTIVE-RETURN-CODE    
                                                                        
           IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                   
              CONTINUE                                                  
           ELSE                                                         
              MOVE WS-ACTIVE-RETURN-CODE      TO RS-RETURN-CODE         
              MOVE PROGRAM-NAME               TO ABEND-PROGRAM          
              MOVE '7090'                     TO ACTIVE-PARAGRAPH       
              MOVE 'SELECT'                   TO ABEND-FUNCTION         
              MOVE 'CSS_ADDR_FREEFORM'        TO TABLE-1                
              MOVE 'ADDRESS_ID'               TO TABLE-ELEMENT-1        
              MOVE DZ-ADDRESS-ID              TO HOSTVAR-ELEMENT-1      
              MOVE 'ACCOUNT_NO'               TO TABLE-ELEMENT-2        
              MOVE WO-ACCOUNT-NO              TO HOSTVAR-ELEMENT-2      
              PERFORM 9000-SEND-ERROR-RESULT        THRU 9000-EXIT      
              PERFORM 9900-SQL-ERROR-ROUTINE        THRU 9900-EXIT      
           END-IF.                                                      
      *                                                                         
       7090-EXIT.                                                       
           EXIT.                                                        
      *                                                                         
      ******************************************************************        
      *8000A-DELETE-GTT-ROWS.                                                   
      ******************************************************************        
       8000A-DELETE-GTT-ROWS.                                           
      *                                                                         
            MOVE 'DELETE ROWS'            TO S-SQL-STATEMENT-V.         
      *                                                                         
            EXEC SQL                                                    
                DELETE FROM #CSR03827_R1                         
            END-EXEC.                                                   

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ049
MFA-TR*     EXEC SQL                                                            
MFA-TR*         DELETE FROM SESSION.CSR03827_R1                                 
MFA-TR*     END-EXEC.                                                           

MSQ017     CALL "MFASQLCA"
MSQ017       USING SQLCA, BY VALUE MFA-PROGRAM-ID, "0", "0", "0",
MSQ017       BY REFERENCE MFSQLMESSAGETEXT
MSQ017     END-CALL

      *                                                                         
            MOVE SQLCODE                  TO WS-ACTIVE-RETURN-CODE.     
      *                                                                         
            IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL OR NOT-FOUND     
               CONTINUE                                                 
            ELSE                                                        
               MOVE WS-ACTIVE-RETURN-CODE TO RS-RETURN-CODE             
               MOVE PROGRAM-NAME          TO  ABEND-PROGRAM             
               MOVE '8000A'               TO  ACTIVE-PARAGRAPH          
               MOVE 'DELETE'              TO  ABEND-FUNCTION            
               MOVE SQLCODE               TO  ABEND-SQLCODE             
               MOVE SPACES                TO  ABEND-SQL-PREDICATES      
                                              ABEND-TABLES              
               MOVE 'CSR03827_R1'         TO  TABLE-1                   
               MOVE SPACES                TO  TABLE-ELEMENT-1           
               MOVE SPACES                TO  HOSTVAR-ELEMENT-1         
               PERFORM 9000-SEND-ERROR-RESULT                           
                                          THRU 9000-EXIT                
               PERFORM 9900-SQL-ERROR-ROUTINE                           
                                          THRU 9900-EXIT                
            END-IF.                                                     
      *                                                                         
       8000A-EXIT.                                                      
            EXIT.                                                       
      ******************************************************************        
      *8100-SEND-RESULT.                                                        
      ******************************************************************        
       8100-SEND-RESULT.                                                
                                                                        
           EXEC SQL                                                     
               INSERT INTO #CSR03827_R1                          
               (                                                        
                   RETURN_CODE                                          
                  ,STATUS_CD                                            
                  ,EXPIRATION_DT                                        
                  ,EFFECTIVE_DT                                         
                  ,PTNT_SSN                                             
                  ,PTNT_PREFIX                                          
                  ,PTNT_FIRST_NAME                                      
                  ,PTNT_MIDDLE_NAME                                     
                  ,PTNT_LAST_NAME                                       
                  ,PTNT_SUFFIX                                          
                  ,PTNT_DOB                                             
                  ,PTNT_PHONE                                           
                  ,RELATIONSHIP                                         
                  ,MED_COND_CODE                                        
                  ,MED_COND_DESC                                        
                  ,AMBULANCE_FL                                         
                  ,PTNT_ASSIST_FL                                       
                  ,MED_LICENCE_NO                                       
                  ,MED_LIC_STATE_CD                                     
                  ,PHY_PREFIX                                           
                  ,PHY_FIRST_NAME                                       
                  ,PHY_MIDDLE_NAME                                      
                  ,PHY_LAST_NAME                                        
                  ,PHY_SUFFIX                                           
                  ,ADDRESS_ID                                           
                  ,DURATION                                             
                  ,COMMENT                                              
                  ,APPLICATION_ID                                       
                  ,PHYSICIAN_ID                                         
                  ,HCP_EXTN                                             
                  ,HCP_PHONE                                            
                  ,HOUSE_NO                                             
                  ,ADDR_PREFIX_1                                        
                  ,ADDR_PREFIX_2                                        
                  ,STREET_NAME                                          
                  ,STREET_LOCATION_1                                    
                  ,STREET_LOCATION_2                                    
                  ,STREET_SUFFIX                                        
                  ,ADDR_OVERFLO                                         
                  ,ZIP_CODE                                             
                  ,ZIP_CODE_PLUS_FOUR                                   
                  ,ZIP_CODE_TOKEN                                       
                  ,ADDR_SUFFIX                                          
                  ,PTNT_NAME_ID                                         
                  ,PTNT_OTHRACCT_ACTV                                   
                  ,CITY                                                 
                  ,STATE                                                
                  ,ADDRESS_FORMAT                                       
                  ,ADDR_FF_STREET                                       
                  ,ADDR_FF_CITY_STATE                                   
                  ,ADDR_FF_ZIP_CODE                                     
                  ,ADDR_FF_OVERFLOW                                     
               )                                                        
               VALUES                                                   
               (                                                        
               :S-RETURN-CODE                                           
              ,:S-STATUS-CD                                             
              ,:S-EXPIRATION-DT                                         
              ,:S-EFFECTIVE-DT                                          
              ,:S-PTNT-SSN                                              
              ,:S-PTNT-PREFIX                                           
              ,:S-PTNT-FIRST-NAME                                       
              ,:S-PTNT-MIDDLE-NAME                                      
              ,:S-PTNT-LAST-NAME                                        
              ,:S-PTNT-SUFFIX                                           
              ,:S-PTNT-DOB                                              
              ,:S-PTNT-PHONE                                            
              ,:S-RELATIONSHIP                                          
              ,:S-MED-COND-CODE                                         
              ,:S-MED-COND-DESC                                         
              ,:S-AMBULANCE-FL                                          
              ,:S-PTNT-ASSIST-FL                                        
              ,:S-MED-LICENCE-NO                                        
              ,:S-MED-LIC-STATE-CD                                      
              ,:S-PHY-PREFIX                                            
              ,:S-PHY-FIRST-NAME                                        
              ,:S-PHY-MIDDLE-NAME                                       
              ,:S-PHY-LAST-NAME                                         
              ,:S-PHY-SUFFIX                                            
              ,:S-ADDRESS-ID                                            
              ,:S-DURATION                                              
              ,:S-COMMENT                                               
              ,:S-APPLICATION-ID                                        
              ,:S-PHYSICIAN-ID                                          
              ,:S-HCP-EXTN                                              
              ,:S-HCP-PHONE                                             
              ,:S-HOUSE-NO                                              
              ,:S-ADDR-PREFIX-1                                         
              ,:S-ADDR-PREFIX-2                                         
              ,:S-STREET-NAME                                           
              ,:S-STREET-LOCATION-1                                     
              ,:S-STREET-LOCATION-2                                     
              ,:S-STREET-SUFFIX                                         
              ,:S-ADDRESS-OVERFLOW                                      
              ,:S-ZIP-CODE                                              
              ,:S-ZIP-CODE-PLU-FOUR                                     
              ,:S-ZIP-CODE-TOKEN                                        
              ,:S-ADDR-SUFFIX                                           
              ,:S-PTNT-NAME-ID                                          
              ,:S-PTNT-OTHRACCT-ACTV                                    
              ,:S-CITY                                                  
              ,:S-STATE                                                 
              ,:S-ADDRESS-FORMAT                                        
              ,:S-ADDR-FF-STREET                                        
              ,:S-ADDR-FF-CITY-STATE                                    
              ,:S-ADDR-FF-ZIP-CODE                                      
              ,:S-ADDR-FF-OVERFLOW                                      
              )                                                         
           END-EXEC.                                                    

MFA-TR* TRANSFORMATION LIST
MFA-TR* MSQ049
MFA-TR*    EXEC SQL                                                             
MFA-TR*        INSERT INTO SESSION.CSR03827_R1                                  
MFA-TR*        (                                                                
MFA-TR*            RETURN_CODE                                                  
MFA-TR*           ,STATUS_CD                                                    
MFA-TR*           ,EXPIRATION_DT                                                
MFA-TR*           ,EFFECTIVE_DT                                                 
MFA-TR*           ,PTNT_SSN                                                     
MFA-TR*           ,PTNT_PREFIX                                                  
MFA-TR*           ,PTNT_FIRST_NAME                                              
MFA-TR*           ,PTNT_MIDDLE_NAME                                             
MFA-TR*           ,PTNT_LAST_NAME                                               
MFA-TR*           ,PTNT_SUFFIX                                                  
MFA-TR*           ,PTNT_DOB                                                     
MFA-TR*           ,PTNT_PHONE                                                   
MFA-TR*           ,RELATIONSHIP                                                 
MFA-TR*           ,MED_COND_CODE                                                
MFA-TR*           ,MED_COND_DESC                                                
MFA-TR*           ,AMBULANCE_FL                                                 
MFA-TR*           ,PTNT_ASSIST_FL                                               
MFA-TR*           ,MED_LICENCE_NO                                               
MFA-TR*           ,MED_LIC_STATE_CD                                             
MFA-TR*           ,PHY_PREFIX                                                   
MFA-TR*           ,PHY_FIRST_NAME                                               
MFA-TR*           ,PHY_MIDDLE_NAME                                              
MFA-TR*           ,PHY_LAST_NAME                                                
MFA-TR*           ,PHY_SUFFIX                                                   
MFA-TR*           ,ADDRESS_ID                                                   
MFA-TR*           ,DURATION                                                     
MFA-TR*           ,COMMENT                                                      
MFA-TR*           ,APPLICATION_ID                                               
MFA-TR*           ,PHYSICIAN_ID                                                 
MFA-TR*           ,HCP_EXTN                                                     
MFA-TR*           ,HCP_PHONE                                                    
MFA-TR*           ,HOUSE_NO                                                     
MFA-TR*           ,ADDR_PREFIX_1                                                
MFA-TR*           ,ADDR_PREFIX_2                                                
MFA-TR*           ,STREET_NAME                                                  
MFA-TR*           ,STREET_LOCATION_1                                            
MFA-TR*           ,STREET_LOCATION_2                                            
MFA-TR*           ,STREET_SUFFIX                                                
MFA-TR*           ,ADDR_OVERFLO                                                 
MFA-TR*           ,ZIP_CODE                                                     
MFA-TR*           ,ZIP_CODE_PLUS_FOUR                                           
MFA-TR*           ,ZIP_CODE_TOKEN                                               
MFA-TR*           ,ADDR_SUFFIX                                                  
MFA-TR*           ,PTNT_NAME_ID                                                 
MFA-TR*           ,PTNT_OTHRACCT_ACTV                                           
MFA-TR*           ,CITY                                                         
MFA-TR*           ,STATE                                                        
MFA-TR*           ,ADDRESS_FORMAT                                               
MFA-TR*           ,ADDR_FF_STREET                                               
MFA-TR*           ,ADDR_FF_CITY_STATE                                           
MFA-TR*           ,ADDR_FF_ZIP_CODE                                             
MFA-TR*           ,ADDR_FF_OVERFLOW                                             
MFA-TR*        )                                                                
MFA-TR*        VALUES                                                           
MFA-TR*        (                                                                
MFA-TR*        :S-RETURN-CODE                                                   
MFA-TR*       ,:S-STATUS-CD                                                     
MFA-TR*       ,:S-EXPIRATION-DT                                                 
MFA-TR*       ,:S-EFFECTIVE-DT                                                  
MFA-TR*       ,:S-PTNT-SSN                                                      
MFA-TR*       ,:S-PTNT-PREFIX                                                   
MFA-TR*       ,:S-PTNT-FIRST-NAME                                               
MFA-TR*       ,:S-PTNT-MIDDLE-NAME                                              
MFA-TR*       ,:S-PTNT-LAST-NAME                                                
MFA-TR*       ,:S-PTNT-SUFFIX                                                   
MFA-TR*       ,:S-PTNT-DOB                                                      
MFA-TR*       ,:S-PTNT-PHONE                                                    
MFA-TR*       ,:S-RELATIONSHIP                                                  
MFA-TR*       ,:S-MED-COND-CODE                                                 
MFA-TR*       ,:S-MED-COND-DESC                                                 
MFA-TR*       ,:S-AMBULANCE-FL                                                  
MFA-TR*       ,:S-PTNT-ASSIST-FL                                                
MFA-TR*       ,:S-MED-LICENCE-NO                                                
MFA-TR*       ,:S-MED-LIC-STATE-CD                                              
MFA-TR*       ,:S-PHY-PREFIX                                                    
MFA-TR*       ,:S-PHY-FIRST-NAME                                                
MFA-TR*       ,:S-PHY-MIDDLE-NAME                                               
MFA-TR*       ,:S-PHY-LAST-NAME                                                 
MFA-TR*       ,:S-PHY-SUFFIX                                                    
MFA-TR*       ,:S-ADDRESS-ID                                                    
MFA-TR*       ,:S-DURATION                                                      
MFA-TR*       ,:S-COMMENT                                                       
MFA-TR*       ,:S-APPLICATION-ID                                                
MFA-TR*       ,:S-PHYSICIAN-ID                                                  
MFA-TR*       ,:S-HCP-EXTN                                                      
MFA-TR*       ,:S-HCP-PHONE                                                     
MFA-TR*       ,:S-HOUSE-NO                                                      
MFA-TR*       ,:S-ADDR-PREFIX-1                                                 
MFA-TR*       ,:S-ADDR-PREFIX-2                                                 
MFA-TR*       ,:S-STREET-NAME                                                   
MFA-TR*       ,:S-STREET-LOCATION-1                                             
MFA-TR*       ,:S-STREET-LOCATION-2                                             
MFA-TR*       ,:S-STREET-SUFFIX                                                 
MFA-TR*       ,:S-ADDRESS-OVERFLOW                                              
MFA-TR*       ,:S-ZIP-CODE                                                      
MFA-TR*       ,:S-ZIP-CODE-PLU-FOUR                                             
MFA-TR*       ,:S-ZIP-CODE-TOKEN                                                
MFA-TR*       ,:S-ADDR-SUFFIX                                                   
MFA-TR*       ,:S-PTNT-NAME-ID                                                  
MFA-TR*       ,:S-PTNT-OTHRACCT-ACTV                                            
MFA-TR*       ,:S-CITY                                                          
MFA-TR*       ,:S-STATE                                                         
MFA-TR*       ,:S-ADDRESS-FORMAT                                                
MFA-TR*       ,:S-ADDR-FF-STREET                                                
MFA-TR*       ,:S-ADDR-FF-CITY-STATE                                            
MFA-TR*       ,:S-ADDR-FF-ZIP-CODE                                              
MFA-TR*       ,:S-ADDR-FF-OVERFLOW                                              
MFA-TR*       )                                                                 
MFA-TR*    END-EXEC.                                                            

MSQ017     CALL "MFASQLCA"
MSQ017       USING SQLCA, BY VALUE MFA-PROGRAM-ID, "0", "0", "0",
MSQ017       BY REFERENCE MFSQLMESSAGETEXT
MSQ017     END-CALL

      *                                                                         
             MOVE SQLCODE TO WS-ACTIVE-RETURN-CODE.                     
      *                                                                         
             IF WS-ACTIVE-RETURN-CODE = SUCCESSFUL-CALL                 
                ADD +1                    TO  CTR-ROWS                  
             ELSE                                                       
                MOVE PROGRAM-NAME         TO  ABEND-PROGRAM             
                MOVE '8100'               TO  ACTIVE-PARAGRAPH          
                MOVE 'INSERT'             TO  ABEND-FUNCTION            
                MOVE SQLCODE              TO  ABEND-SQLCODE             
                MOVE SPACES               TO  ABEND-SQL-PREDICATES      
                                              ABEND-TABLES              
                MOVE 'CSR03827_R1'        TO  TABLE-1                   
                MOVE SPACES               TO  TABLE-ELEMENT-1           
                MOVE SPACES               TO  HOSTVAR-ELEMENT-1         
                PERFORM 9900-SQL-ERROR-ROUTINE  THRU 9900-EXIT          
             END-IF.                                                    
      *                                                                         
       8100-EXIT.                                                       
            EXIT.                                                       
      ******************************************************************        
      * 9900- JOURNALING / ERROR HANDLING INCLUDE                      *        
      ******************************************************************        
                                                                        
           EXEC SQL                                                             
              INCLUDE CPDSP300                                                  
           END-EXEC.                                                            
      ******************************************************************        
      *       END PROGRAM COPYLIB                                      *        
      ******************************************************************        
                                                                        
           EXEC SQL                                                             
              INCLUDE CPD00320                                                  
           END-EXEC.                                                            
