      Process pgmname(longmixed),lib,thread NSYMBOL(NATIONAL)
      ******************************************************
      * THIS PROGRAM IS CALLED TO PROCESS RECORDS          *
      * PASSED TO THIS PROGRAM THAT WILL THEN CALL THE JAVA*
      * CMS MCE JAR. DATA IS RETURNED TO CALLING PGM       *
      ******************************************************
       IDENTIFICATION DIVISION.
       PROGRAM-ID. "MCT410JV" RECURSIVE.
      ************************
      * ENV / DATA DIVISIONS *
      ************************
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       REPOSITORY.
400        Class ZUtil   is "com.ibm.jzos.ZUtil"
           Class Base is "java.lang.Object"
           Class jstring is "jstring"
NEW410     Class JavaException is "java.lang.Exception"
NEW410     Class JavaObject    is "java.lang.Object"
NEW410     Class JavaString    is "java.lang.String"
NEW410     Class JavaClass     is "java.lang.Class"
NEW410     Class jint          is "jint"
           Class Mce  is
               "gov/cms/mainframe/editor/mce/Mce".
400   ******************************************************
      * CLASS ZUTIL WAS ADDED TO REROUTE SYSOUT            *
      ******************************************************
       DATA DIVISION.
      ******************************************************
      * WORKING STORAGE                                    *
      ******************************************************
       WORKING-STORAGE SECTION.
       01  WS-Parm-String   object reference jstring.
       01  WS-Return-String object reference jstring.
       01  WS-Return-String-length object reference jstring.
       01  WS-length-field                   PIC S9(9) COMP-5.
       01  RC                                PIC S9(9) COMP-5.
NEW410 01  ex             object reference JavaException.
NEW391 01  VOID                              PIC S9(9) COMP-5.
       01  DEBUG-TRACKING.
           03 DISP-IND                       PIC X(01).
      *add 1 byte. 501 instead of 500
      *Required for the x'00' for newstringplatform
       01  WS-INTERFACE-AREA-1               PIC X(0500).
       01  WS-CLAIM-INPUT-RECORD REDEFINES WS-INTERFACE-AREA-1.
           07 WS-CLAIM-AGE                    PIC X(03).
           07 WS-CLAIM-SEX                    PIC X(01).
           07 WS-CLAIM-DISCHARGE-STATUS       PIC X(02).
           07 WS-CLAIM-LOS                    PIC X(05).
           07 WS-CLAIM-DISCHARGE-DATE         PIC X(08).
           07 WS-CLAIM-DISCHARGE-DATE-N REDEFINES
              WS-CLAIM-DISCHARGE-DATE         PIC 9(08).
           07 WS-DIAG-CODES                   PIC X(208).
           07 WS-PROC-CODES                   PIC X(175).
           07 WS-PROV                         PIC X(15).
           07 WS-PPS                          PIC X(1).
           07 WS-I9-I10-IND                   PIC X(1).
           07 FILLER                          PIC X(80).
           07 WS-DEBUG-IND                    PIC X(1).
NEW410     07 FILLER                          PIC X(01).
NEW410 01 WS-JAVA-WORK-AREA                  PIC N(0500).
      *add 1 byte. 1143 instead of 1142
      *Required for the x'00' for newstringplatform
CHG391 01  WS-INTERFACE-AREA-2               PIC X(1143).
       01  WS-CLAIM-OTPUT-RECORD REDEFINES WS-INTERFACE-AREA-2.
           07 WS-OUT-CMSMCE-VER                  PIC X(03).
           07 WS-OUT-CMSMCE-OUTADXFLAG           PIC X(01).
CHG391     07 WS-OUT-CMSMCE-OUTDXFLGS            PIC X(500).
CHG391     07 WS-OUT-CMSMCE-OUTPRFLGS            PIC X(500).
           07 WS-OUT-CMSMCE-OUTBUFF.
              09 WS-OUT-CMSMCE-OUTPROV           PIC X(15).
              09 WS-OUT-CMSMCE-PPS               PIC X(01).
              09 WS-OUT-CMSMCE-ACCUMS            PIC X(120).
              09 FILLER     REDEFINES WS-OUT-CMSMCE-ACCUMS.
                 11 OUTEDITS  OCCURS 60 TIMES PIC X(02).
              09 WS-OUT-CMSMCE-OUTEDFLAG         PIC X(02).
      ******************************************************
      ******************************************************
      * COMMUNICATION AREA                                 *
      ******************************************************
       LINKAGE SECTION.
       01  LNK-INTERFACE-AREA-1                  PIC X(0500).
       01  LNK-CLAIM-INPUT-RECORD REDEFINES LNK-INTERFACE-AREA-1.
           07 LNK-CLAIM-AGE                   PIC X(03).
           07 LNK-CLAIM-SEX                   PIC X(01).
           07 LNK-CLAIM-DISCHARGE-STATUS      PIC X(02).
           07 LNK-CLAIM-LOS                   PIC X(05).
           07 LNK-CLAIM-DISCHARGE-DATE        PIC X(08).
           07 LNK-DIAG-CODES                  PIC X(208).
           07 LNK-PROC-CODES                  PIC X(175).
           07 LNK-PROV                        PIC X(15).
           07 LNK-PPS                         PIC X(1).
           07 LNK-I9-I10-IND                  PIC X(1).
           07 FILLER                          PIC X(80).
           07 LNK-DEBUG-IND                   PIC X(1).
