      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. "MCT381JV" RECURSIVE.
      ************************
      * ENV / DATA DIVISIONS *
      ************************
       ENVIRONMENT DIVISION.
       CONFIGURATION SECTION.
       REPOSITORY.
           Class Base is "java.lang.Object"
           Class jstring is "jstring"
           Class Mce  is
               "gov/cms/mainframe/editor/mce/Mce".
       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.
       01  DEBUG-TRACKING.
           03 DISP-IND                       PIC X(01).
       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).
       01  WS-INTERFACE-AREA-2               PIC X(0918).
       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).
           07 WS-OUT-CMSMCE-OUTDXFLGS            PIC X(350).
           07 WS-OUT-CMSMCE-OUTPRFLGS            PIC X(425).
           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).
       01  WS-CNV-INTERFACE-AREA-1           PIC X(0918).
       01  WS-CNV-INTERFACE-AREA-2           PIC X(0918).
       01  WS-CCSID                          PIC 9(0005).
       01  WS-AREA                           PIC N(0918).
       01  WS-ASCII                          PIC X(0918).
       01  WS-EBCDIC                         PIC X(0918).
      ******************************************************
      ******************************************************
      * 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).
       01  LNK-INTERFACE-AREA-2                  PIC X(917).
       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).
           07 LNK-OUT-CMSMCE-OUTDXFLGS           PIC X(350).
           07 LNK-OUT-CMSMCE-OUTPRFLGS           PIC X(425).
           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 03/03/2021"
              DISPLAY "     COBOL PROGRAM MCT381JV 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.
      *------------------------------------------------------------*
      *    Call NewStringPlatform to convert from EBCDIC to jstring
      *------------------------------------------------------------*
           IF DISP-IND = 'Y'
              DISPLAY "MCT381JV ABOUT TO CALL NewStringPlatform".
           CALL "NewStringPlatform"
               USING BY VALUE   JNIEnvPtr
                     ADDRESS OF WS-INTERFACE-AREA-1
                     ADDRESS OF WS-Parm-String
                     0
                     RETURNING RC
           IF DISP-IND = 'Y'
              DISPLAY "MCT381JV RETRND FROM CALL NewStringPlatform".
           IF RC NOT = ZERO THEN
              DISPLAY "Error occurred creating jstring OBJECT"
              STOP RUN
           END-IF.
      *------------------------------------------------------------*
      *    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 MCT381JV".
      *------------------------------------------------------------*
      *    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 "MCT381JV 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).
           IF RC NOT = ZERO
              DISPLAY "Error occurred creating EBCDIC  OBJECT"
              DISPLAY "RETURN CODE " RC
              STOP RUN
           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.
      *------------------------------------------------------------*
      *    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.
      *------------------------------------------------------------*
      *    CONVERSION FUNCTION TO CONVERT ASCII TO EBCDIC RETURNED
      *------------------------------------------------------------*
           GOBACK.
