      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 DRG JAR V41.0 DATA IS RETURNED TO CALLING PGM  *
      ******************************************************
       IDENTIFICATION DIVISION.
       PROGRAM-ID. "DRG410JV" 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 Msdrg is
               "gov/cms/grouper/mainframe/Msdrg".
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.
       01  VOID                              PIC S9(9) COMP-5.
       01  DEBUG-TRACKING.
           03 DISP-IND                       PIC X(01).
CHG410* THE BELOW IS NO LONGER REQUIRED FOR THE FUNCTION LOGIC.
      *add 1 byte. 639 instead of 638
      *Required for the x'00' for newstringplatform
CHG410 01 WS-INTERFACE-AREA-1                PIC X(0639).
      *
NEW410 01 WS-JAVA-WORK-AREA                  PIC N(0638).
      *
       01  WS-INTERFACE-AREA-2               PIC X(1163).
      ******************************************************
      ******************************************************
      * COMMUNICATION AREA                                 *
      ******************************************************
       LINKAGE SECTION.
       01  LNK-INTERFACE-AREA-1                  PIC X(0638).
       01  LNK-INTERFACE-AREA-2                  PIC X(1162).
       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
401        MOVE SPACES               TO WS-INTERFACE-AREA-1.
           MOVE LNK-INTERFACE-AREA-1 TO WS-INTERFACE-AREA-1.
           MOVE 'N'    TO DISP-IND.
           IF LNK-INTERFACE-AREA-1 (638:1) = 'Y'
              MOVE 'Y' TO DISP-IND.
           IF DISP-IND = 'Y'
              DISPLAY "0100 COMPILE DATE 06/15/2023"
              DISPLAY "     COBOL PROGRAM DRG410JV ENTERED"
              DISPLAY "     LNK-INTERFACE-AREA-1          "
                            LNK-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".
      *------------------------------------------------------------*
      *    USE FUNCTION NATIONAL-OF and DISPLAY-OF to convert data
      *------------------------------------------------------------*
           IF DISP-IND = 'Y'
              DISPLAY "    JUST BEFORE FUNCTION NATIONAL-OF  ".
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
      *    END-IF.
      *    IF DISP-IND = 'Y'
      *       DISPLAY "  RETURNED FROM NewStringPlatform CALL".
      *------------------------------------------------------------*
      *    Call (processMsdrg) method
      *------------------------------------------------------------*
           IF DISP-IND = 'Y'
              DISPLAY "    JUST BEFORE processMsdrg CALL".
           INVOKE Msdrg "processMsdrg"
                  USING   BY VALUE
                             WS-Parm-String
                  RETURNING  WS-Return-String
           END-INVOKE.
           IF DISP-IND = 'Y'
              DISPLAY "   RETURNED FROM JAVA processMsdrg TO DRG410JV".
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 "1st 440 char of string displayed       "
                    WS-INTERFACE-AREA-2 (1:440)
           DISPLAY "1st 2 bytes are RC                     "
                    WS-INTERFACE-AREA-2 (1:2)
           DISPLAY "bytes 3-4   are MDC                    "
                    WS-INTERFACE-AREA-2 (3:2)
           DISPLAY "bytes 5-8   are DRG                    "
                    WS-INTERFACE-AREA-2 (5:4).
      *
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.
           MOVE WS-INTERFACE-AREA-2 TO LNK-INTERFACE-AREA-2.
      *------------------------------------------------------------*
      *    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 "DRG410JV Caught a Java Exception"
              Display "DRG410JV Printing StackTrace"
              Invoke ex "printStackTrace"
              Display "DRG410JV - force RC = 97 and end Job"
              COMPUTE RETURN-CODE = 97
           End-if.
       P9999-EXIT. EXIT.