CHG391 01  LNK-INTERFACE-AREA-2                  PIC X(1142).
       01  LNK-INTERFACE-AREA-2-RD REDEFINES LNK-INTERFACE-AREA-2.
           07 LNK-OUT-CMSMCE-VER                 PIC X(03).
           07 LNK-OUT-CMSMCE-OUTADXFLAG          PIC X(01).
CHG391     07 LNK-OUT-CMSMCE-OUTDXFLGS           PIC X(500).
CHG391     07 LNK-OUT-CMSMCE-OUTPRFLGS           PIC X(500).
           07 LNK-OUT-CMSMCE-OUTBUFF.
              09 LNK-OUT-CMSMCE-OUTPROV          PIC X(15).
              09 LNK-OUT-CMSMCE-PPS              PIC X(01).
              09 LNK-OUT-CMSMCE-ACCUMS           PIC X(120).
              09 FILLER     REDEFINES LNK-OUT-CMSMCE-ACCUMS.
                 11 OUTEDITS  OCCURS 60 TIMES PIC X(02).
              09 LNK-OUT-CMSMCE-OUTEDFLAG        PIC X(02).
       COPY JNI.
      ******************************************************
      * PROGRAM EXECUTION                                  *
      ******************************************************
       PROCEDURE DIVISION USING
                 LNK-INTERFACE-AREA-1
                 LNK-INTERFACE-AREA-2.
       0100-MAINLINE.
           SET ADDRESS OF JNIENV TO JNIENVPTR
           SET ADDRESS OF JNINATIVEINTERFACE TO JNIENV
           MOVE SPACES TO WS-INTERFACE-AREA-1.
           MOVE 'N'    TO DISP-IND.
           IF LNK-DEBUG-IND                = 'Y'
              MOVE 'Y' TO DISP-IND.
           IF DISP-IND = 'Y'
              DISPLAY "0100 COMPILE DATE 06/27/2023"
              DISPLAY "     COBOL PROGRAM MCT410JV ENTERED"
              DISPLAY "      WS-INTERFACE-AREA-1          "
                             WS-INTERFACE-AREA-1
              DISPLAY "      WS-I9-I10-IND                "
                             WS-I9-I10-IND
              DISPLAY "     LNK-INTERFACE-AREA-1          "
                            LNK-INTERFACE-AREA-1.
           MOVE LNK-CLAIM-AGE              TO WS-CLAIM-AGE
           MOVE LNK-CLAIM-SEX              TO WS-CLAIM-SEX
           MOVE LNK-CLAIM-DISCHARGE-STATUS TO
                                           WS-CLAIM-DISCHARGE-STATUS
           MOVE LNK-CLAIM-LOS              TO WS-CLAIM-LOS
           MOVE LNK-CLAIM-DISCHARGE-DATE   TO WS-CLAIM-DISCHARGE-DATE
           MOVE LNK-DIAG-CODES  TO WS-DIAG-CODES
           MOVE LNK-PROC-CODES  TO WS-PROC-CODES
           MOVE LNK-PROV        TO WS-PROV
           MOVE LNK-PPS         TO WS-PPS
           MOVE LNK-I9-I10-IND  TO WS-I9-I10-IND
           MOVE LNK-DEBUG-IND   TO WS-DEBUG-IND.
      ******************************************************
      * SET ICD INDICATOR TO I9 = 9 OR I10 = 0             *
      * IF DISCHARGE DATE PRIOR TO 10/01/2015 SET TO I9 =9 *
      * IF DISCHARGE DATE >=    TO 10/01/2015 SET TO I10=0 *
      ******************************************************
           IF  WS-CLAIM-DISCHARGE-DATE-N <  20151001
               MOVE '9' TO WS-I9-I10-IND
           ELSE
               MOVE '0' TO WS-I9-I10-IND.
400        IF DISP-IND = 'Y'
              DISPLAY "      WS-INTERFACE-AREA-1          "
                             WS-INTERFACE-AREA-1.
400   ******************************************************
      * BELOW CLASS ADDED TO REROUTE SYSOUT                *
      ******************************************************
           IF DISP-IND = 'Y'
              DISPLAY "    JUST BEFORE ZUTIL DIRECT CALL".
400        Invoke ZUtil "redirectStandardStreams"
400        IF DISP-IND = 'Y'
400        Display "Returned from ZUtil.redirectStandardStreams".
      *------------------------------------------------------------*
      *    Call NewStringPlatform to convert from EBCDIC to jstring
      *------------------------------------------------------------*
           IF DISP-IND = 'Y'
              DISPLAY "MCT410JV ABOUT TO CALL NewStringPlatform".
CHG410*    CALL "NewStringPlatform"
      *        USING BY VALUE   JNIEnvPtr
      *              ADDRESS OF WS-INTERFACE-AREA-1
      *              ADDRESS OF WS-Parm-String
      *              0
      *              RETURNING RC
NEW410     MOVE FUNCTION NATIONAL-OF (WS-INTERFACE-AREA-1, 1047) TO
              WS-JAVA-WORK-AREA.
           MOVE FUNCTION DISPLAY-OF (WS-JAVA-WORK-AREA, 1208) TO
              WS-INTERFACE-AREA-1.

           IF DISP-IND = 'Y'
              DISPLAY "    JUST BEFORE NewStringUTF          ".
           CALL  NewStringUTF
               USING BY VALUE   JNIEnvPtr
                     ADDRESS OF WS-INTERFACE-AREA-1
                     RETURNING WS-Parm-String.
      *
           IF DISP-IND = 'Y'
              DISPLAY "  Returned From Data Conversion Functions".
      *
           IF WS-PARM-STRING EQUAL NULL
NEW410        PERFORM P9999-ERRORCHECK THRU P9999-EXIT
              DISPLAY "Error occurred creating jstring Functions"
              DISPLAY "Error occurred WS-INTERFACE-AREA-1"
              GOBACK
           END-IF.
      *
DEL410*    IF RC NOT = ZERO THEN
      *       DISPLAY "Error occurred creating jstring OBJECT"
401   *       DISPLAY "in NewStringPlatform call "
401   *       DISPLAY "NewStringPlatform RC      " RC
      *       GOBACK
      *       STOP RUN
      *    END-IF.
      *    IF DISP-IND = 'Y'
      *       DISPLAY "MCT410JV RETRND FROM CALL NewStringPlatform".
      *------------------------------------------------------------*
      *    Call (processMce)  method
      *------------------------------------------------------------*
           IF DISP-IND = 'Y'
              DISPLAY "    JUST BEFORE INVOKE run CALL".
           INVOKE  Mce  "processMce"
                  USING   BY VALUE
                             WS-Parm-String
                  RETURNING  WS-Return-String
           END-INVOKE.
           IF DISP-IND = 'Y'
              DISPLAY "    RETURNED FROM JAVA invoke run TO MCT410JV".
      *
NEW410     PERFORM P9999-ERRORCHECK THRU P9999-EXIT.
           IF RETURN-CODE = 97
              GOBACK.
      *
      *------------------------------------------------------------*
      *    Call getStringPlatform to convert from jstring to EBCDIC
      *------------------------------------------------------------*
           IF DISP-IND = 'Y'
              DISPLAY "     ABOUT TO CALL GetStringPlatform".
           CALL "GetStringPlatform"
               USING BY VALUE   JNIEnvPtr
                     WS-Return-String
                     ADDRESS OF WS-INTERFACE-AREA-2
                     LENGTH  OF WS-INTERFACE-AREA-2
                     0
                     RETURNING RC.
           IF DISP-IND = 'Y'
              DISPLAY "getStringPlatform 2 cnvrt from jstring to ebcdic"
              DISPLAY "MCT410JV RETRND FROM CALL GetStringPlatform".
           IF DISP-IND = 'Y'
           DISPLAY "1st 440 char of string displayed       "
                    WS-INTERFACE-AREA-2 (1:440)
           DISPLAY "1st 3 bytes are Version                "
                    WS-INTERFACE-AREA-2 (1:3)
           DISPLAY "bytes 4-4   are Admit flag             "
                    WS-INTERFACE-AREA-2 (4:1)
           DISPLAY "bytes 5-22  are Dx flag 1              "
                    WS-INTERFACE-AREA-2 (5:17).
      *
NEW410     PERFORM P9999-ERRORCHECK THRU P9999-EXIT
           IF RETURN-CODE = 97
              GOBACK.
      *
           IF RC NOT = ZERO
              DISPLAY "Error occurred creating EBCDIC  OBJECT"
401           DISPLAY "in GetStringPlatform call"
401           DISPLAY "GetStringPlatform RC     " RC
401           GOBACK
           END-IF.
           IF DISP-IND = 'Y'
              DISPLAY "     BACK FROM CALL TO GetStringPlatform"
              DISPLAY "     WS-INTERFACE-AREA-2                "
                            WS-INTERFACE-AREA-2.
      *------------------------------------------------------------*
      *    Load output from Jar into linkage to return to calling
      *------------------------------------------------------------*
           MOVE WS-OUT-CMSMCE-VER         TO LNK-OUT-CMSMCE-VER
           MOVE WS-OUT-CMSMCE-OUTADXFLAG  TO LNK-OUT-CMSMCE-OUTADXFLAG
           MOVE WS-OUT-CMSMCE-OUTDXFLGS   TO LNK-OUT-CMSMCE-OUTDXFLGS
           MOVE WS-OUT-CMSMCE-OUTPRFLGS   TO LNK-OUT-CMSMCE-OUTPRFLGS
           MOVE WS-OUT-CMSMCE-OUTPROV     TO LNK-OUT-CMSMCE-OUTPROV
           MOVE WS-OUT-CMSMCE-PPS         TO LNK-OUT-CMSMCE-PPS
           MOVE WS-OUT-CMSMCE-ACCUMS      TO LNK-OUT-CMSMCE-ACCUMS
           MOVE WS-OUT-CMSMCE-OUTEDFLAG   TO LNK-OUT-CMSMCE-OUTEDFLAG.
           IF DISP-IND = 'Y'
           DISPLAY 'WS-OUT-CMSMCE-VER        ' WS-OUT-CMSMCE-VER
           DISPLAY 'WS-OUT-CMSMCE-OUTADXFLAG ' WS-OUT-CMSMCE-OUTADXFLAG
           DISPLAY 'WS-OUT-CMSMCE-OUTDXFLGS  ' WS-OUT-CMSMCE-OUTDXFLGS
           DISPLAY 'WS-OUT-CMSMCE-OUTPRFLGS  ' WS-OUT-CMSMCE-OUTPRFLGS
           DISPLAY 'WS-OUT-CMSMCE-PPS        ' WS-OUT-CMSMCE-PPS
           DISPLAY 'WS-OUT-CMSMCE-ACCUMS     ' WS-OUT-CMSMCE-ACCUMS
           DISPLAY 'WS-OUT-CMSMCE-OUTEDFLAG  ' WS-OUT-CMSMCE-OUTEDFLAG
           DISPLAY 'LNK-OUT-CMSMCE-VER       ' LNK-OUT-CMSMCE-VER
           DISPLAY 'LNK-OUT-CMSMCE-OUTADXFL ' LNK-OUT-CMSMCE-OUTADXFLAG AG
           DISPLAY 'LNK-OUT-CMSMCE-OUTDXFLGS ' LNK-OUT-CMSMCE-OUTDXFLGS S
           DISPLAY 'LNK-OUT-CMSMCE-OUTPRFLGS ' LNK-OUT-CMSMCE-OUTPRFLGS S
           DISPLAY 'LNK-OUT-CMSMCE-PPS       ' LNK-OUT-CMSMCE-PPS
           DISPLAY 'LNK-OUT-CMSMCE-ACCUMS    ' LNK-OUT-CMSMCE-ACCUMS
           DISPLAY 'LNK-OUT-CMSMCE-OUTEDFLG  ' LNK-OUT-CMSMCE-OUTEDFLAG.G
      *------------------------------------------------------------*
      *    Call DeleteLocalRef to free up jstring object
      *------------------------------------------------------------*
           IF DISP-IND = 'Y'
              DISPLAY 'Del Local Ref WS-Parm-String '.
           CALL  DeleteLocalRef
               USING BY VALUE   JNIEnvPtr
                     WS-Parm-String
                     RETURNING VOID.
      *------------------------------------------------------------*
      *    Call DeleteLocalRef to free up jstring object
      *------------------------------------------------------------*
           IF DISP-IND = 'Y'
              DISPLAY 'Del Local Ref WS-Return-String '.
           CALL  DeleteLocalRef
               USING BY VALUE   JNIEnvPtr
                     WS-Return-String
                     RETURNING VOID.
           GOBACK.
NEW410*------------------------------------------------------------*
      *    ERROR CHECK
      *------------------------------------------------------------*
       P9999-ERRORCHECK.
           CALL ExceptionOccurred
                USING BY VALUE JNIEnvPtr
                RETURNING ex
           If ex not = null then
              Call ExceptionClear using by value JNIEnvPtr
              Display "MCT410JV Caught a Java Exception"
              Display "MCT410JV Printing StackTrace"
              Invoke ex "printStackTrace"
              Display "MCT410JV - force RC = 97 and end Job"
              COMPUTE RETURN-CODE = 97
           End-if.
       P9999-EXIT. EXIT.
