From 09fd7827bcf13d1527857efdd949858cd1e3a3e7 Mon Sep 17 00:00:00 2001 From: stephen waite Date: Sat, 9 May 2026 18:21:07 -0400 Subject: [PATCH 01/78] w/o prog --- rri/collt/wo001.cob | 137 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 137 insertions(+) create mode 100644 rri/collt/wo001.cob diff --git a/rri/collt/wo001.cob b/rri/collt/wo001.cob new file mode 100644 index 00000000..cc495487 --- /dev/null +++ b/rri/collt/wo001.cob @@ -0,0 +1,137 @@ + * @package cms + * @link http://www.cmsvt.com + * @author s waite + * @copyright Copyright (c) 2026 cms + * @license https://github.com/openemr/openemr/blob/master/LICENSE GNU General Public License 3 + IDENTIFICATION DIVISION. + PROGRAM-ID. wo001. + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + + SELECT GARFILE ASSIGN TO "S30" ORGANIZATION IS INDEXED + ACCESS MODE IS DYNAMIC RECORD KEY IS G-GARNO + ALTERNATE RECORD KEY IS G-ACCT WITH DUPLICATES + LOCK MODE MANUAL. + + SELECT CHARCUR ASSIGN TO "S35" ORGANIZATION IS INDEXED + ACCESS MODE IS DYNAMIC RECORD KEY IS CHARCUR-KEY + ALTERNATE RECORD KEY IS CC-PAYCODE WITH DUPLICATES + LOCK MODE MANUAL. + + SELECT PAYCUR ASSIGN TO "S40" ORGANIZATION IS INDEXED + ACCESS MODE IS DYNAMIC RECORD KEY IS PAYCUR-KEY + LOCK MODE MANUAL. + + SELECT PAYFILE ASSIGN TO "S45" ORGANIZATION IS INDEXED + ACCESS IS DYNAMIC RECORD KEY IS PAYFILE-KEY + LOCK MODE MANUAL. + + SELECT INFILE ASSIGN TO "S50" + ORGANIZATION IS LINE SEQUENTIAL. + + DATA DIVISION. + FILE SECTION. + + FD GARFILE. + COPY GARFILE.CPY. + + FD CHARCUR. + COPY CHARCUR.CPY. + + FD PAYCUR. + COPY PAYCUR.CPY. + + FD PAYFILE. + COPY PAYFILE.CPY. + + FD INFILE. + 01 INREC. + 05 IN-KEY8 PIC X(8). + 05 IN-KEY3 PIC X(3). + 05 FILLER PIC X(69). + + WORKING-STORAGE SECTION. + 77 TOTALPAY PIC S9(7)V99 COMP-3 VALUE ZERO. + 77 WO-AMT PIC S9(7)V99 COMP-3. + 77 TODAY PIC X(8). + 77 XYZ PIC 9(3). + 01 TIME-NOW. + 05 TN-HHMMSS PIC X(6). + 05 FILLER PIC X(2). + + PROCEDURE DIVISION. + MAIN. + OPEN INPUT INFILE CHARCUR PAYCUR GARFILE + OPEN I-O PAYFILE + ACCEPT TODAY FROM DATE YYYYMMDD. + + P00. + READ INFILE AT END GO TO P-DONE END-READ. + + MOVE IN-KEY8 TO CC-KEY8 + MOVE IN-KEY3 TO CC-KEY3. + READ CHARCUR INVALID KEY + DISPLAY "NO CHARGE: " IN-KEY8 " " IN-KEY3 + GO TO P00 + END-READ. + + MOVE CC-KEY8 TO G-GARNO. + READ GARFILE INVALID KEY + DISPLAY "NO GAR: " CC-KEY8 + MOVE SPACES TO G-GARNAME + END-READ. + + MOVE ZERO TO TOTALPAY + MOVE CC-KEY8 TO PC-KEY8 + MOVE LOW-VALUES TO PC-KEY3. + START PAYCUR KEY >= PAYCUR-KEY + INVALID KEY GO TO P-WO + END-START. + + P1. + READ PAYCUR NEXT AT END GO TO P-WO END-READ. + IF PC-KEY8 NOT = CC-KEY8 GO TO P-WO. + IF PC-CLAIM NOT = CC-CLAIM GO TO P1. + ADD PC-AMOUNT TO TOTALPAY. + GO TO P1. + + P-WO. + COMPUTE WO-AMT = CC-AMOUNT - TOTALPAY. + IF WO-AMT NOT > 0 + DISPLAY "SKIP " IN-KEY8 " " IN-KEY3 + " CLM=" CC-CLAIM " BAL=" WO-AMT + GO TO P00. + + MOVE CC-KEY8 TO PD-KEY8 + MOVE ZERO TO XYZ. + P3. + ADD 1 TO XYZ. + MOVE XYZ TO PD-KEY3. + READ PAYFILE INVALID GO TO P4. + GO TO P3. + + P4. + ACCEPT TIME-NOW FROM TIME. + + MOVE G-GARNAME TO PD-NAME + MOVE WO-AMT TO PD-AMOUNT + MOVE "013" TO PD-PAYCODE + MOVE SPACES TO PD-DENIAL + MOVE CC-CLAIM TO PD-CLAIM + MOVE TODAY TO PD-DATE-T + MOVE TODAY TO PD-DATE-E + MOVE TN-HHMMSS TO PD-ORDER + MOVE SPACES TO PD-BATCH. + + WRITE PAYFILE-REC INVALID KEY + DISPLAY "DUP: " PD-KEY8 " " PD-KEY3 + GO TO P00 + END-WRITE. + DISPLAY "WO " IN-KEY8 " " IN-KEY3 + " CLM=" CC-CLAIM " AMT=" WO-AMT. + GO TO P00. + + P-DONE. + CLOSE INFILE CHARCUR PAYCUR GARFILE PAYFILE. + STOP RUN. \ No newline at end of file From b15935398da3faf7c01891988d42611a316a46bb Mon Sep 17 00:00:00 2001 From: stephen waite Date: Sat, 9 May 2026 18:22:25 -0400 Subject: [PATCH 02/78] w/o prog --- rri/collt/wo001.cob | 27 ++------------------------- 1 file changed, 2 insertions(+), 25 deletions(-) diff --git a/rri/collt/wo001.cob b/rri/collt/wo001.cob index cc495487..cf32cee7 100644 --- a/rri/collt/wo001.cob +++ b/rri/collt/wo001.cob @@ -1,6 +1,7 @@ * @package cms * @link http://www.cmsvt.com * @author s waite + * @author Claude (Anthropic) * @copyright Copyright (c) 2026 cms * @license https://github.com/openemr/openemr/blob/master/LICENSE GNU General Public License 3 IDENTIFICATION DIVISION. @@ -8,49 +9,37 @@ ENVIRONMENT DIVISION. INPUT-OUTPUT SECTION. FILE-CONTROL. - SELECT GARFILE ASSIGN TO "S30" ORGANIZATION IS INDEXED ACCESS MODE IS DYNAMIC RECORD KEY IS G-GARNO ALTERNATE RECORD KEY IS G-ACCT WITH DUPLICATES LOCK MODE MANUAL. - SELECT CHARCUR ASSIGN TO "S35" ORGANIZATION IS INDEXED ACCESS MODE IS DYNAMIC RECORD KEY IS CHARCUR-KEY ALTERNATE RECORD KEY IS CC-PAYCODE WITH DUPLICATES LOCK MODE MANUAL. - SELECT PAYCUR ASSIGN TO "S40" ORGANIZATION IS INDEXED ACCESS MODE IS DYNAMIC RECORD KEY IS PAYCUR-KEY LOCK MODE MANUAL. - SELECT PAYFILE ASSIGN TO "S45" ORGANIZATION IS INDEXED ACCESS IS DYNAMIC RECORD KEY IS PAYFILE-KEY LOCK MODE MANUAL. - SELECT INFILE ASSIGN TO "S50" ORGANIZATION IS LINE SEQUENTIAL. - DATA DIVISION. FILE SECTION. - FD GARFILE. COPY GARFILE.CPY. - FD CHARCUR. COPY CHARCUR.CPY. - FD PAYCUR. COPY PAYCUR.CPY. - FD PAYFILE. COPY PAYFILE.CPY. - FD INFILE. 01 INREC. 05 IN-KEY8 PIC X(8). 05 IN-KEY3 PIC X(3). 05 FILLER PIC X(69). - WORKING-STORAGE SECTION. 77 TOTALPAY PIC S9(7)V99 COMP-3 VALUE ZERO. 77 WO-AMT PIC S9(7)V99 COMP-3. @@ -59,50 +48,42 @@ 01 TIME-NOW. 05 TN-HHMMSS PIC X(6). 05 FILLER PIC X(2). - PROCEDURE DIVISION. MAIN. OPEN INPUT INFILE CHARCUR PAYCUR GARFILE OPEN I-O PAYFILE ACCEPT TODAY FROM DATE YYYYMMDD. - P00. READ INFILE AT END GO TO P-DONE END-READ. - MOVE IN-KEY8 TO CC-KEY8 MOVE IN-KEY3 TO CC-KEY3. READ CHARCUR INVALID KEY DISPLAY "NO CHARGE: " IN-KEY8 " " IN-KEY3 GO TO P00 END-READ. - MOVE CC-KEY8 TO G-GARNO. READ GARFILE INVALID KEY DISPLAY "NO GAR: " CC-KEY8 MOVE SPACES TO G-GARNAME END-READ. - MOVE ZERO TO TOTALPAY MOVE CC-KEY8 TO PC-KEY8 MOVE LOW-VALUES TO PC-KEY3. START PAYCUR KEY >= PAYCUR-KEY INVALID KEY GO TO P-WO END-START. - P1. READ PAYCUR NEXT AT END GO TO P-WO END-READ. IF PC-KEY8 NOT = CC-KEY8 GO TO P-WO. IF PC-CLAIM NOT = CC-CLAIM GO TO P1. ADD PC-AMOUNT TO TOTALPAY. GO TO P1. - P-WO. COMPUTE WO-AMT = CC-AMOUNT - TOTALPAY. IF WO-AMT NOT > 0 DISPLAY "SKIP " IN-KEY8 " " IN-KEY3 " CLM=" CC-CLAIM " BAL=" WO-AMT GO TO P00. - MOVE CC-KEY8 TO PD-KEY8 MOVE ZERO TO XYZ. P3. @@ -110,10 +91,8 @@ MOVE XYZ TO PD-KEY3. READ PAYFILE INVALID GO TO P4. GO TO P3. - P4. ACCEPT TIME-NOW FROM TIME. - MOVE G-GARNAME TO PD-NAME MOVE WO-AMT TO PD-AMOUNT MOVE "013" TO PD-PAYCODE @@ -123,15 +102,13 @@ MOVE TODAY TO PD-DATE-E MOVE TN-HHMMSS TO PD-ORDER MOVE SPACES TO PD-BATCH. - - WRITE PAYFILE-REC INVALID KEY + WRITE PAYFILE01 INVALID KEY DISPLAY "DUP: " PD-KEY8 " " PD-KEY3 GO TO P00 END-WRITE. DISPLAY "WO " IN-KEY8 " " IN-KEY3 " CLM=" CC-CLAIM " AMT=" WO-AMT. GO TO P00. - P-DONE. CLOSE INFILE CHARCUR PAYCUR GARFILE PAYFILE. STOP RUN. \ No newline at end of file From b9db864c7a53eeb853dac6bf2c52c27d81a66183 Mon Sep 17 00:00:00 2001 From: stephen waite Date: Sat, 9 May 2026 18:33:56 -0400 Subject: [PATCH 03/78] debug --- rri/collt/wo001.cob | 1 + 1 file changed, 1 insertion(+) diff --git a/rri/collt/wo001.cob b/rri/collt/wo001.cob index cf32cee7..8cfbcf26 100644 --- a/rri/collt/wo001.cob +++ b/rri/collt/wo001.cob @@ -108,6 +108,7 @@ END-WRITE. DISPLAY "WO " IN-KEY8 " " IN-KEY3 " CLM=" CC-CLAIM " AMT=" WO-AMT. + ACCEPT OMITTED. GO TO P00. P-DONE. CLOSE INFILE CHARCUR PAYCUR GARFILE PAYFILE. From f38236b61c4447091f0b7e35ea2dab47f6280b48 Mon Sep 17 00:00:00 2001 From: stephen waite Date: Sat, 9 May 2026 18:48:15 -0400 Subject: [PATCH 04/78] payments are stored negative so add them --- rri/collt/wo001.cob | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/rri/collt/wo001.cob b/rri/collt/wo001.cob index 8cfbcf26..88440d96 100644 --- a/rri/collt/wo001.cob +++ b/rri/collt/wo001.cob @@ -79,7 +79,7 @@ ADD PC-AMOUNT TO TOTALPAY. GO TO P1. P-WO. - COMPUTE WO-AMT = CC-AMOUNT - TOTALPAY. + COMPUTE WO-AMT = CC-AMOUNT + TOTALPAY. IF WO-AMT NOT > 0 DISPLAY "SKIP " IN-KEY8 " " IN-KEY3 " CLM=" CC-CLAIM " BAL=" WO-AMT From 3117a44f8f4e7879d05cb7eb04fa1a4ce62f74a5 Mon Sep 17 00:00:00 2001 From: stephen waite Date: Sat, 9 May 2026 18:54:06 -0400 Subject: [PATCH 05/78] add create a negative pd-amount --- rri/collt/wo001.cob | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/rri/collt/wo001.cob b/rri/collt/wo001.cob index 88440d96..3cabd988 100644 --- a/rri/collt/wo001.cob +++ b/rri/collt/wo001.cob @@ -94,7 +94,7 @@ P4. ACCEPT TIME-NOW FROM TIME. MOVE G-GARNAME TO PD-NAME - MOVE WO-AMT TO PD-AMOUNT + COMPUTE PD-AMOUNT = 0 - WO-AMT MOVE "013" TO PD-PAYCODE MOVE SPACES TO PD-DENIAL MOVE CC-CLAIM TO PD-CLAIM From db38ec1115d661664403309b65d988dd55b6e48a Mon Sep 17 00:00:00 2001 From: stephen waite Date: Sat, 9 May 2026 20:00:48 -0400 Subject: [PATCH 06/78] wo002 to adj to zero by dos range --- rri/collt/wo002.cob | 115 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 115 insertions(+) create mode 100644 rri/collt/wo002.cob diff --git a/rri/collt/wo002.cob b/rri/collt/wo002.cob new file mode 100644 index 00000000..e7ab3c0c --- /dev/null +++ b/rri/collt/wo002.cob @@ -0,0 +1,115 @@ + * @package cms + * @link http://www.cmsvt.com + * @author s waite + * @author Claude (Anthropic) + * @copyright Copyright (c) 2026 cms + * @license https://github.com/openemr/openemr/blob/master/LICENSE GNU General Public License 3 + IDENTIFICATION DIVISION. + PROGRAM-ID. wo002. + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT GARFILE ASSIGN TO "S30" ORGANIZATION IS INDEXED + ACCESS MODE IS DYNAMIC RECORD KEY IS G-GARNO + ALTERNATE RECORD KEY IS G-ACCT WITH DUPLICATES + LOCK MODE MANUAL. + SELECT CHARCUR ASSIGN TO "S35" ORGANIZATION IS INDEXED + ACCESS MODE IS DYNAMIC RECORD KEY IS CHARCUR-KEY + ALTERNATE RECORD KEY IS CC-PAYCODE WITH DUPLICATES + LOCK MODE MANUAL. + SELECT PAYCUR ASSIGN TO "S40" ORGANIZATION IS INDEXED + ACCESS MODE IS DYNAMIC RECORD KEY IS PAYCUR-KEY + LOCK MODE MANUAL. + SELECT PAYFILE ASSIGN TO "S45" ORGANIZATION IS INDEXED + ACCESS IS DYNAMIC RECORD KEY IS PAYFILE-KEY + LOCK MODE MANUAL. + SELECT OWESFILE ASSIGN TO "S50" + ORGANIZATION IS LINE SEQUENTIAL. + SELECT OWEDFILE ASSIGN TO "S55" + ORGANIZATION IS LINE SEQUENTIAL. + DATA DIVISION. + FILE SECTION. + FD GARFILE. + COPY GARFILE.CPY. + FD CHARCUR. + COPY CHARCUR.CPY. + FD PAYCUR. + COPY PAYCUR.CPY. + FD PAYFILE. + COPY PAYFILE.CPY. + FD OWESFILE. + 01 OWES-REC PIC X(160). + FD OWEDFILE. + 01 OWED-REC PIC X(160). + WORKING-STORAGE SECTION. + 77 TOTALPAY PIC S9(7)V99 COMP-3 VALUE ZERO. + 77 WO-AMT PIC S9(7)V99 COMP-3. + 77 TODAY PIC X(8). + 77 FROM-DATE PIC X(8). + 77 TO-DATE PIC X(8). + 77 CNT-OWES PIC 9(6) VALUE ZERO. + 77 CNT-OWED PIC 9(6) VALUE ZERO. + 77 CNT-ZERO PIC 9(6) VALUE ZERO. + PROCEDURE DIVISION. + MAIN. + DISPLAY "From date (YYYYMMDD): " WITH NO ADVANCING. + ACCEPT FROM-DATE. + DISPLAY "To date (YYYYMMDD): " WITH NO ADVANCING. + ACCEPT TO-DATE. + IF FROM-DATE = SPACES OR TO-DATE = SPACES + DISPLAY "Both dates required." + STOP RUN. + IF FROM-DATE > TO-DATE + DISPLAY "From date must be <= to date." + STOP RUN. + OPEN INPUT CHARCUR PAYCUR GARFILE + OPEN I-O PAYFILE + OPEN OUTPUT OWESFILE OWEDFILE + ACCEPT TODAY FROM DATE YYYYMMDD. + MOVE LOW-VALUES TO CHARCUR-KEY. + START CHARCUR KEY >= CHARCUR-KEY + INVALID KEY GO TO P-DONE + END-START. + P00. + READ CHARCUR NEXT AT END GO TO P-DONE END-READ. + IF CC-DATE-T < FROM-DATE GO TO P00. + IF CC-DATE-T > TO-DATE GO TO P00. + MOVE CC-KEY8 TO G-GARNO. + READ GARFILE INVALID KEY + DISPLAY "NO GAR: " CC-KEY8 + MOVE SPACES TO G-GARNAME + END-READ. + MOVE ZERO TO TOTALPAY + MOVE CC-KEY8 TO PC-KEY8 + MOVE LOW-VALUES TO PC-KEY3. + START PAYCUR KEY >= PAYCUR-KEY + INVALID KEY GO TO P-EVAL + END-START. + P1. + READ PAYCUR NEXT AT END GO TO P-EVAL END-READ. + IF PC-KEY8 NOT = CC-KEY8 GO TO P-EVAL. + IF PC-CLAIM NOT = CC-CLAIM GO TO P1. + ADD PC-AMOUNT TO TOTALPAY. + GO TO P1. + P-EVAL. + COMPUTE WO-AMT = CC-AMOUNT + TOTALPAY. + IF WO-AMT = 0 + ADD 1 TO CNT-ZERO + GO TO P00. + IF WO-AMT > 0 + WRITE OWES-REC FROM CHARCUR01 + ADD 1 TO CNT-OWES + DISPLAY "OWES " CC-KEY8 " " CC-KEY3 + " CLM=" CC-CLAIM " BAL=" WO-AMT + GO TO P00. + WRITE OWED-REC FROM CHARCUR01 + ADD 1 TO CNT-OWED + DISPLAY "OWED " CC-KEY8 " " CC-KEY3 + " CLM=" CC-CLAIM " BAL=" WO-AMT. + GO TO P00. + P-DONE. + DISPLAY "OWES (debit balances): " CNT-OWES. + DISPLAY "OWED (credit balances): " CNT-OWED. + DISPLAY "ZERO (paid in full): " CNT-ZERO. + CLOSE CHARCUR PAYCUR GARFILE PAYFILE OWESFILE OWEDFILE. + STOP RUN. \ No newline at end of file From 9ee775e1377ace3a2ccc4f3a20c70e151fd5a740 Mon Sep 17 00:00:00 2001 From: stephen waite Date: Sun, 10 May 2026 13:58:48 -0400 Subject: [PATCH 07/78] wo001 changes for credit bals --- rri/collt/wo001.cob | 39 +++++++++++++++++++++++++++------------ 1 file changed, 27 insertions(+), 12 deletions(-) diff --git a/rri/collt/wo001.cob b/rri/collt/wo001.cob index 3cabd988..66166d06 100644 --- a/rri/collt/wo001.cob +++ b/rri/collt/wo001.cob @@ -1,4 +1,4 @@ - * @package cms +* @package cms * @link http://www.cmsvt.com * @author s waite * @author Claude (Anthropic) @@ -39,17 +39,29 @@ 01 INREC. 05 IN-KEY8 PIC X(8). 05 IN-KEY3 PIC X(3). - 05 FILLER PIC X(69). + 05 FILLER PIC X(149). WORKING-STORAGE SECTION. 77 TOTALPAY PIC S9(7)V99 COMP-3 VALUE ZERO. 77 WO-AMT PIC S9(7)V99 COMP-3. 77 TODAY PIC X(8). 77 XYZ PIC 9(3). + 77 ADJ-MODE PIC X. + 77 ADJ-PAYCODE PIC X(3). 01 TIME-NOW. 05 TN-HHMMSS PIC X(6). 05 FILLER PIC X(2). PROCEDURE DIVISION. MAIN. + DISPLAY "Adjust mode (D=debit/owes, C=credit/owed): " + WITH NO ADVANCING. + ACCEPT ADJ-MODE. + IF ADJ-MODE = "D" + MOVE "014" TO ADJ-PAYCODE + ELSE IF ADJ-MODE = "C" + MOVE "015" TO ADJ-PAYCODE + ELSE + DISPLAY "Invalid mode." + STOP RUN. OPEN INPUT INFILE CHARCUR PAYCUR GARFILE OPEN I-O PAYFILE ACCEPT TODAY FROM DATE YYYYMMDD. @@ -80,7 +92,11 @@ GO TO P1. P-WO. COMPUTE WO-AMT = CC-AMOUNT + TOTALPAY. - IF WO-AMT NOT > 0 + IF ADJ-MODE = "D" AND WO-AMT NOT > 0 + DISPLAY "SKIP " IN-KEY8 " " IN-KEY3 + " CLM=" CC-CLAIM " BAL=" WO-AMT + GO TO P00. + IF ADJ-MODE = "C" AND WO-AMT NOT < 0 DISPLAY "SKIP " IN-KEY8 " " IN-KEY3 " CLM=" CC-CLAIM " BAL=" WO-AMT GO TO P00. @@ -93,22 +109,21 @@ GO TO P3. P4. ACCEPT TIME-NOW FROM TIME. - MOVE G-GARNAME TO PD-NAME + MOVE G-GARNAME TO PD-NAME COMPUTE PD-AMOUNT = 0 - WO-AMT - MOVE "013" TO PD-PAYCODE - MOVE SPACES TO PD-DENIAL - MOVE CC-CLAIM TO PD-CLAIM - MOVE TODAY TO PD-DATE-T - MOVE TODAY TO PD-DATE-E - MOVE TN-HHMMSS TO PD-ORDER - MOVE SPACES TO PD-BATCH. + MOVE ADJ-PAYCODE TO PD-PAYCODE + MOVE "AA" TO PD-DENIAL + MOVE CC-CLAIM TO PD-CLAIM + MOVE TODAY TO PD-DATE-T + MOVE TODAY TO PD-DATE-E + MOVE TN-HHMMSS TO PD-ORDER + MOVE SPACES TO PD-BATCH. WRITE PAYFILE01 INVALID KEY DISPLAY "DUP: " PD-KEY8 " " PD-KEY3 GO TO P00 END-WRITE. DISPLAY "WO " IN-KEY8 " " IN-KEY3 " CLM=" CC-CLAIM " AMT=" WO-AMT. - ACCEPT OMITTED. GO TO P00. P-DONE. CLOSE INFILE CHARCUR PAYCUR GARFILE PAYFILE. From 6e91c1a133c8dbb568e4dfa328322503cdfee927 Mon Sep 17 00:00:00 2001 From: stephen waite Date: Sun, 10 May 2026 14:00:03 -0400 Subject: [PATCH 08/78] indent --- rri/collt/wo001.cob | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/rri/collt/wo001.cob b/rri/collt/wo001.cob index 66166d06..3eb8bb4d 100644 --- a/rri/collt/wo001.cob +++ b/rri/collt/wo001.cob @@ -1,4 +1,4 @@ -* @package cms + * @package cms * @link http://www.cmsvt.com * @author s waite * @author Claude (Anthropic) From e04afcb8152341d1f72fc6939888f082fb26d3ce Mon Sep 17 00:00:00 2001 From: stephen waite Date: Sun, 10 May 2026 14:12:00 -0400 Subject: [PATCH 09/78] use date of charge as payment date --- rri/collt/wo001.cob | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/rri/collt/wo001.cob b/rri/collt/wo001.cob index 3eb8bb4d..8e590d85 100644 --- a/rri/collt/wo001.cob +++ b/rri/collt/wo001.cob @@ -114,8 +114,8 @@ MOVE ADJ-PAYCODE TO PD-PAYCODE MOVE "AA" TO PD-DENIAL MOVE CC-CLAIM TO PD-CLAIM - MOVE TODAY TO PD-DATE-T - MOVE TODAY TO PD-DATE-E + MOVE CC-DATE-T TO PD-DATE-T + MOVE CC-DATE-T TO PD-DATE-E MOVE TN-HHMMSS TO PD-ORDER MOVE SPACES TO PD-BATCH. WRITE PAYFILE01 INVALID KEY From 6162727c7528d238d43af15fc39a62c72553ef0d Mon Sep 17 00:00:00 2001 From: stephen waite Date: Sun, 10 May 2026 18:13:54 -0400 Subject: [PATCH 10/78] wo004 walk charcur for garfile archive --- rri/collt/wo004.cob | 54 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 54 insertions(+) create mode 100644 rri/collt/wo004.cob diff --git a/rri/collt/wo004.cob b/rri/collt/wo004.cob new file mode 100644 index 00000000..d068b0e8 --- /dev/null +++ b/rri/collt/wo004.cob @@ -0,0 +1,54 @@ +* @package cms + * @link http://www.cmsvt.com + * @author s waite + * @author Claude (Anthropic) + * @copyright Copyright (c) 2026 cms + * @license https://github.com/openemr/openemr/blob/master/LICENSE GNU General Public License 3 + IDENTIFICATION DIVISION. + PROGRAM-ID. wo004. + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT CHARCUR ASSIGN TO "S35" ORGANIZATION IS INDEXED + ACCESS MODE IS DYNAMIC RECORD KEY IS CHARCUR-KEY + ALTERNATE RECORD KEY IS CC-PAYCODE WITH DUPLICATES + LOCK MODE MANUAL. + SELECT FILEOUT ASSIGN TO "S50" + ORGANIZATION IS LINE SEQUENTIAL. + DATA DIVISION. + FILE SECTION. + FD CHARCUR. + COPY CHARCUR.CPY. + FD FILEOUT. + 01 FILEOUT01 PIC X(8). + WORKING-STORAGE SECTION. + 77 TO-DATE PIC X(8). + 77 HOLD8 PIC X(8). + 77 CNT PIC 9(7) VALUE ZERO. + PROCEDURE DIVISION. + MAIN. + DISPLAY "Archive charges on or before (YYYYMMDD): " + WITH NO ADVANCING. + ACCEPT TO-DATE. + IF TO-DATE = SPACES + DISPLAY "Date required." + STOP RUN. + OPEN INPUT CHARCUR + OPEN OUTPUT FILEOUT. + MOVE LOW-VALUES TO CHARCUR-KEY. + START CHARCUR KEY >= CHARCUR-KEY + INVALID KEY GO TO P-DONE + END-START. + MOVE LOW-VALUES TO HOLD8. + P00. + READ CHARCUR NEXT AT END GO TO P-DONE END-READ. + IF CC-DATE-T > TO-DATE GO TO P00. + IF CC-KEY8 = HOLD8 GO TO P00. + MOVE CC-KEY8 TO HOLD8. + WRITE FILEOUT01 FROM CC-KEY8. + ADD 1 TO CNT. + GO TO P00. + P-DONE. + DISPLAY "GARNOs written: " CNT. + CLOSE CHARCUR FILEOUT. + STOP RUN. \ No newline at end of file From d20a501c06a82029742896278d266e5b0a26d59e Mon Sep 17 00:00:00 2001 From: stephen waite Date: Sun, 10 May 2026 18:18:55 -0400 Subject: [PATCH 11/78] indent --- rri/collt/wo004.cob | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/rri/collt/wo004.cob b/rri/collt/wo004.cob index d068b0e8..f65a7479 100644 --- a/rri/collt/wo004.cob +++ b/rri/collt/wo004.cob @@ -1,4 +1,4 @@ -* @package cms + * @package cms * @link http://www.cmsvt.com * @author s waite * @author Claude (Anthropic) From 8a06eb8d2f5f7dab709541a4effdb99b6a40c275 Mon Sep 17 00:00:00 2001 From: stephen waite Date: Sun, 10 May 2026 18:24:54 -0400 Subject: [PATCH 12/78] per charge filter for archival --- rri/collt/rri750.cob | 174 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 174 insertions(+) create mode 100644 rri/collt/rri750.cob diff --git a/rri/collt/rri750.cob b/rri/collt/rri750.cob new file mode 100644 index 00000000..b2c742ef --- /dev/null +++ b/rri/collt/rri750.cob @@ -0,0 +1,174 @@ + * @package cms + * @link http://www.cmsvt.com + * @author s waite + * @author Claude (Anthropic) + * @copyright Copyright (c) 2026 cms + * @license https://github.com/openemr/openemr/blob/master/LICENSE GNU General Public License 3 + IDENTIFICATION DIVISION. + PROGRAM-ID. rri750. + AUTHOR. SWAITE. + DATE-COMPILED. TODAY. + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT GARFILE ASSIGN TO "S30" ORGANIZATION IS INDEXED + ACCESS MODE IS DYNAMIC RECORD KEY IS G-GARNO + ALTERNATE RECORD KEY IS G-ACCT WITH DUPLICATES + LOCK MODE MANUAL. + SELECT CHARCUR ASSIGN TO "S35" ORGANIZATION IS INDEXED + ACCESS MODE IS DYNAMIC RECORD KEY IS CHARCUR-KEY + ALTERNATE RECORD KEY IS CC-PAYCODE WITH DUPLICATES + LOCK MODE MANUAL. + SELECT PAYCUR ASSIGN TO "S40" ORGANIZATION IS INDEXED + ACCESS MODE IS DYNAMIC RECORD KEY IS PAYCUR-KEY + LOCK MODE MANUAL. + SELECT FILEIN ASSIGN TO "S50" + ORGANIZATION LINE SEQUENTIAL. + SELECT PARMFILE ASSIGN TO "S55" + ORGANIZATION LINE SEQUENTIAL. + SELECT GAROUT ASSIGN TO "S60" + ORGANIZATION LINE SEQUENTIAL. + SELECT CHAROUT ASSIGN TO "S65" + ORGANIZATION LINE SEQUENTIAL. + SELECT PAYOUT ASSIGN TO "S70" + ORGANIZATION LINE SEQUENTIAL. + SELECT CHARNEW ASSIGN TO "S75" + ORGANIZATION LINE SEQUENTIAL. + SELECT PAYNEW ASSIGN TO "S80" + ORGANIZATION LINE SEQUENTIAL. + DATA DIVISION. + FILE SECTION. + FD GARFILE. + COPY GARFILE.CPY. + FD CHARCUR. + COPY CHARCUR.CPY. + FD PAYCUR. + COPY PAYCUR.CPY. + FD FILEIN. + 01 FILEIN01 PIC X(8). + FD PARMFILE. + 01 PARMFILE01. + 02 PF1 PIC 9(8). + 02 PF2 PIC 9(8). + FD GAROUT. + 01 GAROUT01 PIC X(277). + FD CHAROUT. + 01 CHAROUT01 PIC X(160). + FD PAYOUT. + 01 PAYOUT01 PIC X(50). + FD CHARNEW. + 01 CHARNEW01 PIC X(160). + FD PAYNEW. + 01 PAYNEW01 PIC X(50). + WORKING-STORAGE SECTION. + 01 PHR01. + 02 PHR02 OCCURS 999 TIMES INDEXED BY PHR. + 03 PHR-KEY8 PIC X(8). + 03 PHR-KEY3 PIC 999. + 03 PHR-AMOUNT PIC S9(4)V99. + 03 PHR-PAYCODE PIC 999. + 03 PHR-DENIAL PIC XX. + 03 PHR-CLAIM PIC 9(6). + 03 PHR-DATE-T PIC 9(8). + 03 PHR-DATE-E PIC 9(8). + 03 PHR-BATCH PIC X(6). + 01 CLAIM-TOT PIC S9(6)V99. + 01 X USAGE IS INDEX. + 01 FLAGX PIC 9. + 01 GARFLAG PIC 9. + 77 ACCT-CNT PIC 9(7) VALUE ZERO. + 77 ARCH-CNT PIC 9(7) VALUE ZERO. + PROCEDURE DIVISION. + P0. + OPEN INPUT GARFILE PARMFILE FILEIN + OPEN OUTPUT GAROUT PAYOUT CHAROUT CHARNEW PAYNEW + OPEN INPUT PAYCUR CHARCUR. + READ PARMFILE AT END + DISPLAY "NO DELETE RANGE" + GO TO R20 + END-READ. + DISPLAY "PF1 (archive charges before): " PF1. + DISPLAY "PF2 (skip if activity after): " PF2. + P1. + READ FILEIN AT END GO TO R20. + ADD 1 TO ACCT-CNT. + IF FUNCTION MOD(ACCT-CNT, 1000) = 0 + DISPLAY ACCT-CNT " scanned, " ARCH-CNT " archived" + END-IF. + MOVE FILEIN01 TO G-GARNO. + START GARFILE KEY NOT < G-GARNO INVALID GO TO P1. + R0. + READ GARFILE NEXT AT END GO TO P1. + IF G-GARNO NOT = FILEIN01 GO TO P1. + SET PHR TO 1. + MOVE 0 TO GARFLAG. + MOVE G-GARNO TO PC-KEY8 + MOVE 000 TO PC-KEY3. + START PAYCUR KEY > PAYCUR-KEY INVALID GO TO R2. + R5. + READ PAYCUR NEXT AT END GO TO R2. + IF G-GARNO NOT = PC-KEY8 GO TO R2. + IF PHR > 999 + DISPLAY G-GARNO " " G-GARNAME " PHR OVERFLOW" + GO TO R0. + MOVE PC-KEY8 TO PHR-KEY8(PHR) + MOVE PC-KEY3 TO PHR-KEY3(PHR) + MOVE PC-AMOUNT TO PHR-AMOUNT(PHR) + MOVE PC-PAYCODE TO PHR-PAYCODE(PHR) + MOVE PC-DENIAL TO PHR-DENIAL(PHR) + MOVE PC-CLAIM TO PHR-CLAIM(PHR) + MOVE PC-DATE-T TO PHR-DATE-T(PHR) + MOVE PC-DATE-E TO PHR-DATE-E(PHR) + MOVE PC-BATCH TO PHR-BATCH(PHR) + SET PHR UP BY 1. + GO TO R5. + R2. + SET PHR DOWN BY 1. + MOVE G-GARNO TO CC-KEY8 + MOVE "000" TO CC-KEY3. + START CHARCUR KEY > CHARCUR-KEY INVALID GO TO R30. + R6. + READ CHARCUR NEXT AT END GO TO R30. + IF G-GARNO NOT = CC-KEY8 GO TO R30. + IF CC-DATE-T > PF1 + WRITE CHARNEW01 FROM CHARCUR01 + PERFORM A6 THRU A6-EXIT + VARYING X FROM 1 BY 1 UNTIL X > PHR + GO TO R6. + COMPUTE CLAIM-TOT = CC-AMOUNT + MOVE 0 TO FLAGX + PERFORM PH3 VARYING X FROM 1 BY 1 UNTIL X > PHR. + IF (CLAIM-TOT NOT = 0) OR (FLAGX NOT = 0) + WRITE CHARNEW01 FROM CHARCUR01 + PERFORM A6 THRU A6-EXIT + VARYING X FROM 1 BY 1 UNTIL X > PHR + GO TO R6. + PERFORM A5 THRU A5-EXIT + VARYING X FROM 1 BY 1 UNTIL X > PHR. + MOVE 1 TO GARFLAG. + WRITE CHAROUT01 FROM CHARCUR01. + GO TO R6. + PH3. + IF CC-CLAIM = PHR-CLAIM(X) + ADD PHR-AMOUNT(X) CLAIM-TOT GIVING CLAIM-TOT + IF PHR-DATE-T(X) > PF2 + MOVE 1 TO FLAGX. + A5. + IF PHR-CLAIM(X) NOT = CC-CLAIM GO TO A5-EXIT. + WRITE PAYOUT01 FROM PHR02(X). + A5-EXIT. EXIT. + A6. + IF PHR-CLAIM(X) NOT = CC-CLAIM GO TO A6-EXIT. + WRITE PAYNEW01 FROM PHR02(X). + A6-EXIT. EXIT. + R30. + IF GARFLAG = 1 + WRITE GAROUT01 FROM GARFILE01 + ADD 1 TO ARCH-CNT. + GO TO P1. + R20. + DISPLAY "Accounts scanned: " ACCT-CNT. + DISPLAY "Accounts archived (1+ charge): " ARCH-CNT. + CLOSE GARFILE CHARCUR PAYCUR FILEIN PARMFILE + GAROUT CHAROUT PAYOUT CHARNEW PAYNEW. + STOP RUN. \ No newline at end of file From 9498495e1d62b174cad4100c24c4cfcab71bae83 Mon Sep 17 00:00:00 2001 From: stephen waite Date: Sun, 10 May 2026 20:14:29 -0400 Subject: [PATCH 13/78] write to hisfile --- rri/collt/rrihist.cob | 214 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 214 insertions(+) create mode 100644 rri/collt/rrihist.cob diff --git a/rri/collt/rrihist.cob b/rri/collt/rrihist.cob new file mode 100644 index 00000000..13e2697b --- /dev/null +++ b/rri/collt/rrihist.cob @@ -0,0 +1,214 @@ + * @package cms + * @link http://www.cmsvt.com + * @author s waite + * @author Claude (Anthropic) + * @copyright Copyright (c) 2026 cms + * @license https://github.com/openemr/openemr/blob/master/LICENSE GNU General Public License 3 + IDENTIFICATION DIVISION. + PROGRAM-ID. rrihist. + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT CHAROUT ASSIGN TO "S65" + ORGANIZATION LINE SEQUENTIAL. + SELECT HISFILE ASSIGN TO "S70" ORGANIZATION IS INDEXED + ACCESS IS DYNAMIC RECORD KEY IS HISFILE-KEY. + SELECT PAYOUT ASSIGN TO "S85" + ORGANIZATION LINE SEQUENTIAL. + DATA DIVISION. + FILE SECTION. + FD CHAROUT. + 01 CHAROUT01. + 02 CO-KEY8 PIC X(8). + 02 CO-KEY3 PIC X(3). + 02 CO-PATID PIC X(8). + 02 CO-CLAIM PIC X(6). + 02 FILLER PIC X(135). + FD PAYOUT. + 01 PAYOUT01. + 02 PO-KEY8 PIC X(8). + 02 PO-KEY3 PIC 999. + 02 PO-AMOUNT PIC S9(4)V99. + 02 PO-PAYCODE PIC 999. + 02 PO-DENIAL PIC XX. + 02 PO-CLAIM PIC 9(6). + 02 PO-DATE-T PIC 9(8). + 02 PO-DATE-E PIC 9(8). + 02 PO-BATCH PIC X(6). + FD HISFILE + BLOCK CONTAINS 5 RECORDS + DATA RECORD IS HISFILE01. + 01 HISFILE01. + 02 HISFILE-KEY. + 03 HS-KEY8 PIC X(8). + 03 HS-CLAIM PIC X(6). + 03 HS-REC-TYPE PIC X. + 03 HS-KEY4 PIC X(4). + 02 HS-BODY PIC X(116). + 01 PAYHIS01 REDEFINES HISFILE01. + 02 PH-KEY. + 03 PH-KEY8 PIC X(8). + 03 PH-CLAIM PIC X(6). + 03 PH-REC-TYPE PIC X. + 03 PH-KEY4 PIC X(4). + 02 PC1. + 03 PC1-IND PIC X. + 03 PC1-AMOUNT PIC S9(4)V99. + 03 PC1-PAYCODE PIC X(3). + 03 PC1-DENIAL PIC XX. + 03 PC1-DATE-T PIC X(8). + 03 PC1-DATE-E PIC X(8). + 03 PC1-BATCH PIC X(6). + 02 PC1-PAD PIC X(10). + 02 PC2. + 03 PC2-IND PIC X. + 03 PC2-AMOUNT PIC S9(4)V99. + 03 PC2-PAYCODE PIC X(3). + 03 PC2-DENIAL PIC XX. + 03 PC2-DATE-T PIC X(8). + 03 PC2-DATE-E PIC X(8). + 03 PC2-BATCH PIC X(6). + 02 PH-FUTURE PIC X(38). + WORKING-STORAGE SECTION. + 01 PHR01. + 02 PHR02 OCCURS 999 TIMES INDEXED BY PXR. + 03 PHR-AMOUNT PIC S9(4)V99. + 03 PHR-PAYCODE PIC 999. + 03 PHR-DENIAL PIC XX. + 03 PHR-CLAIM PIC 9(6). + 03 PHR-DATE-T PIC 9(8). + 03 PHR-DATE-E PIC 9(8). + 03 PHR-BATCH PIC X(6). + 77 HOLD8 PIC X(8). + 77 PHR-CNT PIC 9(4) VALUE ZERO. + 77 PC-SLOT PIC 9 VALUE ZERO. + 77 KEY4 PIC 9(4) VALUE ZERO. + 77 CHARS-CNT PIC 9(7) VALUE ZERO. + 77 PAYS-CNT PIC 9(7) VALUE ZERO. + 77 EOF-PAYOUT PIC X VALUE "N". + PROCEDURE DIVISION. + MAIN. + OPEN INPUT CHAROUT PAYOUT + OPEN I-O HISFILE. + MOVE LOW-VALUES TO HOLD8. + READ PAYOUT AT END MOVE "Y" TO EOF-PAYOUT END-READ. + + P00. + READ CHAROUT AT END GO TO P-DONE END-READ. + ADD 1 TO CHARS-CNT. + + *> When KEY8 changes, reload PHR table from PAYOUT + IF CO-KEY8 NOT = HOLD8 + MOVE CO-KEY8 TO HOLD8 + MOVE 0 TO PHR-CNT + PERFORM LOAD-PHR. + + *> Reset KEY4 probe for each charge + MOVE 0 TO KEY4. + P-CHRG-KEY. + ADD 1 TO KEY4. + MOVE CO-KEY8 TO HS-KEY8 + MOVE CO-CLAIM TO HS-CLAIM + MOVE "1" TO HS-REC-TYPE + MOVE KEY4 TO HS-KEY4. + READ HISFILE INVALID GO TO P-CHRG-WRITE. + GO TO P-CHRG-KEY. + + P-CHRG-WRITE. + MOVE CHAROUT01 TO HISFILE01 + MOVE CO-KEY8 TO HS-KEY8 + MOVE CO-CLAIM TO HS-CLAIM + MOVE "1" TO HS-REC-TYPE + MOVE KEY4 TO HS-KEY4. + WRITE HISFILE01 INVALID KEY + DISPLAY "DUP CHARGE: " HS-KEY8 " " HS-CLAIM + " " HS-KEY4 + END-WRITE. + + *> Pack payments for this claim into PC1/PC2 pairs + MOVE 0 TO PC-SLOT. + PERFORM PACK-PAYS + VARYING PXR FROM 1 BY 1 UNTIL PXR > PHR-CNT. + + *> Flush any partial pair (odd payment count for this claim) + IF PC-SLOT = 1 + PERFORM WRITE-PAYHIS. + + GO TO P00. + + *> ─── Load all payments for HOLD8 into PHR table ─── + LOAD-PHR. + IF EOF-PAYOUT = "Y" EXIT PARAGRAPH. + IF PO-KEY8 NOT = HOLD8 EXIT PARAGRAPH. + ADD 1 TO PHR-CNT. + IF PHR-CNT > 999 + DISPLAY "PHR OVERFLOW: " HOLD8 + GO TO LOAD-PHR-NEXT. + MOVE PO-AMOUNT TO PHR-AMOUNT(PHR-CNT) + MOVE PO-PAYCODE TO PHR-PAYCODE(PHR-CNT) + MOVE PO-DENIAL TO PHR-DENIAL(PHR-CNT) + MOVE PO-CLAIM TO PHR-CLAIM(PHR-CNT) + MOVE PO-DATE-T TO PHR-DATE-T(PHR-CNT) + MOVE PO-DATE-E TO PHR-DATE-E(PHR-CNT) + MOVE PO-BATCH TO PHR-BATCH(PHR-CNT). + LOAD-PHR-NEXT. + READ PAYOUT AT END + MOVE "Y" TO EOF-PAYOUT + EXIT PARAGRAPH + END-READ. + GO TO LOAD-PHR. + + *> ─── Pack a single payment into PC1 or PC2 ─── + PACK-PAYS. + IF PHR-CLAIM(PXR) NOT = CO-CLAIM EXIT PARAGRAPH. + IF PC-SLOT = 0 + MOVE "1" TO PC1-IND + MOVE PHR-AMOUNT(PXR) TO PC1-AMOUNT + MOVE PHR-PAYCODE(PXR) TO PC1-PAYCODE + MOVE PHR-DENIAL(PXR) TO PC1-DENIAL + MOVE PHR-DATE-T(PXR) TO PC1-DATE-T + MOVE PHR-DATE-E(PXR) TO PC1-DATE-E + MOVE PHR-BATCH(PXR) TO PC1-BATCH + MOVE SPACES TO PC1-PAD + MOVE "0" TO PC2-IND + MOVE ZERO TO PC2-AMOUNT + MOVE "000" TO PC2-PAYCODE + MOVE SPACES TO PC2-DENIAL + MOVE "00000000" TO PC2-DATE-T PC2-DATE-E + MOVE "000000" TO PC2-BATCH + MOVE 1 TO PC-SLOT + ADD 1 TO PAYS-CNT + ELSE + MOVE "2" TO PC2-IND + MOVE PHR-AMOUNT(PXR) TO PC2-AMOUNT + MOVE PHR-PAYCODE(PXR) TO PC2-PAYCODE + MOVE PHR-DENIAL(PXR) TO PC2-DENIAL + MOVE PHR-DATE-T(PXR) TO PC2-DATE-T + MOVE PHR-DATE-E(PXR) TO PC2-DATE-E + MOVE PHR-BATCH(PXR) TO PC2-BATCH + ADD 1 TO PAYS-CNT + PERFORM WRITE-PAYHIS. + + *> ─── Write the payment record, probe for next KEY4 ─── + WRITE-PAYHIS. + MOVE CO-KEY8 TO PH-KEY8 + MOVE CO-CLAIM TO PH-CLAIM + MOVE "2" TO PH-REC-TYPE + MOVE SPACES TO PH-FUTURE. + P-PAY-KEY. + ADD 1 TO KEY4. + MOVE KEY4 TO PH-KEY4. + READ HISFILE INVALID GO TO P-PAY-WRITE. + GO TO P-PAY-KEY. + P-PAY-WRITE. + WRITE HISFILE01 INVALID KEY + DISPLAY "DUP PAY: " PH-KEY8 " " PH-CLAIM + " " PH-KEY4 + END-WRITE. + MOVE 0 TO PC-SLOT. + + P-DONE. + DISPLAY "Charges written: " CHARS-CNT. + DISPLAY "Payments packed: " PAYS-CNT. + CLOSE CHAROUT PAYOUT HISFILE. + STOP RUN. \ No newline at end of file From 47a2609c58e21c3975c68fb8ee93fc6eb77dd4ed Mon Sep 17 00:00:00 2001 From: stephen waite Date: Sun, 10 May 2026 20:20:23 -0400 Subject: [PATCH 14/78] use copybook --- copylib/rri/hisfile.cpy | 41 +++++++++++++++++++++++++++++++++++++++++ rri/collt/rrihist.cob | 30 +++++++++++++----------------- 2 files changed, 54 insertions(+), 17 deletions(-) create mode 100644 copylib/rri/hisfile.cpy diff --git a/copylib/rri/hisfile.cpy b/copylib/rri/hisfile.cpy new file mode 100644 index 00000000..02b5677c --- /dev/null +++ b/copylib/rri/hisfile.cpy @@ -0,0 +1,41 @@ + 01 HISFILE01. + 02 HISFILE-KEY. + 03 HS-KEY8 PIC X(8). + 03 HS-CLAIM PIC X(6). + 03 HS-REC-TYPE PIC X. + 03 HS-KEY4 PIC XXXX. + 02 HS-PATID. + 03 HS-PATID7 PIC X(7). + 03 HS-PATID1 PIC X. + 02 HS-SERVICE PIC X. + 02 HS-DIAG PIC X(5). + 02 HS-PROC PIC X(11). + 02 HS-MOD2 PIC XX. + 02 HS-MOD3 PIC XX. + 02 HS-MOD4 PIC XX. + 02 HS-AMOUNT PIC X(6). + 02 HS-DOCR PIC X(3). + 02 HS-DOCP PIC X(2). + 02 HS-PAYCODE PIC XXX. + 02 HS-STUD PIC X. + 02 HS-WORK PIC XX. + 02 HS-DAT1 PIC X(8). + 02 HS-RESULT PIC X. + 02 HS-ACT PIC X. + 02 HS-SORCREF PIC X. + 02 HS-COLLT PIC X. + 02 HS-AGE PIC X. + 02 HS-PAPER PIC X. + 02 HS-PLACE PIC X. + 02 HS-EPSDT PIC X. + 02 HS-DATE-T PIC X(8). + 02 HS-DATE-A PIC X(8). + 02 HS-DATE-E PIC X(8). + 02 HS-REC-STAT PIC X. + 02 HS-DX2 PIC X(5). + 02 HS-DX3 PIC X(5). + 02 HS-ACC-TYPE PIC X. + 02 HS-DATE-M PIC X(8). + 02 HS-ASSIGN PIC X. + 02 HS-NEIC-ASSIGN PIC X. + 02 HS-FUTURE PIC X(6). \ No newline at end of file diff --git a/rri/collt/rrihist.cob b/rri/collt/rrihist.cob index 13e2697b..ebdf200e 100644 --- a/rri/collt/rrihist.cob +++ b/rri/collt/rrihist.cob @@ -1,4 +1,4 @@ - * @package cms +* @package cms * @link http://www.cmsvt.com * @author s waite * @author Claude (Anthropic) @@ -35,17 +35,10 @@ 02 PO-DATE-T PIC 9(8). 02 PO-DATE-E PIC 9(8). 02 PO-BATCH PIC X(6). - FD HISFILE - BLOCK CONTAINS 5 RECORDS - DATA RECORD IS HISFILE01. - 01 HISFILE01. - 02 HISFILE-KEY. - 03 HS-KEY8 PIC X(8). - 03 HS-CLAIM PIC X(6). - 03 HS-REC-TYPE PIC X. - 03 HS-KEY4 PIC X(4). - 02 HS-BODY PIC X(116). - 01 PAYHIS01 REDEFINES HISFILE01. + FD HISFILE. + COPY HISFILE.CPY. + WORKING-STORAGE SECTION. + 01 PAYHIS01. 02 PH-KEY. 03 PH-KEY8 PIC X(8). 03 PH-CLAIM PIC X(6). @@ -69,7 +62,6 @@ 03 PC2-DATE-E PIC X(8). 03 PC2-BATCH PIC X(6). 02 PH-FUTURE PIC X(38). - WORKING-STORAGE SECTION. 01 PHR01. 02 PHR02 OCCURS 999 TIMES INDEXED BY PXR. 03 PHR-AMOUNT PIC S9(4)V99. @@ -103,7 +95,7 @@ MOVE 0 TO PHR-CNT PERFORM LOAD-PHR. - *> Reset KEY4 probe for each charge + *> Probe HISFILE for next free KEY4 for this charge MOVE 0 TO KEY4. P-CHRG-KEY. ADD 1 TO KEY4. @@ -189,7 +181,7 @@ ADD 1 TO PAYS-CNT PERFORM WRITE-PAYHIS. - *> ─── Write the payment record, probe for next KEY4 ─── + *> ─── Write payment record from PAYHIS01, probe KEY4 ─── WRITE-PAYHIS. MOVE CO-KEY8 TO PH-KEY8 MOVE CO-CLAIM TO PH-CLAIM @@ -197,11 +189,15 @@ MOVE SPACES TO PH-FUTURE. P-PAY-KEY. ADD 1 TO KEY4. - MOVE KEY4 TO PH-KEY4. + MOVE KEY4 TO PH-KEY4 + MOVE PH-KEY8 TO HS-KEY8 + MOVE PH-CLAIM TO HS-CLAIM + MOVE "2" TO HS-REC-TYPE + MOVE KEY4 TO HS-KEY4. READ HISFILE INVALID GO TO P-PAY-WRITE. GO TO P-PAY-KEY. P-PAY-WRITE. - WRITE HISFILE01 INVALID KEY + WRITE HISFILE01 FROM PAYHIS01 INVALID KEY DISPLAY "DUP PAY: " PH-KEY8 " " PH-CLAIM " " PH-KEY4 END-WRITE. From 6a646c8245089709712023d5247540539f3b5a3a Mon Sep 17 00:00:00 2001 From: stephen waite Date: Sun, 10 May 2026 21:52:32 -0400 Subject: [PATCH 15/78] use copybook --- rri/collt/rrihist.cob | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/rri/collt/rrihist.cob b/rri/collt/rrihist.cob index ebdf200e..805df162 100644 --- a/rri/collt/rrihist.cob +++ b/rri/collt/rrihist.cob @@ -1,4 +1,4 @@ -* @package cms + * @package cms * @link http://www.cmsvt.com * @author s waite * @author Claude (Anthropic) From e860c5e013e65d1d5d613aef82cb5dc5e085adc8 Mon Sep 17 00:00:00 2001 From: stephen waite Date: Sun, 10 May 2026 22:29:17 -0400 Subject: [PATCH 16/78] missing pays --- rri/collt/rrihist.cob | 30 +++++++++++++----------------- 1 file changed, 13 insertions(+), 17 deletions(-) diff --git a/rri/collt/rrihist.cob b/rri/collt/rrihist.cob index 805df162..2ae9484e 100644 --- a/rri/collt/rrihist.cob +++ b/rri/collt/rrihist.cob @@ -27,13 +27,13 @@ FD PAYOUT. 01 PAYOUT01. 02 PO-KEY8 PIC X(8). - 02 PO-KEY3 PIC 999. + 02 PO-KEY3 PIC X(3). 02 PO-AMOUNT PIC S9(4)V99. - 02 PO-PAYCODE PIC 999. + 02 PO-PAYCODE PIC X(3). 02 PO-DENIAL PIC XX. - 02 PO-CLAIM PIC 9(6). - 02 PO-DATE-T PIC 9(8). - 02 PO-DATE-E PIC 9(8). + 02 PO-CLAIM PIC X(6). + 02 PO-DATE-T PIC X(8). + 02 PO-DATE-E PIC X(8). 02 PO-BATCH PIC X(6). FD HISFILE. COPY HISFILE.CPY. @@ -63,18 +63,19 @@ 03 PC2-BATCH PIC X(6). 02 PH-FUTURE PIC X(38). 01 PHR01. - 02 PHR02 OCCURS 999 TIMES INDEXED BY PXR. + 02 PHR02 OCCURS 999 TIMES. 03 PHR-AMOUNT PIC S9(4)V99. - 03 PHR-PAYCODE PIC 999. + 03 PHR-PAYCODE PIC X(3). 03 PHR-DENIAL PIC XX. - 03 PHR-CLAIM PIC 9(6). - 03 PHR-DATE-T PIC 9(8). - 03 PHR-DATE-E PIC 9(8). + 03 PHR-CLAIM PIC X(6). + 03 PHR-DATE-T PIC X(8). + 03 PHR-DATE-E PIC X(8). 03 PHR-BATCH PIC X(6). 77 HOLD8 PIC X(8). 77 PHR-CNT PIC 9(4) VALUE ZERO. 77 PC-SLOT PIC 9 VALUE ZERO. 77 KEY4 PIC 9(4) VALUE ZERO. + 77 PXR PIC 9(4). 77 CHARS-CNT PIC 9(7) VALUE ZERO. 77 PAYS-CNT PIC 9(7) VALUE ZERO. 77 EOF-PAYOUT PIC X VALUE "N". @@ -89,13 +90,11 @@ READ CHAROUT AT END GO TO P-DONE END-READ. ADD 1 TO CHARS-CNT. - *> When KEY8 changes, reload PHR table from PAYOUT IF CO-KEY8 NOT = HOLD8 MOVE CO-KEY8 TO HOLD8 MOVE 0 TO PHR-CNT PERFORM LOAD-PHR. - *> Probe HISFILE for next free KEY4 for this charge MOVE 0 TO KEY4. P-CHRG-KEY. ADD 1 TO KEY4. @@ -117,18 +116,15 @@ " " HS-KEY4 END-WRITE. - *> Pack payments for this claim into PC1/PC2 pairs MOVE 0 TO PC-SLOT. PERFORM PACK-PAYS VARYING PXR FROM 1 BY 1 UNTIL PXR > PHR-CNT. - *> Flush any partial pair (odd payment count for this claim) IF PC-SLOT = 1 PERFORM WRITE-PAYHIS. GO TO P00. - *> ─── Load all payments for HOLD8 into PHR table ─── LOAD-PHR. IF EOF-PAYOUT = "Y" EXIT PARAGRAPH. IF PO-KEY8 NOT = HOLD8 EXIT PARAGRAPH. @@ -150,7 +146,6 @@ END-READ. GO TO LOAD-PHR. - *> ─── Pack a single payment into PC1 or PC2 ─── PACK-PAYS. IF PHR-CLAIM(PXR) NOT = CO-CLAIM EXIT PARAGRAPH. IF PC-SLOT = 0 @@ -181,7 +176,6 @@ ADD 1 TO PAYS-CNT PERFORM WRITE-PAYHIS. - *> ─── Write payment record from PAYHIS01, probe KEY4 ─── WRITE-PAYHIS. MOVE CO-KEY8 TO PH-KEY8 MOVE CO-CLAIM TO PH-CLAIM @@ -206,5 +200,7 @@ P-DONE. DISPLAY "Charges written: " CHARS-CNT. DISPLAY "Payments packed: " PAYS-CNT. + DISPLAY "Press any key to exit..." + ACCEPT OMITTED. CLOSE CHAROUT PAYOUT HISFILE. STOP RUN. \ No newline at end of file From bf284afd4768cf1da36bd5285b776cb2e096d224 Mon Sep 17 00:00:00 2001 From: stephen waite Date: Sun, 10 May 2026 22:41:06 -0400 Subject: [PATCH 17/78] truncate for icd9 --- rri/collt/rrihist.cob | 182 +++++++++++++++++++++++++++++------------- 1 file changed, 125 insertions(+), 57 deletions(-) diff --git a/rri/collt/rrihist.cob b/rri/collt/rrihist.cob index 2ae9484e..ed25321d 100644 --- a/rri/collt/rrihist.cob +++ b/rri/collt/rrihist.cob @@ -23,12 +23,48 @@ 02 CO-KEY3 PIC X(3). 02 CO-PATID PIC X(8). 02 CO-CLAIM PIC X(6). - 02 FILLER PIC X(135). + 02 CO-SERVICE PIC X. + 02 CO-DIAG PIC X(7). + 02 CO-PROC PIC X(11). + 02 CO-MOD2 PIC XX. + 02 CO-MOD3 PIC XX. + 02 CO-MOD4 PIC XX. + 02 CO-AMOUNT PIC X(6). + 02 CO-DOCR PIC X(3). + 02 CO-DOCP PIC X(2). + 02 CO-PAYCODE PIC X(3). + 02 CO-STUD PIC X. + 02 CO-WORK PIC XX. + 02 CO-DAT1 PIC X(8). + 02 CO-RESULT PIC X. + 02 CO-ACT PIC X. + 02 CO-SORCREF PIC X. + 02 CO-COLLT PIC X. + 02 CO-AUTH PIC X. + 02 CO-PAPER PIC X. + 02 CO-PLACE PIC X. + 02 CO-EPSDT PIC X. + 02 CO-DATE-T PIC X(8). + 02 CO-DATE-A PIC X(8). + 02 CO-DATE-P PIC X(8). + 02 CO-REC-STAT PIC X. + 02 CO-DX2 PIC X(7). + 02 CO-DX3 PIC X(7). + 02 CO-ACC-TYPE PIC X. + 02 CO-DATE-M PIC X(8). + 02 CO-ASSIGN PIC X. + 02 CO-NEIC-ASSIGN PIC X. + 02 CO-DX4 PIC X(7). + 02 CO-QP1 PIC XX. + 02 CO-QP2 PIC XX. + 02 CO-VISITNO PIC X(7). + 02 CO-QP3 PIC XX. + 02 CO-FUTURE PIC X(7). FD PAYOUT. 01 PAYOUT01. 02 PO-KEY8 PIC X(8). 02 PO-KEY3 PIC X(3). - 02 PO-AMOUNT PIC S9(4)V99. + 02 PO-AMOUNT PIC X(6). 02 PO-PAYCODE PIC X(3). 02 PO-DENIAL PIC XX. 02 PO-CLAIM PIC X(6). @@ -46,7 +82,7 @@ 03 PH-KEY4 PIC X(4). 02 PC1. 03 PC1-IND PIC X. - 03 PC1-AMOUNT PIC S9(4)V99. + 03 PC1-AMOUNT PIC X(6). 03 PC1-PAYCODE PIC X(3). 03 PC1-DENIAL PIC XX. 03 PC1-DATE-T PIC X(8). @@ -55,7 +91,7 @@ 02 PC1-PAD PIC X(10). 02 PC2. 03 PC2-IND PIC X. - 03 PC2-AMOUNT PIC S9(4)V99. + 03 PC2-AMOUNT PIC X(6). 03 PC2-PAYCODE PIC X(3). 03 PC2-DENIAL PIC XX. 03 PC2-DATE-T PIC X(8). @@ -64,7 +100,7 @@ 02 PH-FUTURE PIC X(38). 01 PHR01. 02 PHR02 OCCURS 999 TIMES. - 03 PHR-AMOUNT PIC S9(4)V99. + 03 PHR-AMOUNT PIC X(6). 03 PHR-PAYCODE PIC X(3). 03 PHR-DENIAL PIC XX. 03 PHR-CLAIM PIC X(6). @@ -106,11 +142,45 @@ GO TO P-CHRG-KEY. P-CHRG-WRITE. - MOVE CHAROUT01 TO HISFILE01 - MOVE CO-KEY8 TO HS-KEY8 - MOVE CO-CLAIM TO HS-CLAIM - MOVE "1" TO HS-REC-TYPE - MOVE KEY4 TO HS-KEY4. + MOVE SPACES TO HISFILE01. + MOVE CO-KEY8 TO HS-KEY8 + MOVE CO-CLAIM TO HS-CLAIM + MOVE "1" TO HS-REC-TYPE + MOVE KEY4 TO HS-KEY4. + MOVE CO-PATID(1:7) TO HS-PATID7 + MOVE CO-PATID(8:1) TO HS-PATID1 + MOVE CO-SERVICE TO HS-SERVICE + MOVE CO-DIAG(1:5) TO HS-DIAG + MOVE CO-PROC TO HS-PROC + MOVE CO-MOD2 TO HS-MOD2 + MOVE CO-MOD3 TO HS-MOD3 + MOVE CO-MOD4 TO HS-MOD4 + MOVE CO-AMOUNT TO HS-AMOUNT + MOVE CO-DOCR TO HS-DOCR + MOVE CO-DOCP TO HS-DOCP + MOVE CO-PAYCODE TO HS-PAYCODE + MOVE CO-STUD TO HS-STUD + MOVE CO-WORK TO HS-WORK + MOVE CO-DAT1 TO HS-DAT1 + MOVE CO-RESULT TO HS-RESULT + MOVE CO-ACT TO HS-ACT + MOVE CO-SORCREF TO HS-SORCREF + MOVE CO-COLLT TO HS-COLLT + MOVE CO-AUTH TO HS-AGE + MOVE CO-PAPER TO HS-PAPER + MOVE CO-PLACE TO HS-PLACE + MOVE CO-EPSDT TO HS-EPSDT + MOVE CO-DATE-T TO HS-DATE-T + MOVE CO-DATE-A TO HS-DATE-A + MOVE CO-DATE-P TO HS-DATE-E + MOVE CO-REC-STAT TO HS-REC-STAT + MOVE CO-DX2(1:5) TO HS-DX2 + MOVE CO-DX3(1:5) TO HS-DX3 + MOVE CO-ACC-TYPE TO HS-ACC-TYPE + MOVE CO-DATE-M TO HS-DATE-M + MOVE CO-ASSIGN TO HS-ASSIGN + MOVE CO-NEIC-ASSIGN TO HS-NEIC-ASSIGN + MOVE SPACES TO HS-FUTURE. WRITE HISFILE01 INVALID KEY DISPLAY "DUP CHARGE: " HS-KEY8 " " HS-CLAIM " " HS-KEY4 @@ -126,55 +196,53 @@ GO TO P00. LOAD-PHR. - IF EOF-PAYOUT = "Y" EXIT PARAGRAPH. - IF PO-KEY8 NOT = HOLD8 EXIT PARAGRAPH. - ADD 1 TO PHR-CNT. - IF PHR-CNT > 999 - DISPLAY "PHR OVERFLOW: " HOLD8 - GO TO LOAD-PHR-NEXT. - MOVE PO-AMOUNT TO PHR-AMOUNT(PHR-CNT) - MOVE PO-PAYCODE TO PHR-PAYCODE(PHR-CNT) - MOVE PO-DENIAL TO PHR-DENIAL(PHR-CNT) - MOVE PO-CLAIM TO PHR-CLAIM(PHR-CNT) - MOVE PO-DATE-T TO PHR-DATE-T(PHR-CNT) - MOVE PO-DATE-E TO PHR-DATE-E(PHR-CNT) - MOVE PO-BATCH TO PHR-BATCH(PHR-CNT). - LOAD-PHR-NEXT. - READ PAYOUT AT END - MOVE "Y" TO EOF-PAYOUT - EXIT PARAGRAPH - END-READ. - GO TO LOAD-PHR. + IF EOF-PAYOUT = "N" AND PO-KEY8 = HOLD8 + ADD 1 TO PHR-CNT + IF PHR-CNT > 999 + DISPLAY "PHR OVERFLOW: " HOLD8 + ELSE + MOVE PO-AMOUNT TO PHR-AMOUNT(PHR-CNT) + MOVE PO-PAYCODE TO PHR-PAYCODE(PHR-CNT) + MOVE PO-DENIAL TO PHR-DENIAL(PHR-CNT) + MOVE PO-CLAIM TO PHR-CLAIM(PHR-CNT) + MOVE PO-DATE-T TO PHR-DATE-T(PHR-CNT) + MOVE PO-DATE-E TO PHR-DATE-E(PHR-CNT) + MOVE PO-BATCH TO PHR-BATCH(PHR-CNT) + END-IF + READ PAYOUT AT END MOVE "Y" TO EOF-PAYOUT END-READ + GO TO LOAD-PHR. PACK-PAYS. - IF PHR-CLAIM(PXR) NOT = CO-CLAIM EXIT PARAGRAPH. - IF PC-SLOT = 0 - MOVE "1" TO PC1-IND - MOVE PHR-AMOUNT(PXR) TO PC1-AMOUNT - MOVE PHR-PAYCODE(PXR) TO PC1-PAYCODE - MOVE PHR-DENIAL(PXR) TO PC1-DENIAL - MOVE PHR-DATE-T(PXR) TO PC1-DATE-T - MOVE PHR-DATE-E(PXR) TO PC1-DATE-E - MOVE PHR-BATCH(PXR) TO PC1-BATCH - MOVE SPACES TO PC1-PAD - MOVE "0" TO PC2-IND - MOVE ZERO TO PC2-AMOUNT - MOVE "000" TO PC2-PAYCODE - MOVE SPACES TO PC2-DENIAL - MOVE "00000000" TO PC2-DATE-T PC2-DATE-E - MOVE "000000" TO PC2-BATCH - MOVE 1 TO PC-SLOT - ADD 1 TO PAYS-CNT - ELSE - MOVE "2" TO PC2-IND - MOVE PHR-AMOUNT(PXR) TO PC2-AMOUNT - MOVE PHR-PAYCODE(PXR) TO PC2-PAYCODE - MOVE PHR-DENIAL(PXR) TO PC2-DENIAL - MOVE PHR-DATE-T(PXR) TO PC2-DATE-T - MOVE PHR-DATE-E(PXR) TO PC2-DATE-E - MOVE PHR-BATCH(PXR) TO PC2-BATCH - ADD 1 TO PAYS-CNT - PERFORM WRITE-PAYHIS. + IF PHR-CLAIM(PXR) = CO-CLAIM + IF PC-SLOT = 0 + MOVE "1" TO PC1-IND + MOVE PHR-AMOUNT(PXR) TO PC1-AMOUNT + MOVE PHR-PAYCODE(PXR) TO PC1-PAYCODE + MOVE PHR-DENIAL(PXR) TO PC1-DENIAL + MOVE PHR-DATE-T(PXR) TO PC1-DATE-T + MOVE PHR-DATE-E(PXR) TO PC1-DATE-E + MOVE PHR-BATCH(PXR) TO PC1-BATCH + MOVE SPACES TO PC1-PAD + MOVE "0" TO PC2-IND + MOVE "000000" TO PC2-AMOUNT + MOVE "000" TO PC2-PAYCODE + MOVE SPACES TO PC2-DENIAL + MOVE "00000000" TO PC2-DATE-T PC2-DATE-E + MOVE "000000" TO PC2-BATCH + MOVE 1 TO PC-SLOT + ADD 1 TO PAYS-CNT + ELSE + MOVE "2" TO PC2-IND + MOVE PHR-AMOUNT(PXR) TO PC2-AMOUNT + MOVE PHR-PAYCODE(PXR) TO PC2-PAYCODE + MOVE PHR-DENIAL(PXR) TO PC2-DENIAL + MOVE PHR-DATE-T(PXR) TO PC2-DATE-T + MOVE PHR-DATE-E(PXR) TO PC2-DATE-E + MOVE PHR-BATCH(PXR) TO PC2-BATCH + ADD 1 TO PAYS-CNT + PERFORM WRITE-PAYHIS + END-IF + END-IF. WRITE-PAYHIS. MOVE CO-KEY8 TO PH-KEY8 From 7d39082802fa9d955a5d4f9658cd0d1b3f5c5019 Mon Sep 17 00:00:00 2001 From: stephen waite Date: Sun, 10 May 2026 22:50:09 -0400 Subject: [PATCH 18/78] perform thru --- rri/collt/rrihist.cob | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/rri/collt/rrihist.cob b/rri/collt/rrihist.cob index ed25321d..648a8cfc 100644 --- a/rri/collt/rrihist.cob +++ b/rri/collt/rrihist.cob @@ -191,7 +191,7 @@ VARYING PXR FROM 1 BY 1 UNTIL PXR > PHR-CNT. IF PC-SLOT = 1 - PERFORM WRITE-PAYHIS. + PERFORM WRITE-PAYHIS THRU P-PAY-WRITE. GO TO P00. @@ -240,7 +240,7 @@ MOVE PHR-DATE-E(PXR) TO PC2-DATE-E MOVE PHR-BATCH(PXR) TO PC2-BATCH ADD 1 TO PAYS-CNT - PERFORM WRITE-PAYHIS + PERFORM WRITE-PAYHIS THRU P-PAY-WRITE END-IF END-IF. From 08220642fb6209ed217d67e8310aaa32d14db003 Mon Sep 17 00:00:00 2001 From: stephen waite Date: Mon, 11 May 2026 09:50:34 -0400 Subject: [PATCH 19/78] 2ndary 026 --- rri/claims/npi5r3026.cob | 2619 ++++++++++++++++++++++++++++++++++++++ 1 file changed, 2619 insertions(+) create mode 100644 rri/claims/npi5r3026.cob diff --git a/rri/claims/npi5r3026.cob b/rri/claims/npi5r3026.cob new file mode 100644 index 00000000..2d2bc727 --- /dev/null +++ b/rri/claims/npi5r3026.cob @@ -0,0 +1,2619 @@ + * @package cms + * @link http://www.cmsvt.com + * @author s waite + * @copyright Copyright (c) 2020 cms + * @license https://github.com/openemr/openemr/blob/master/LICENSE GNU General Public License 3 + IDENTIFICATION DIVISION. + PROGRAM-ID. npi5r3026. + AUTHOR. SID WAITE. + DATE-COMPILED. TODAY. + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT CHARCUR ASSIGN TO "S30" ORGANIZATION IS INDEXED + ACCESS MODE IS DYNAMIC RECORD KEY IS CHARCUR-KEY + ALTERNATE RECORD KEY IS CC-PAYCODE WITH DUPLICATES + LOCK MODE MANUAL. + SELECT GARFILE ASSIGN TO "S35" ORGANIZATION IS INDEXED + ACCESS MODE IS DYNAMIC RECORD KEY IS G-GARNO + ALTERNATE RECORD KEY IS G-ACCT WITH DUPLICATES + LOCK MODE MANUAL. + SELECT PATFILE ASSIGN TO "S40" ORGANIZATION IS INDEXED + ACCESS MODE IS DYNAMIC RECORD KEY IS P-PATNO + ALTERNATE RECORD KEY IS P-GARNO WITH DUPLICATES + LOCK MODE MANUAL. + SELECT SEGFILE ASSIGN TO "S45" ORGANIZATION + LINE SEQUENTIAL. + SELECT FILEIN ASSIGN TO "S50" ORGANIZATION + LINE SEQUENTIAL. + SELECT ERRFILE ASSIGN TO "S55" ORGANIZATION + LINE SEQUENTIAL. + SELECT PARMFILE ASSIGN TO "S60" ORGANIZATION + LINE SEQUENTIAL. + SELECT REFPHY ASSIGN TO "S65" ORGANIZATION IS INDEXED + ACCESS IS DYNAMIC RECORD KEY IS REF-KEY + ALTERNATE RECORD KEY IS REF-BSNUM WITH DUPLICATES + ALTERNATE RECORD KEY IS REF-CRNUM WITH DUPLICATES + ALTERNATE RECORD KEY IS REF-UPIN WITH DUPLICATES + ALTERNATE RECORD KEY IS REF-CDNUM WITH DUPLICATES + ALTERNATE RECORD KEY IS REF-NAME WITH DUPLICATES + LOCK MODE MANUAL. + SELECT DIAGFILE ASSIGN TO "S70" ORGANIZATION IS INDEXED + ACCESS IS RANDOM RECORD KEY IS DIAG-KEY + ALTERNATE RECORD KEY IS DIAG-TITLE WITH DUPLICATES + LOCK MODE MANUAL. + SELECT AUTHFILE ASSIGN TO "S75" ORGANIZATION IS INDEXED + ACCESS MODE IS DYNAMIC RECORD KEY IS AUTH-KEY + LOCK MODE MANUAL. + SELECT MPLRFILE ASSIGN TO "S80" ORGANIZATION IS INDEXED + ACCESS IS DYNAMIC RECORD KEY IS MPLR-KEY + LOCK MODE MANUAL. + SELECT INSFILE ASSIGN TO "S85" ORGANIZATION IS INDEXED + ACCESS IS DYNAMIC RECORD KEY IS INS-KEY + ALTERNATE RECORD KEY IS INS-NAME WITH DUPLICATES + ALTERNATE RECORD KEY IS INS-CITY WITH DUPLICATES + ALTERNATE RECORD KEY IS INS-ASSIGN WITH DUPLICATES + ALTERNATE RECORD KEY IS INS-CLAIMTYPE WITH DUPLICATES + ALTERNATE RECORD KEY IS INS-NEIC WITH DUPLICATES + ALTERNATE RECORD KEY IS INS-NEIC-ASSIGN WITH DUPLICATES + LOCK MODE MANUAL. + SELECT GAPFILE ASSIGN TO "S90" ORGANIZATION IS INDEXED + ACCESS IS DYNAMIC RECORD KEY IS GAPKEY + ALTERNATE RECORD KEY IS GAP-NAME WITH DUPLICATES + ALTERNATE RECORD KEY IS GAP-CITY WITH DUPLICATES + ALTERNATE RECORD KEY IS GAP-STATE WITH DUPLICATES + LOCK MODE MANUAL. + SELECT PAYCUR ASSIGN TO "S95" ORGANIZATION IS INDEXED + ACCESS MODE IS DYNAMIC RECORD KEY IS PAYCUR-KEY + LOCK MODE MANUAL. + SELECT PLACEFILE ASSIGN TO "S100" ORGANIZATION + LINE SEQUENTIAL. + SELECT PARMFILE2 ASSIGN TO "S105" ORGANIZATION + LINE SEQUENTIAL. + SELECT HIPCLAIMFILE ASSIGN TO "S110" ORGANIZATION IS INDEXED + ACCESS MODE IS DYNAMIC RECORD KEY IS HIP-KEY + LOCK MODE MANUAL. + SELECT PROCFILE ASSIGN TO "S115" ORGANIZATION IS INDEXED + ACCESS MODE IS DYNAMIC RECORD KEY IS PROC-KEY + LOCK MODE MANUAL. + + DATA DIVISION. + FILE SECTION. + + FD PROCFILE + DATA RECORD PROCFILE01. + 01 PROCFILE01. + 02 PROC-KEY. + 03 PROC-KEY1 PIC X(4). + 03 PROC-KEY2 PIC X(7). + 02 PROC-TYPE PIC X. + 02 PROC-TITLE PIC X(28). + 02 PROC-AMOUNT PIC 9(4)V99. + FD HIPCLAIMFILE. + 01 HIPCLAIMFILE01. + 02 HIP-KEY PIC X. + 02 HIP-NUM PIC 9(9). + FD PLACEFILE. + 01 PLACEFILE01. + 02 DF1 PIC X. + 02 DF2 PIC X. + 02 DF3 PIC X(22). + 02 DF4 PIC X(18). + 02 DF5 PIC X(15). + 02 DF6 PIC XX. + 02 DF7 PIC X(9). + + FD PARMFILE. + 01 PARMFILE01 PIC X(75). + FD PARMFILE2. + 01 PARMFILE201 PIC X(15). + + FD ERRFILE. + 01 ERRFILE01. + 02 EF-1 PIC X(11). + 02 FILLER PIC X VALUE SPACE. + 02 EF-2 PIC X(9). + 02 FILLER PIC X VALUE SPACE. + 02 EF-3 PIC X(16). + 02 EF-4 PIC X(20). + 02 FILLER PIC X VALUE SPACE. + 02 EF-5 PIC X(10). + FD FILEIN. + 01 FILEIN01. + 02 FILEIN-KEY. + 03 FI-KEY8 PIC X(8). + 03 FI-KEY3 PIC XXX. + 02 FI-PATID. + 03 FI-PATID7 PIC X(7). + 03 FI-PATID8 PIC X. + 02 FI-CLAIM PIC X(6). + 02 FI-SERVICE PIC X. + 02 FI-DIAG PIC X(7). + 02 FI-PROC. + 03 FI-PROC0 PIC X(4). + 03 FI-PROC1 PIC X(5). + 03 FI-PROC2 PIC XX. + 02 FI-MOD2 PIC XX. + 02 FI-MOD3 PIC XX. + 02 FI-MOD4 PIC XX. + 02 FI-AMOUNT PIC S9(4)V99. + 02 FI-DOCR PIC X(3). + 02 FI-DOCP PIC 99. + 02 FI-PAYCODE PIC XXX. + 02 FI-STUD PIC X. + 02 FI-WORK PIC 99. + 02 FI-DAT1 PIC X(8). + 02 FI-RESULT PIC X. + 02 FI-ACTION PIC X. + 02 FI-SORCREF PIC X. + 02 FI-COLLT PIC X. + 02 FI-AGE PIC X. + 02 FI-PAPER PIC X. + 02 FI-PLACE PIC X. + 02 FI-IOPAT PIC X. + 02 FI-DATE-T PIC X(8). + 02 FI-DATE-A PIC X(8). + 02 FI-DATE-P PIC X(8). + 02 FI-REC-STAT PIC X. + 02 FI-DX2 PIC X(7). + 02 FI-DX3 PIC X(7). + 02 FI-ACC-TYPE PIC X. + 02 FI-DATE-M PIC X(8). + 02 FI-ASSIGN PIC X. + 02 FI-NEIC-ASSIGN PIC X. + 02 FI-DX4 PIC X(7). + 02 FI-DX5 PIC X(7). + 02 FI-DX6 PIC X(7). + 02 FI-FREQ PIC X. + 02 FI-FUTURE PIC X(5). + + FD SEGFILE. + 01 SEGFILE01 PIC X(160). + FD CHARCUR + BLOCK CONTAINS 3 RECORDS + DATA RECORD IS CHARCUR01. + 01 CHARCUR01. + 02 CHARCUR-KEY. + 03 CC-KEY8 PIC X(8). + 03 CC-KEY3 PIC XXX. + 02 CC-PATID. + 03 CC-PATID7 PIC X(7). + 03 CC-PATID8 PIC X. + 02 CC-CLAIM PIC X(6). + 02 CC-SERVICE PIC X. + 02 CC-DIAG PIC X(7). + 02 CC-PROC. + 03 CC-PROC0 PIC X(4). + 03 CC-PROC1 PIC X(5). + 03 CC-PROC2 PIC XX. + 02 CC-MOD2 PIC XX. + 02 CC-MOD3 PIC XX. + 02 CC-MOD4 PIC XX. + 02 CC-AMOUNT PIC S9(4)V99. + 02 CC-DOCR PIC X(3). + 02 CC-DOCP PIC X(2). + 02 CC-PAYCODE PIC XXX. + 02 CC-STUD PIC X. + 02 CC-WORK PIC XX. + 02 CC-DAT1 PIC X(8). + 02 CC-RESULT PIC X. + 02 CC-ACTION PIC X. + 02 CC-SORCREF PIC X. + 02 CC-COLLT PIC X. + 02 CC-AGE PIC X. + 02 CC-PAPER PIC X. + 02 CC-PLACE PIC X. + 02 CC-IOPAT PIC X. + 02 CC-DATE-T PIC X(8). + 02 CC-DATE-A PIC X(8). + 02 CC-DATE-P PIC X(8). + 02 CC-REC-STAT PIC X. + 02 CC-DX2 PIC X(7). + 02 CC-DX3 PIC X(7). + 02 CC-ACC-TYPE PIC X. + 02 CC-DATE-M PIC X(8). + 02 CC-ASSIGN PIC X. + 02 CC-NEIC-ASSIGN PIC X. + 02 CC-DX4 PIC X(7). + 02 CC-DX5 PIC X(7). + 02 CC-DX6 PIC X(7). + 02 CC-FREQ PIC X. + 02 CC-FUTURE PIC X(5). + FD GARFILE + BLOCK CONTAINS 3 RECORDS + DATA RECORD IS G-MASTER. + 01 G-MASTER. + 02 G-GARNO PIC X(8). + 02 G-GARNAME PIC X(24). + 02 G-BILLADD PIC X(22). + 02 G-STREET PIC X(22). + 02 G-CITY PIC X(18). + 02 G-STATE PIC X(2). + 02 G-ZIP PIC X(9). + 02 G-COLLT PIC X. + 02 G-PHONE PIC X(10). + 02 G-SEX PIC X. + 02 G-RELATE PIC X. + 02 G-MSTAT PIC X. + 02 G-DOB PIC X(8). + 02 G-DUNNING PIC X. + 02 G-ACCTSTAT PIC X. + 02 G-PR-MPLR PIC X(4). + 02 G-PRINS PIC XXX. + 02 G-PR-ASSIGN PIC X. + 02 G-PR-OFFICE PIC X(4). + 02 G-PR-GROUP PIC X(10). + 02 G-PRIPOL PIC X(16). + 02 G-PRNAME PIC X(24). + 02 G-PR-RELATE PIC X. + 02 G-SE-MPLR PIC X(4). + 02 G-SEINS PIC XXX. + 02 G-SE-ASSIGN PIC X. + 02 G-TRINSIND PIC X. + 02 G-TRINS PIC XXX. + 02 G-SE-GROUP PIC X(10). + 02 G-SECPOL PIC X(16). + 02 G-SENAME PIC X(24). + 02 G-SE-RELATE PIC X. + 02 G-COPAY PIC S9(5)V99. + 02 G-LASTBILL PIC X(8). + 02 G-ASSIGNM PIC X. + 02 G-PRIVATE PIC X. + 02 G-BILLCYCLE PIC X. + 02 G-DELETE PIC X. + 02 G-FILLER PIC XXX. + 02 G-ACCT PIC X(8). + 02 G-PRGRPNAME PIC X(15). + 02 G-SEGRPNAME PIC X(15). + + + + FD PAYCUR + * BLOCK CONTAINS 3 RECORDS + DATA RECORD IS PAYCUR01. + 01 PAYCUR01. + 02 PAYCUR-KEY. + 03 PC-KEY8 PIC X(8). + 03 PC-KEY3 PIC XXX. + 02 PC-AMOUNT PIC S9(4)V99. + 02 PC-PAYCODE PIC XXX. + 02 PC-DENIAL PIC XX. + 02 PC-CLAIM PIC X(6). + 02 PC-DATE-T PIC X(8). + 02 PC-DATE-E PIC X(8). + 02 PC-BATCH PIC X(6). + + FD INSFILE + * BLOCK CONTAINS 6 RECORDS + DATA RECORD IS INSFILE01. + 01 INSFILE01. + 02 INS-KEY PIC XXX. + 02 INS-NAME PIC X(22). + 02 INS-STREET PIC X(24). + 02 INS-CITY PIC X(15). + 02 INS-STATE PIC XX. + 02 INS-ZIP PIC X(9). + 02 INS-ASSIGN PIC X. + 02 INS-CLAIMTYPE PIC X. + 02 INS-NEIC PIC X(5). + 02 INS-NEICLEVEL PIC X. + 02 INS-NEIC-ASSIGN PIC X. + 02 INS-PPO PIC X. + 02 INS-PRVNUM PIC X(10). + 02 INS-HMO PIC X(3). + 02 INS-STATUS PIC X. + 02 INS-LEVEL PIC X. + 02 INS-LASTDATE PIC X(8). + 02 INS-CAID PIC XXX. + 02 INS-REFWARN PIC X. + 02 INS-FUTURE PIC X(8). + + FD PATFILE + * BLOCK CONTAINS 5 RECORDS + DATA RECORD IS P-MASTER. + 01 P-MASTER. + 02 P-PATNO PIC X(8). + 02 P-GARNO PIC X(8). + 02 P-PATNAME PIC X(24). + 02 P-SEX PIC X. + 02 P-RELATE PIC X. + 02 P-MSTAT PIC X. + 02 P-DOB PIC X(8). + + FD MPLRFILE. + 01 MPLRFILE01. + 02 MPLR-KEY PIC X(8). + 02 MPLR-NAME PIC X(22). + 02 MPLR-STREET PIC X(24). + 02 MPLR-CITY PIC X(15). + 02 MPLR-STATE PIC XX. + 02 MPLR-ZIP PIC X(9). + 02 MPLR-CLAIMNO PIC X(15). + 02 MPLR-TRINS PIC XXX. + 02 MPLR-TR-ASSIGN PIC X. + 02 MPLR-TR-GROUP PIC X(10). + 02 MPLR-TRIPOL PIC X(16). + 02 MPLR-TR-NAME PIC X(24). + 02 MPLR-TR-RELATE PIC X. + 02 MPLR-FUTURE PIC X(6). + + FD AUTHFILE + BLOCK CONTAINS 6 RECORDS + DATA RECORD IS AUTHFILE01. + 01 AUTHFILE01. + 02 AUTH-KEY. + 03 AUTH-KEY8 PIC X(8). + 03 AUTH-KEY6 PIC X(6). + 02 AUTH-NUM PIC X(15). + 02 AUTH-QNTY PIC XX. + 02 AUTH-DATE-E PIC X(8). + 02 AUTH-FILLER PIC XXX. + + FD REFPHY + * BLOCK CONTAINS 5 RECORDS + DATA RECORD IS REFPHY01. + 01 REFPHY01. + 02 REF-KEY PIC XXX. + 02 REF-BSNUM PIC X(5). + 02 REF-CRNUM PIC X(6). + 02 REF-UPIN PIC X(6). + 02 REF-CDNUM PIC X(7). + 02 REF-NAME PIC X(24). + 02 REF-NPI PIC X(10). + FD GAPFILE. + 01 GAPFILE01. + 02 GAPKEY PIC X(7). + 02 GAP-NAME PIC X(25). + 02 GAP-ADDR PIC X(22). + 02 GAP-CITY PIC X(15). + 02 GAP-STATE PIC XX. + 02 GAP-ZIP PIC X(9). + 02 GAP-TYPE PIC X. + 02 GAP-FUTURE PIC X(40). + FD DIAGFILE + BLOCK CONTAINS 15 RECORDS + DATA RECORD IS DIAG01. + 01 DIAG01. + 02 DIAG-KEY PIC X(7). + 02 DIAG-TITLE PIC X(61). + 02 DIAG-MEDB PIC X(5). + + WORKING-STORAGE SECTION. + 01 ISA01. + 02 ISA-0 PIC XXX VALUE "ISA". + 02 ISA-S0 PIC X VALUE "*". + 02 ISA-1 PIC XX. + 02 ISA-S1 PIC X VALUE "*". + 02 ISA-2 PIC X(10). + 02 ISA-S2 PIC X VALUE "*". + 02 ISA-3 PIC XX. + 02 ISA-S3 PIC X VALUE "*". + 02 ISA-4 PIC X(10). + 02 ISA-S4 PIC X VALUE "*". + 02 ISA-5 PIC XX. + 02 ISA-S5 PIC X VALUE "*". + 02 ISA-6 PIC X(15). + 02 ISA-S6 PIC X VALUE "*". + 02 ISA-7 PIC XX. + 02 ISA-S7 PIC X VALUE "*". + 02 ISA-8 PIC X(15). + 02 ISA-S8 PIC X VALUE "*". + 02 ISA-9 PIC X(6). + 02 ISA-S9 PIC X VALUE "*". + 02 ISA-10 PIC X(4). + 02 ISA-S10 PIC X VALUE "*". + 02 ISA-11 PIC X. + 02 ISA-S11 PIC X VALUE "*". + 02 ISA-12 PIC X(5). + 02 ISA-S12 PIC X VALUE "*". + 02 ISA-13 PIC X(9). + 02 ISA-S13 PIC X VALUE "*". + 02 ISA-14 PIC X. + 02 ISA-S14 PIC X VALUE "*". + 02 ISA-15 PIC X. + 02 ISA-S15 PIC X VALUE "*". + 02 ISA-16 PIC X. + 02 ISA-S16 PIC X VALUE "*". + 02 ISA-END PIC X VALUE "~". + 01 IEA01. + 02 IEA-0 PIC XXX VALUE "IEA". + 02 IEA-S0 PIC X VALUE "*". + 02 IEA-1 PIC X VALUE "1". + 02 IEA-END PIC X VALUE "~". + + 01 GS01. + 02 GS-0 PIC XX VALUE "GS". + 02 GS-S0 PIC X VALUE "*". + 02 GS-1 PIC XX VALUE "HC". + 02 GS-S1 PIC X VALUE "*". + 02 GS-2 PIC X(9) VALUE "0M4 ". + 02 GS-S2 PIC X VALUE "*". + 02 GS-3 PIC X(9) VALUE "EMEDNYBAT". + 02 GS-S3 PIC X VALUE "*". + 02 GS-4 PIC X(8). + 02 GS-S4 PIC X VALUE "*". + 02 GS-5 PIC X(4). + 02 GS-S5 PIC X VALUE "*". + 02 GS-NUM PIC X(9). + 02 GS-S6 PIC X VALUE "*". + 02 GS-7 PIC X VALUE "X". + 02 GS-S7 PIC X VALUE "*". + 02 GS-8 PIC X(12) VALUE "005010X222A1". + 02 GS-S8 PIC X VALUE "*". + 02 GS-END PIC X VALUE "~". + 01 ST01. + 02 ST-0 PIC XX VALUE "ST". + 02 ST-S0 PIC X VALUE "*". + 02 ST-1 PIC XXX VALUE "837". + 02 ST-S1 PIC X VALUE "*". + 02 ST-NUM PIC X(9). + 02 ST-S2 PIC X VALUE "*". + 02 ST-CONVENT-REF PIC X(12) VALUE "005010X222A1". + 02 ST-END PIC X VALUE "~". + 01 SE01. + 02 SE-0 PIC XX VALUE "SE". + 02 SE-S0 PIC X VALUE "*". + 02 SE-CNTR PIC X(9). + 02 SE-S1 PIC X VALUE "*". + 02 SE-NUM PIC X(9). + 02 SE-END PIC X VALUE "~". + 01 GE01. + 02 GE-0 PIC XX VALUE "GE". + 02 GE-S0 PIC X VALUE "*". + 02 GE-CNTR PIC 9 VALUE 1. + 02 GE-S1 PIC X VALUE "*". + 02 GE-NUM PIC X(9). + 02 GE-END PIC X VALUE "~". + + + 01 BHT01. + 02 BHT-0 PIC XXX VALUE "BHT". + 02 BHT-S0 PIC X VALUE "*". + 02 BHT-1 PIC X(4) VALUE "0019". + 02 BHT-S1 PIC X VALUE "*". + 02 BHT-2 PIC XX VALUE "00". + 02 BHT-S2 PIC X VALUE "*". + 02 BHT-NUM PIC X(9). + 02 BHT-S3 PIC X VALUE "*". + 02 BHT-DATE PIC X(8). + 02 BHT-S4 PIC X VALUE "*". + 02 BHT-TIME PIC X(4). + 02 BHT-S5 PIC X VALUE "*". + 02 BHT-6 PIC XX VALUE "CH". + 02 BHT-END PIC X VALUE "~". + 01 REF01. + 02 REF-0 PIC XXX VALUE "REF". + 02 REF-S0 PIC X VALUE "*". + 02 REF-CODE PIC X(30). + 02 REF-S1 PIC X VALUE "*". + 02 REF-ID PIC X(30). + 02 REF-S2 PIC X VALUE "*". + 02 REF-3 PIC XX VALUE SPACE. + 02 REF-S3 PIC X VALUE "*". + 02 REF-4 PIC XX VALUE SPACE. + 02 REF-S4 PIC X VALUE "*". + 02 REF-END PIC X VALUE "~". + 01 SAVE-DOCREF01. + 02 SAVE-DOCREF-0 PIC XXX VALUE "REF". + 02 SAVE-DOCREF-S0 PIC X VALUE "*". + 02 SAVE-DOCREF-CODE PIC X(30). + 02 SAVE-DOCREF-S1 PIC X VALUE "*". + 02 SAVE-DOCREF-ID PIC X(30). + 02 SAVE-DOCREF-S2 PIC X VALUE "*". + 02 SAVE-DOCREF-3 PIC XX VALUE SPACE. + 02 SAVE-DOCREF-S3 PIC X VALUE "*". + 02 SAVE-DOCREF-4 PIC XX VALUE SPACE. + 02 SAVE-DOCREF-S4 PIC X VALUE "*". + 02 SAVE-DOCREF-END PIC X VALUE "~". + + 01 SUBM01. + 02 SUBM-0 PIC XXX VALUE "NM1". + 02 SUBM-S0 PIC X VALUE "*". + 02 SUBM-1 PIC XX VALUE "41". + 02 SUBM-S1 PIC X VALUE "*". + 02 SUBM-2 PIC X VALUE "2". + 02 SUBM-S2 PIC X VALUE "*". + 02 SUBM-3 PIC X(25) VALUE "CARE MANAGEMENT SOLUTIONS". + 02 SUBM-S3 PIC X VALUE "*". + 02 SUBM-S4 PIC X VALUE "*". + 02 SUBM-S5 PIC X VALUE "*". + 02 SUBM-S51 PIC X VALUE "*". + 02 SUBM-S6 PIC X VALUE "*". + 02 SUBM-8 PIC XX VALUE "46". + 02 SUBM-S7 PIC X VALUE "*". + 02 SUBM-NUM PIC X(9) VALUE "030353360". + 02 SUBM-END PIC X VALUE "~". + 01 SUBPER01. + 02 SUBPER-0 PIC XXX VALUE "PER". + 02 SUBPER-S0 PIC X VALUE "*". + 02 SUBPER-1 PIC XX VALUE "IC". + 02 SUBPER-S1 PIC X VALUE "*". + 02 SUBPER-2 PIC X(9) VALUE "S WAITE". + 02 SUBPER-S2 PIC X VALUE "*". + 02 SUBPER-3 PIC XX VALUE "TE". + 02 SUBPER-S3 PIC X VALUE "*". + 02 SUBPER-4 PIC X(10) VALUE "8003718685". + 02 SUBPER-S4 PIC X VALUE "*". + 02 SUBPER-5 PIC XX VALUE "FX". + 02 SUBPER-S5 PIC X VALUE "*". + 02 SUBPER-6 PIC X(10) VALUE "8027705175". + 02 SUBPER-S6 PIC X VALUE "*". + 02 SUBPER-7 PIC XX VALUE "EM". + 02 SUBPER-S7 PIC X VALUE "*". + 02 SUBPER-8 PIC X(23) VALUE "stephen.waite@cmsvt.com". + 02 SUBPER-S9 PIC X VALUE "*". + 02 SUBPER-END PIC X VALUE "~". + 01 INSNM01. + 02 INSNM-1 PIC XXX VALUE "NM1". + 02 INSNM-S0 PIC X VALUE "*". + 02 INSNM-2 PIC XX VALUE "40". + 02 INSNM-S1 PIC X VALUE "*". + 02 INSNM-3 PIC X VALUE "2". + 02 INSNM-S2 PIC X VALUE "*". + 02 INSNM-NAME PIC X(35). + 02 INSNM-S3 PIC X VALUE "*". + 02 INSNM-S4 PIC X VALUE "*". + 02 INSNM-S5 PIC X VALUE "*". + 02 INSNM-S51 PIC X VALUE "*". + 02 INSNM-S6 PIC X VALUE "*". + 02 INSNM-8 PIC XX VALUE "46". + 02 INSNM-S7 PIC X VALUE "*". + 02 INSNM-NUM PIC X(9). + 02 INSNM-END PIC X VALUE "~". + 01 HL01. + 02 HL-0 PIC XX VALUE "HL". + 02 HL-S0 PIC X VALUE "*". + 02 HL-NUMX PIC X(5). + 02 HL-S1 PIC X VALUE "*". + 02 HL-PARENT PIC X(5). + 02 HL-S2 PIC X VALUE "*". + 02 HL-CODE PIC X(4). + 02 HL-S3 PIC X VALUE "*". + 02 HL-CHILD PIC X. + 02 HL-S4 PIC X VALUE "*". + 02 HL-END PIC X VALUE "~". + 01 PRV01. + 02 PRV-0 PIC XXX VALUE "PRV". + 02 PRV-S0 PIC X VALUE "*". + 02 PRV-1 PIC XX VALUE "BI". + 02 PRV-S1 PIC X VALUE "*". + 02 PRV-2 PIC XXX VALUE "PXC". + 02 PRV-S2 PIC X VALUE "*". + 02 PRV-TAX PIC X(10). + 02 PRV-END PIC X VALUE "~". + 01 PER01. + 02 PER-0 PIC XXX VALUE "PER". + 02 PER-S0 PIC X VALUE "*". + 02 PER-1 PIC XX VALUE "IC". + 02 PER-S1 PIC X VALUE "*". + 02 PER-CONTACT PIC X(30). + 02 PER-S2 PIC X VALUE "*". + 02 PER-3 PIC XX VALUE "TE". + 02 PER-STE PIC X VALUE "*". + 02 PER-PHONE PIC X(10). + 02 PER-S3 PIC X VALUE "*". + 02 PER-S4 PIC X VALUE "*". + 02 PER-S5 PIC X VALUE "*". + 02 PER-S6 PIC X VALUE "*". + 02 PER-S7 PIC X VALUE "*". + 02 PER-S8 PIC X VALUE "*". + 02 PER-S9 PIC X VALUE "*". + 02 PER-END PIC X VALUE "~". + 01 NM101. + 02 NM1-0 PIC XXX VALUE "NM1". + 02 NM1-S0 PIC X VALUE "*". + 02 NM1-1 PIC XXX. + 02 NM1-S1 PIC X VALUE "*". + 02 NM1-SOLO PIC X. + 02 NM1-S2 PIC X VALUE "*". + 02 NM1-NAMEL PIC X(40). + 02 NM1-S3 PIC X VALUE "*". + 02 NM1-NAMEF PIC X(25). + 02 NM1-S4 PIC X VALUE "*". + 02 NM1-NAMEM PIC X. + 02 NM1-S5 PIC X VALUE "*". + 02 NM1-S51 PIC X VALUE "*". + 02 NM1-NAMES PIC XXX. + 02 NM1-S6 PIC X VALUE "*". + 02 NM1-EINSS PIC XX. + 02 NM1-S7 PIC X VALUE "*". + 02 NM1-CODE PIC X(16). + 02 NM1-END PIC X VALUE "~". + 01 SAVE-DOCNM101. + 02 SAVE-DOCNM1-0 PIC XXX VALUE "NM1". + 02 SAVE-DOCNM1-S0 PIC X VALUE "*". + 02 SAVE-DOCNM1-1 PIC XXX. + 02 SAVE-DOCNM1-S1 PIC X VALUE "*". + 02 SAVE-DOCNM1-SOLO PIC X. + 02 SAVE-DOCNM1-S2 PIC X VALUE "*". + 02 SAVE-DOCNM1-NAMEL PIC X(40). + 02 SAVE-DOCNM1-S3 PIC X VALUE "*". + 02 SAVE-DOCNM1-NAMEF PIC X(25). + 02 SAVE-DOCNM1-S4 PIC X VALUE "*". + 02 SAVE-DOCNM1-NAMEM PIC X. + 02 SAVE-DOCNM1-S5 PIC X VALUE "*". + 02 SAVE-DOCNM1-S51 PIC X VALUE "*". + 02 SAVE-DOCNM1-NAMES PIC XXX. + 02 SAVE-DOCNM1-S6 PIC X VALUE "*". + 02 SAVE-DOCNM1-EINSS PIC XX. + 02 SAVE-DOCNM1-S7 PIC X VALUE "*". + 02 SAVE-DOCNM1-CODE PIC X(16). + 02 SAVE-DOCNM1-END PIC X VALUE "~". + + 01 RECNM101. + 02 RECNM1-0 PIC XXX VALUE "NM1". + 02 RECNM1-S0 PIC X VALUE "*". + 02 RECNM1-1 PIC XXX VALUE "40 ". + 02 RECNM1-S1 PIC X VALUE "*". + 02 RECNM1-SOLO PIC X VALUE "2". + 02 RECNM1-S2 PIC X VALUE "*". + 02 RECNM1-NAMEL PIC X(5) VALUE "NYSDOH". + 02 RECNM1-S3 PIC X VALUE "*". + 02 RECNM1-S4 PIC X VALUE "*". + 02 RECNM1-S5 PIC X VALUE "*". + 02 RECNM1-S51 PIC X VALUE "*". + 02 RECNM1-S6 PIC X VALUE "*". + 02 RECNM1-8 PIC XX VALUE "46". + 02 RECNM1-S7 PIC X VALUE "*". + 02 RECNM1-CODE PIC X(9) VALUE "141797357". + 02 RECNM1-END PIC X VALUE "~". + + 01 N301. + 02 N3-0 PIC XX VALUE "N3". + 02 N3-S0 PIC X VALUE "*". + 02 N3-STREET PIC X(24). + 02 N3-S1 PIC X VALUE "*". + 02 N3-BILLADD PIC X(24). + 02 N3-S2 PIC X VALUE "*". + 02 N3-END PIC X VALUE "~". + 01 N401. + 02 N4-0 PIC XX VALUE "N4". + 02 N4-S0 PIC X VALUE "*". + 02 N4-CITY PIC X(20). + 02 N4-S1 PIC X VALUE "*". + 02 N4-STATE PIC XX. + 02 N4-S2 PIC X VALUE "*". + 02 N4-ZIP PIC X(9). + 02 N4-S3 PIC X VALUE "*". + 02 N4-S4 PIC X VALUE "*". + 02 N4-S5 PIC X VALUE "*". + 02 N4-S6 PIC X VALUE "*". + 02 N4-END PIC X VALUE "~". + 01 SBR01. + 02 SBR-0 PIC XXX VALUE "SBR". + 02 SBR-S0 PIC X VALUE "*". + 02 SBR-PST PIC X. + 02 SBR-S1 PIC X VALUE "*". + 02 SBR-RELATE PIC XX. + 02 SBR-S2 PIC X VALUE "*". + 02 SBR-GROUP PIC X(16). + 02 SBR-S3 PIC X VALUE "*". + 02 SBR-GRNAME PIC X(22) VALUE SPACE. + 02 SBR-S4 PIC X VALUE "*". + 02 SBR-TYPE PIC XX. + 02 SBR-S5 PIC X VALUE "*". + 02 SBR-6 PIC X. + 02 SBR-S6 PIC X VALUE "*". + 02 SBR-7 PIC X. + 02 SBR-S7 PIC X VALUE "*". + 02 SBR-8 PIC X. + 02 SBR-S8 PIC X VALUE "*". + 02 SBR-INSCODE PIC XXX. + 02 SBR-S9 PIC X VALUE "*". + 02 SBR-END PIC X VALUE "~". + 01 DMG01. + 02 DMG-0 PIC XXX VALUE "DMG". + 02 DMG-S0 PIC X VALUE "*". + 02 DMG-1 PIC XX VALUE "D8". + 02 DMG-S1 PIC X VALUE "*". + 02 DMG-DOB PIC X(8). + 02 DMG-S2 PIC X VALUE "*". + 02 DMG-GENDER PIC X. + 02 DMG-S3 PIC X VALUE "*". + 02 DMG-S4 PIC X VALUE "*". + 02 DMG-S5 PIC X VALUE "*". + 02 DMG-S6 PIC X VALUE "*". + 02 DMG-S7 PIC X VALUE "*". + 02 DMG-S8 PIC X VALUE "*". + 02 DMG-S9 PIC X VALUE "*". + 02 DMG-END PIC X VALUE "~". + 01 PAT01. + 02 PAT-0 PIC XXX VALUE "PAT". + 02 PAT-S0 PIC X VALUE "*". + 02 PAT-RELATE PIC XX. + 02 PAT-S1 PIC X VALUE "*". + 02 PAT-LOCATE PIC X. + 02 PAT-S2 PIC X VALUE "*". + 02 PAT-EMPLOYM PIC XX. + 02 PAT-S3 PIC X VALUE "*". + 02 PAT-STUD PIC X. + 02 PAT-S4 PIC X VALUE "*". + 02 PAT-QUAL PIC XX . + 02 PAT-S5 PIC X VALUE "*". + 02 PAT-DATE PIC X(8). + 02 PAT-S6 PIC X VALUE "*". + 02 PAT-MEAS PIC XX. + 02 PAT-S7 PIC X VALUE "*". + 02 PAT-WT PIC X. + 02 PAT-S8 PIC X VALUE "*". + 02 PAT-PREGO PIC X. + 02 PAT-S9 PIC X VALUE "*". + 02 PAT-END PIC X VALUE "~". + + 01 CLM01. + 02 CLM-0 PIC XXX VALUE "CLM". + 02 CLM-S0 PIC X VALUE "*". + 02 CLM-1 PIC X(16). + 02 CLM-S1 PIC X VALUE "*". + 02 CLM-2 PIC X(8). + 02 CLM-S2 PIC X VALUE "*". + 02 CLM-3 PIC XX VALUE SPACE. + 02 CLM-S3 PIC X VALUE "*". + 02 CLM-4 PIC X VALUE SPACE. + 02 CLM-S4 PIC X VALUE "*". + 02 CLM-5 PIC XX. + 02 CLM-S52 PIC X VALUE ":". + 02 CLM-5-2 PIC X VALUE "B". + 02 CLM-COLON-PLACE PIC X VALUE ":". + 02 CLM-FREQ PIC X VALUE "1". + 02 CLM-S5 PIC X VALUE "*". + 02 CLM-6 PIC X VALUE "Y". + 02 CLM-S6 PIC X VALUE "*". + 02 CLM-7 PIC X VALUE "A". + 02 CLM-S7 PIC X VALUE "*". + 02 CLM-8 PIC X VALUE "Y". + 02 CLM-S8 PIC X VALUE "*". + 02 CLM-9 PIC X VALUE "Y". + 02 CLM-S9 PIC X VALUE "*". + 02 CLM-10 PIC X VALUE "P". + 02 CLM-S10 PIC X VALUE "*". + 02 CLM-11 PIC XX. + 02 CLM-COLON-ACCIDENT PIC X VALUE SPACE. + 02 CLM-S11 PIC X VALUE "*". + 02 CLM-12 PIC XXX. + 02 CLM-S12 PIC X VALUE "*". + 02 CLM-13 PIC X. + 02 CLM-S13 PIC X VALUE "*". + 02 CLM-14 PIC XXX. + 02 CLM-S14 PIC X VALUE "*". + 02 CLM-15 PIC X. + 02 CLM-S15 PIC X VALUE "*". + 02 CLM-16 PIC X. + 02 CLM-S16 PIC X VALUE "*". + 02 CLM-17 PIC XX. + 02 CLM-S17 PIC X VALUE "*". + 02 CLM-18 PIC X. + 02 CLM-S18 PIC X VALUE "*". + 02 CLM-19 PIC XX. + 02 CLM-S19 PIC X VALUE "*". + 02 CLM-20 PIC XX. + 02 CLM-END PIC X VALUE "~". + + 01 HI901. + 02 HI9-0 PIC XX VALUE "HI". + 02 HI9-S0 PIC X VALUE "*". + 02 HI9-1C PIC XXX VALUE "BK:". + 02 HI9-DX1 PIC X(5). + 02 HI9-DIAG-FILLER PIC X(108). + 02 HI9-END PIC X VALUE "~". + 01 HI1001. + 02 HI10-0 PIC XX VALUE "HI". + 02 HI10-S0 PIC X VALUE "*". + 02 HI10-1C PIC XXXX VALUE "ABK:". + 02 HI10-DX1 PIC X(7). + 02 HI10-DIAG-FILLER PIC X(144). + 02 HI10-END PIC X VALUE "~". + 01 CAS01. + 02 CAS-0 PIC XXX VALUE "CAS". + 02 CAS-S0 PIC X VALUE "*". + 02 CAS-1 PIC XX. + 02 CAS-S1 PIC X VALUE "*". + 02 CAS-2 PIC XXX. + 02 CAS-S2 PIC X VALUE "*". + 02 CAS-3 PIC X(8). + 02 CAS-S3 PIC X VALUE "*". + 02 CAS-4 PIC X. + 02 CAS-END PIC X VALUE "~". + 01 AMT01. + 02 AMT-0 PIC XXX VALUE "AMT". + 02 AMT-S0 PIC X VALUE "*". + 02 AMT-1 PIC XXX. + 02 AMT-S1 PIC X VALUE "*". + 02 AMT-2 PIC X(8). + 02 AMT-END PIC X VALUE "~". + 01 LX01. + 02 LX-0 PIC XX VALUE "LX". + 02 LX-S0 PIC X VALUE "*". + 02 LX-1 PIC XX. + 02 LX-END PIC X VALUE "~". + 01 SV101. + 02 SV1-0 PIC XXX VALUE "SV1". + 02 SV1-S0 PIC X VALUE "*". + 02 SV1-1 PIC XX VALUE "HC". + 02 SV1-S1 PIC X VALUE ":". + 02 SV1-PROC PIC X(5). + 02 SV1-MOD-FILLER PIC X(33). + 02 SV1-S6 PIC X VALUE "*". + 02 SV1-AMT PIC X(7). + 02 SV1-S7 PIC X VALUE "*". + 02 SV1-8 PIC XX VALUE "UN". + 02 SV1-S8 PIC X VALUE "*". + 02 SV1-WORK PIC XX. + 02 SV1-S9 PIC X VALUE "*". + 02 SV1-PLACE PIC XX. + 02 SV1-S10 PIC X VALUE "*". + 02 SV1-S11 PIC X VALUE "*". + 02 SV1-PT PIC X(36). + 02 SV1-S15 PIC X VALUE "*". + 02 SV1-S16 PIC X VALUE "*". + 02 SV1-EMER PIC X. + 02 SV1-S115 PIC XX VALUE "**". + 02 SV1-EPSDT PIC XX. + 02 SV1-S116 PIC X VALUE "*". + 02 SV1-FAMILY PIC X. + 02 SV1-S117 PIC XXX VALUE "***". + 02 SV1-COPAY PIC X. + 02 SV1-END PIC X VALUE "~". + 01 DTP01. + 02 DTP-0 PIC XXX VALUE "DTP". + 02 DTP-S0 PIC X VALUE "*". + 02 DTP-1 PIC XXX. + 02 DTP-S1 PIC X VALUE "*". + 02 DTP-2 PIC XX VALUE "D8". + 02 DTP-S2 PIC X VALUE "*". + 02 DTP-3 PIC X(8). + 02 DTP-END PIC X VALUE "~". + 01 SVD01. + 02 SVD-0 PIC XXX VALUE "SVD". + 02 SVD-S1 PIC X VALUE "*". + 02 SVD-1 PIC X(5). + 02 SVD-S3 PIC X VALUE "*". + 02 SVD-2 PIC X(8). + 02 SVD-S2 PIC X VALUE "*". + 02 SVD-3 PIC X(20). + 02 SVD-S34 PIC XX VALUE "**". + 02 SVD-4 PIC XX. + 02 SVD-END PIC X VALUE "~". + 01 OI01. + 02 OI-0 PIC XX VALUE "OI". + 02 OI-S12 PIC XXX VALUE "***". + 02 OI-3 PIC X VALUE "Y". + 02 OI-S4 PIC X VALUE "*". + 02 OI-4 PIC X VALUE "P". + 02 OI-S56 PIC XX VALUE "**". + 02 OI-6 PIC X VALUE "Y". + 02 OI-END PIC X VALUE "~". + 01 TEST-DATE. + 05 T-CC PIC XX. + 05 T-YY PIC XX. + 05 T-MM PIC XX. + 05 T-DD PIC XX. + 01 DISPLAY-DATE. + 05 T-MM PIC XX. + 05 FILLER PIC X VALUE "/". + 05 T-DD PIC XX. + 05 FILLER PIC X VALUE "/". + 05 T-CC PIC XX. + 05 T-YY PIC XX. + 01 ALF14. + 02 ALF14-3 PIC XXX. + 02 ALF14-9 PIC X(9). + 02 FILLER PIC XX. + 01 DATE-X PIC X(8). + 01 TIME-X. + 02 TIME-HHMM PIC X(4). + 02 FILLER PIC X(4). + 01 DDFLAG PIC 9. + 01 FLAG PIC 9. + 01 CLIA-FLAG PIC 9. + 01 ORDER-FLAG PIC 9. + 01 END-FLAG PIC 9 VALUE 0. + 01 GAP-FLAG PIC 9. + 01 CNTR PIC 99. + 01 DIAG-CNTR PIC 99. + 01 DX-CNTR-PT PIC 9. + 01 X PIC 99. + 01 DIAG-X PIC X(7). + 01 Y PIC 99. + 01 A PIC 99. + 01 B PIC 99. + 01 C PIC 999. + 01 D PIC 999. + 01 DIAG9-ARRAY01. + 02 DIAG9-ARRAY OCCURS 12 TIMES. + 03 DIAG9-BF PIC XXXX. + 03 DIAG9-CODE PIC X(5). + 01 DIAG10-ARRAY01. + 02 DIAG10-ARRAY OCCURS 12 TIMES. + 03 DIAG10-BF PIC XXXXX. + 03 DIAG10-CODE PIC X(7). + 01 MOD-ARRAY01. + 02 MOD-ARRAY OCCURS 4 TIMES. + 03 MOD-C PIC X. + 03 MOD-CODE PIC XX. + 01 DIAG-POINTER01. + 02 DIAG-POINTER OCCURS 12 TIMES. + 03 DIAG-PT PIC Z9. + 03 DIAG-C PIC X. + 01 DIAGTAB01. + 02 DIAGTAB PIC X(7) OCCURS 12 TIMES. + 01 FILETAB01. + 02 FILETAB PIC X(160) OCCURS 50 TIMES. + 01 TAB3601. + 02 TAB36 PIC X OCCURS 36 TIMES. + 01 tab11401. + 02 TAB114 PIC X OCCURS 114 TIMES. + 01 ALF114 PIC X(114). + 01 GROUP-3 PIC XXX. + 01 ALF1 PIC X. + 01 ALF-4. + 02 ALF-4-1 PIC XX. + 02 ALF-4-2 PIC XX. + 01 ALF10 PIC X(10). + 01 ALF20 PIC X(20). + 01 ALF5 PIC X(5). + 01 ALF7. + 02 ALF71 PIC XX. + 02 ALF72 PIC X(5). + 01 ALF9 PIC X(9). + 01 ALF-9 PIC X(9). + 01 ALFS PIC X(5). + 01 ALFS8 PIC X(8). + 01 ALFS9 PIC X(9). + 01 ALF5Z PIC ZZZZZ. + 01 ALF9Z PIC ZZZZZZZZZ. + 01 ALF5NUM PIC X(5). + 01 ALF9NUM PIC X(9). + 01 NUM7 PIC 9(5)V99. + 01 ALF8 PIC X(8). + 01 ALF8Z PIC ZZZZ9.99. + 01 ALF8NUM PIC X(8). + 01 NUM5 PIC 9(5). + 01 NUM9 PIC 9(9). + 01 NUM2 PIC 99. + 01 HL-NUMPARENT PIC 9(5). + 01 HL-NUM PIC 9(5) VALUE 0. + 01 DOC-TAB01. + 02 DOC-TAB02 OCCURS 90 TIMES. + 03 DOC-TAX PIC X(10). + 03 DOC-SS PIC X(9). + 03 DOC-NUM PIC X(9). + 03 DOC-LASTNAME PIC X(20). + 03 DOC-FIRSTNAME PIC X(10). + 03 DOC-MI PIC X. + 03 DOC-NPI PIC X(10). + 01 PARM01. + 02 PM-1 PIC XX. + 02 FILLER PIC X. + 02 PM-2 PIC X(10). + 02 FILLER PIC X. + 02 PM-3 PIC X(9). + 02 FILLER PIC X. + 02 PM-4 PIC X(8). + 02 FILLER PIC X. + 02 PM-5 PIC X(31). + 02 FILLER PIC X. + 02 PM-6 PIC X(10). + 01 EINSS PIC X(9). + 01 EINSS-TYPE PIC X. + 01 PARMLAST PIC X(15). + 01 PARMFIRST PIC X(15). + 01 PARMMIDDLE PIC X. + 01 ORG-NAME PIC X(40). + 01 ORG-CITY PIC X(30). + 01 ORG-STATE PIC XX. + 01 ORG-ZIP PIC X(9). + 01 INSTYPE-CODE PIC XXX. + 01 SUBMIT01. + 02 SUBMIT-1 PIC X(8). + 02 SUBMIT-2 PIC XX. + 01 TELE-PHONE PIC X(10). + 01 ORG-STREET PIC X(24). + 01 EIN-CODE PIC X(12). + 01 CONTACT-NAME PIC X(30). + 01 PLACE-TAB01. + 02 PLACE-TAB OCCURS 29 TIMES. + 03 PL-TAB PIC X. + 03 PL-NUM PIC X. + 03 PL-NAME PIC X(22). + 03 PL-STREET PIC X(18). + 03 PL-CITY PIC X(15). + 03 PL-STATE PIC XX. + 03 PL-ZIP PIC X(9). + 01 PLINDX PIC 99 VALUE 0. + 01 CC-PL PIC X. + 01 HL-NUMPRV-SAVE PIC X(5). + 01 HL-SBR-SAVE PIC X(5). + 01 X-RELATE PIC X. + 01 SBR-RELATEHOLD PIC X. + 01 SUB-RELATE PIC X. + 01 SUB-NAME PIC X(24). + 01 SUB-GROUP PIC X(12). + 01 SUB-POLICY PIC X(14). + 01 TOT-AMOUNT PIC 9(4)V99. + 01 PLACE-POINTER PIC 99. + 01 SAVE01 PIC X(160). + 01 X-MOD. + 02 X-MOD1 PIC XX. + 02 X-MOD2 PIC XX. + 02 X-MOD3 PIC XX. + 01 NAME-1 PIC X(24). + 01 NAME-2 PIC X(24). + 01 HOLD-FILEIN01. + 02 HOLD-FILEIN-KEY. + 03 HOLD-KEY8 PIC X(8). + 03 HOLD-KEY3 PIC XXX. + 02 HOLD-PATID. + 03 HOLD-PATID7 PIC X(7). + 03 HOLD-PATID8 PIC X. + 02 HOLD-CLAIM PIC X(6). + 02 HOLD-SERVICE PIC X. + 02 HOLD-DIAG PIC X(7). + 02 HOLD-PROC. + 03 HOLD-PROC0 PIC X(4). + 03 HOLD-PROC1 PIC X(5). + 03 HOLD-PROC2 PIC XX. + 02 HOLD-MOD2 PIC XX. + 02 HOLD-MOD3 PIC XX. + 02 HOLD-MOD4 PIC XX. + 02 HOLD-AMOUNT PIC S9(4)V99. + 02 HOLD-DOCR PIC X(3). + 02 HOLD-DOCP PIC 99. + 02 HOLD-PAYCODE PIC XXX. + 02 HOLD-STUD PIC X. + 02 HOLD-WORK PIC 99. + 02 HOLD-DAT1 PIC X(8). + 02 HOLD-RESULT PIC X. + 02 HOLD-ACTION PIC X. + 02 HOLD-SORCREF PIC X. + 02 HOLD-COLLT PIC X. + 02 HOLD-AGE PIC X. + 02 HOLD-PAPER PIC X. + 02 HOLD-PLACE PIC X. + 02 HOLD-IOPAT PIC X. + 02 HOLD-DATE-T PIC X(8). + 02 HOLD-DATE-A PIC X(8). + 02 HOLD-DATE-P PIC X(8). + 02 HOLD-REC-STAT PIC X. + 02 HOLD-DX2 PIC X(7). + 02 HOLD-DX3 PIC X(7). + 02 HOLD-ACC-TYPE PIC X. + 02 HOLD-DATE-M PIC X(8). + 02 HOLD-ASSIGN PIC X. + 02 HOLD-NEIC-ASSIGN PIC X. + 02 HOLD-DX4 PIC X(7). + 02 HOLD-DX5 PIC X(7). + 02 HOLD-DX6 PIC X(7). + 02 HOLD-FREQ PIC X. + 02 HOLD-FUTURE PIC X(5). + 01 MAMMO-FLAG PIC 9. + 01 mammo-code pic x(6). + 01 CLIA-NUM PIC X(12). + 01 GROUP-TAX PIC X(10). + 01 AGEX. + 02 AGEXYY PIC 9999. + 02 AGEXMMDD PIC XXXX. + 01 AGEY. + 02 AGEYYY PIC 9999. + 02 AGEYMMDD PIC XXXX. + 01 AGEZ PIC 999. + 01 CAS-DEDUC01. + 02 CAS-DEDUC PIC S9(4)V99 OCCURS 50 TIMES. + 01 CAS-REDUCE01. + 02 CAS-REDUCE PIC S9(4)V99 OCCURS 50 TIMES. + 01 CAS-ALLOWED01. + 02 CAS-ALLOWED PIC S9(4)V99 OCCURS 50 TIMES. + 01 CAS-PAID01. + 02 CAS-PAID PIC S9(4)V99 OCCURS 50 TIMES. + 01 CAS-PAYDATE01. + 02 CAS-PAYDATE PIC X(8) OCCURS 50 TIMES. + 01 CAS-DD01. + 02 CAS-DD PIC X OCCURS 50 TIMES. + + 01 CAS-TOT-REDUCE PIC 9(4)V99. + 01 CAS-TOT-CHARGE PIC 9(4)V99. + 01 CAS-TOT-ALLOWED PIC 9(4)V99. + 01 CAS-TOT-PAID PIC 9(4)V99. + 01 CLMBAL01. + 02 CLM-BAL PIC S9(4)V99 OCCURS 50 TIMES. + 01 REDUCE-FLAG PIC 9. + 01 PRIME-FLAG PIC 9. + 01 AMOUNT-X PIC S9(4)V99. + 01 MONTH-TABLE-CONS. + 05 FILLER PIC X(24) VALUE "312931303130313130313031". + 01 MONTH-TABLE REDEFINES MONTH-TABLE-CONS. + 05 DAYS-IN-MONTH OCCURS 12 TIMES PIC 99. + 01 X-DOB. + 02 X-YYYY PIC 9999. + 02 X-MM PIC 99. + 02 X-DD PIC 99. + 01 ANS PIC X. + 01 INSGROUP-CODE PIC X(12). + 01 INSGROUP-LEG PIC X(6). + 01 LASTREF PIC XXX. + 01 ZEF-7 PIC Z,ZZ9.99CR. + 01 CLAIM-ADJ-DATE PIC X(8). + + PROCEDURE DIVISION. + P0. + OPEN INPUT FILEIN GARFILE PATFILE INSFILE REFPHY + AUTHFILE MPLRFILE DIAGFILE PLACEFILE GAPFILE PARMFILE + PARMFILE2 PAYCUR PROCFILE. + OPEN OUTPUT SEGFILE ERRFILE. + OPEN I-O HIPCLAIMFILE + MOVE "A" TO HIP-KEY + READ HIPCLAIMFILE WITH LOCK INVALID + DISPLAY "BAD HIPCLAIMFILE" + GO TO P99. + COMPUTE NUM9 = HIP-NUM + PERFORM NUM-LEFT9 + MOVE ALF9NUM TO GS-NUM + MOVE ALF9NUM TO GE-NUM + ADD 1 TO HIP-NUM + OPEN I-O CHARCUR. + PERFORM ISA-1 THRU ISA-EXIT + PERFORM A0 THRU A0-EXIT. + MOVE SPACE TO SEGFILE01 + * WRITE SEGFILE01 FROM ISA01 + ACCEPT TIME-X FROM TIME + MOVE TIME-HHMM TO BHT-TIME GS-5. + ACCEPT BHT-DATE FROM CENTURY-DATE. + MOVE BHT-DATE TO GS-4. + + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM GS01 + MOVE SPACE TO SEGFILE01 + + COMPUTE NUM9 = HIP-NUM + PERFORM NUM-LEFT9 + MOVE ALF9NUM TO ST-NUM + MOVE ALF9NUM TO SE-NUM + + + ADD 1 TO HIP-NUM + WRITE SEGFILE01 FROM ST01. + + COMPUTE NUM9 = HIP-NUM + PERFORM NUM-LEFT9 + MOVE ALF9NUM TO BHT-NUM + + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM BHT01. + * MOVE SPACE TO REF-CODE REF-ID + * MOVE "87 " TO REF-CODE + * MOVE "005010X222A1" TO REF-ID + * MOVE SPACE TO SEGFILE01 + * WRITE SEGFILE01 FROM REF01. + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM SUBM01. + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM SUBPER01. + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM RECNM101. + + + P00. READ PLACEFILE AT END GO TO P000. + ADD 1 TO PLINDX. + MOVE DF1 TO PL-TAB(PLINDX) + MOVE DF2 TO PL-NUM(PLINDX) + MOVE DF3 TO PL-NAME(PLINDX) + MOVE DF4 TO PL-STREET(PLINDX) + MOVE DF5 TO PL-CITY(PLINDX) + MOVE DF6 TO PL-STATE(PLINDX) + MOVE DF7 TO PL-ZIP(PLINDX) + GO TO P00. + + P000. + READ FILEIN AT END GO TO P98. + MOVE FILEIN01 TO HOLD-FILEIN01 + PERFORM DF-SEARCH + PERFORM 2000A THRU 2000B + GO TO P0000-1. + + P0000. + MOVE SAVE01 TO HOLD-FILEIN01 FILEIN01 + PERFORM DF-SEARCH. + P0000-1. + MOVE 0 TO CNTR DIAG-CNTR TOT-AMOUNT MAMMO-FLAG + CLIA-FLAG + GO TO P1-1. + P1. READ FILEIN AT END MOVE 1 TO END-FLAG GO TO P2. + P1-1. + * IF CNTR > 0 GO TO P2. + IF DIAG-CNTR > 11 GO TO P2. + IF FI-PLACE = HOLD-PLACE + AND FI-KEY8 = HOLD-KEY8 + AND FI-PATID = HOLD-PATID + AND FI-DOCP = HOLD-DOCP + AND FI-DOCR = HOLD-DOCR + AND FI-DAT1 = HOLD-DAT1 + AND FI-ACC-TYPE = HOLD-ACC-TYPE + AND CNTR < 50 + PERFORM DIAG-1 THRU DIAG-EXIT + IF DIAG-CNTR > 12 GO TO P2 + END-IF + IF FI-SERVICE = "4" MOVE 1 TO CLIA-FLAG + END-IF + ADD 1 TO CNTR + MOVE FILEIN01 TO FILETAB(CNTR) + ADD FI-AMOUNT TO TOT-AMOUNT + GO TO P1. + P2. + MOVE FILEIN01 TO SAVE01 + PERFORM 2300CLM + PERFORM HI-DIAG THRU HI-DIAG-EXIT + PERFORM 2310D + PERFORM 2310E THRU 2310E-EXIT + PERFORM 2320A THRU 2320A-EXIT + MOVE 0 TO CAS-TOT-REDUCE + MOVE 0 TO CAS-TOT-CHARGE + MOVE 0 TO CAS-TOT-ALLOWED + MOVE 0 TO CAS-TOT-PAID + MOVE "0" TO DDFLAG + PERFORM CAS-TOT THRU CAS-TOT-EXIT + VARYING X FROM 1 BY 1 UNTIL X > CNTR + PERFORM 2320S THRU 2320S-EXIT + PERFORM 2400SRV THRU 2400SRV-EXIT + VARYING X FROM 1 BY 1 UNTIL X > CNTR + IF END-FLAG = 1 GO TO P98. + MOVE SAVE01 TO FILEIN01 + IF FI-DOCP NOT = HOLD-DOCP + MOVE FILEIN01 TO HOLD-FILEIN01 + PERFORM DOCP-1. + MOVE FILEIN01 TO HOLD-FILEIN01 + PERFORM 2000B + GO TO P0000. + + DIAG-1. + IF FI-DIAG = "0000000" GO TO DIAG-EXIT. + + MOVE FI-DIAG TO DIAG-X + MOVE 0 TO FLAG + PERFORM DIAG-2 VARYING X FROM 1 BY 1 UNTIL X > DIAG-CNTR + IF FLAG = 0 + ADD 1 TO DIAG-CNTR + MOVE FI-DIAG TO DIAGTAB(DIAG-CNTR). + + IF FI-DX2 = "0000000" GO TO DIAG-EXIT. + + MOVE FI-DX2 TO DIAG-X. + MOVE 0 TO FLAG + PERFORM DIAG-2 VARYING X FROM 1 BY 1 UNTIL X > DIAG-CNTR + IF FLAG = 0 + ADD 1 TO DIAG-CNTR + MOVE FI-DX2 TO DIAGTAB(DIAG-CNTR). + + IF FI-DX3 = "0000000" GO TO DIAG-EXIT. + + MOVE FI-DX3 TO DIAG-X + MOVE 0 TO FLAG + PERFORM DIAG-2 VARYING X FROM 1 BY 1 UNTIL X > DIAG-CNTR + IF FLAG = 0 + ADD 1 TO DIAG-CNTR + MOVE FI-DX3 TO DIAGTAB(DIAG-CNTR). + + IF FI-DX4 = "0000000" GO TO DIAG-EXIT. + + MOVE FI-DX4 TO DIAG-X + MOVE 0 TO FLAG + PERFORM DIAG-2 VARYING X FROM 1 BY 1 UNTIL X > DIAG-CNTR + IF FLAG = 0 + ADD 1 TO DIAG-CNTR + MOVE FI-DX4 TO DIAGTAB(DIAG-CNTR). + + DIAG-EXIT. EXIT. + DIAG-2. IF DIAGTAB(X) = DIAG-X + MOVE DIAG-CNTR TO X + MOVE 1 TO FLAG. + + + 2000A. + ADD 1 TO HL-NUM + MOVE HL-NUM TO HL-NUMPRV-SAVE + COMPUTE NUM5 = HL-NUM + PERFORM NUM-LEFT + MOVE ALF5NUM TO HL-NUMX + MOVE SPACE TO HL-PARENT + MOVE "20 " TO HL-CODE + MOVE "1" TO HL-CHILD + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM HL01 + MOVE GROUP-TAX TO PRV-TAX + MOVE SPACE TO SEGFILE01. + * WRITE SEGFILE01 FROM PRV01 + PERFORM DOCP-1. + + * BILLING PROVIDER/ADDRESS + 2010AA. + MOVE "85 " TO NM1-1 + MOVE "1" TO NM1-SOLO + MOVE "34" TO NM1-EINSS + MOVE SPACE TO NM1-CODE NM1-NAMEL NM1-NAMEF + NM1-NAMEM NM1-NAMES + MOVE DOC-LASTNAME(HOLD-DOCP) TO NM1-NAMEL + MOVE DOC-FIRSTNAME(HOLD-DOCP) TO NM1-NAMEF + MOVE DOC-MI(HOLD-DOCP) TO NM1-NAMEM + MOVE DOC-SS(HOLD-DOCP) TO NM1-CODE + MOVE SPACE TO SEGFILE01 + * WRITE SEGFILE01 FROM NM101. + * PERFORM PLACE-OF-SERVICE + MOVE SPACE TO N3-STREET N3-BILLADD + MOVE PL-STREET(PLACE-POINTER) TO N3-STREET + MOVE SPACE TO SEGFILE01 + * WRITE SEGFILE01 FROM N301 + MOVE SPACE TO N4-CITY N4-STATE N4-ZIP + MOVE PL-CITY(PLACE-POINTER) TO N4-CITY + MOVE PL-STATE(PLACE-POINTER) TO N4-STATE + MOVE PL-ZIP(PLACE-POINTER) TO N4-ZIP + IF N4-ZIP(6:4) = SPACE + MOVE "9999"TO N4-ZIP(6:4) + END-IF + MOVE SPACE TO SEGFILE01 + * WRITE SEGFILE01 FROM N401. + MOVE SPACE TO REF-CODE REF-ID + MOVE DOC-NUM(HOLD-DOCP) TO REF-ID + MOVE INSTYPE-CODE TO REF-CODE + MOVE SPACE TO SEGFILE01. + * WRITE SEGFILE01 FROM REF01. + + MOVE CONTACT-NAME TO PER-CONTACT + MOVE TELE-PHONE TO PER-PHONE + MOVE SPACE TO SEGFILE01. + * WRITE SEGFILE01 FROM PER01. + + * PAY-TO PROVIDER/ADDRESS + 2010AB. + IF EINSS-TYPE = "E" + MOVE "2" TO NM1-SOLO + MOVE ORG-NAME TO NM1-NAMEL + MOVE SPACE TO NM1-NAMEF NM1-NAMEM NM1-NAMES + MOVE "24" TO NM1-EINSS + ELSE + MOVE "1" TO NM1-SOLO + MOVE PARMLAST TO NM1-NAMEL + MOVE PARMFIRST TO NM1-NAMEF + MOVE PARMMIDDLE TO NM1-NAMEM + MOVE "34" TO NM1-EINSS. + MOVE "XX" TO NM1-EINSS. + MOVE "85" TO NM1-1 + MOVE SPACE TO NM1-CODE + MOVE INSGROUP-CODE TO NM1-CODE + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM NM101 + MOVE SPACE TO N3-STREET N3-BILLADD + MOVE ORG-STREET TO N3-STREET + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM N301 + MOVE SPACE TO N4-CITY N4-STATE N4-ZIP + MOVE ORG-CITY TO N4-CITY + MOVE ORG-STATE TO N4-STATE + MOVE ORG-ZIP TO N4-ZIP + IF N4-ZIP(6:4) = SPACE + MOVE "9999"TO N4-ZIP(6:4) + END-IF + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM N401 + MOVE SPACE TO REF-CODE REF-ID + MOVE INSTYPE-CODE TO REF-CODE + MOVE INSGROUP-LEG TO REF-ID + MOVE SPACE TO SEGFILE01. + * WRITE SEGFILE01 FROM REF01. + MOVE SPACE TO REF-CODE REF-ID + IF EINSS-TYPE = "E" + MOVE "EI" TO REF-CODE + ELSE + MOVE "SY" TO REF-CODE. + MOVE EIN-CODE TO REF-ID + MOVE SPACE TO SEGFILE01. + WRITE SEGFILE01 FROM REF01. + 2000B. + ADD 1 TO HL-NUM + COMPUTE NUM5 = HL-NUM + PERFORM NUM-LEFT + MOVE ALF5NUM TO HL-NUMX + MOVE HL-NUMPRV-SAVE TO NUM5 + PERFORM NUM-LEFT + MOVE ALF5NUM TO HL-PARENT + MOVE "22 " TO HL-CODE + PERFORM SUBSCRIBER-1 THRU SUBSCRIBER-EXIT. + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM HL01 + MOVE SPACE TO SEGFILE01 + MOVE SPACE TO SBR-GRNAME + WRITE SEGFILE01 FROM SBR01 + PERFORM 2010BA. + PERFORM 2010BB. + + 2010BA. + MOVE "IL " TO NM1-1 + MOVE "1" TO NM1-SOLO + MOVE SPACE TO NM1-NAMEL NM1-NAMEF NM1-NAMEM NM1-NAMES + UNSTRING G-GARNAME DELIMITED BY "; " OR ";" INTO + NM1-NAMEL NM1-NAMEF NM1-NAMEM + MOVE SPACE TO NAME-1 NAME-2 + UNSTRING NM1-NAMEL DELIMITED BY " " INTO NAME-1 NAME-2 + IF NAME-2 = "JR" OR "SR" OR "II" OR "III" + MOVE SPACE TO NM1-NAMEL NM1-NAMES + MOVE NAME-1 TO NM1-NAMEL + MOVE NAME-2 TO NM1-NAMES. + IF NM1-NAMEM = SPACE + MOVE SPACE TO NAME-1 NAME-2 + UNSTRING NM1-NAMEF DELIMITED BY " " INTO NAME-1 NAME-2 + IF NAME-2 NOT = SPACE + MOVE SPACE TO NM1-NAMEF NM1-NAMEM + MOVE NAME-1 TO NM1-NAMEF + MOVE NAME-2 TO NM1-NAMEM + END-IF + END-IF. + MOVE SPACE TO NM1-CODE + MOVE G-SECPOL TO NM1-CODE + IF G-TRINS = HOLD-PAYCODE + MOVE MPLR-TRIPOL TO NM1-CODE + END-IF + MOVE "MI" TO NM1-EINSS + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM NM101. + MOVE SPACE TO N3-STREET N3-BILLADD + MOVE G-BILLADD TO N3-STREET + MOVE G-STREET TO N3-BILLADD + IF G-BILLADD = SPACE + MOVE G-STREET TO N3-STREET + MOVE SPACE TO N3-BILLADD. + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM N301. + MOVE SPACE TO N4-CITY N4-STATE N4-ZIP + MOVE G-CITY TO N4-CITY + MOVE G-STATE TO N4-STATE + MOVE G-ZIP TO N4-ZIP + IF N4-ZIP(6:4) = SPACE + MOVE "9999"TO N4-ZIP(6:4) + END-IF + + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM N401. + MOVE G-DOB TO DMG-DOB + MOVE G-SEX TO DMG-GENDER + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM DMG01. + 2010BB. + MOVE "PR " TO NM1-1 + MOVE "2" TO NM1-SOLO + MOVE SPACE TO NM1-NAMEL NM1-NAMEF NM1-NAMEM NM1-NAMES + MOVE G-SEINS TO INS-KEY + READ INSFILE + INVALID + MOVE "NYSDOH" TO NM1-NAMEL + MOVE "PI" TO NM1-EINSS + MOVE "141797357" TO NM1-CODE + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM NM101 + MOVE SPACE TO N3-STREET N3-BILLADD + MOVE "1 CSC WAY" TO N3-STREET + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM N301 + MOVE SPACE TO N4-CITY N4-STATE N4-ZIP + MOVE "RENSSELAER" TO N4-CITY + MOVE "NY" TO N4-STATE + MOVE "12144 " TO N4-ZIP + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM N401 + NOT INVALID + MOVE INS-NAME TO NM1-NAMEL + MOVE "PI" TO NM1-EINSS + MOVE INS-NEIC TO NM1-CODE + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM NM101 + MOVE SPACE TO N3-STREET N3-BILLADD + MOVE INS-STREET TO N3-STREET + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM N301 + MOVE SPACE TO N4-CITY N4-STATE N4-ZIP + MOVE INS-CITY TO N4-CITY + MOVE INS-STATE TO N4-STATE + MOVE INS-ZIP TO N4-ZIP + IF N4-ZIP(6:4) = SPACE + MOVE "9999" TO N4-ZIP(6:4) + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM N401. + + 2300CLM. + MOVE HOLD-KEY8 TO SUBMIT-1 + MOVE SUBMIT01 TO CLM-1 + COMPUTE NUM7 = TOT-AMOUNT + PERFORM AMT-LEFT + MOVE ALF8NUM TO CLM-2 + MOVE SPACE TO CLM-11 CLM-COLON-ACCIDENT + IF HOLD-DAT1 NOT = ZEROES + PERFORM ACCIDENT-1 THRU ACCIDENT-EXIT. + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM CLM01. + IF HOLD-DAT1 NOT = ZEROES + MOVE "439" TO DTP-1 + MOVE HOLD-DAT1 TO DTP-3 + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM DTP01. + IF (CLM-5 = "21" OR "61") + MOVE "435" TO DTP-1 + MOVE HOLD-DATE-M TO DTP-3 + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM DTP01. + IF (CLIA-FLAG = 1) + AND (CLIA-NUM NOT = SPACE) + MOVE SPACE TO REF-CODE + MOVE "X4" TO REF-CODE + MOVE SPACE TO REF-ID + MOVE CLIA-NUM TO REF-ID + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM REF01. + IF MAMMO-FLAG= 1 + MOVE SPACE TO REF-CODE REF-ID SEGFILE01 + MOVE "EW" TO REF-CODE + MOVE MAMMO-CODE TO REF-ID + WRITE SEGFILE01 FROM REF01. + + 2300CLM-EXIT. EXIT. + + + ACCIDENT-1. + MOVE "OA" TO CLM-11. + * MOVE ":" TO CLM-COLON-ACCIDENT. + ACCIDENT-EXIT. + EXIT. + 2310D. + IF HOLD-PLACE NOT = "2" + MOVE "77 " TO NM1-1 + IF HOLD-PLACE = "4" + MOVE "IL " TO NM1-1 + END-IF + MOVE "2" TO NM1-SOLO + MOVE PL-NAME(PLACE-POINTER) TO NM1-NAMEL + MOVE SPACE TO NM1-NAMEF NM1-NAMEM NM1-NAMES + MOVE " " TO NM1-EINSS + MOVE SPACE TO NM1-CODE + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM NM101 + MOVE SPACE TO N3-STREET N3-BILLADD + MOVE PL-STREET(PLACE-POINTER) TO N3-STREET + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM N301 + MOVE SPACE TO N4-CITY N4-STATE N4-ZIP + MOVE PL-CITY(PLACE-POINTER) TO N4-CITY + MOVE PL-STATE(PLACE-POINTER) TO N4-STATE + MOVE PL-ZIP(PLACE-POINTER) TO N4-ZIP + IF N4-ZIP(6:4) = SPACE + MOVE "9999"TO N4-ZIP(6:4) + END-IF + + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM N401. + + 2310E. + IF LASTREF = SPACE GO TO 2310E-EXIT. + MOVE LASTREF TO REF-KEY + READ REFPHY INVALID GO TO 2310E-1. + MOVE "DQ " TO NM1-1 + MOVE "1" TO NM1-SOLO + MOVE SPACE TO NM1-NAMEL NM1-NAMEF NM1-NAMEM + UNSTRING REF-NAME DELIMITED BY + "; " OR ";" OR " ; " OR " ," OR ", " OR " , " OR "," + INTO NM1-NAMEL NM1-NAMEF + MOVE SPACE TO NM1-NAMES NM1-EINSS NM1-CODE + MOVE "XX" TO NM1-EINSS + MOVE REF-NPI TO NM1-CODE + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM NM101. + GO TO 2310E-EXIT. + 2310E-1. + IF ORDER-FLAG = 1 + MOVE HOLD-DOCP TO NUM2 + MOVE "DQ " TO NM1-1 + MOVE "1" TO NM1-SOLO + MOVE SPACE TO NM1-NAMEL NM1-NAMEF NM1-NAMEM + MOVE DOC-LASTNAME(NUM2) TO NM1-NAMEL + MOVE DOC-FIRSTNAME(NUM2) TO NM1-NAMEF + MOVE SPACE TO NM1-NAMES NM1-EINSS NM1-CODE + MOVE "XX " TO NM1-EINSS + MOVE DOC-NPI(NUM2) TO NM1-CODE + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM NM101. + 2310E-EXIT. + EXIT. + + 2320A. + GO TO 2320A-EXIT. + IF G-SEINS = "001" OR "012" OR "075" OR "076" + GO TO 2320A-EXIT. + IF G-SEINS = "005" PERFORM CMP-1 + GO TO 2320A-EXIT. + IF G-SEINS = "004" OR "064" PERFORM CAID-1 + GO TO 2320A-EXIT. + MOVE 0 TO GAP-FLAG + IF G-SEINS = "062" PERFORM GAP-1 THRU GAP-1-EXIT. + 2320A-EXIT. EXIT. + CAS-TOT. + MOVE FILETAB(X) TO FILEIN01 + MOVE 0 TO CAS-REDUCE(X) CAS-PAID(X) + COMPUTE CLM-BAL(X) = FI-AMOUNT + MOVE SPACE TO CAS-PAYDATE(X) + MOVE 0 TO REDUCE-FLAG PRIME-FLAG DDFLAG + MOVE 0 TO CAS-REDUCE(X) CAS-PAID(X) + MOVE "0" TO CAS-DD(X) + MOVE FI-DATE-T TO CAS-PAYDATE(X) + MOVE FI-KEY8 TO PC-KEY8 + MOVE SPACE TO PC-KEY3 + START PAYCUR KEY NOT < PAYCUR-KEY + INVALID GO TO CAS-TOT-EXIT. + CAS-TOT-1. + READ PAYCUR NEXT AT END GO TO CAS-TOT-2. + IF PC-KEY8 NOT = FI-KEY8 GO TO CAS-TOT-2. + IF PC-CLAIM NOT = FI-CLAIM GO TO CAS-TOT-1. + IF (PC-PAYCODE = "001" OR "021" OR "022") go to cas-tot-1. + COMPUTE CLM-BAL(X) = CLM-BAL(X) + PC-AMOUNT. + IF (PC-PAYCODE = G-PRINS AND PC-DENIAL = "14") + OR (PC-PAYCODE = "014" OR "015") + MOVE 1 TO REDUCE-FLAG + COMPUTE CAS-REDUCE(X) = cas-reduce(x) + (-1 * PC-AMOUNT) + display g-garname + move pc-amount to zef-7 + * display zef-7 " pay-amount" + move cas-reduce(x) to zef-7 + * display zef-7 " cas-reduce" + * display pc-paycode " " pc-denial + * accept alf1 + + GO TO CAS-TOT-1 + END-IF + IF ((PC-PAYCODE = G-PRINS) + AND (PC-DENIAL = SPACE OR "DA" OR "DD" OR "DI" OR "TO" + or "CP")) + COMPUTE CAS-PAID(X) = CAS-PAID(X) + (-1 * PC-AMOUNT) + MOVE PC-DATE-T TO CAS-PAYDATE(X) CLAIM-ADJ-DATE + IF PC-DENIAL = "DD" + MOVE 1 TO CAS-DD(X) + END-IF + END-IF. + + GO TO CAS-TOT-1. + + CAS-TOT-2. + COMPUTE CAS-ALLOWED(X) = FI-AMOUNT - CAS-REDUCE(X) + ADD FI-AMOUNT TO CAS-TOT-CHARGE + ADD CAS-PAID(X) TO CAS-TOT-PAID. + ADD CAS-REDUCE(X) TO CAS-TOT-REDUCE + ADD CAS-ALLOWED(X) TO CAS-TOT-ALLOWED. + MOvE 0 TO CAS-DEDUC(X) + IF ((CAS-DD(X) = 1) OR (CAS-DD(X) = 0 AND CAS-PAID(X) = 0)) + compute CAS-DEDUC(X) = + FI-AMOUNT - CAS-PAID(X) - CAS-REDUCE(X) + MOVE 1 TO CAS-DD(X) + END-IF. + CAS-TOT-EXIT. EXIT. + 2320S. + MOVE "P" TO SBR-PST + MOVE "18" TO SBR-RELATE + MOVE " " TO SBR-GROUP + MOVE G-PRINS TO INS-KEY + MOVE " " TO SBR-TYPE + MOVE "CI " TO SBR-INSCODE + IF G-PRINS = "003" + MOVE "MB" TO SBR-INSCODE. + + READ INSFILE INVALID + MOVE "COMMERCIAL INS" TO INS-NAME + END-READ. + MOVE SPACE TO SBR-GRNAME + * MOVE INS-NAME TO SBR-GRNAME + * IF G-PRINS = "006" + * MOVE "OF " TO SBR-INSCODE. + * IF G-PRINS = "141" + * MOVE "CH " TO SBR-INSCODE. + * IF (G-PRINS = "002") OR (INS-CAID = "EE ") + * MOVE "BL " TO SBR-INSCODE. + MOVE SPACE TO SBR-6 SBR-7 SBR-8 + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM SBR01. + MOVE SPACE TO CAS-1 CAS-2 CAS-3 + * MOVE "CO" TO CAS-1 + * MOVE "45 " TO CAS-2 + * COMPUTE NUM7 = CAS-TOT-REDUCE + * PERFORM AMT-LEFT + * MOVE ALF8NUM TO CAS-3 + * MOVE SPACE TO SEGFILE01 + * WRITE SEGFILE01 FROM CAS01 + + + * MOVE SPACE TO AMT-1 AMT-2 + * MOVE "AAE" TO AMT-1 + * COMPUTE NUM7 = CAS-TOT-ALLOWED + * PERFORM AMT-LEFT + * MOVE ALF8NUM TO AMT-2 + * MOVE SPACE TO SEGFILE01 + * WRITE SEGFILE01 FROM AMT01 + + + MOVE SPACE TO AMT-1 AMT-2 + MOVE "D " TO AMT-1 + COMPUTE NUM7 = CAS-TOT-PAID + PERFORM AMT-LEFT + MOVE ALF8NUM TO AMT-2 + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM AMT01 + + * MOVE "B6 " TO AMT-1 + * MOVE SPACE TO SEGFILE01 + * WRITE SEGFILE01 FROM AMT01 + + * IF PRIMARY INS SUBSCRIBER NOT = 2ND SUBSCRIBER + * MAKE UP DOB FOR DMG01 SEGMENT + IF (G-PR-RELATE NOT = G-SE-RELATE) + OR (G-GARNAME NOT = G-PRNAME) + UNSTRING G-PRNAME DELIMITED BY ";" INTO + NM1-NAMEL NM1-NAMEF + ELSE + MOVE G-DOB TO DMG-DOB + MOVE G-SEX TO DMG-GENDER. + MOVE SPACE TO SEGFILE01 + * WRITE SEGFILE01 FROM DMG01. + + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM OI01. + + MOVE "IL " TO NM1-1 + MOVE "1" TO NM1-SOLO + MOVE SPACE TO NM1-NAMEL NM1-NAMEF NM1-NAMEM NM1-NAMES + + IF (G-PR-RELATE NOT = G-SE-RELATE) + OR (G-GARNAME NOT = G-PRNAME) + UNSTRING G-PRNAME DELIMITED BY ";" INTO + NM1-NAMEL NM1-NAMEF + ELSE + UNSTRING G-GARNAME DELIMITED BY ";" INTO + NM1-NAMEL NM1-NAMEF. + + MOVE "MI" TO NM1-EINSS + MOVE G-PRIPOL TO NM1-CODE + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM NM101. + MOVE SPACE TO N3-STREET N3-BILLADD + MOVE G-BILLADD TO N3-STREET + MOVE G-STREET TO N3-BILLADD + IF G-BILLADD = SPACE + MOVE G-STREET TO N3-STREET + MOVE SPACE TO N3-BILLADD. + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM N301. + MOVE SPACE TO N4-CITY N4-STATE N4-ZIP + MOVE G-CITY TO N4-CITY + MOVE G-STATE TO N4-STATE + MOVE G-ZIP TO N4-ZIP + IF N4-ZIP(6:4) = SPACE + MOVE "9999"TO N4-ZIP(6:4) + END-IF + + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM N401. + * MOVE SPACE TO REF-CODE REF-ID + * MOVE "IG" TO REF-CODE + * MOVE G-PRIPOL TO REF-ID + * WRITE SEGFILE01 FROM REF01. + MOVE "PR " TO NM1-1 + MOVE "2" TO NM1-SOLO + MOVE SPACE TO NM1-NAMEL NM1-NAMEF NM1-NAMEM NM1-NAMES + MOVE INS-NAME TO NM1-NAMEL + MOVE "PI" TO NM1-EINSS + MOVE SPACE TO NM1-CODE + MOVE ins-neic TO NM1-CODE + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM NM101. + + MOVE "573" TO DTP-1 + MOVE CLAIM-ADJ-DATE TO DTP-3 + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM DTP01. + + 2320S-EXIT. + EXIT. + + CMP-1. + MOVE "S" TO SBR-PST + MOVE G-SE-GROUP TO SBR-GROUP + MOVE "18" TO SBR-RELATE + MOVE " " TO SBR-TYPE. + MOVE SPACE TO SBR-6 SBR-7 SBR-8 + MOVE "BL" TO SBR-INSCODE. + IF G-SEINS = "006" + MOVE "OF" TO SBR-INSCODE + END-IF + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM SBR01. + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM OI01. + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM DMG01. + MOVE SPACE TO NM1-NAMEL NM1-NAMEF NM1-NAMEM NM1-NAMES + UNSTRING G-SENAME DELIMITED BY ";" INTO + NM1-NAMEL NM1-NAMEF NM1-NAMEM + MOVE SPACE TO NAME-1 NAME-2 + UNSTRING NM1-NAMEL DELIMITED BY " " INTO NAME-1 NAME-2 + IF NAME-2 = "JR" OR "SR" OR "II" OR "III" + MOVE SPACE TO NM1-NAMEL NM1-NAMES + MOVE NAME-1 TO NM1-NAMEL + MOVE NAME-2 TO NM1-NAMES. + IF NM1-NAMEM = SPACE + MOVE SPACE TO NAME-1 NAME-2 + UNSTRING NM1-NAMEF DELIMITED BY ALL " " INTO NAME-1 NAME-2 + IF NAME-2 NOT = SPACE + MOVE SPACE TO NM1-NAMEF NM1-NAMEM + MOVE NAME-1 TO NM1-NAMEF + MOVE NAME-2 TO NM1-NAMEM + END-IF + END-IF. + + MOVE "1" TO NM1-SOLO + MOVE "IL" TO NM1-1 + MOVE "MI" TO NM1-EINSS + MOVE SPACE TO NM1-CODE + MOVE G-SECPOL TO NM1-CODE + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM NM101. + MOVE SPACE TO N3-STREET N3-BILLADD + MOVE G-BILLADD TO N3-STREET + MOVE G-STREET TO N3-BILLADD + IF G-BILLADD = SPACE + MOVE G-STREET TO N3-STREET + MOVE SPACE TO N3-BILLADD. + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM N301. + MOVE SPACE TO N4-CITY N4-STATE N4-ZIP + MOVE G-CITY TO N4-CITY + MOVE G-STATE TO N4-STATE + MOVE G-ZIP TO N4-ZIP + IF N4-ZIP(6:4) = SPACE + MOVE "9999"TO N4-ZIP(6:4) + END-IF + + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM N401. + MOVE SPACE TO NM1-NAMEL NM1-NAMEF NM1-NAMEM NM1-NAMES + MOVE "MEDICOMP" TO NM1-NAMEL + MOVE "2" TO NM1-SOLO + MOVE "PR" TO NM1-1 + MOVE "PI" TO NM1-EINSS + MOVE SPACE TO NM1-CODE + MOVE "00026" TO NM1-CODE + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM NM101. + + CAID-1. + MOVE "S" TO SBR-PST + MOVE G-SE-GROUP TO SBR-GROUP + MOVE "18" TO SBR-RELATE + MOVE "MC" TO SBR-TYPE. + MOVE SPACE TO SBR-6 SBR-7 SBR-8 + MOVE "MC" TO SBR-INSCODE + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM SBR01. + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM OI01. + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM DMG01. + MOVE SPACE TO NM1-NAMEL NM1-NAMEF NM1-NAMEM NM1-NAMES + UNSTRING G-SENAME DELIMITED BY ";" INTO + NM1-NAMEL NM1-NAMEF NM1-NAMEM + MOVE SPACE TO NAME-1 NAME-2 + UNSTRING NM1-NAMEL DELIMITED BY " " INTO NAME-1 NAME-2 + IF NAME-2 = "JR" OR "SR" OR "II" OR "III" + MOVE SPACE TO NM1-NAMEL NM1-NAMES + MOVE NAME-1 TO NM1-NAMEL + MOVE NAME-2 TO NM1-NAMES. + IF NM1-NAMEM = SPACE + MOVE SPACE TO NAME-1 NAME-2 + UNSTRING NM1-NAMEF DELIMITED BY ALL " " INTO NAME-1 NAME-2 + IF NAME-2 NOT = SPACE + MOVE SPACE TO NM1-NAMEF NM1-NAMEM + MOVE NAME-1 TO NM1-NAMEF + MOVE NAME-2 TO NM1-NAMEM + END-IF + END-IF. + + MOVE "1" TO NM1-SOLO + MOVE "IL" TO NM1-1 + MOVE "MI" TO NM1-EINSS + MOVE SPACE TO NM1-CODE + MOVE G-SECPOL TO ALF9 + MOVE ALF9 TO NM1-CODE + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM NM101. + MOVE SPACE TO N3-STREET N3-BILLADD + MOVE G-BILLADD TO N3-STREET + MOVE G-STREET TO N3-BILLADD + IF G-BILLADD = SPACE + MOVE G-STREET TO N3-STREET + MOVE SPACE TO N3-BILLADD. + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM N301. + MOVE SPACE TO N4-CITY N4-STATE N4-ZIP + MOVE G-CITY TO N4-CITY + MOVE G-STATE TO N4-STATE + IF N4-ZIP(6:4) = SPACE + MOVE "9999"TO N4-ZIP(6:4) + END-IF + + MOVE G-ZIP TO N4-ZIP + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM N401. + MOVE SPACE TO NM1-NAMEL NM1-NAMEF NM1-NAMEM NM1-NAMES + MOVE "VT MEDICAID" TO NM1-NAMEL + MOVE "2" TO NM1-SOLO + MOVE "PR" TO NM1-1 + MOVE "PI" TO NM1-EINSS + MOVE SPACE TO NM1-CODE + MOVE "VTXIX" TO NM1-CODE + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM NM101. + GAP-1. + MOVE G-PR-GROUP TO GAPKEY + READ GAPFILE INVALID MOVE 1 TO GAP-FLAG GO TO GAP-1-EXIT. + MOVE "S" TO SBR-PST + MOVE G-SE-GROUP TO SBR-GROUP + IF G-RELATE = G-SE-RELATE + MOVE "18" TO SBR-RELATE + ELSE MOVE "01" TO SBR-RELATE. + IF GAP-TYPE = "X" + MOVE "MI" TO SBR-TYPE + ELSE MOVE " " TO SBR-TYPE. + MOVE SPACE TO SBR-6 SBR-7 SBR-8 + MOVE "CI" TO SBR-INSCODE + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM SBR01. + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM OI01. + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM DMG01. + MOVE SPACE TO NM1-NAMEL NM1-NAMEF NM1-NAMEM NM1-NAMES + UNSTRING G-SENAME DELIMITED BY ";" INTO + NM1-NAMEL NM1-NAMEF NM1-NAMEM + MOVE SPACE TO NAME-1 NAME-2 + UNSTRING NM1-NAMEL DELIMITED BY " " INTO NAME-1 NAME-2 + IF NAME-2 = "JR" OR "SR" OR "II" OR "III" OR "IV" + MOVE SPACE TO NM1-NAMEL NM1-NAMES + MOVE NAME-1 TO NM1-NAMEL + MOVE NAME-2 TO NM1-NAMES. + IF NM1-NAMEM = SPACE + MOVE SPACE TO NAME-1 NAME-2 + UNSTRING NM1-NAMEF DELIMITED BY ALL " " INTO NAME-1 NAME-2 + IF NAME-2 NOT = SPACE + MOVE SPACE TO NM1-NAMEF NM1-NAMEM + MOVE NAME-1 TO NM1-NAMEF + MOVE NAME-2 TO NM1-NAMEM + END-IF + END-IF. + MOVE "1" TO NM1-SOLO + MOVE "IL" TO NM1-1 + MOVE "MI" TO NM1-EINSS + MOVE SPACE TO NM1-CODE + MOVE G-SECPOL TO NM1-CODE + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM NM101. + MOVE SPACE TO N3-STREET N3-BILLADD + MOVE G-BILLADD TO N3-STREET + MOVE G-STREET TO N3-BILLADD + IF G-BILLADD = SPACE + MOVE G-STREET TO N3-STREET + MOVE SPACE TO N3-BILLADD. + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM N301. + MOVE SPACE TO N4-CITY N4-STATE N4-ZIP + MOVE G-CITY TO N4-CITY + MOVE G-STATE TO N4-STATE + MOVE G-ZIP TO N4-ZIP + IF N4-ZIP(6:4) = SPACE + MOVE "9999"TO N4-ZIP(6:4) + END-IF + + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM N401. + MOVE SPACE TO NM1-NAMEL NM1-NAMEF NM1-NAMEM NM1-NAMES + MOVE GAP-NAME TO NM1-NAMEL + MOVE "2" TO NM1-SOLO + MOVE "PR" TO NM1-1 + MOVE "PI" TO NM1-EINSS + MOVE SPACE TO NM1-CODE + MOVE GAPKEY TO ALF7 + MOVE ALF72 TO NM1-CODE + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM NM101. + GAP-1-EXIT. EXIT. + 2400SRV. + MOVE FILETAB(X) TO FILEIN01 + MOVE FI-PROC1 TO SV1-PROC. + MOVE SPACE TO SV1-EPSDT + IF ((FI-PROC1 = "W9020") + OR (FI-PROC1 > "99380" AND < "99387") + OR (FI-PROC1 > "99390" AND < "99397")) + MOVE G-DOB TO AGEX + MOVE FI-DATE-T TO AGEY + COMPUTE AGEZ = AGEYYY - AGEXYY + IF AGEZ = 21 AND AGEXMMDD > AGEYMMDD + COMPUTE AGEZ = 20 + END-IF + IF AGEZ < 21 + MOVE "Y" TO SV1-EPSDT + MOVE "EP" TO FI-PROC2 + END-IF + END-IF. + MOVE SPACE TO SV1-FAMILY + IF ((HOLD-DATE-T < "20151001") + AND (CC-DIAG > "V25 " AND < "V2700")) + OR ((CC-DATE-T > "20150930") + AND (CC-DIAG > "Z2999 " AND < "Z3200 ")) + + MOVE "Y" TO SV1-FAMILY. + PERFORM SV-MOD + COMPUTE NUM7 = FI-AMOUNT + PERFORM AMT-LEFT + + MOVE ALF8NUM TO SV1-AMT + COMPUTE NUM5 = FI-WORK + PERFORM NUM-LEFT + MOVE ALF5NUM TO SV1-WORK + MOVE SPACE TO SV1-PLACE + + MOVE 0 TO DX-CNTR-PT + MOVE SPACE TO DIAG-POINTER01 + + IF NOT (FI-DIAG = SPACE OR "0000000") + MOVE FI-DIAG TO DIAG-X + PERFORM DIAG-3 VARYING A FROM 1 BY 1 UNTIL A > 12 + END-IF + + IF NOT (FI-DX2 = SPACE OR "0000000") + MOVE FI-DX2 TO DIAG-X + PERFORM DIAG-3 VARYING A FROM 1 BY 1 UNTIL A > 12 + END-IF + + IF NOT (FI-DX3 = SPACE OR "0000000") + MOVE FI-DX3 TO DIAG-X + PERFORM DIAG-3 VARYING A FROM 1 BY 1 UNTIL A > 12 + END-IF + + IF NOT (FI-DX4 = SPACE OR "0000000") + MOVE FI-DX4 TO DIAG-X + PERFORM DIAG-3 VARYING A FROM 1 BY 1 UNTIL A > 12 + END-IF + + MOVE SPACE TO DIAG-C(DX-CNTR-PT) + MOVE DIAG-POINTER01 TO SV1-PT + GO TO SV1-0. + + DIAG-3. + IF DIAGTAB(A) = DIAG-X + ADD 1 TO DX-CNTR-PT + MOVE A TO DIAG-PT(DX-CNTR-PT) + MOVE ":" TO DIAG-C(DX-CNTR-PT) + MOVE 12 TO A. + + + + + + SV1-0. + MOVE " " TO SV1-EMER + IF CLM-5 = "23" MOVE "Y" TO SV1-EMER. + COMPUTE NUM5 = X + PERFORM NUM-LEFT + MOVE ALF5NUM TO LX-1 + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM LX01. + MOVE SPACE TO SV1-COPAY + IF NOT (sv1-proc(1:1) = "J" OR SV1-PROC(1:5) = "Q2039") + GO TO 2400SRV-1. + move sv1-proc to proc-key + read procfile invalid + go to 2400srv-1 + end-read + move space to sv1-mod-filler + string ":::::" proc-title + delimited by size into sv1-mod-filler. + 2400srv-1. + MOVE SPACE TO tab11401 + MOVE 0 TO D + PERFORM VARYING C FROM 1 BY 1 UNTIL C > 114 + IF SV101(C:1) NOT = " " + ADD 1 TO D + MOVE SV101(C:1) TO TAB114(D) + END-IF + END-PERFORM + MOVE tab11401 TO ALF114 + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM ALF114. + + + + MOVE "472" TO DTP-1 + + MOVE FI-DATE-T TO DTP-3 + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM DTP01. + * MOVE SPACE TO REF-CODE REF-ID + * MOVE "6R" TO REF-CODE + * MOVE CR-ICN TO REF-ID + * MOVE SPACE TO SEGFILE01 + * WRITE SEGFILE01 FROM REF01. + + * MOVE SPACE TO AMT-1 AMT-2 + * MOVE "AAE" TO AMT-1 + * COMPUTE NUM7 = CAS-ALLOWED(X) + * PERFORM AMT-LEFT + * MOVE ALF8NUM TO AMT-2 + * MOVE SPACE TO SEGFILE01 + * WRITE SEGFILE01 FROM AMT01 + + MOVE INS-NEIC TO SVD-1 + COMPUTE NUM7 = CAS-PAID(X) + PERFORM AMT-LEFT + + * iEDI wants us to suppress leading zero + IF ALF8NUM = "0.00" + MOVE ".00" TO ALF8NUM + END-IF + + MOVE ALF8NUM TO SVD-2 + MOVE SPACE TO SVD-3 + STRING "HC:" SV1-PROC SV1-MOD-FILLER DELIMITED BY SIZE + INTO SVD-3 + MOVE SV1-WORK TO SVD-4 + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM SVD01 + + MOVE SPACE TO CAS-1 CAS-2 CAS-3 + MOVE "CO" TO CAS-1 + MOVE "45" TO CAS-2 + COMPUTE NUM7 = CAS-REDUCE(X) + PERFORM AMT-LEFT + MOVE ALF8NUM TO CAS-3 + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM CAS01 + + IF CAS-DD(X) = "1" + MOVE SPACE TO CAS-1 CAS-2 CAS-3 + MOVE "PR" TO CAS-1 + MOVE "1 " TO CAS-2 + COMPUTE NUM7 = CLM-BAL(X) + PERFORM AMT-LEFT + MOVE ALF8NUM TO CAS-3 + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM CAS01 + + ELSE + + MOVE SPACE TO CAS-1 CAS-2 CAS-3 + MOVE "PR" TO CAS-1 + MOVE "2 " TO CAS-2 + COMPUTE NUM7 = CLM-BAL(X) + PERFORM AMT-LEFT + MOVE ALF8NUM TO CAS-3 + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM CAS01. + + + MOVE "573" TO DTP-1 + MOVE CAS-PAYDATE(X) TO DTP-3 + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM DTP01 + MOVE FILEIN-KEY TO CHARCUR-KEY + READ CHARCUR WITH LOCK INVALID GO TO 2400SRV-EXIT. + IF CC-REC-STAT = "0" MOVE "2" TO CC-REC-STAT. + IF CC-REC-STAT = "1" MOVE "3" TO CC-REC-STAT. + MOVE "E" TO CC-PAPER. + MOVE BHT-DATE TO CC-DATE-A. + REWRITE CHARCUR01. + 2400SRV-EXIT. EXIT. + REF-1. + IF HOLD-DOCR = "000" GO TO REF-2. + MOVE HOLD-DOCR TO REF-KEY + READ REFPHY INVALID GO TO REF-2. + MOVE "DN " TO NM1-1 + MOVE "1" TO NM1-SOLO + MOVE SPACE TO NM1-NAMEL NM1-NAMEF NM1-NAMEM + UNSTRING REF-NAME DELIMITED BY ", " OR " ," + OR " , " OR "," OR ";" INTO NM1-NAMEL NM1-NAMEF + MOVE SPACE TO NM1-NAMES NM1-EINSS NM1-CODE + MOVE "XX" TO NM1-EINSS + MOVE REF-NPI TO NM1-CODE + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM NM101. + GO TO REF-1-EXIT. + REF-2. + MOVE "DN" TO NM1-1 + MOVE "1" TO NM1-SOLO + MOVE SPACE TO NM1-NAMEL NM1-NAMEF NM1-NAMEM + MOVE SPACE TO NM1-NAMES NM1-EINSS NM1-CODE + MOVE DOC-LASTNAME(HOLD-DOCP) TO NM1-NAMEL + MOVE DOC-FIRSTNAME(HOLD-DOCP) TO NM1-NAMEF + MOVE DOC-MI(HOLD-DOCP) TO NM1-NAMEM + MOVE "XX" TO NM1-EINSS + MOVE DOC-NPI(HOLD-DOCP) TO NM1-CODE + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM NM101. + REF-1-EXIT. EXIT. + + DOCP-1. + MOVE DOC-LASTNAME(HOLD-DOCP) TO SAVE-DOCNM1-NAMEL + MOVE DOC-FIRSTNAME(HOLD-DOCP) TO SAVE-DOCNM1-NAMEF + MOVE DOC-MI(HOLD-DOCP) TO SAVE-DOCNM1-NAMES + MOVE DOC-NPI(HOLD-DOCP) TO SAVE-DOCNM1-CODE + MOVE DOC-SS(HOLD-DOCP) TO SAVE-DOCREF-ID + MOVE "SY" TO SAVE-DOCREF-CODE + MOVE "82 " TO SAVE-DOCNM1-1 + MOVE "1" TO SAVE-DOCNM1-SOLO + MOVE SPACE TO SAVE-DOCNM1-NAMES + MOVE "XX" TO SAVE-DOCNM1-EINSS. + + SUBSCRIBER-1. + MOVE HOLD-KEY8 TO G-GARNO + READ GARFILE INVALID DISPLAY "BAD BAD BAD" + GO TO P99. + IF G-TRINS NOT = "001" + MOVE "0" TO MPLR-TR-RELATE + MOVE G-GARNO TO MPLR-KEY + READ MPLRFILE INVALID CONTINUE + END-READ + END-IF. + MOVE G-RELATE TO SUB-RELATE + MOVE G-GARNAME TO SUB-NAME + MOVE G-PRIPOL TO SUB-POLICY + MOVE SPACE TO SUB-GROUP + MOVE "P" TO SBR-PST + IF HOLD-PAYCODE = G-SEINS + MOVE "S" TO SBR-PST + MOVE G-SE-RELATE TO SUB-RELATE + MOVE G-SENAME TO SUB-NAME + MOVE G-SECPOL TO ALF-9 + MOVE ALF-9 TO SUB-POLICY + MOVE G-SE-GROUP TO SUB-GROUP + END-IF. + IF (HOLD-PAYCODE = G-TRINS) AND (MPLR-TR-RELATE NOT = "0") + MOVE "S" TO SBR-PST + MOVE MPLR-TR-RELATE TO SUB-RELATE + MOVE MPLR-TR-NAME TO SUB-NAME + MOVE MPLR-TRIPOL TO SUB-POLICY + MOVE MPLR-TR-GROUP TO SUB-GROUP + END-IF. + MOVE G-RELATE TO X-RELATE. + IF HOLD-PATID8 = "P" PERFORM PAT-READ. + IF X-RELATE = "0" + MOVE G-RELATE TO X-RELATE. + IF X-RELATE = SUB-RELATE + MOVE "18" TO SBR-RELATE + GO TO SUBSCRIBER-2. + IF (X-RELATE = "2" OR "K") + AND (SUB-RELATE = "2" OR "K") + MOVE "01" TO SBR-RELATEHOLD GO TO SUBSCRIBER-2. + IF (X-RELATE = "8" OR "Q") MOVE "29" TO SBR-RELATEHOLD + GO TO SUBSCRIBER-2. + IF (X-RELATE = "4" OR "M") MOVE "02" TO SBR-RELATEHOLD + GO TO SUBSCRIBER-2. + IF (X-RELATE = "5" OR "N") MOVE "17" TO SBR-RELATEHOLD + GO TO SUBSCRIBER-2. + SUBSCRIBER-2. + MOVE SPACE TO SBR-GROUP + MOVE "0 " TO HL-CHILD + MOVE "CI" TO SBR-INSCODE + * MOVE "12" TO SBR-TYPE + IF SBR-PST = "S" + IF G-PRINS = "091" + MOVE "15" TO SBR-TYPE + END-IF + IF G-PRINS = "006" + MOVE "16" TO SBR-TYPE + END-IF + IF G-PRINS = "079" + MOVE "42" TO SBR-TYPE + END-IF + + IF HOLD-ACC-TYPE = "2" + MOVE "14" TO SBR-TYPE + END-IF + + IF HOLD-ACC-TYPE = "1" + MOVE "15" TO SBR-TYPE + END-IF + END-IF. + + SUBSCRIBER-EXIT. + EXIT. + + 2000B-PAT. + + + PAT-READ. + MOVE HOLD-PATID TO P-PATNO + READ PATFILE INVALID MOVE "0" TO P-RELATE. + MOVE P-RELATE TO X-RELATE. + NUM-LEFT. + MOVE NUM5 TO ALF5Z ALFS + MOVE SPACE TO ALF5NUM + MOVE ALF5Z TO ALF5 + UNSTRING ALF5 DELIMITED ALL " " INTO ALFS ALF5NUM. + NUM-LEFT9. + MOVE NUM9 TO ALF9Z + MOVE SPACE TO ALF9NUM + MOVE ALF9Z TO ALF9 ALFS9 + UNSTRING ALF9 DELIMITED ALL " " INTO ALFS9 ALF9NUM. + AMT-LEFT. + MOVE NUM7 TO ALF8Z + MOVE SPACE TO ALF8NUM ALFS8 + MOVE ALF8Z TO ALF8 + UNSTRING ALF8 DELIMITED ALL " " INTO ALFS8 ALF8NUM. + + 2000C. + * ISA RECORD. + ISA-1. + * AUTHORIZATION INFO QUALIFIER + READ PARMFILE2 AT END GO TO A0-EXIT. + MOVE PARMFILE201 TO ISA-1. + * AUTHORIZATION INFO + READ PARMFILE2 AT END GO TO A0-EXIT. + MOVE PARMFILE201 TO ISA-2. + * SECURITY INFO QUAL + READ PARMFILE2 AT END GO TO A0-EXIT. + MOVE PARMFILE201 TO ISA-3. + * SECURITY INFO + READ PARMFILE2 AT END GO TO A0-EXIT. + MOVE PARMFILE201 TO ISA-4. + * INTERCHANGE ID QUALIFIER + READ PARMFILE2 AT END GO TO A0-EXIT. + MOVE PARMFILE201 TO ISA-5. + * INTERCHANGE SENDER ID + READ PARMFILE2 AT END GO TO A0-EXIT. + MOVE PARMFILE201 TO ISA-6. + * INTERCHANGE ID QUALIFIER + READ PARMFILE2 AT END GO TO A0-EXIT. + MOVE PARMFILE201 TO ISA-7. + * INTERCHANGE RECEIVER ID + READ PARMFILE2 AT END GO TO A0-EXIT. + MOVE PARMFILE201 TO ISA-8. + * INTERCHANGE DATE + READ PARMFILE2 AT END GO TO A0-EXIT. + ACCEPT ISA-9 FROM DATE. + * INTERCHANGE TIME + READ PARMFILE2 AT END GO TO A0-EXIT. + ACCEPT TIME-X FROM TIME + MOVE TIME-HHMM TO ISA-10. + * INTERCHAGNE CONTROL STANDARDS ID + READ PARMFILE2 AT END GO TO A0-EXIT. + MOVE PARMFILE201 TO ISA-11. + * INTERCHANGE CONTROL VERSION CODE + READ PARMFILE2 AT END GO TO A0-EXIT. + MOVE PARMFILE201 TO ISA-12. + * INTERCHANGE CONTROL NUMBER + READ PARMFILE2 AT END GO TO A0-EXIT. + MOVE PARMFILE201 TO ISA-13. + * ACKNOWLEDGEMENT REQUESTED + READ PARMFILE2 AT END GO TO A0-EXIT. + MOVE PARMFILE201 TO ISA-14. + * USAGE INDICATOR + READ PARMFILE2 AT END GO TO A0-EXIT. + MOVE PARMFILE201 TO ISA-15. + * COMPONENT ELEMENT SEPARATOR + READ PARMFILE2 AT END GO TO A0-EXIT. + MOVE PARMFILE201 TO ISA-16. + ISA-EXIT. EXIT. + * TAX ID NUMBER + A0. + READ PARMFILE AT END GO TO A0-EXIT. + MOVE PARMFILE01 TO EIN-CODE. + * TAX ID TYPE + READ PARMFILE AT END GO TO A0-EXIT. + MOVE PARMFILE01 TO EINSS-TYPE. + * CONTACT NAME # + READ PARMFILE AT END GO TO A0-EXIT. + MOVE PARMFILE01 TO CONTACT-NAME. + * TELEPHONE # + READ PARMFILE AT END GO TO A0-EXIT. + MOVE PARMFILE01 TO TELE-PHONE. + * INSURANCE-CODE # + READ PARMFILE AT END GO TO A0-EXIT. + MOVE PARMFILE01 TO INSTYPE-CODE. + * INSURANCE-GROUP # + READ PARMFILE AT END GO TO A0-EXIT. + MOVE SPACE TO INSGROUP-CODE INSGROUP-LEG + UNSTRING PARMFILE01 DELIMITED BY " " INTO + INSGROUP-CODE INSGROUP-LEG. + * SUBMITER ID INDICATORS (2) + READ PARMFILE AT END GO TO A0-EXIT. + MOVE PARMFILE01 TO SUBMIT-2. + * ORGANIZATION NAME + READ PARMFILE AT END GO TO A0-EXIT. + IF EINSS-TYPE = "S" + MOVE SPACE TO PARMLAST PARMFIRST PARMMIDDLE + UNSTRING PARMFILE01 DELIMITED BY ";" + INTO PARMLAST PARMFIRST PARMMIDDLE + ELSE MOVE PARMFILE01 TO ORG-NAME. + * GROUP'S STREET + READ PARMFILE AT END GO TO A0-EXIT. + MOVE PARMFILE01 TO ORG-STREET + * GROUP'S CITY + READ PARMFILE AT END GO TO A0-EXIT. + MOVE PARMFILE01 TO ORG-CITY + * GROUP'S STATE + READ PARMFILE AT END GO TO A0-EXIT. + MOVE PARMFILE01 TO ORG-STATE + * GROUP'S ZIP CODE + READ PARMFILE AT END GO TO A0-EXIT. + MOVE PARMFILE01 TO ORG-ZIP + * GROUP 3-CHARACTER MNEMONIC CODE + READ PARMFILE AT END GO TO A0-EXIT. + MOVE PARMFILE01 TO GROUP-3. + * CLIA-NUMBER + READ PARMFILE AT END GO TO A0-EXIT. + MOVE PARMFILE01 TO mammo-code. + + * ACCT-TAXONOMY. + READ PARMFILE AT END GO TO A0-EXIT. + MOVE PARMFILE01 TO GROUP-TAX. + + * INDIVIDUAL PROVIDER DATA + A1. READ PARMFILE AT END GO TO A0-EXIT. + MOVE PARMFILE01 TO PARM01 + MOVE PM-1 TO NUM2 + MOVE PM-2 TO DOC-TAX(NUM2) + MOVE PM-3 TO DOC-SS(NUM2) + MOVE PM-4 TO DOC-NUM(NUM2) + MOVE SPACE TO ALF20 ALF10 ALF1 + UNSTRING PM-5 DELIMITED BY ";" INTO ALF20 ALF10 ALF1 + MOVE ALF20 TO DOC-LASTNAME(NUM2) + MOVE ALF10 TO DOC-FIRSTNAME(NUM2) + MOVE ALF1 TO DOC-MI(NUM2) + MOVE PM-6 TO DOC-NPI(NUM2) + GO TO A1. + A0-EXIT. EXIT. + + DF-SEARCH. + MOVE 0 TO FLAG. + MOVE "1" TO CC-PL + MOVE "11" TO CLM-5 + PERFORM DF-SEARCH2 VARYING Y FROM 1 BY 1 UNTIL Y > PLINDX. + DF-SEARCH2. + IF HOLD-PLACE = PL-TAB(Y) + MOVE PL-NUM(Y) TO CC-PL + MOVE Y TO PLACE-POINTER + PERFORM PLACE-OF-SERVICE + MOVE PLINDX TO Y. + PLACE-OF-SERVICE. + IF CC-PL = "1" MOVE "11" TO CLM-5. + IF CC-PL = "3" MOVE "21" TO CLM-5. + IF CC-PL = "4" MOVE "32" TO CLM-5. + IF CC-PL = "5" MOVE "22" TO CLM-5. + IF CC-PL = "6" MOVE "81" TO CLM-5. + IF CC-PL = "7" MOVE "61" TO CLM-5. + IF CC-PL = "8" MOVE "99" TO CLM-5. + IF CC-PL = "E" MOVE "23" TO CLM-5 + IF CC-PL = "K" MOVE "31" TO CLM-5. + IF HOLD-PROC1 > "99200" AND < "99206" MOVE "11" TO CLM-5. + IF HOLD-PROC1 > "99210" AND < "99216" MOVE "11" TO CLM-5. + IF HOLD-PROC1 > "99216" AND < "99221" MOVE "22" TO CLM-5. + IF HOLD-PROC1 > "99220" AND < "99224" MOVE "21" TO CLM-5. + IF HOLD-PROC1 > "99230" AND < "99234" MOVE "21" TO CLM-5. + IF HOLD-PROC1 = "99238" MOVE "21" TO CLM-5. + IF HOLD-PROC1 > "99240" AND < "99246" MOVE "11" TO CLM-5. + IF HOLD-PROC1 > "99250" AND < "99256" MOVE "21" TO CLM-5. + IF HOLD-PROC1 > "99260" AND < "99264" MOVE "21" TO CLM-5. + IF HOLD-PROC1 > "99280" AND < "99289" MOVE "23" TO CLM-5. + IF HOLD-PROC1 > "99320" AND < "99324" MOVE "33" TO CLM-5. + IF HOLD-PROC1 > "99330" AND < "99334" MOVE "33" TO CLM-5. + + HI-DIAG. + IF HOLD-DATE-T > "20150930" GO TO HI-DIAG10. + MOVE HOLD-DIAG TO DIAG-KEY + READ DIAGFILE INVALID MOVE SPACE TO DIAG-MEDB. + MOVE DIAG-MEDB TO HI9-DX1 + MOVE SPACE TO HI9-DIAG-FILLER DIAG9-ARRAY01 + + PERFORM VARYING X FROM 2 BY 1 UNTIL X > DIAG-CNTR + MOVE DIAGTAB(X) TO DIAG-KEY + READ DIAGFILE INVALID CONTINUE + END-READ + MOVE "*BF:" TO DIAG9-BF(X - 1) + MOVE DIAG-MEDB TO DIAG9-CODE(X - 1) + END-PERFORM. + MOVE DIAG9-ARRAY01 TO HI9-DIAG-FILLER + WRITE SEGFILE01 FROM HI901. + GO TO HI-2. + HI-DIAG10. + MOVE HOLD-DIAG TO DIAG-KEY + READ DIAGFILE INVALID MOVE SPACE TO DIAG-MEDB. + MOVE DIAG-KEY TO HI10-DX1 + MOVE SPACE TO HI10-DIAG-FILLER DIAG10-ARRAY01 + + PERFORM VARYING X FROM 2 BY 1 UNTIL X > DIAG-CNTR + MOVE DIAGTAB(X) TO DIAG10-CODE(X - 1) + MOVE "*ABF:" TO DIAG10-BF(X - 1) + END-PERFORM. + MOVE DIAG10-ARRAY01 TO HI10-DIAG-FILLER + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM HI1001. + HI-2. + PERFORM REF-1 THRU REF-1-EXIT. + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM SAVE-DOCNM101 + MOVE SPACE TO SEGFILE01. + HI-DIAG-EXIT. + EXIT. + + SV-MOD. + MOVE SPACE TO SV1-MOD-FILLER MOD-ARRAY01 + MOVE FI-PROC2 TO X-MOD1 + MOVE FI-MOD2 TO X-MOD2 + MOVE FI-MOD3 TO X-MOD3 + IF X-MOD1 = SPACE AND X-MOD2 = SPACE + MOVE X-MOD3 TO X-MOD1 + MOVE SPACE TO X-MOD3. + IF X-MOD1 = SPACE + MOVE X-MOD2 TO X-MOD1 + MOVE X-MOD3 TO X-MOD2 + MOVE SPACE TO X-MOD3. + IF X-MOD2 = SPACE + MOVE X-MOD3 TO X-MOD2 + MOVE SPACE TO X-MOD3. + IF X-MOD1 NOT = SPACE + AND X-MOD2 = SPACE + MOVE X-MOD3 TO X-MOD2 + MOVE SPACE TO X-MOD3. + IF X-MOD1 NOT = SPACE + MOVE ":" TO MOD-C(1) + MOVE X-MOD1 TO MOD-CODE(1). + IF X-MOD2 NOT = SPACE + MOVE ":" TO MOD-C(2) + MOVE X-MOD2 TO MOD-CODE(2). + IF X-MOD3 NOT = SPACE + MOVE ":" TO MOD-C(3) + MOVE X-MOD3 TO MOD-CODE(3). + MOVE MOD-ARRAY01 TO SV1-MOD-FILLER. + + + + MAKE-IT-UP. + MOVE G-DOB TO X-DOB. + ADD 1 TO X-YYYY + COMPUTE X-MM = 12 + X-DD. + MAKE-IT-1. + IF X-MM > 12 + COMPUTE X-MM = X-MM - 12 + GO TO MAKE-IT-1 + END-IF + IF X-MM = 0 MOVE 1 TO X-MM. + COMPUTE X-DD = X-DD + 32 + (X-YYYY - 1900). + + MAKE-IT-2. + IF X-DD > DAYS-IN-MONTH(X-MM) + COMPUTE X-DD = X-DD - DAYS-IN-MONTH(X-MM) + GO TO MAKE-IT-2 + END-IF + IF X-DD < 1 MOVE 1 TO X-DD. + IF X-DD = 29 AND X-MM = 2 + MOVE 2 TO X-DD + MOVE 3 TO X-MM + END-IF + DISPLAY G-DOB " " G-SE-RELATE " " G-GARNAME + DISPLAY X-DOB " " G-PR-RELATE " " G-PRNAME. + * ACCEPT ANS + MOVE X-DOB TO DMG-DOB + MOVE "M" TO DMG-GENDER + IF G-PR-RELATE NOT NUMERIC + MOVE "F" TO DMG-GENDER. + MAKE-IT-UP-EXIT. + EXIT. + P98. + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM SE01 + MOVE SPACE TO SEGFILE01 + WRITE SEGFILE01 FROM GE01 + MOVE SPACE TO SEGFILE01. + * WRITE SEGFILE01 FROM IEA01. + + P99. + REWRITE HIPCLAIMFILE01. + CLOSE GARFILE HIPCLAIMFILE CHARCUR ERRFILE. + STOP RUN. From 50d0c119652dccbad7f794a8baf9f2d4efeadb16 Mon Sep 17 00:00:00 2001 From: stephen waite Date: Mon, 11 May 2026 10:15:10 -0400 Subject: [PATCH 20/78] Adj nm1 size --- rri/claims/npi5r3026.cob | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/rri/claims/npi5r3026.cob b/rri/claims/npi5r3026.cob index 2d2bc727..7edf5d12 100644 --- a/rri/claims/npi5r3026.cob +++ b/rri/claims/npi5r3026.cob @@ -647,7 +647,7 @@ 02 RECNM1-S1 PIC X VALUE "*". 02 RECNM1-SOLO PIC X VALUE "2". 02 RECNM1-S2 PIC X VALUE "*". - 02 RECNM1-NAMEL PIC X(5) VALUE "NYSDOH". + 02 RECNM1-NAMEL PIC X(6) VALUE "NYSDOH". 02 RECNM1-S3 PIC X VALUE "*". 02 RECNM1-S4 PIC X VALUE "*". 02 RECNM1-S5 PIC X VALUE "*". From 63b666c246d5af4558cb2a13a31edcc9adb521e2 Mon Sep 17 00:00:00 2001 From: stephen waite Date: Mon, 11 May 2026 10:26:59 -0400 Subject: [PATCH 21/78] MC ins type --- rri/claims/npi5r3026.cob | 51 +++++++++++++++++++++------------------- 1 file changed, 27 insertions(+), 24 deletions(-) diff --git a/rri/claims/npi5r3026.cob b/rri/claims/npi5r3026.cob index 7edf5d12..0dadc924 100644 --- a/rri/claims/npi5r3026.cob +++ b/rri/claims/npi5r3026.cob @@ -2252,44 +2252,46 @@ SUBSCRIBER-1. MOVE HOLD-KEY8 TO G-GARNO - READ GARFILE INVALID DISPLAY "BAD BAD BAD" - GO TO P99. - IF G-TRINS NOT = "001" - MOVE "0" TO MPLR-TR-RELATE - MOVE G-GARNO TO MPLR-KEY - READ MPLRFILE INVALID CONTINUE - END-READ - END-IF. + READ GARFILE + INVALID DISPLAY "BAD BAD BAD" + GO TO P99. + IF G-TRINS NOT = "001" + MOVE "0" TO MPLR-TR-RELATE + MOVE G-GARNO TO MPLR-KEY + READ MPLRFILE + INVALID CONTINUE + END-READ + END-IF. MOVE G-RELATE TO SUB-RELATE MOVE G-GARNAME TO SUB-NAME MOVE G-PRIPOL TO SUB-POLICY MOVE SPACE TO SUB-GROUP MOVE "P" TO SBR-PST IF HOLD-PAYCODE = G-SEINS - MOVE "S" TO SBR-PST - MOVE G-SE-RELATE TO SUB-RELATE - MOVE G-SENAME TO SUB-NAME - MOVE G-SECPOL TO ALF-9 - MOVE ALF-9 TO SUB-POLICY - MOVE G-SE-GROUP TO SUB-GROUP + MOVE "S" TO SBR-PST + MOVE G-SE-RELATE TO SUB-RELATE + MOVE G-SENAME TO SUB-NAME + MOVE G-SECPOL TO ALF-9 + MOVE ALF-9 TO SUB-POLICY + MOVE G-SE-GROUP TO SUB-GROUP END-IF. IF (HOLD-PAYCODE = G-TRINS) AND (MPLR-TR-RELATE NOT = "0") MOVE "S" TO SBR-PST - MOVE MPLR-TR-RELATE TO SUB-RELATE - MOVE MPLR-TR-NAME TO SUB-NAME - MOVE MPLR-TRIPOL TO SUB-POLICY - MOVE MPLR-TR-GROUP TO SUB-GROUP + MOVE MPLR-TR-RELATE TO SUB-RELATE + MOVE MPLR-TR-NAME TO SUB-NAME + MOVE MPLR-TRIPOL TO SUB-POLICY + MOVE MPLR-TR-GROUP TO SUB-GROUP END-IF. MOVE G-RELATE TO X-RELATE. IF HOLD-PATID8 = "P" PERFORM PAT-READ. IF X-RELATE = "0" - MOVE G-RELATE TO X-RELATE. + MOVE G-RELATE TO X-RELATE. IF X-RELATE = SUB-RELATE - MOVE "18" TO SBR-RELATE - GO TO SUBSCRIBER-2. + MOVE "18" TO SBR-RELATE + GO TO SUBSCRIBER-2. IF (X-RELATE = "2" OR "K") - AND (SUB-RELATE = "2" OR "K") - MOVE "01" TO SBR-RELATEHOLD GO TO SUBSCRIBER-2. + AND (SUB-RELATE = "2" OR "K") + MOVE "01" TO SBR-RELATEHOLD GO TO SUBSCRIBER-2. IF (X-RELATE = "8" OR "Q") MOVE "29" TO SBR-RELATEHOLD GO TO SUBSCRIBER-2. IF (X-RELATE = "4" OR "M") MOVE "02" TO SBR-RELATEHOLD @@ -2299,7 +2301,8 @@ SUBSCRIBER-2. MOVE SPACE TO SBR-GROUP MOVE "0 " TO HL-CHILD - MOVE "CI" TO SBR-INSCODE + * NEED TO USE MC FOR 026 + MOVE "MC" TO SBR-INSCODE * MOVE "12" TO SBR-TYPE IF SBR-PST = "S" IF G-PRINS = "091" From 6e6b03c20114775239e8bb16e1873577d10d3fa3 Mon Sep 17 00:00:00 2001 From: stephen waite Date: Mon, 11 May 2026 13:27:39 -0400 Subject: [PATCH 22/78] MB for prim payer ins type --- rri/claims/npi5r3026.cob | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/rri/claims/npi5r3026.cob b/rri/claims/npi5r3026.cob index 0dadc924..965e1676 100644 --- a/rri/claims/npi5r3026.cob +++ b/rri/claims/npi5r3026.cob @@ -1694,7 +1694,7 @@ MOVE " " TO SBR-GROUP MOVE G-PRINS TO INS-KEY MOVE " " TO SBR-TYPE - MOVE "CI " TO SBR-INSCODE + MOVE "MB " TO SBR-INSCODE IF G-PRINS = "003" MOVE "MB" TO SBR-INSCODE. From 3a569c6987b72c138f176e069610130d753bb275 Mon Sep 17 00:00:00 2001 From: stephen waite Date: Mon, 11 May 2026 21:00:55 -0400 Subject: [PATCH 23/78] fix memory leak --- rri/posting/hiproa.cob | 12 ++++++++---- 1 file changed, 8 insertions(+), 4 deletions(-) diff --git a/rri/posting/hiproa.cob b/rri/posting/hiproa.cob index a7a8e31a..79503f65 100644 --- a/rri/posting/hiproa.cob +++ b/rri/posting/hiproa.cob @@ -1000,10 +1000,18 @@ COMPUTE CLAIM-TOT = CC-AMOUNT + PD-AMOUNT PERFORM S4 THRU S5 PERFORM CHECK-CLAIM-TOT THRU CHECK-CLAIM-TOT-EXIT + IF PAID-FLAG = 1 OR OVERPAY-FLAG = 1 + PERFORM P1-LOST-SVC + GO TO P5-SVC-LOOP-EXIT + END-IF MOVE PAYFILE01 TO PAYBACK PERFORM S4-PAYFILE THRU S4-PAYFILE-EXIT MOVE PAYBACK TO PAYFILE01 PERFORM CHECK-CLAIM-TOT THRU CHECK-CLAIM-TOT-EXIT + IF PAID-FLAG = 1 OR OVERPAY-FLAG = 1 + PERFORM P1-LOST-SVC + GO TO P5-SVC-LOOP-EXIT + END-IF ACCEPT ORDER-8 FROM TIME MOVE ORDER-6 TO PD-ORDER @@ -2016,13 +2024,9 @@ CHECK-CLAIM-TOT. IF CLAIM-TOT = 0 MOVE 1 TO PAID-FLAG - PERFORM P1-LOST-SVC - GO TO P5-SVC-LOOP-EXIT END-IF IF CLAIM-TOT < 0 MOVE 1 TO OVERPAY-FLAG - PERFORM P1-LOST-SVC - GO TO P5-SVC-LOOP-EXIT END-IF. CHECK-CLAIM-TOT-EXIT. From acf7bb54a66fc1c2c7934875108f496693645f97 Mon Sep 17 00:00:00 2001 From: stephen waite Date: Tue, 12 May 2026 07:27:07 -0400 Subject: [PATCH 24/78] 0M4 --- rri/claims/npi5r3026.cob | 240 +++++++++++++++++++-------------------- 1 file changed, 120 insertions(+), 120 deletions(-) diff --git a/rri/claims/npi5r3026.cob b/rri/claims/npi5r3026.cob index 965e1676..2a514691 100644 --- a/rri/claims/npi5r3026.cob +++ b/rri/claims/npi5r3026.cob @@ -22,7 +22,7 @@ ACCESS MODE IS DYNAMIC RECORD KEY IS P-PATNO ALTERNATE RECORD KEY IS P-GARNO WITH DUPLICATES LOCK MODE MANUAL. - SELECT SEGFILE ASSIGN TO "S45" ORGANIZATION + SELECT SEGFILE ASSIGN TO "S45" ORGANIZATION LINE SEQUENTIAL. SELECT FILEIN ASSIGN TO "S50" ORGANIZATION LINE SEQUENTIAL. @@ -66,7 +66,7 @@ SELECT PAYCUR ASSIGN TO "S95" ORGANIZATION IS INDEXED ACCESS MODE IS DYNAMIC RECORD KEY IS PAYCUR-KEY LOCK MODE MANUAL. - SELECT PLACEFILE ASSIGN TO "S100" ORGANIZATION + SELECT PLACEFILE ASSIGN TO "S100" ORGANIZATION LINE SEQUENTIAL. SELECT PARMFILE2 ASSIGN TO "S105" ORGANIZATION LINE SEQUENTIAL. @@ -102,12 +102,12 @@ 02 DF5 PIC X(15). 02 DF6 PIC XX. 02 DF7 PIC X(9). - + FD PARMFILE. 01 PARMFILE01 PIC X(75). FD PARMFILE2. 01 PARMFILE201 PIC X(15). - + FD ERRFILE. 01 ERRFILE01. 02 EF-1 PIC X(11). @@ -265,7 +265,7 @@ 02 G-ACCT PIC X(8). 02 G-PRGRPNAME PIC X(15). 02 G-SEGRPNAME PIC X(15). - + FD PAYCUR @@ -322,7 +322,7 @@ FD MPLRFILE. 01 MPLRFILE01. - 02 MPLR-KEY PIC X(8). + 02 MPLR-KEY PIC X(8). 02 MPLR-NAME PIC X(22). 02 MPLR-STREET PIC X(24). 02 MPLR-CITY PIC X(15). @@ -486,7 +486,7 @@ 02 REF-S0 PIC X VALUE "*". 02 REF-CODE PIC X(30). 02 REF-S1 PIC X VALUE "*". - 02 REF-ID PIC X(30). + 02 REF-ID PIC X(30). 02 REF-S2 PIC X VALUE "*". 02 REF-3 PIC XX VALUE SPACE. 02 REF-S3 PIC X VALUE "*". @@ -498,7 +498,7 @@ 02 SAVE-DOCREF-S0 PIC X VALUE "*". 02 SAVE-DOCREF-CODE PIC X(30). 02 SAVE-DOCREF-S1 PIC X VALUE "*". - 02 SAVE-DOCREF-ID PIC X(30). + 02 SAVE-DOCREF-ID PIC X(30). 02 SAVE-DOCREF-S2 PIC X VALUE "*". 02 SAVE-DOCREF-3 PIC XX VALUE SPACE. 02 SAVE-DOCREF-S3 PIC X VALUE "*". @@ -521,12 +521,12 @@ 02 SUBM-S6 PIC X VALUE "*". 02 SUBM-8 PIC XX VALUE "46". 02 SUBM-S7 PIC X VALUE "*". - 02 SUBM-NUM PIC X(9) VALUE "030353360". + 02 SUBM-NUM PIC X(9) VALUE "0M4". 02 SUBM-END PIC X VALUE "~". 01 SUBPER01. 02 SUBPER-0 PIC XXX VALUE "PER". 02 SUBPER-S0 PIC X VALUE "*". - 02 SUBPER-1 PIC XX VALUE "IC". + 02 SUBPER-1 PIC XX VALUE "IC". 02 SUBPER-S1 PIC X VALUE "*". 02 SUBPER-2 PIC X(9) VALUE "S WAITE". 02 SUBPER-S2 PIC X VALUE "*". @@ -584,7 +584,7 @@ 01 PER01. 02 PER-0 PIC XXX VALUE "PER". 02 PER-S0 PIC X VALUE "*". - 02 PER-1 PIC XX VALUE "IC". + 02 PER-1 PIC XX VALUE "IC". 02 PER-S1 PIC X VALUE "*". 02 PER-CONTACT PIC X(30). 02 PER-S2 PIC X VALUE "*". @@ -761,34 +761,34 @@ 02 CLM-S6 PIC X VALUE "*". 02 CLM-7 PIC X VALUE "A". 02 CLM-S7 PIC X VALUE "*". - 02 CLM-8 PIC X VALUE "Y". + 02 CLM-8 PIC X VALUE "Y". 02 CLM-S8 PIC X VALUE "*". - 02 CLM-9 PIC X VALUE "Y". + 02 CLM-9 PIC X VALUE "Y". 02 CLM-S9 PIC X VALUE "*". - 02 CLM-10 PIC X VALUE "P". + 02 CLM-10 PIC X VALUE "P". 02 CLM-S10 PIC X VALUE "*". - 02 CLM-11 PIC XX. - 02 CLM-COLON-ACCIDENT PIC X VALUE SPACE. + 02 CLM-11 PIC XX. + 02 CLM-COLON-ACCIDENT PIC X VALUE SPACE. 02 CLM-S11 PIC X VALUE "*". - 02 CLM-12 PIC XXX. + 02 CLM-12 PIC XXX. 02 CLM-S12 PIC X VALUE "*". - 02 CLM-13 PIC X. + 02 CLM-13 PIC X. 02 CLM-S13 PIC X VALUE "*". - 02 CLM-14 PIC XXX. + 02 CLM-14 PIC XXX. 02 CLM-S14 PIC X VALUE "*". - 02 CLM-15 PIC X. + 02 CLM-15 PIC X. 02 CLM-S15 PIC X VALUE "*". - 02 CLM-16 PIC X. + 02 CLM-16 PIC X. 02 CLM-S16 PIC X VALUE "*". - 02 CLM-17 PIC XX. + 02 CLM-17 PIC XX. 02 CLM-S17 PIC X VALUE "*". - 02 CLM-18 PIC X. + 02 CLM-18 PIC X. 02 CLM-S18 PIC X VALUE "*". - 02 CLM-19 PIC XX. + 02 CLM-19 PIC XX. 02 CLM-S19 PIC X VALUE "*". - 02 CLM-20 PIC XX. + 02 CLM-20 PIC XX. 02 CLM-END PIC X VALUE "~". - + 01 HI901. 02 HI9-0 PIC XX VALUE "HI". 02 HI9-S0 PIC X VALUE "*". @@ -900,7 +900,7 @@ 02 ALF14-9 PIC X(9). 02 FILLER PIC XX. 01 DATE-X PIC X(8). - 01 TIME-X. + 01 TIME-X. 02 TIME-HHMM PIC X(4). 02 FILLER PIC X(4). 01 DDFLAG PIC 9. @@ -964,13 +964,13 @@ 01 ALF9Z PIC ZZZZZZZZZ. 01 ALF5NUM PIC X(5). 01 ALF9NUM PIC X(9). - 01 NUM7 PIC 9(5)V99. + 01 NUM7 PIC 9(5)V99. 01 ALF8 PIC X(8). 01 ALF8Z PIC ZZZZ9.99. 01 ALF8NUM PIC X(8). - 01 NUM5 PIC 9(5). + 01 NUM5 PIC 9(5). 01 NUM9 PIC 9(9). - 01 NUM2 PIC 99. + 01 NUM2 PIC 99. 01 HL-NUMPARENT PIC 9(5). 01 HL-NUM PIC 9(5) VALUE 0. 01 DOC-TAB01. @@ -1135,14 +1135,14 @@ 01 CLAIM-ADJ-DATE PIC X(8). PROCEDURE DIVISION. - P0. + P0. OPEN INPUT FILEIN GARFILE PATFILE INSFILE REFPHY AUTHFILE MPLRFILE DIAGFILE PLACEFILE GAPFILE PARMFILE PARMFILE2 PAYCUR PROCFILE. OPEN OUTPUT SEGFILE ERRFILE. OPEN I-O HIPCLAIMFILE MOVE "A" TO HIP-KEY - READ HIPCLAIMFILE WITH LOCK INVALID + READ HIPCLAIMFILE WITH LOCK INVALID DISPLAY "BAD HIPCLAIMFILE" GO TO P99. COMPUTE NUM9 = HIP-NUM @@ -1159,24 +1159,24 @@ MOVE TIME-HHMM TO BHT-TIME GS-5. ACCEPT BHT-DATE FROM CENTURY-DATE. MOVE BHT-DATE TO GS-4. - + MOVE SPACE TO SEGFILE01 WRITE SEGFILE01 FROM GS01 MOVE SPACE TO SEGFILE01 - + COMPUTE NUM9 = HIP-NUM PERFORM NUM-LEFT9 MOVE ALF9NUM TO ST-NUM MOVE ALF9NUM TO SE-NUM - + ADD 1 TO HIP-NUM WRITE SEGFILE01 FROM ST01. - + COMPUTE NUM9 = HIP-NUM PERFORM NUM-LEFT9 MOVE ALF9NUM TO BHT-NUM - + MOVE SPACE TO SEGFILE01 WRITE SEGFILE01 FROM BHT01. * MOVE SPACE TO REF-CODE REF-ID @@ -1203,13 +1203,13 @@ MOVE DF7 TO PL-ZIP(PLINDX) GO TO P00. - P000. + P000. READ FILEIN AT END GO TO P98. MOVE FILEIN01 TO HOLD-FILEIN01 PERFORM DF-SEARCH PERFORM 2000A THRU 2000B GO TO P0000-1. - + P0000. MOVE SAVE01 TO HOLD-FILEIN01 FILEIN01 PERFORM DF-SEARCH. @@ -1218,7 +1218,7 @@ CLIA-FLAG GO TO P1-1. P1. READ FILEIN AT END MOVE 1 TO END-FLAG GO TO P2. - P1-1. + P1-1. * IF CNTR > 0 GO TO P2. IF DIAG-CNTR > 11 GO TO P2. IF FI-PLACE = HOLD-PLACE @@ -1229,23 +1229,23 @@ AND FI-DAT1 = HOLD-DAT1 AND FI-ACC-TYPE = HOLD-ACC-TYPE AND CNTR < 50 - PERFORM DIAG-1 THRU DIAG-EXIT + PERFORM DIAG-1 THRU DIAG-EXIT IF DIAG-CNTR > 12 GO TO P2 END-IF IF FI-SERVICE = "4" MOVE 1 TO CLIA-FLAG - END-IF - ADD 1 TO CNTR + END-IF + ADD 1 TO CNTR MOVE FILEIN01 TO FILETAB(CNTR) ADD FI-AMOUNT TO TOT-AMOUNT GO TO P1. - P2. + P2. MOVE FILEIN01 TO SAVE01 PERFORM 2300CLM PERFORM HI-DIAG THRU HI-DIAG-EXIT PERFORM 2310D PERFORM 2310E THRU 2310E-EXIT PERFORM 2320A THRU 2320A-EXIT - MOVE 0 TO CAS-TOT-REDUCE + MOVE 0 TO CAS-TOT-REDUCE MOVE 0 TO CAS-TOT-CHARGE MOVE 0 TO CAS-TOT-ALLOWED MOVE 0 TO CAS-TOT-PAID @@ -1257,13 +1257,13 @@ VARYING X FROM 1 BY 1 UNTIL X > CNTR IF END-FLAG = 1 GO TO P98. MOVE SAVE01 TO FILEIN01 - IF FI-DOCP NOT = HOLD-DOCP + IF FI-DOCP NOT = HOLD-DOCP MOVE FILEIN01 TO HOLD-FILEIN01 PERFORM DOCP-1. MOVE FILEIN01 TO HOLD-FILEIN01 - PERFORM 2000B + PERFORM 2000B GO TO P0000. - + DIAG-1. IF FI-DIAG = "0000000" GO TO DIAG-EXIT. @@ -1307,7 +1307,7 @@ MOVE 1 TO FLAG. - 2000A. + 2000A. ADD 1 TO HL-NUM MOVE HL-NUM TO HL-NUMPRV-SAVE COMPUTE NUM5 = HL-NUM @@ -1362,13 +1362,13 @@ * WRITE SEGFILE01 FROM PER01. * PAY-TO PROVIDER/ADDRESS - 2010AB. + 2010AB. IF EINSS-TYPE = "E" MOVE "2" TO NM1-SOLO MOVE ORG-NAME TO NM1-NAMEL MOVE SPACE TO NM1-NAMEF NM1-NAMEM NM1-NAMES MOVE "24" TO NM1-EINSS - ELSE + ELSE MOVE "1" TO NM1-SOLO MOVE PARMLAST TO NM1-NAMEL MOVE PARMFIRST TO NM1-NAMEF @@ -1399,7 +1399,7 @@ MOVE SPACE TO SEGFILE01. * WRITE SEGFILE01 FROM REF01. MOVE SPACE TO REF-CODE REF-ID - IF EINSS-TYPE = "E" + IF EINSS-TYPE = "E" MOVE "EI" TO REF-CODE ELSE MOVE "SY" TO REF-CODE. @@ -1497,7 +1497,7 @@ MOVE "12144 " TO N4-ZIP MOVE SPACE TO SEGFILE01 WRITE SEGFILE01 FROM N401 - NOT INVALID + NOT INVALID MOVE INS-NAME TO NM1-NAMEL MOVE "PI" TO NM1-EINSS MOVE INS-NEIC TO NM1-CODE @@ -1537,7 +1537,7 @@ MOVE HOLD-DATE-M TO DTP-3 MOVE SPACE TO SEGFILE01 WRITE SEGFILE01 FROM DTP01. - IF (CLIA-FLAG = 1) + IF (CLIA-FLAG = 1) AND (CLIA-NUM NOT = SPACE) MOVE SPACE TO REF-CODE MOVE "X4" TO REF-CODE @@ -1594,8 +1594,8 @@ MOVE "DQ " TO NM1-1 MOVE "1" TO NM1-SOLO MOVE SPACE TO NM1-NAMEL NM1-NAMEF NM1-NAMEM - UNSTRING REF-NAME DELIMITED BY - "; " OR ";" OR " ; " OR " ," OR ", " OR " , " OR "," + UNSTRING REF-NAME DELIMITED BY + "; " OR ";" OR " ; " OR " ," OR ", " OR " , " OR "," INTO NM1-NAMEL NM1-NAMEF MOVE SPACE TO NM1-NAMES NM1-EINSS NM1-CODE MOVE "XX" TO NM1-EINSS @@ -1623,12 +1623,12 @@ GO TO 2320A-EXIT. IF G-SEINS = "001" OR "012" OR "075" OR "076" GO TO 2320A-EXIT. - IF G-SEINS = "005" PERFORM CMP-1 + IF G-SEINS = "005" PERFORM CMP-1 GO TO 2320A-EXIT. - IF G-SEINS = "004" OR "064" PERFORM CAID-1 + IF G-SEINS = "004" OR "064" PERFORM CAID-1 GO TO 2320A-EXIT. MOVE 0 TO GAP-FLAG - IF G-SEINS = "062" PERFORM GAP-1 THRU GAP-1-EXIT. + IF G-SEINS = "062" PERFORM GAP-1 THRU GAP-1-EXIT. 2320A-EXIT. EXIT. CAS-TOT. MOVE FILETAB(X) TO FILEIN01 @@ -1643,7 +1643,7 @@ MOVE SPACE TO PC-KEY3 START PAYCUR KEY NOT < PAYCUR-KEY INVALID GO TO CAS-TOT-EXIT. - CAS-TOT-1. + CAS-TOT-1. READ PAYCUR NEXT AT END GO TO CAS-TOT-2. IF PC-KEY8 NOT = FI-KEY8 GO TO CAS-TOT-2. IF PC-CLAIM NOT = FI-CLAIM GO TO CAS-TOT-1. @@ -1689,27 +1689,27 @@ END-IF. CAS-TOT-EXIT. EXIT. 2320S. - MOVE "P" TO SBR-PST - MOVE "18" TO SBR-RELATE - MOVE " " TO SBR-GROUP + MOVE "P" TO SBR-PST + MOVE "18" TO SBR-RELATE + MOVE " " TO SBR-GROUP MOVE G-PRINS TO INS-KEY - MOVE " " TO SBR-TYPE + MOVE " " TO SBR-TYPE MOVE "MB " TO SBR-INSCODE IF G-PRINS = "003" MOVE "MB" TO SBR-INSCODE. - - READ INSFILE INVALID + + READ INSFILE INVALID MOVE "COMMERCIAL INS" TO INS-NAME END-READ. MOVE SPACE TO SBR-GRNAME - * MOVE INS-NAME TO SBR-GRNAME + * MOVE INS-NAME TO SBR-GRNAME * IF G-PRINS = "006" * MOVE "OF " TO SBR-INSCODE. * IF G-PRINS = "141" * MOVE "CH " TO SBR-INSCODE. * IF (G-PRINS = "002") OR (INS-CAID = "EE ") * MOVE "BL " TO SBR-INSCODE. - MOVE SPACE TO SBR-6 SBR-7 SBR-8 + MOVE SPACE TO SBR-6 SBR-7 SBR-8 MOVE SPACE TO SEGFILE01 WRITE SEGFILE01 FROM SBR01. MOVE SPACE TO CAS-1 CAS-2 CAS-3 @@ -1720,8 +1720,8 @@ * MOVE ALF8NUM TO CAS-3 * MOVE SPACE TO SEGFILE01 * WRITE SEGFILE01 FROM CAS01 - - + + * MOVE SPACE TO AMT-1 AMT-2 * MOVE "AAE" TO AMT-1 * COMPUTE NUM7 = CAS-TOT-ALLOWED @@ -1729,7 +1729,7 @@ * MOVE ALF8NUM TO AMT-2 * MOVE SPACE TO SEGFILE01 * WRITE SEGFILE01 FROM AMT01 - + MOVE SPACE TO AMT-1 AMT-2 MOVE "D " TO AMT-1 @@ -1743,8 +1743,8 @@ * MOVE SPACE TO SEGFILE01 * WRITE SEGFILE01 FROM AMT01 - * IF PRIMARY INS SUBSCRIBER NOT = 2ND SUBSCRIBER - * MAKE UP DOB FOR DMG01 SEGMENT + * IF PRIMARY INS SUBSCRIBER NOT = 2ND SUBSCRIBER + * MAKE UP DOB FOR DMG01 SEGMENT IF (G-PR-RELATE NOT = G-SE-RELATE) OR (G-GARNAME NOT = G-PRNAME) UNSTRING G-PRNAME DELIMITED BY ";" INTO @@ -1754,14 +1754,14 @@ MOVE G-SEX TO DMG-GENDER. MOVE SPACE TO SEGFILE01 * WRITE SEGFILE01 FROM DMG01. - + MOVE SPACE TO SEGFILE01 WRITE SEGFILE01 FROM OI01. - + MOVE "IL " TO NM1-1 MOVE "1" TO NM1-SOLO MOVE SPACE TO NM1-NAMEL NM1-NAMEF NM1-NAMEM NM1-NAMES - + IF (G-PR-RELATE NOT = G-SE-RELATE) OR (G-GARNAME NOT = G-PRNAME) UNSTRING G-PRNAME DELIMITED BY ";" INTO @@ -1813,7 +1813,7 @@ 2320S-EXIT. EXIT. - + CMP-1. MOVE "S" TO SBR-PST MOVE G-SE-GROUP TO SBR-GROUP @@ -1830,7 +1830,7 @@ WRITE SEGFILE01 FROM OI01. MOVE SPACE TO SEGFILE01 WRITE SEGFILE01 FROM DMG01. - MOVE SPACE TO NM1-NAMEL NM1-NAMEF NM1-NAMEM NM1-NAMES + MOVE SPACE TO NM1-NAMEL NM1-NAMEF NM1-NAMEM NM1-NAMES UNSTRING G-SENAME DELIMITED BY ";" INTO NM1-NAMEL NM1-NAMEF NM1-NAMEM MOVE SPACE TO NAME-1 NAME-2 @@ -1874,7 +1874,7 @@ MOVE SPACE TO SEGFILE01 WRITE SEGFILE01 FROM N401. - MOVE SPACE TO NM1-NAMEL NM1-NAMEF NM1-NAMEM NM1-NAMES + MOVE SPACE TO NM1-NAMEL NM1-NAMEF NM1-NAMEM NM1-NAMES MOVE "MEDICOMP" TO NM1-NAMEL MOVE "2" TO NM1-SOLO MOVE "PR" TO NM1-1 @@ -1883,7 +1883,7 @@ MOVE "00026" TO NM1-CODE MOVE SPACE TO SEGFILE01 WRITE SEGFILE01 FROM NM101. - + CAID-1. MOVE "S" TO SBR-PST MOVE G-SE-GROUP TO SBR-GROUP @@ -1897,7 +1897,7 @@ WRITE SEGFILE01 FROM OI01. MOVE SPACE TO SEGFILE01 WRITE SEGFILE01 FROM DMG01. - MOVE SPACE TO NM1-NAMEL NM1-NAMEF NM1-NAMEM NM1-NAMES + MOVE SPACE TO NM1-NAMEL NM1-NAMEF NM1-NAMEM NM1-NAMES UNSTRING G-SENAME DELIMITED BY ";" INTO NM1-NAMEL NM1-NAMEF NM1-NAMEM MOVE SPACE TO NAME-1 NAME-2 @@ -1942,7 +1942,7 @@ MOVE G-ZIP TO N4-ZIP MOVE SPACE TO SEGFILE01 WRITE SEGFILE01 FROM N401. - MOVE SPACE TO NM1-NAMEL NM1-NAMEF NM1-NAMEM NM1-NAMES + MOVE SPACE TO NM1-NAMEL NM1-NAMEF NM1-NAMEM NM1-NAMES MOVE "VT MEDICAID" TO NM1-NAMEL MOVE "2" TO NM1-SOLO MOVE "PR" TO NM1-1 @@ -1951,7 +1951,7 @@ MOVE "VTXIX" TO NM1-CODE MOVE SPACE TO SEGFILE01 WRITE SEGFILE01 FROM NM101. - GAP-1. + GAP-1. MOVE G-PR-GROUP TO GAPKEY READ GAPFILE INVALID MOVE 1 TO GAP-FLAG GO TO GAP-1-EXIT. MOVE "S" TO SBR-PST @@ -1970,7 +1970,7 @@ WRITE SEGFILE01 FROM OI01. MOVE SPACE TO SEGFILE01 WRITE SEGFILE01 FROM DMG01. - MOVE SPACE TO NM1-NAMEL NM1-NAMEF NM1-NAMEM NM1-NAMES + MOVE SPACE TO NM1-NAMEL NM1-NAMEF NM1-NAMEM NM1-NAMES UNSTRING G-SENAME DELIMITED BY ";" INTO NM1-NAMEL NM1-NAMEF NM1-NAMEM MOVE SPACE TO NAME-1 NAME-2 @@ -2013,7 +2013,7 @@ MOVE SPACE TO SEGFILE01 WRITE SEGFILE01 FROM N401. - MOVE SPACE TO NM1-NAMEL NM1-NAMEF NM1-NAMEM NM1-NAMES + MOVE SPACE TO NM1-NAMEL NM1-NAMEF NM1-NAMEM NM1-NAMES MOVE GAP-NAME TO NM1-NAMEL MOVE "2" TO NM1-SOLO MOVE "PR" TO NM1-1 @@ -2031,7 +2031,7 @@ IF ((FI-PROC1 = "W9020") OR (FI-PROC1 > "99380" AND < "99387") OR (FI-PROC1 > "99390" AND < "99397")) - MOVE G-DOB TO AGEX + MOVE G-DOB TO AGEX MOVE FI-DATE-T TO AGEY COMPUTE AGEZ = AGEYYY - AGEXYY IF AGEZ = 21 AND AGEXMMDD > AGEYMMDD @@ -2080,7 +2080,7 @@ IF NOT (FI-DX4 = SPACE OR "0000000") MOVE FI-DX4 TO DIAG-X PERFORM DIAG-3 VARYING A FROM 1 BY 1 UNTIL A > 12 - END-IF + END-IF MOVE SPACE TO DIAG-C(DX-CNTR-PT) MOVE DIAG-POINTER01 TO SV1-PT @@ -2089,7 +2089,7 @@ DIAG-3. IF DIAGTAB(A) = DIAG-X ADD 1 TO DX-CNTR-PT - MOVE A TO DIAG-PT(DX-CNTR-PT) + MOVE A TO DIAG-PT(DX-CNTR-PT) MOVE ":" TO DIAG-C(DX-CNTR-PT) MOVE 12 TO A. @@ -2109,7 +2109,7 @@ IF NOT (sv1-proc(1:1) = "J" OR SV1-PROC(1:5) = "Q2039") GO TO 2400SRV-1. move sv1-proc to proc-key - read procfile invalid + read procfile invalid go to 2400srv-1 end-read move space to sv1-mod-filler @@ -2153,16 +2153,16 @@ COMPUTE NUM7 = CAS-PAID(X) PERFORM AMT-LEFT - * iEDI wants us to suppress leading zero + * iEDI wants us to suppress leading zero IF ALF8NUM = "0.00" MOVE ".00" TO ALF8NUM - END-IF + END-IF MOVE ALF8NUM TO SVD-2 MOVE SPACE TO SVD-3 STRING "HC:" SV1-PROC SV1-MOD-FILLER DELIMITED BY SIZE INTO SVD-3 - MOVE SV1-WORK TO SVD-4 + MOVE SV1-WORK TO SVD-4 MOVE SPACE TO SEGFILE01 WRITE SEGFILE01 FROM SVD01 @@ -2205,7 +2205,7 @@ READ CHARCUR WITH LOCK INVALID GO TO 2400SRV-EXIT. IF CC-REC-STAT = "0" MOVE "2" TO CC-REC-STAT. IF CC-REC-STAT = "1" MOVE "3" TO CC-REC-STAT. - MOVE "E" TO CC-PAPER. + MOVE "E" TO CC-PAPER. MOVE BHT-DATE TO CC-DATE-A. REWRITE CHARCUR01. 2400SRV-EXIT. EXIT. @@ -2239,26 +2239,26 @@ REF-1-EXIT. EXIT. DOCP-1. - MOVE DOC-LASTNAME(HOLD-DOCP) TO SAVE-DOCNM1-NAMEL - MOVE DOC-FIRSTNAME(HOLD-DOCP) TO SAVE-DOCNM1-NAMEF - MOVE DOC-MI(HOLD-DOCP) TO SAVE-DOCNM1-NAMES + MOVE DOC-LASTNAME(HOLD-DOCP) TO SAVE-DOCNM1-NAMEL + MOVE DOC-FIRSTNAME(HOLD-DOCP) TO SAVE-DOCNM1-NAMEF + MOVE DOC-MI(HOLD-DOCP) TO SAVE-DOCNM1-NAMES MOVE DOC-NPI(HOLD-DOCP) TO SAVE-DOCNM1-CODE MOVE DOC-SS(HOLD-DOCP) TO SAVE-DOCREF-ID MOVE "SY" TO SAVE-DOCREF-CODE MOVE "82 " TO SAVE-DOCNM1-1 MOVE "1" TO SAVE-DOCNM1-SOLO - MOVE SPACE TO SAVE-DOCNM1-NAMES + MOVE SPACE TO SAVE-DOCNM1-NAMES MOVE "XX" TO SAVE-DOCNM1-EINSS. SUBSCRIBER-1. MOVE HOLD-KEY8 TO G-GARNO - READ GARFILE + READ GARFILE INVALID DISPLAY "BAD BAD BAD" GO TO P99. IF G-TRINS NOT = "001" MOVE "0" TO MPLR-TR-RELATE MOVE G-GARNO TO MPLR-KEY - READ MPLRFILE + READ MPLRFILE INVALID CONTINUE END-READ END-IF. @@ -2267,7 +2267,7 @@ MOVE G-PRIPOL TO SUB-POLICY MOVE SPACE TO SUB-GROUP MOVE "P" TO SBR-PST - IF HOLD-PAYCODE = G-SEINS + IF HOLD-PAYCODE = G-SEINS MOVE "S" TO SBR-PST MOVE G-SE-RELATE TO SUB-RELATE MOVE G-SENAME TO SUB-NAME @@ -2284,12 +2284,12 @@ END-IF. MOVE G-RELATE TO X-RELATE. IF HOLD-PATID8 = "P" PERFORM PAT-READ. - IF X-RELATE = "0" + IF X-RELATE = "0" MOVE G-RELATE TO X-RELATE. - IF X-RELATE = SUB-RELATE + IF X-RELATE = SUB-RELATE MOVE "18" TO SBR-RELATE GO TO SUBSCRIBER-2. - IF (X-RELATE = "2" OR "K") + IF (X-RELATE = "2" OR "K") AND (SUB-RELATE = "2" OR "K") MOVE "01" TO SBR-RELATEHOLD GO TO SUBSCRIBER-2. IF (X-RELATE = "8" OR "Q") MOVE "29" TO SBR-RELATEHOLD @@ -2318,19 +2318,19 @@ IF HOLD-ACC-TYPE = "2" MOVE "14" TO SBR-TYPE END-IF - + IF HOLD-ACC-TYPE = "1" MOVE "15" TO SBR-TYPE END-IF END-IF. - SUBSCRIBER-EXIT. + SUBSCRIBER-EXIT. EXIT. 2000B-PAT. - - PAT-READ. + + PAT-READ. MOVE HOLD-PATID TO P-PATNO READ PATFILE INVALID MOVE "0" TO P-RELATE. MOVE P-RELATE TO X-RELATE. @@ -2352,7 +2352,7 @@ 2000C. * ISA RECORD. - ISA-1. + ISA-1. * AUTHORIZATION INFO QUALIFIER READ PARMFILE2 AT END GO TO A0-EXIT. MOVE PARMFILE201 TO ISA-1. @@ -2403,7 +2403,7 @@ READ PARMFILE2 AT END GO TO A0-EXIT. MOVE PARMFILE201 TO ISA-16. ISA-EXIT. EXIT. - * TAX ID NUMBER + * TAX ID NUMBER A0. READ PARMFILE AT END GO TO A0-EXIT. MOVE PARMFILE01 TO EIN-CODE. @@ -2451,7 +2451,7 @@ MOVE PARMFILE01 TO GROUP-3. * CLIA-NUMBER READ PARMFILE AT END GO TO A0-EXIT. - MOVE PARMFILE01 TO mammo-code. + MOVE PARMFILE01 TO mammo-code. * ACCT-TAXONOMY. READ PARMFILE AT END GO TO A0-EXIT. @@ -2473,13 +2473,13 @@ GO TO A1. A0-EXIT. EXIT. - DF-SEARCH. + DF-SEARCH. MOVE 0 TO FLAG. MOVE "1" TO CC-PL MOVE "11" TO CLM-5 PERFORM DF-SEARCH2 VARYING Y FROM 1 BY 1 UNTIL Y > PLINDX. - DF-SEARCH2. - IF HOLD-PLACE = PL-TAB(Y) + DF-SEARCH2. + IF HOLD-PLACE = PL-TAB(Y) MOVE PL-NUM(Y) TO CC-PL MOVE Y TO PLACE-POINTER PERFORM PLACE-OF-SERVICE @@ -2492,7 +2492,7 @@ IF CC-PL = "6" MOVE "81" TO CLM-5. IF CC-PL = "7" MOVE "61" TO CLM-5. IF CC-PL = "8" MOVE "99" TO CLM-5. - IF CC-PL = "E" MOVE "23" TO CLM-5 + IF CC-PL = "E" MOVE "23" TO CLM-5 IF CC-PL = "K" MOVE "31" TO CLM-5. IF HOLD-PROC1 > "99200" AND < "99206" MOVE "11" TO CLM-5. IF HOLD-PROC1 > "99210" AND < "99216" MOVE "11" TO CLM-5. @@ -2553,7 +2553,7 @@ IF X-MOD1 = SPACE AND X-MOD2 = SPACE MOVE X-MOD3 TO X-MOD1 MOVE SPACE TO X-MOD3. - IF X-MOD1 = SPACE + IF X-MOD1 = SPACE MOVE X-MOD2 TO X-MOD1 MOVE X-MOD3 TO X-MOD2 MOVE SPACE TO X-MOD3. @@ -2577,7 +2577,7 @@ - MAKE-IT-UP. + MAKE-IT-UP. MOVE G-DOB TO X-DOB. ADD 1 TO X-YYYY COMPUTE X-MM = 12 + X-DD. @@ -2588,10 +2588,10 @@ END-IF IF X-MM = 0 MOVE 1 TO X-MM. COMPUTE X-DD = X-DD + 32 + (X-YYYY - 1900). - + MAKE-IT-2. IF X-DD > DAYS-IN-MONTH(X-MM) - COMPUTE X-DD = X-DD - DAYS-IN-MONTH(X-MM) + COMPUTE X-DD = X-DD - DAYS-IN-MONTH(X-MM) GO TO MAKE-IT-2 END-IF IF X-DD < 1 MOVE 1 TO X-DD. @@ -2604,7 +2604,7 @@ * ACCEPT ANS MOVE X-DOB TO DMG-DOB MOVE "M" TO DMG-GENDER - IF G-PR-RELATE NOT NUMERIC + IF G-PR-RELATE NOT NUMERIC MOVE "F" TO DMG-GENDER. MAKE-IT-UP-EXIT. EXIT. @@ -2616,7 +2616,7 @@ MOVE SPACE TO SEGFILE01. * WRITE SEGFILE01 FROM IEA01. - P99. + P99. REWRITE HIPCLAIMFILE01. CLOSE GARFILE HIPCLAIMFILE CHARCUR ERRFILE. STOP RUN. From 8546587ae8b63ba169f56257401368e8675f2ac6 Mon Sep 17 00:00:00 2001 From: stephen waite Date: Tue, 12 May 2026 21:20:10 -0400 Subject: [PATCH 25/78] prior total for paid flag --- rri/posting/hiproa.cob | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/rri/posting/hiproa.cob b/rri/posting/hiproa.cob index 79503f65..b8f1fb5b 100644 --- a/rri/posting/hiproa.cob +++ b/rri/posting/hiproa.cob @@ -393,6 +393,7 @@ 01 PAID-FLAG PIC 9 VALUE 0. 01 MISMATCH-FLAG PIC 9 VALUE 0. 01 SVC-TOTAL PIC S9(5)V99 VALUE 0. + 01 PRIOR-TOT PIC S9(7)V99 VALUE 0. PROCEDURE DIVISION. 0005-START. @@ -2022,7 +2023,8 @@ END-PERFORM. CHECK-CLAIM-TOT. - IF CLAIM-TOT = 0 + COMPUTE PRIOR-TOT = CLAIM-TOT - PD-AMOUNT + IF PRIOR-TOT <= 0 MOVE 1 TO PAID-FLAG END-IF IF CLAIM-TOT < 0 From 78b49d09c6eb25277c57416f0c50a7c341bb5810 Mon Sep 17 00:00:00 2001 From: stephen waite Date: Tue, 12 May 2026 22:17:58 -0400 Subject: [PATCH 26/78] capture auth --- rri/posting/hiproa.cob | 22 +++++++++++++++++++++- 1 file changed, 21 insertions(+), 1 deletion(-) diff --git a/rri/posting/hiproa.cob b/rri/posting/hiproa.cob index b8f1fb5b..69322d0a 100644 --- a/rri/posting/hiproa.cob +++ b/rri/posting/hiproa.cob @@ -101,7 +101,7 @@ 02 PF-3 PIC X(27). FD ERROR-FILE. - 01 ERROR-FILE01 PIC X(150). + 01 ERROR-FILE01 PIC X(175). FD FILEIN. 01 FILEIN01. @@ -185,6 +185,9 @@ 03 EF-DENIAL5 PIC XXX. 03 FILLER PIC X VALUE SPACE. 03 EF-DENIAL6 PIC XXX. + 02 FILLER PIC X VALUE SPACE. + 02 EF-AUTH PIC X(20) VALUE SPACE. + 01 ERR201. 02 EF2-NUM PIC ZZ9. 02 FILLER PIC XX VALUE SPACE. @@ -394,6 +397,13 @@ 01 MISMATCH-FLAG PIC 9 VALUE 0. 01 SVC-TOTAL PIC S9(5)V99 VALUE 0. 01 PRIOR-TOT PIC S9(7)V99 VALUE 0. + 01 CLP-AUTH PIC X(20) VALUE SPACE. + 01 REF01. + 02 REF-0 PIC X(3). + 02 FILLER PIC X. + 02 REF-1 PIC X(3). + 02 FILLER PIC X. + 02 REF-2 PIC X(50). PROCEDURE DIVISION. 0005-START. @@ -618,6 +628,7 @@ MOVE 0 TO LQ-CNTR MOVE 0 TO SVC-TOTAL MOVE 0 TO OVERPAY-FLAG PAID-FLAG MISMATCH-FLAG + MOVE SPACE TO CLP-AUTH MOVE ALL ZEROES TO ALLW-TAB01. P1-NM1. @@ -668,6 +679,14 @@ GO TO P1-NM1 END-IF + IF F1 = "REF" AND F2 = "*G1*" + MOVE SPACE TO REF01 + UNSTRING FILEIN01 DELIMITED BY "*" INTO + REF-0 REF-1 REF-2 + MOVE REF-2 TO CLP-AUTH + GO TO P1-NM1 + END-IF + GO TO P1-NM1. P1-SVC-LOOP. @@ -1295,6 +1314,7 @@ IF MISMATCH-FLAG = 1 MOVE "MISMATCH " TO EF2 END-IF + MOVE CLP-AUTH TO EF-AUTH MOVE SPACE TO ERROR-FILE01 WRITE ERROR-FILE01 FROM ERR01 From b7f1ef253671745a9264fbac66d686ae29b16290 Mon Sep 17 00:00:00 2001 From: stephen waite Date: Wed, 13 May 2026 08:55:59 -0400 Subject: [PATCH 27/78] remove ambigous ref01 --- rri/posting/hiproa.cob | 6 ------ 1 file changed, 6 deletions(-) diff --git a/rri/posting/hiproa.cob b/rri/posting/hiproa.cob index 69322d0a..a611f0ed 100644 --- a/rri/posting/hiproa.cob +++ b/rri/posting/hiproa.cob @@ -398,12 +398,6 @@ 01 SVC-TOTAL PIC S9(5)V99 VALUE 0. 01 PRIOR-TOT PIC S9(7)V99 VALUE 0. 01 CLP-AUTH PIC X(20) VALUE SPACE. - 01 REF01. - 02 REF-0 PIC X(3). - 02 FILLER PIC X. - 02 REF-1 PIC X(3). - 02 FILLER PIC X. - 02 REF-2 PIC X(50). PROCEDURE DIVISION. 0005-START. From 242bf3582861690d2a6220edeae60f19806098d6 Mon Sep 17 00:00:00 2001 From: stephen waite Date: Wed, 13 May 2026 18:29:59 -0400 Subject: [PATCH 28/78] hra and 02 fixes --- rri/posting/hipr136.cob | 1 + rri/posting/hiproa.cob | 3 ++- 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/rri/posting/hipr136.cob b/rri/posting/hipr136.cob index 4be767fd..4d5cc6f3 100644 --- a/rri/posting/hipr136.cob +++ b/rri/posting/hipr136.cob @@ -971,6 +971,7 @@ OR CAS-2 = "27" OR CAS-2 = "29" OR CAS-2 = "96" + OR CAS-2 = "200" OR CAS-2 = "242" ) PERFORM P1-LOST-SVC diff --git a/rri/posting/hiproa.cob b/rri/posting/hiproa.cob index a611f0ed..303aedb9 100644 --- a/rri/posting/hiproa.cob +++ b/rri/posting/hiproa.cob @@ -902,7 +902,8 @@ END-IF END-IF - IF CLP-2CLMSTAT = "1 " AND PAYORID = "43700" + IF CLP-2CLMSTAT = "1 " AND + (PAYORID = "43700" OR PAYORID = "58379") IF SVC-CNTR = 1 MOVE CLP-4TOTCLMPAY TO ALF8 ELSE From 11091df5955712ff82d317cf99350e08e509163e Mon Sep 17 00:00:00 2001 From: stephen waite Date: Fri, 15 May 2026 10:22:32 -0400 Subject: [PATCH 29/78] bump to sonnet 4-6 --- php/rri/reads.php | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/php/rri/reads.php b/php/rri/reads.php index e9007fad..2fc64644 100644 --- a/php/rri/reads.php +++ b/php/rri/reads.php @@ -117,7 +117,7 @@ function suggestIcd10Codes(Client $guzzle, string $interp, string $cpt): array 'timeout' => 30, 'connect_timeout' => 10, 'json' => [ - 'model' => 'claude-sonnet-4-20250514', + 'model' => 'claude-sonnet-4-6', 'max_tokens' => 1024, 'system' => $system, 'messages' => [ From 448d5bee4c1ba144856d023e18b1f4a8618458ad Mon Sep 17 00:00:00 2001 From: stephen waite Date: Fri, 15 May 2026 15:12:43 -0400 Subject: [PATCH 30/78] update sonnet 4-6 --- php/rri/reads.php | 157 +++++++++++++++++++++++++++++++++++----------- 1 file changed, 120 insertions(+), 37 deletions(-) diff --git a/php/rri/reads.php b/php/rri/reads.php index 2fc64644..fdd77235 100644 --- a/php/rri/reads.php +++ b/php/rri/reads.php @@ -52,7 +52,7 @@ function getQualifyingLungFindings(string $note): array ]; } -function suggestIcd10Codes(Client $guzzle, string $interp, string $cpt): array +function suggestIcd10Codes(Client $guzzle, string $interp, string $cpt): ?array { $system = <<post('https://api.anthropic.com/v1/messages', [ - 'headers' => [ - 'x-api-key' => getenv('ANTHROPIC_API_KEY'), - 'anthropic-version' => '2023-06-01', - 'Content-Type' => 'application/json', - ], - 'timeout' => 30, - 'connect_timeout' => 10, - 'json' => [ - 'model' => 'claude-sonnet-4-6', - 'max_tokens' => 1024, - 'system' => $system, - 'messages' => [ - ['role' => 'user', 'content' => $user_message] + $attempts = 0; + $max_attempts = 3; + + while ($attempts < $max_attempts) { + try { + $response = $guzzle->post('https://api.anthropic.com/v1/messages', [ + 'headers' => [ + 'x-api-key' => getenv('ANTHROPIC_API_KEY'), + 'anthropic-version' => '2023-06-01', + 'Content-Type' => 'application/json', ], - ], - ]); - $body = json_decode((string) $response->getBody(), true); - $raw = $body['content'][0]['text'] ?? '[]'; - return json_decode($raw, true) ?? []; - } catch (\GuzzleHttp\Exception\ConnectException $e) { - echo "Claude unavailable (connection timeout) \n"; - } catch (\GuzzleHttp\Exception\RequestException $e) { - echo "Claude request failed: " . $e->getMessage() . " \n"; - } catch (\Exception $e) { - echo "Claude error: " . $e->getMessage() . " \n"; + 'timeout' => 30, + 'connect_timeout' => 10, + 'json' => [ + 'model' => 'claude-sonnet-4-6', + 'max_tokens' => 1024, + 'system' => [ + [ + 'type' => 'text', + 'text' => $system, + 'cache_control' => ['type' => 'ephemeral'], + ], + ], + 'tools' => [ + [ + 'name' => 'submit_diagnosis_codes', + 'description' => 'Submit suggested ICD-10-CM diagnosis codes for the radiology report.', + 'input_schema' => [ + 'type' => 'object', + 'properties' => [ + 'codes' => [ + 'type' => 'array', + 'items' => [ + 'type' => 'object', + 'properties' => [ + 'code' => ['type' => 'string', 'description' => 'ICD-10-CM code'], + 'description' => ['type' => 'string', 'description' => 'Full code description'], + 'confidence' => ['type' => 'string', 'enum' => ['high', 'medium', 'low']], + 'rationale' => ['type' => 'string', 'description' => 'One sentence citing the specific finding or indication'], + ], + 'required' => ['code', 'description', 'confidence', 'rationale'], + ], + ], + ], + 'required' => ['codes'], + ], + ], + ], + 'tool_choice' => ['type' => 'tool', 'name' => 'submit_diagnosis_codes'], + 'messages' => [ + ['role' => 'user', 'content' => $user_message], + ], + ], + ]); + + $body = json_decode((string) $response->getBody(), true); + + // Cache verification — keep during rollout, remove later + $usage = $body['usage'] ?? []; + error_log(sprintf( + "Claude usage: input=%d, output=%d, cache_write=%d, cache_read=%d", + $usage['input_tokens'] ?? 0, + $usage['output_tokens'] ?? 0, + $usage['cache_creation_input_tokens'] ?? 0, + $usage['cache_read_input_tokens'] ?? 0, + )); + + if (($body['stop_reason'] ?? '') === 'max_tokens') { + error_log("Claude: response truncated at max_tokens, consider raising limit"); + } + + foreach ($body['content'] ?? [] as $block) { + if (($block['type'] ?? '') === 'tool_use' + && ($block['name'] ?? '') === 'submit_diagnosis_codes') { + return $block['input']['codes'] ?? []; + } + } + + error_log("Claude: no tool_use block found, stop_reason=" . ($body['stop_reason'] ?? 'null')); + return []; + + } catch (\GuzzleHttp\Exception\ConnectException $e) { + $attempts++; + if ($attempts < $max_attempts) { + sleep(2 ** $attempts); + continue; + } + error_log("Claude unavailable (connection timeout): " . $e->getMessage()); + return null; + + } catch (\GuzzleHttp\Exception\RequestException $e) { + $status = $e->hasResponse() ? $e->getResponse()->getStatusCode() : 0; + $detail = $e->hasResponse() + ? (string) $e->getResponse()->getBody() + : $e->getMessage(); + + if (in_array($status, [429, 529, 500, 502, 503, 504]) && $attempts < $max_attempts - 1) { + $attempts++; + sleep(2 ** $attempts); + continue; + } + error_log("Claude request failed ($status): $detail"); + return null; + + } catch (\Exception $e) { + error_log("Claude error: " . $e->getMessage()); + return null; + } } - return []; + + return null; } $filename = getenv('HOME') . "/W2" . getenv('tid') . $cms_user; @@ -275,13 +355,16 @@ function suggestIcd10Codes(Client $guzzle, string $interp, string $cpt): array echo $note . "\n"; if ($ask_claude && str_contains($coding_display, $rri_cpt)) { $icd10_suggestions = suggestIcd10Codes($guzzle, $interp, $rri_cpt); - foreach ($icd10_suggestions as $s) { - echo sprintf("[%s] %s (%s) — \"%s\"\n", - $s['confidence'], - $s['code'], - $s['description'], - $s['rationale'] - ); + if ($icd10_suggestions === null) { + echo "(Claude unavailable — code manually)\n"; + } elseif (empty($icd10_suggestions)) { + echo "(no ICD-10 suggestions returned)\n"; + } else { + foreach ($icd10_suggestions as $s) { + echo sprintf("[%s] %s (%s) — \"%s\"\n", + $s['confidence'], $s['code'], $s['description'], $s['rationale'] + ); + } } } } From 1a7039f27ddcb0188b497be67ce3abfe57a05326 Mon Sep 17 00:00:00 2001 From: stephen waite Date: Fri, 15 May 2026 17:19:44 -0400 Subject: [PATCH 31/78] debug cache --- php/rri/reads.php | 34 +++++++++++++++++++++++++++++++++- 1 file changed, 33 insertions(+), 1 deletion(-) diff --git a/php/rri/reads.php b/php/rri/reads.php index fdd77235..c6f6fa50 100644 --- a/php/rri/reads.php +++ b/php/rri/reads.php @@ -100,6 +100,37 @@ function suggestIcd10Codes(Client $guzzle, string $interp, string $cpt): ?array 5. If IMPRESSION reveals incidental pathology not mentioned in the indication, include it as a secondary suggestion at lower confidence. + +EXAMPLES: + +EXAMPLE 1 — specific finding in impression: +INDICATION: Right knee pain after fall +IMPRESSION: Complex tear of the posterior horn of the medial meniscus, right knee. +Correct primary: S83.231A (Complex tear of medial meniscus, current injury, right knee, initial encounter) +Wrong: M23.92 (unspecified knee derangement) — fails specificity (laterality, morphology, subsite all documented) + +EXAMPLE 2 — normal impression, specific indication: +INDICATION: Follow-up of known 4mm right MCA aneurysm +IMPRESSION: No change. No new aneurysm. No hemorrhage. +Correct primary: I67.1 (Cerebral aneurysm, nonruptured) +Wrong: Z09 / Z51 aftercare — normal result does not eliminate the underlying diagnosis + +EXAMPLE 3 — rule-out only: +INDICATION: Chest pain, rule out PE +IMPRESSION: No pulmonary embolism. Lungs clear. +Correct primary: R07.9 (Chest pain, unspecified) +Wrong: I26.99 — never code rule-out as confirmed + +EXAMPLE 4 — incidental finding: +INDICATION: Cough +IMPRESSION: No acute cardiopulmonary process. Incidental 6mm right lower lobe pulmonary nodule. +Correct: R05.9 (Cough) primary, R91.1 (Solitary pulmonary nodule) secondary, lower confidence +FINAL CHECKS before returning: +- Did I pick the most specific code the documentation supports? (laterality, subsite, acuity, morphology) +- Did I avoid coding any rule-out/probable/possible/suspected condition as confirmed? +- For a normal study, did I check the clinical indication for a codeable underlying condition? +- Did I include incidental findings as secondary, lower confidence? +- Did I avoid Z51 unless aftercare is explicitly documented? PROMPT; $clean_interp = preg_replace('/(Please note:|Electronically Signed by:).*$/si', '', $interp); @@ -179,7 +210,8 @@ function suggestIcd10Codes(Client $guzzle, string $interp, string $cpt): ?array foreach ($body['content'] ?? [] as $block) { if (($block['type'] ?? '') === 'tool_use' && ($block['name'] ?? '') === 'submit_diagnosis_codes') { - return $block['input']['codes'] ?? []; + error_log("returning " . count($block['input']['codes'] ?? []) . " codes"); + return $block['input']['codes'] ?? []; } } From 164469c5f2126610502040b86ba78b2cfdb2384f Mon Sep 17 00:00:00 2001 From: stephen waite Date: Fri, 15 May 2026 17:23:03 -0400 Subject: [PATCH 32/78] remove debug --- php/rri/reads.php | 1 - 1 file changed, 1 deletion(-) diff --git a/php/rri/reads.php b/php/rri/reads.php index c6f6fa50..7ba7a54a 100644 --- a/php/rri/reads.php +++ b/php/rri/reads.php @@ -210,7 +210,6 @@ function suggestIcd10Codes(Client $guzzle, string $interp, string $cpt): ?array foreach ($body['content'] ?? [] as $block) { if (($block['type'] ?? '') === 'tool_use' && ($block['name'] ?? '') === 'submit_diagnosis_codes') { - error_log("returning " . count($block['input']['codes'] ?? []) . " codes"); return $block['input']['codes'] ?? []; } } From 386502ceda4d0a7ec32c9d6ce123b4c471f781f9 Mon Sep 17 00:00:00 2001 From: stephen waite Date: Sat, 16 May 2026 15:45:50 -0400 Subject: [PATCH 33/78] over paid out in ef-auth --- rri/posting/hiproa.cob | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/rri/posting/hiproa.cob b/rri/posting/hiproa.cob index 303aedb9..7d7e0841 100644 --- a/rri/posting/hiproa.cob +++ b/rri/posting/hiproa.cob @@ -1365,11 +1365,12 @@ MOVE CORR TEST-DATE TO INPUT-DATE MOVE INPUT-DATE TO EF3 MOVE BPR-16 TO EF-PAYDATE + * NOTE THAT THE CLAIM IS ALREADY PAID OR OVER PAID IF OVERPAY-FLAG = 1 - MOVE "OVERPAY " TO EF-PAYDATE + MOVE "OVERPAY " TO EF-AUTH END-IF IF PAID-FLAG = 1 - MOVE "PAID " TO EF-PAYDATE + MOVE "PAID " TO EF-AUTH END-IF MOVE CLP-1 TO EF4 MOVE SPACE TO ALF8 From 0cd04be41dccb4400fea4400bfb3cff1efb40718 Mon Sep 17 00:00:00 2001 From: stephen waite Date: Wed, 20 May 2026 10:49:54 -0400 Subject: [PATCH 34/78] fix logic g-delete --- rri/collt/zeror001.cob | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/rri/collt/zeror001.cob b/rri/collt/zeror001.cob index 977a8bfa..b133b2e6 100644 --- a/rri/collt/zeror001.cob +++ b/rri/collt/zeror001.cob @@ -98,17 +98,17 @@ GO TO R4. R5. - IF CLAIM-TOT NOT = 0 - IF G-DELETE NOT = "1" - MOVE "1" TO G-DELETE - PERFORM R6 thru r6-exit - end-if - ELSE - IF G-DELETE NOT = SPACE - MOVE SPACE TO G-DELETE - PERFORM R6 thru r6-exit - end-if - END-IF + IF CLAIM-TOT NOT = 0 + IF G-DELETE NOT = SPACE + MOVE SPACE TO G-DELETE + PERFORM R6 THRU R6-EXIT + END-IF + ELSE + IF G-DELETE NOT = "1" + MOVE "1" TO G-DELETE + PERFORM R6 THRU R6-EXIT + END-IF + END-IF IF CLAIM-TOT NOT > 0 PERFORM R7 THRU R7-EXIT From 4bf2d32a7bdf38031962acb6ef519ea4403642df Mon Sep 17 00:00:00 2001 From: stephen waite Date: Wed, 20 May 2026 11:17:07 -0400 Subject: [PATCH 35/78] fix no valid record position --- rri/collt/zeror001.cob | 27 ++++++++++++++++----------- 1 file changed, 16 insertions(+), 11 deletions(-) diff --git a/rri/collt/zeror001.cob b/rri/collt/zeror001.cob index b133b2e6..f9bb93ab 100644 --- a/rri/collt/zeror001.cob +++ b/rri/collt/zeror001.cob @@ -50,6 +50,7 @@ 01 CLAIM-TOT PIC S9(6)V99. 01 GARBACK PIC X(315). + 01 GAR-EOF PIC X VALUE "N". PROCEDURE DIVISION. @@ -58,6 +59,9 @@ open output fileout. R1. + IF GAR-EOF = "Y" + GO TO R99 + END-IF READ GARFILE NEXT AT END GO TO R99. @@ -98,17 +102,17 @@ GO TO R4. R5. - IF CLAIM-TOT NOT = 0 - IF G-DELETE NOT = SPACE - MOVE SPACE TO G-DELETE - PERFORM R6 THRU R6-EXIT - END-IF - ELSE - IF G-DELETE NOT = "1" - MOVE "1" TO G-DELETE - PERFORM R6 THRU R6-EXIT - END-IF - END-IF + IF CLAIM-TOT NOT = 0 + IF G-DELETE NOT = SPACE + MOVE SPACE TO G-DELETE + PERFORM R6 THRU R6-EXIT + END-IF + ELSE + IF G-DELETE NOT = "1" + MOVE "1" TO G-DELETE + PERFORM R6 THRU R6-EXIT + END-IF + END-IF IF CLAIM-TOT NOT > 0 PERFORM R7 THRU R7-EXIT @@ -139,6 +143,7 @@ START GARFILE KEY > G-GARNO INVALID DISPLAY "LAST GARNO? " G-GARNO + MOVE "Y" TO GAR-EOF * ACCEPT OMITTED GO TO R6-exit. From 6ee23087e03d8e1af24abd3df76c4e2bc52c1d60 Mon Sep 17 00:00:00 2001 From: stephen waite Date: Wed, 20 May 2026 12:29:48 -0400 Subject: [PATCH 36/78] GARFILE I-O --- rri/collt/zeror001.cob | 48 +++++++----------------------------------- 1 file changed, 8 insertions(+), 40 deletions(-) diff --git a/rri/collt/zeror001.cob b/rri/collt/zeror001.cob index f9bb93ab..6e0edaed 100644 --- a/rri/collt/zeror001.cob +++ b/rri/collt/zeror001.cob @@ -49,20 +49,16 @@ WORKING-STORAGE SECTION. 01 CLAIM-TOT PIC S9(6)V99. - 01 GARBACK PIC X(315). - 01 GAR-EOF PIC X VALUE "N". PROCEDURE DIVISION. P0. - OPEN INPUT GARFILE CHARCUR PAYCUR. - open output fileout. + OPEN I-O GARFILE + OPEN INPUT CHARCUR PAYCUR. + OPEN OUTPUT FILEOUT. R1. - IF GAR-EOF = "Y" - GO TO R99 - END-IF - READ GARFILE NEXT + READ GARFILE NEXT WITH LOCK AT END GO TO R99. @@ -105,12 +101,12 @@ IF CLAIM-TOT NOT = 0 IF G-DELETE NOT = SPACE MOVE SPACE TO G-DELETE - PERFORM R6 THRU R6-EXIT + REWRITE GARFILE01 END-IF ELSE IF G-DELETE NOT = "1" MOVE "1" TO G-DELETE - PERFORM R6 THRU R6-EXIT + REWRITE GARFILE01 END-IF END-IF @@ -122,39 +118,11 @@ GO TO R1. - R6. - MOVE GARFILE01 TO GARBACK - CLOSE GARFILE - OPEN I-O GARFILE - MOVE GARBACK(1:8) TO G-GARNO - READ GARFILE WITH LOCK - INVALID - DISPLAY "COULD NOT READ GARFILE WITH LOCK" - - END-READ - MOVE GARBACK TO GARFILE01 - * DISPLAY G-GARNO " " G-DELETE " " G-DUNNING - * DISPLAY " " - - REWRITE GARFILE01. - CLOSE GARFILE - OPEN INPUT GARFILE. - MOVE GARBACK(1:8) TO G-GARNO - START GARFILE KEY > G-GARNO - INVALID - DISPLAY "LAST GARNO? " G-GARNO - MOVE "Y" TO GAR-EOF - * ACCEPT OMITTED - GO TO R6-exit. - - R6-exit. - exit. - R7. CLOSE CHARCUR OPEN I-O CHARCUR - MOVE GARBACK(1:8) TO CC-KEY8 + MOVE G-GARNO TO CC-KEY8 MOVE SPACE TO CC-KEY3 START CHARCUR KEY NOT < CHARCUR-KEY invalid @@ -167,7 +135,7 @@ GO TO R7-EXIT END-READ - if cc-key8 not = garback(1:8) go to r7-exit. + if cc-key8 not = G-GARNO go to r7-exit. if cc-assign = "A" go to r7-1. From 9aff35d2aea0b5535c8cc76fd08bae89cb1d4cef Mon Sep 17 00:00:00 2001 From: stephen waite Date: Wed, 20 May 2026 12:46:34 -0400 Subject: [PATCH 37/78] CHARCUR I-O --- rri/collt/zeror001.cob | 19 ++++++------------- 1 file changed, 6 insertions(+), 13 deletions(-) diff --git a/rri/collt/zeror001.cob b/rri/collt/zeror001.cob index 6e0edaed..8456541c 100644 --- a/rri/collt/zeror001.cob +++ b/rri/collt/zeror001.cob @@ -53,8 +53,8 @@ PROCEDURE DIVISION. P0. - OPEN I-O GARFILE - OPEN INPUT CHARCUR PAYCUR. + OPEN I-O GARFILE CHARCUR + OPEN INPUT PAYCUR. OPEN OUTPUT FILEOUT. R1. @@ -99,29 +99,24 @@ R5. IF CLAIM-TOT NOT = 0 - IF G-DELETE NOT = SPACE - MOVE SPACE TO G-DELETE + IF G-DELETE NOT = "1" + MOVE "1" TO G-DELETE REWRITE GARFILE01 END-IF ELSE - IF G-DELETE NOT = "1" - MOVE "1" TO G-DELETE + IF G-DELETE NOT = SPACE + MOVE SPACE TO G-DELETE REWRITE GARFILE01 END-IF END-IF IF CLAIM-TOT NOT > 0 PERFORM R7 THRU R7-EXIT - CLOSE charcur - OPEN INPUT charcur END-IF GO TO R1. R7. - CLOSE CHARCUR - OPEN I-O CHARCUR - MOVE G-GARNO TO CC-KEY8 MOVE SPACE TO CC-KEY3 START CHARCUR KEY NOT < CHARCUR-KEY @@ -136,9 +131,7 @@ END-READ if cc-key8 not = G-GARNO go to r7-exit. - if cc-assign = "A" go to r7-1. - IF CC-date-a = "00000000" go to r7-1. move "00000000" to cc-date-a From a4ac580b790669b08d146f871c765d21da78086b Mon Sep 17 00:00:00 2001 From: stephen waite Date: Wed, 20 May 2026 18:32:45 -0400 Subject: [PATCH 38/78] Fix gdelete logic --- rri/collt/zeror001.cob | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/rri/collt/zeror001.cob b/rri/collt/zeror001.cob index 8456541c..d3863283 100644 --- a/rri/collt/zeror001.cob +++ b/rri/collt/zeror001.cob @@ -98,7 +98,7 @@ GO TO R4. R5. - IF CLAIM-TOT NOT = 0 + IF CLAIM-TOT > 0 IF G-DELETE NOT = "1" MOVE "1" TO G-DELETE REWRITE GARFILE01 From 3a3ec128a687fb7d70346743a30755712b510df9 Mon Sep 17 00:00:00 2001 From: stephen waite Date: Wed, 20 May 2026 18:43:18 -0400 Subject: [PATCH 39/78] debug --- rri/collt/zeror001.cob | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/rri/collt/zeror001.cob b/rri/collt/zeror001.cob index d3863283..112fa1c5 100644 --- a/rri/collt/zeror001.cob +++ b/rri/collt/zeror001.cob @@ -98,6 +98,10 @@ GO TO R4. R5. + IF G-GARNO = "BER1334G" + DISPLAY G-GARNO " CLAIM-TOT=[" CLAIM-TOT "]" + END-IF + IF CLAIM-TOT > 0 IF G-DELETE NOT = "1" MOVE "1" TO G-DELETE From 05833e76981cc945220831ea2fbf1204324d09f2 Mon Sep 17 00:00:00 2001 From: stephen waite Date: Wed, 20 May 2026 18:55:07 -0400 Subject: [PATCH 40/78] remove debug --- rri/collt/zeror001.cob | 4 ---- 1 file changed, 4 deletions(-) diff --git a/rri/collt/zeror001.cob b/rri/collt/zeror001.cob index 112fa1c5..d3863283 100644 --- a/rri/collt/zeror001.cob +++ b/rri/collt/zeror001.cob @@ -98,10 +98,6 @@ GO TO R4. R5. - IF G-GARNO = "BER1334G" - DISPLAY G-GARNO " CLAIM-TOT=[" CLAIM-TOT "]" - END-IF - IF CLAIM-TOT > 0 IF G-DELETE NOT = "1" MOVE "1" TO G-DELETE From f63dfac25cc7bb17ce3a810089c25eff1728048a Mon Sep 17 00:00:00 2001 From: stephen waite Date: Thu, 21 May 2026 12:07:51 -0400 Subject: [PATCH 41/78] chcrr uppercase --- rri/chcrr/upperCase.php | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) create mode 100644 rri/chcrr/upperCase.php diff --git a/rri/chcrr/upperCase.php b/rri/chcrr/upperCase.php new file mode 100644 index 00000000..16233f99 --- /dev/null +++ b/rri/chcrr/upperCase.php @@ -0,0 +1,19 @@ +\n"); + exit(1); +} + +$in = fopen($argv[1], 'r'); +if ($in === false) { + fwrite(STDERR, "Cannot open {$argv[1]}\n"); + exit(1); +} +$out = fopen('output.csv', 'w'); + +while (($line = fgets($in)) !== false) { + fwrite($out, strtoupper($line)); +} + +fclose($in); +fclose($out); \ No newline at end of file From ad9b0e0db7263d82bafaf409bcec6834770e1eb7 Mon Sep 17 00:00:00 2001 From: stephen waite Date: Fri, 29 May 2026 15:12:21 -0400 Subject: [PATCH 42/78] unique isa gs for aggregated remits --- sidw/hip5140.cob | 50 +++++++++++++++++++----------------------------- 1 file changed, 20 insertions(+), 30 deletions(-) diff --git a/sidw/hip5140.cob b/sidw/hip5140.cob index d1e0b337..f8241f34 100644 --- a/sidw/hip5140.cob +++ b/sidw/hip5140.cob @@ -97,37 +97,27 @@ MOVE PARMFILE01 TO PROV-FED. READ PARMFILE AT END GO TO P99. MOVE PARMFILE01 TO PROV-LEG. - - P000. - perform p-read - - IF FI-1 NOT = "ISA" GO TO P000. - MOVE SPACE TO ISA01 - UNSTRING FILEIN01 DELIMITED BY "*" INTO - ISA-0 ISA-1 ISA-2 ISA-3 ISA-4 ISA-5 ISA-6 ISA-7 - ISA-8 ISA-9 ISA-10 ISA-11 ISA-12 ISA-13 - - MOVE FILEIN01 TO SAVE-TAB(1). - - P00. - perform p-read - - IF FI-1 NOT = "GS*" GO TO P00. - MOVE SPACE TO GS01 - UNSTRING FILEIN01 DELIMITED BY "*" INTO - GS-0 GS-1 GS-2 GS-3 GS-4 GS-5 GS-6 - - MOVE FILEIN01 TO SAVE-TAB(2). - - P0. - perform p-read - - IF FI-1 NOT = "ST*" GO TO P0. - - MOVE FILEIN01 TO SAVE-TAB(3). - MOVE 3 TO X. - + PERFORM P-READ. + IF FI-1 = "ISA" + MOVE SPACE TO ISA01 + UNSTRING FILEIN01 DELIMITED BY "*" INTO + ISA-0 ISA-1 ISA-2 ISA-3 ISA-4 ISA-5 ISA-6 ISA-7 + ISA-8 ISA-9 ISA-10 ISA-11 ISA-12 ISA-13 + MOVE FILEIN01 TO SAVE-TAB(1) + GO TO P0 + END-IF. + IF FI-1 = "GS*" + MOVE SPACE TO GS01 + UNSTRING FILEIN01 DELIMITED BY "*" INTO + GS-0 GS-1 GS-2 GS-3 GS-4 GS-5 GS-6 + MOVE FILEIN01 TO SAVE-TAB(2) + GO TO P0 + END-IF. + IF FI-1 NOT = "ST*" GO TO P0. + MOVE FILEIN01 TO SAVE-TAB(3). + MOVE 3 TO X. + P1-2. perform p-read. From 4137698507447508c1094e1dd6cc8c843d36b7bf Mon Sep 17 00:00:00 2001 From: stephen waite Date: Fri, 29 May 2026 15:23:46 -0400 Subject: [PATCH 43/78] fix mtime warning --- bcbsvt/check_x12s.php | 24 +++++++++--------------- 1 file changed, 9 insertions(+), 15 deletions(-) diff --git a/bcbsvt/check_x12s.php b/bcbsvt/check_x12s.php index 3267b1f0..afc6a280 100644 --- a/bcbsvt/check_x12s.php +++ b/bcbsvt/check_x12s.php @@ -17,21 +17,15 @@ $path = '/Home/cms'; -$files = $sftp->rawlist($path, true); -if (!is_array($files)) { - throw new RuntimeException("rawlist failed: " . $sftp->getLastError()); -} +$files = array_filter($files, function ($f, $name) { + return $name !== '.' && $name !== '..' && $f->type !== NET_SFTP_TYPE_DIRECTORY; +}, ARRAY_FILTER_USE_BOTH); + usort($files, fn($a, $b) => $a->mtime <=> $b->mtime); -if (!empty($files)) { - foreach ($files as $file) { - if (!empty($file)) { - $dt_utc = new DateTimeImmutable('@' . $file->mtime); // unix timestamp directly - $date = $dt_utc->setTimezone(new DateTimeZone('America/New_York')); - echo "file: " . $file->filename . " uploaded to 02 on " . - $date->format('Y-m-d h:i:s a') . "\n"; - } - } -} else { - // there's a test directory +foreach ($files as $file) { + $dt_utc = new DateTimeImmutable('@' . $file->mtime); + $date = $dt_utc->setTimezone(new DateTimeZone('America/New_York')); + echo "file: {$file->filename} uploaded to 02 on " + . $date->format('Y-m-d h:i:s a') . "\n"; } From f1c405886623cd124c6bdbab76b2ee0a8fb6b3b5 Mon Sep 17 00:00:00 2001 From: stephen waite Date: Fri, 29 May 2026 15:25:29 -0400 Subject: [PATCH 44/78] fix mtime warning --- bcbsvt/check_x12s.php | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/bcbsvt/check_x12s.php b/bcbsvt/check_x12s.php index afc6a280..acefd2e0 100644 --- a/bcbsvt/check_x12s.php +++ b/bcbsvt/check_x12s.php @@ -16,6 +16,10 @@ }; $path = '/Home/cms'; +$files = $sftp->rawlist($path); +if (!is_array($files)) { + throw new RuntimeException("rawlist failed: " . $sftp->getLastError()); +} $files = array_filter($files, function ($f, $name) { return $name !== '.' && $name !== '..' && $f->type !== NET_SFTP_TYPE_DIRECTORY; From 6c8e5810a19f5150ebe6f712b1307a3e467e480d Mon Sep 17 00:00:00 2001 From: stephen waite Date: Fri, 29 May 2026 15:28:20 -0400 Subject: [PATCH 45/78] debug --- bcbsvt/check_x12s.php | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/bcbsvt/check_x12s.php b/bcbsvt/check_x12s.php index acefd2e0..f98a86f0 100644 --- a/bcbsvt/check_x12s.php +++ b/bcbsvt/check_x12s.php @@ -17,6 +17,10 @@ $path = '/Home/cms'; $files = $sftp->rawlist($path); +foreach ($raw as $name => $entry) { + var_dump($name, $entry); + break; +} if (!is_array($files)) { throw new RuntimeException("rawlist failed: " . $sftp->getLastError()); } From 0b3fd67af62e841b5b3389f39b855c28954bcfcf Mon Sep 17 00:00:00 2001 From: stephen waite Date: Fri, 29 May 2026 15:30:05 -0400 Subject: [PATCH 46/78] claudes fix --- bcbsvt/check_x12s.php | 50 ++++++++++++++++++++++++++----------------- 1 file changed, 30 insertions(+), 20 deletions(-) diff --git a/bcbsvt/check_x12s.php b/bcbsvt/check_x12s.php index f98a86f0..728bdde4 100644 --- a/bcbsvt/check_x12s.php +++ b/bcbsvt/check_x12s.php @@ -1,39 +1,49 @@ setTimeout(300); // 5 minutes instead of default -$sftp->setKeepAlive(30); // Send keep-alive every 30 seconds +$sftp->setTimeout(300); // 5 minutes instead of default +$sftp->setKeepAlive(30); // send keep-alive every 30 seconds + if (!$sftp->login($cms_user, $cms_pass)) { - echo "login failed" . "\n"; + echo "login failed\n"; exit; -}; +} $path = '/Home/cms'; -$files = $sftp->rawlist($path); -foreach ($raw as $name => $entry) { - var_dump($name, $entry); - break; -} -if (!is_array($files)) { +$raw = $sftp->rawlist($path); +if (!is_array($raw)) { throw new RuntimeException("rawlist failed: " . $sftp->getLastError()); } -$files = array_filter($files, function ($f, $name) { - return $name !== '.' && $name !== '..' && $f->type !== NET_SFTP_TYPE_DIRECTORY; -}, ARRAY_FILTER_USE_BOTH); +// read a field whether the entry is an object or an associative array +$prop = function ($entry, $key) { + if (is_object($entry)) return $entry->$key ?? null; + if (is_array($entry)) return $entry[$key] ?? null; + return null; +}; -usort($files, fn($a, $b) => $a->mtime <=> $b->mtime); +$files = []; +foreach ($raw as $name => $entry) { + if ($name === '.' || $name === '..') continue; + if ($prop($entry, 'type') === NET_SFTP_TYPE_DIRECTORY) continue; // 2 + $mtime = $prop($entry, 'mtime'); + if (!$mtime) continue; + $files[] = [ + 'filename' => $prop($entry, 'filename') ?? $name, + 'mtime' => $mtime, + ]; +} + +usort($files, fn($a, $b) => $a['mtime'] <=> $b['mtime']); foreach ($files as $file) { - $dt_utc = new DateTimeImmutable('@' . $file->mtime); + $dt_utc = new DateTimeImmutable('@' . $file['mtime']); $date = $dt_utc->setTimezone(new DateTimeZone('America/New_York')); - echo "file: {$file->filename} uploaded to 02 on " + echo "file: {$file['filename']} uploaded to 02 on " . $date->format('Y-m-d h:i:s a') . "\n"; -} +} \ No newline at end of file From a9cb9fb9cde3f3d79aa4dd2bb9f5e000e6ea38be Mon Sep 17 00:00:00 2001 From: stephen waite Date: Mon, 1 Jun 2026 08:46:29 -0400 Subject: [PATCH 47/78] python update --- python/vtmed_dnl_to_server.py | 1 + python/vtmed_elig.py | 1 + python/vtmed_upl_from_server.py | 1 + 3 files changed, 3 insertions(+) diff --git a/python/vtmed_dnl_to_server.py b/python/vtmed_dnl_to_server.py index 55ca564d..4404e42f 100644 --- a/python/vtmed_dnl_to_server.py +++ b/python/vtmed_dnl_to_server.py @@ -1,3 +1,4 @@ +#!/opt/cms-venvs/vtmed/bin/python3 from playwright.sync_api import sync_playwright import sys import os diff --git a/python/vtmed_elig.py b/python/vtmed_elig.py index 21c5f950..85cf36b7 100644 --- a/python/vtmed_elig.py +++ b/python/vtmed_elig.py @@ -1,3 +1,4 @@ +#!/opt/cms-venvs/vtmed/bin/python3 from playwright.sync_api import sync_playwright import sys import os diff --git a/python/vtmed_upl_from_server.py b/python/vtmed_upl_from_server.py index 3157d6be..584c05d6 100644 --- a/python/vtmed_upl_from_server.py +++ b/python/vtmed_upl_from_server.py @@ -1,3 +1,4 @@ +#!/opt/cms-venvs/vtmed/bin/python3 from playwright.sync_api import sync_playwright import sys import time From 7fa5b5ddeca6b48c178a018f88b0b13e6126645c Mon Sep 17 00:00:00 2001 From: stephen waite Date: Mon, 1 Jun 2026 08:49:23 -0400 Subject: [PATCH 48/78] +x for python scripts --- python/vtmed_dnl_to_server.py | 0 python/vtmed_elig.py | 0 python/vtmed_upl_from_server.py | 0 3 files changed, 0 insertions(+), 0 deletions(-) mode change 100644 => 100755 python/vtmed_dnl_to_server.py mode change 100644 => 100755 python/vtmed_elig.py mode change 100644 => 100755 python/vtmed_upl_from_server.py diff --git a/python/vtmed_dnl_to_server.py b/python/vtmed_dnl_to_server.py old mode 100644 new mode 100755 diff --git a/python/vtmed_elig.py b/python/vtmed_elig.py old mode 100644 new mode 100755 diff --git a/python/vtmed_upl_from_server.py b/python/vtmed_upl_from_server.py old mode 100644 new mode 100755 From 3c147c2e7738bee32d572898153fe9ca1814f12d Mon Sep 17 00:00:00 2001 From: stephen waite Date: Wed, 3 Jun 2026 15:47:58 -0400 Subject: [PATCH 49/78] prompt for specificity --- php/rri/reads.php | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/php/rri/reads.php b/php/rri/reads.php index 7ba7a54a..ce9389d8 100644 --- a/php/rri/reads.php +++ b/php/rri/reads.php @@ -63,6 +63,8 @@ function suggestIcd10Codes(Client $guzzle, string $interp, string $cpt): ?array - description: full code description - confidence: high/medium/low - rationale: one sentence citing the specific finding or indication +- specificity_check: one sentence confirming why a more specific code is not available, + or "n/a" if the code is already maximally specific CODING HIERARCHY — follow in order: @@ -101,6 +103,11 @@ function suggestIcd10Codes(Client $guzzle, string $interp, string $cpt): ?array 5. If IMPRESSION reveals incidental pathology not mentioned in the indication, include it as a secondary suggestion at lower confidence. +6. Never suggest an unspecified code (codes ending in 9, or descriptions containing + "unspecified") when a more specific code is supportable from the report text. + If the text does not support a specific code, omit the finding rather than + falling back to unspecified. + EXAMPLES: EXAMPLE 1 — specific finding in impression: From 5e5bd6fcbbb34ba0f27a93145a70202b5a5349d4 Mon Sep 17 00:00:00 2001 From: stephen waite Date: Wed, 3 Jun 2026 15:51:33 -0400 Subject: [PATCH 50/78] prompt for specificity --- php/rri/reads.php | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/php/rri/reads.php b/php/rri/reads.php index ce9389d8..1d148cf7 100644 --- a/php/rri/reads.php +++ b/php/rri/reads.php @@ -63,8 +63,10 @@ function suggestIcd10Codes(Client $guzzle, string $interp, string $cpt): ?array - description: full code description - confidence: high/medium/low - rationale: one sentence citing the specific finding or indication -- specificity_check: one sentence confirming why a more specific code is not available, - or "n/a" if the code is already maximally specific +- specificity_check: if the code contains "unspecified" in its description or ends in + a 9, you MUST explain here why no specific code is supportable from the report text. + If the code is specific, confirm the exact text that supports the specificity (e.g. + "posterior horn documented in findings"). "n/a" is not acceptable — always cite text. CODING HIERARCHY — follow in order: From 4584eb93bd0bf161a21622592099d203db639ccd Mon Sep 17 00:00:00 2001 From: stephen waite Date: Wed, 3 Jun 2026 15:56:50 -0400 Subject: [PATCH 51/78] prompt meniscus tear table --- php/rri/reads.php | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/php/rri/reads.php b/php/rri/reads.php index 1d148cf7..e965f382 100644 --- a/php/rri/reads.php +++ b/php/rri/reads.php @@ -134,6 +134,18 @@ function suggestIcd10Codes(Client $guzzle, string $interp, string $cpt): ?array INDICATION: Cough IMPRESSION: No acute cardiopulmonary process. Incidental 6mm right lower lobe pulmonary nodule. Correct: R05.9 (Cough) primary, R91.1 (Solitary pulmonary nodule) secondary, lower confidence + +MENISCUS TEAR SPECIFICITY — ICD-10-CM M23.2xx: +- Posterior horn of medial meniscus → M23.221 (right) / M23.222 (left) +- Anterior horn of medial meniscus → M23.211 (right) / M23.212 (left) +- Other medial meniscus (body/NOS) → M23.201 (right) / M23.202 (left) ← last resort only +- Posterior horn of lateral meniscus → M23.261 (right) / M23.262 (left) +- Anterior horn of lateral meniscus → M23.251 (right) / M23.252 (left) +- Other lateral meniscus (body/NOS) → M23.261 (right) / M23.262 (left) +When both posterior horn AND body are documented, code posterior horn as primary +(M23.221/M23.222) and note the body involvement in rationale. Do not use M23.20x +(unspecified) when a location is explicitly stated in the report. + FINAL CHECKS before returning: - Did I pick the most specific code the documentation supports? (laterality, subsite, acuity, morphology) - Did I avoid coding any rule-out/probable/possible/suspected condition as confirmed? From 59e052201ffb63d2754a10a1460d578c9b835985 Mon Sep 17 00:00:00 2001 From: stephen waite Date: Wed, 3 Jun 2026 16:09:52 -0400 Subject: [PATCH 52/78] symptom codes --- php/rri/reads.php | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/php/rri/reads.php b/php/rri/reads.php index e965f382..03277686 100644 --- a/php/rri/reads.php +++ b/php/rri/reads.php @@ -146,6 +146,15 @@ function suggestIcd10Codes(Client $guzzle, string $interp, string $cpt): ?array (M23.221/M23.222) and note the body involvement in rationale. Do not use M23.20x (unspecified) when a location is explicitly stated in the report. +MUCOID DEGENERATION (no discrete tear): +- Meniscus mucoid degeneration without tear → M23.892 (left) / M23.891 (right) + Do NOT use M23.2xx — that family requires a documented tear. +- ACL/ligament mucoid degeneration → M67.862 (left) / M67.861 (right) + +SYMPTOM CODES: +- Only code symptoms explicitly documented in the report or indication. +- Never infer a symptom (e.g. stiffness, swelling) that is not stated. + FINAL CHECKS before returning: - Did I pick the most specific code the documentation supports? (laterality, subsite, acuity, morphology) - Did I avoid coding any rule-out/probable/possible/suspected condition as confirmed? From c948a4c2372c87f0aa104e6c09d7ad562bf7e661 Mon Sep 17 00:00:00 2001 From: stephen waite Date: Wed, 3 Jun 2026 16:15:22 -0400 Subject: [PATCH 53/78] suppress read when ask claude --- php/rri/reads.php | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/php/rri/reads.php b/php/rri/reads.php index 03277686..097e7c97 100644 --- a/php/rri/reads.php +++ b/php/rri/reads.php @@ -413,7 +413,9 @@ function suggestIcd10Codes(Client $guzzle, string $interp, string $cpt): ?array $pdf->ezText($note, 10); $pdf_page_count++; } else { - echo $note . "\n"; + if (!$ask_claude) { + echo $note . "\n"; + } if ($ask_claude && str_contains($coding_display, $rri_cpt)) { $icd10_suggestions = suggestIcd10Codes($guzzle, $interp, $rri_cpt); if ($icd10_suggestions === null) { From 85157d3987cac3aab73e27d6af6bbcb765d94849 Mon Sep 17 00:00:00 2001 From: stephen waite Date: Wed, 3 Jun 2026 17:15:35 -0400 Subject: [PATCH 54/78] prompt for specificity --- php/rri/reads.php | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/php/rri/reads.php b/php/rri/reads.php index 097e7c97..4e44acb0 100644 --- a/php/rri/reads.php +++ b/php/rri/reads.php @@ -154,6 +154,9 @@ function suggestIcd10Codes(Client $guzzle, string $interp, string $cpt): ?array SYMPTOM CODES: - Only code symptoms explicitly documented in the report or indication. - Never infer a symptom (e.g. stiffness, swelling) that is not stated. +- For pain symptoms, use the most anatomically specific pain code available. + Prefer site-specific codes (e.g. M25.562 Pain in left knee, M54.50 Low back pain) + over generic R52 (Pain, unspecified). Only use R52 if no site-specific pain code exists. FINAL CHECKS before returning: - Did I pick the most specific code the documentation supports? (laterality, subsite, acuity, morphology) @@ -205,6 +208,7 @@ function suggestIcd10Codes(Client $guzzle, string $interp, string $cpt): ?array 'description' => ['type' => 'string', 'description' => 'Full code description'], 'confidence' => ['type' => 'string', 'enum' => ['high', 'medium', 'low']], 'rationale' => ['type' => 'string', 'description' => 'One sentence citing the specific finding or indication'], + 'specificity_check' => ['type' => 'string', 'description' => 'Text from report supporting code specificity'], ], 'required' => ['code', 'description', 'confidence', 'rationale'], ], @@ -264,7 +268,9 @@ function suggestIcd10Codes(Client $guzzle, string $interp, string $cpt): ?array if (in_array($status, [429, 529, 500, 502, 503, 504]) && $attempts < $max_attempts - 1) { $attempts++; - sleep(2 ** $attempts); + if ($attempts < $max_attempts) { + sleep(2 ** $attempts); + } continue; } error_log("Claude request failed ($status): $detail"); From 9f56cfa947a96ce6d024e1277fe9b5801d66bf00 Mon Sep 17 00:00:00 2001 From: stephen waite Date: Wed, 3 Jun 2026 17:18:11 -0400 Subject: [PATCH 55/78] bump max_tokens --- php/rri/reads.php | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/php/rri/reads.php b/php/rri/reads.php index 4e44acb0..9a564bb2 100644 --- a/php/rri/reads.php +++ b/php/rri/reads.php @@ -184,7 +184,7 @@ function suggestIcd10Codes(Client $guzzle, string $interp, string $cpt): ?array 'connect_timeout' => 10, 'json' => [ 'model' => 'claude-sonnet-4-6', - 'max_tokens' => 1024, + 'max_tokens' => 2048, 'system' => [ [ 'type' => 'text', From 1973cf3d35af001184f606888c41951f0eb14ec0 Mon Sep 17 00:00:00 2001 From: stephen waite Date: Wed, 3 Jun 2026 17:22:56 -0400 Subject: [PATCH 56/78] check it's a valid code --- php/rri/reads.php | 21 ++++++++++++++++++++- 1 file changed, 20 insertions(+), 1 deletion(-) diff --git a/php/rri/reads.php b/php/rri/reads.php index 9a564bb2..1789f11b 100644 --- a/php/rri/reads.php +++ b/php/rri/reads.php @@ -367,6 +367,14 @@ function suggestIcd10Codes(Client $guzzle, string $interp, string $cpt): ?array $pdf_page_count = 0; + $icd10_valid = []; + $order_file = '/home/sidw/icd10_valid.txt'; + if (is_readable($order_file)) { + foreach (file($order_file, FILE_IGNORE_NEW_LINES | FILE_SKIP_EMPTY_LINES) as $code) { + $icd10_valid[$code] = true; + } + } + foreach ($jsonObj['entry'] as $entry) { $cntr++; $coding_display = $entry['resource']['code']['coding'][0]['display']; @@ -430,8 +438,13 @@ function suggestIcd10Codes(Client $guzzle, string $interp, string $cpt): ?array echo "(no ICD-10 suggestions returned)\n"; } else { foreach ($icd10_suggestions as $s) { + $flag = isValidIcd10Code($s['code'], $icd10_valid) ? '' : ' *** VERIFY — not in current code set ***'; echo sprintf("[%s] %s (%s) — \"%s\"\n", - $s['confidence'], $s['code'], $s['description'], $s['rationale'] + $s['confidence'], + $s['code'], + $s['description'], + $s['rationale'], + $flag ); } } @@ -462,3 +475,9 @@ function suggestIcd10Codes(Client $guzzle, string $interp, string $cpt): ?array echo "No reports added to PDF, nothing saved.\n"; } } + +function isValidIcd10Code(string $code, array $icd10_valid): bool +{ + if (empty($icd10_valid)) return true; // file missing — don't block + return isset($icd10_valid[str_replace('.', '', $code)]); +} \ No newline at end of file From efd5ad38f382168fe209145b3cf57fd54271f319 Mon Sep 17 00:00:00 2001 From: stephen waite Date: Wed, 3 Jun 2026 17:25:53 -0400 Subject: [PATCH 57/78] debug valid icd10 --- php/rri/reads.php | 1 + 1 file changed, 1 insertion(+) diff --git a/php/rri/reads.php b/php/rri/reads.php index 1789f11b..fc4b9759 100644 --- a/php/rri/reads.php +++ b/php/rri/reads.php @@ -374,6 +374,7 @@ function suggestIcd10Codes(Client $guzzle, string $interp, string $cpt): ?array $icd10_valid[$code] = true; } } + error_log("icd10_valid loaded: " . count($icd10_valid) . " codes from $order_file"); foreach ($jsonObj['entry'] as $entry) { $cntr++; From 1e947b63334db94cb6c0e067128a9cc7482fff38 Mon Sep 17 00:00:00 2001 From: stephen waite Date: Wed, 3 Jun 2026 17:30:18 -0400 Subject: [PATCH 58/78] only load icd10s for claude --- php/rri/reads.php | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/php/rri/reads.php b/php/rri/reads.php index fc4b9759..dd15d24f 100644 --- a/php/rri/reads.php +++ b/php/rri/reads.php @@ -369,12 +369,14 @@ function suggestIcd10Codes(Client $guzzle, string $interp, string $cpt): ?array $icd10_valid = []; $order_file = '/home/sidw/icd10_valid.txt'; - if (is_readable($order_file)) { - foreach (file($order_file, FILE_IGNORE_NEW_LINES | FILE_SKIP_EMPTY_LINES) as $code) { - $icd10_valid[$code] = true; + if ($ask_claude) { + if (is_readable($order_file)) { + foreach (file($order_file, FILE_IGNORE_NEW_LINES | FILE_SKIP_EMPTY_LINES) as $code) { + $icd10_valid[$code] = true; + } } + error_log("icd10_valid loaded: " . count($icd10_valid) . " codes from $order_file"); } - error_log("icd10_valid loaded: " . count($icd10_valid) . " codes from $order_file"); foreach ($jsonObj['entry'] as $entry) { $cntr++; From 4586e80bea31254002e91449d9c3e68c39df4c33 Mon Sep 17 00:00:00 2001 From: stephen waite Date: Wed, 3 Jun 2026 17:35:40 -0400 Subject: [PATCH 59/78] debug valid icd10 --- php/rri/reads.php | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/php/rri/reads.php b/php/rri/reads.php index dd15d24f..664683bf 100644 --- a/php/rri/reads.php +++ b/php/rri/reads.php @@ -441,7 +441,9 @@ function suggestIcd10Codes(Client $guzzle, string $interp, string $cpt): ?array echo "(no ICD-10 suggestions returned)\n"; } else { foreach ($icd10_suggestions as $s) { - $flag = isValidIcd10Code($s['code'], $icd10_valid) ? '' : ' *** VERIFY — not in current code set ***'; + $valid = isValidIcd10Code($s['code'], $icd10_valid); + error_log("checking {$s['code']} -> " . ($valid ? 'valid' : 'INVALID') . " (set size: " . count($icd10_valid) . ")"); + $flag = $valid ? '' : ' *** VERIFY — not in current code set ***'; echo sprintf("[%s] %s (%s) — \"%s\"\n", $s['confidence'], $s['code'], From d26c7a7372dd9d5524ae1926d1bc7abc262e6cc5 Mon Sep 17 00:00:00 2001 From: stephen waite Date: Wed, 3 Jun 2026 17:38:37 -0400 Subject: [PATCH 60/78] debug valid icd10 --- php/rri/reads.php | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/php/rri/reads.php b/php/rri/reads.php index 664683bf..05b518bd 100644 --- a/php/rri/reads.php +++ b/php/rri/reads.php @@ -375,7 +375,7 @@ function suggestIcd10Codes(Client $guzzle, string $interp, string $cpt): ?array $icd10_valid[$code] = true; } } - error_log("icd10_valid loaded: " . count($icd10_valid) . " codes from $order_file"); + //error_log("icd10_valid loaded: " . count($icd10_valid) . " codes from $order_file"); } foreach ($jsonObj['entry'] as $entry) { @@ -442,9 +442,8 @@ function suggestIcd10Codes(Client $guzzle, string $interp, string $cpt): ?array } else { foreach ($icd10_suggestions as $s) { $valid = isValidIcd10Code($s['code'], $icd10_valid); - error_log("checking {$s['code']} -> " . ($valid ? 'valid' : 'INVALID') . " (set size: " . count($icd10_valid) . ")"); $flag = $valid ? '' : ' *** VERIFY — not in current code set ***'; - echo sprintf("[%s] %s (%s) — \"%s\"\n", + echo sprintf("[%s] %s (%s) — \"%s\"%s\n", $s['confidence'], $s['code'], $s['description'], From ff29b29e4d2ab75f33b9f218b6847df1771d5191 Mon Sep 17 00:00:00 2001 From: stephen waite Date: Fri, 5 Jun 2026 10:00:39 -0400 Subject: [PATCH 61/78] move g1 auth capture to svc loop --- rri/posting/hiproa.cob | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/rri/posting/hiproa.cob b/rri/posting/hiproa.cob index 7d7e0841..52024b2d 100644 --- a/rri/posting/hiproa.cob +++ b/rri/posting/hiproa.cob @@ -673,14 +673,6 @@ GO TO P1-NM1 END-IF - IF F1 = "REF" AND F2 = "*G1*" - MOVE SPACE TO REF01 - UNSTRING FILEIN01 DELIMITED BY "*" INTO - REF-0 REF-1 REF-2 - MOVE REF-2 TO CLP-AUTH - GO TO P1-NM1 - END-IF - GO TO P1-NM1. P1-SVC-LOOP. @@ -755,6 +747,13 @@ MOVE DTM-2 TO SVC-DATE(SVC-CNTR) END-IF + IF F1 = "REF" AND F2 = "*G1*" + MOVE SPACE TO REF01 + UNSTRING FILEIN01 DELIMITED BY "*" INTO + REF-0 REF-1 REF-2 + MOVE REF-2 TO CLP-AUTH + END-IF + GO TO P1-SVC-LOOP. * VALIDATE INCOMING DATA AGAINST CHARGES @@ -1365,7 +1364,8 @@ MOVE CORR TEST-DATE TO INPUT-DATE MOVE INPUT-DATE TO EF3 MOVE BPR-16 TO EF-PAYDATE - * NOTE THAT THE CLAIM IS ALREADY PAID OR OVER PAID + * NOTE THAT THE CLAIM IS ALREADY PAID OR OVER PAID + * err-178 NEEDS DATES IN THE EF-PAYDATE FIELD IF OVERPAY-FLAG = 1 MOVE "OVERPAY " TO EF-AUTH END-IF From 7d574c7751c0f80d396832c7e6945abe01145fd8 Mon Sep 17 00:00:00 2001 From: stephen waite Date: Fri, 5 Jun 2026 10:16:16 -0400 Subject: [PATCH 62/78] REVERT move g1 auth capture to svc loop --- rri/posting/hiproa.cob | 15 ++++++++------- 1 file changed, 8 insertions(+), 7 deletions(-) diff --git a/rri/posting/hiproa.cob b/rri/posting/hiproa.cob index 52024b2d..675d24d7 100644 --- a/rri/posting/hiproa.cob +++ b/rri/posting/hiproa.cob @@ -673,6 +673,14 @@ GO TO P1-NM1 END-IF + IF F1 = "REF" AND F2 = "*G1*" + MOVE SPACE TO REF01 + UNSTRING FILEIN01 DELIMITED BY "*" INTO + REF-0 REF-1 REF-2 + MOVE REF-2 TO CLP-AUTH + GO TO P1-NM1 + END-IF + GO TO P1-NM1. P1-SVC-LOOP. @@ -747,13 +755,6 @@ MOVE DTM-2 TO SVC-DATE(SVC-CNTR) END-IF - IF F1 = "REF" AND F2 = "*G1*" - MOVE SPACE TO REF01 - UNSTRING FILEIN01 DELIMITED BY "*" INTO - REF-0 REF-1 REF-2 - MOVE REF-2 TO CLP-AUTH - END-IF - GO TO P1-SVC-LOOP. * VALIDATE INCOMING DATA AGAINST CHARGES From 833cf582f15a5be6463f8a24320b43316e563fef Mon Sep 17 00:00:00 2001 From: stephen waite Date: Fri, 5 Jun 2026 10:39:39 -0400 Subject: [PATCH 63/78] debug --- rri/posting/hiproa.cob | 2 ++ 1 file changed, 2 insertions(+) diff --git a/rri/posting/hiproa.cob b/rri/posting/hiproa.cob index 675d24d7..cebbf0f2 100644 --- a/rri/posting/hiproa.cob +++ b/rri/posting/hiproa.cob @@ -677,6 +677,7 @@ MOVE SPACE TO REF01 UNSTRING FILEIN01 DELIMITED BY "*" INTO REF-0 REF-1 REF-2 + DISPLAY ">>> REF-2=[" REF-2 "]" MOVE REF-2 TO CLP-AUTH GO TO P1-NM1 END-IF @@ -1310,6 +1311,7 @@ MOVE "MISMATCH " TO EF2 END-IF MOVE CLP-AUTH TO EF-AUTH + DISPLAY ">>> CLP-AUTH=[" CLP-AUTH "] EF-AUTH=[" EF-AUTH "]" MOVE SPACE TO ERROR-FILE01 WRITE ERROR-FILE01 FROM ERR01 From 4d39ed6a13967fbd17f7867dd2f93dee6e7e8a18 Mon Sep 17 00:00:00 2001 From: stephen waite Date: Fri, 5 Jun 2026 10:41:44 -0400 Subject: [PATCH 64/78] debug --- rri/posting/hiproa.cob | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/rri/posting/hiproa.cob b/rri/posting/hiproa.cob index cebbf0f2..236d948e 100644 --- a/rri/posting/hiproa.cob +++ b/rri/posting/hiproa.cob @@ -677,7 +677,8 @@ MOVE SPACE TO REF01 UNSTRING FILEIN01 DELIMITED BY "*" INTO REF-0 REF-1 REF-2 - DISPLAY ">>> REF-2=[" REF-2 "]" + DISPLAY ">>> REF-2=[" REF-2 "]" + ACCEPT OMITTED MOVE REF-2 TO CLP-AUTH GO TO P1-NM1 END-IF @@ -1312,6 +1313,7 @@ END-IF MOVE CLP-AUTH TO EF-AUTH DISPLAY ">>> CLP-AUTH=[" CLP-AUTH "] EF-AUTH=[" EF-AUTH "]" + ACCEPT OMITTED MOVE SPACE TO ERROR-FILE01 WRITE ERROR-FILE01 FROM ERR01 From 3250e029ff5ca6e23cc0476e9ebcade8171a7e99 Mon Sep 17 00:00:00 2001 From: stephen waite Date: Fri, 5 Jun 2026 11:01:33 -0400 Subject: [PATCH 65/78] debug --- rri/posting/hiproa.cob | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/rri/posting/hiproa.cob b/rri/posting/hiproa.cob index 236d948e..cde62425 100644 --- a/rri/posting/hiproa.cob +++ b/rri/posting/hiproa.cob @@ -622,6 +622,7 @@ MOVE 0 TO LQ-CNTR MOVE 0 TO SVC-TOTAL MOVE 0 TO OVERPAY-FLAG PAID-FLAG MISMATCH-FLAG + DISPLAY ">>> CLP-2 RESET" MOVE SPACE TO CLP-AUTH MOVE ALL ZEROES TO ALLW-TAB01. @@ -677,9 +678,9 @@ MOVE SPACE TO REF01 UNSTRING FILEIN01 DELIMITED BY "*" INTO REF-0 REF-1 REF-2 - DISPLAY ">>> REF-2=[" REF-2 "]" ACCEPT OMITTED MOVE REF-2 TO CLP-AUTH + DISPLAY ">>> CAPTURED CLP-AUTH=[" CLP-AUTH "]" GO TO P1-NM1 END-IF @@ -1312,7 +1313,8 @@ MOVE "MISMATCH " TO EF2 END-IF MOVE CLP-AUTH TO EF-AUTH - DISPLAY ">>> CLP-AUTH=[" CLP-AUTH "] EF-AUTH=[" EF-AUTH "]" + DISPLAY ">>> AT WRITE CLP-AUTH=[" CLP-AUTH "] + EF-AUTH=[" EF-AUTH "]" ACCEPT OMITTED MOVE SPACE TO ERROR-FILE01 WRITE ERROR-FILE01 FROM ERR01 From c1f40e513570d01983f428439868d6b054499c52 Mon Sep 17 00:00:00 2001 From: stephen waite Date: Fri, 5 Jun 2026 11:05:27 -0400 Subject: [PATCH 66/78] debug --- rri/posting/hiproa.cob | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/rri/posting/hiproa.cob b/rri/posting/hiproa.cob index cde62425..769d1288 100644 --- a/rri/posting/hiproa.cob +++ b/rri/posting/hiproa.cob @@ -1313,8 +1313,8 @@ MOVE "MISMATCH " TO EF2 END-IF MOVE CLP-AUTH TO EF-AUTH - DISPLAY ">>> AT WRITE CLP-AUTH=[" CLP-AUTH "] - EF-AUTH=[" EF-AUTH "]" + DISPLAY ">>> AT WRITE CLP-AUTH=[" CLP-AUTH "] " + "EF-AUTH=[" EF-AUTH "]" ACCEPT OMITTED MOVE SPACE TO ERROR-FILE01 WRITE ERROR-FILE01 FROM ERR01 From 03dde4650be637221455ebd31f087d5a05d786ec Mon Sep 17 00:00:00 2001 From: stephen waite Date: Fri, 5 Jun 2026 11:26:54 -0400 Subject: [PATCH 67/78] SAVE-AUTH --- rri/posting/hiproa.cob | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/rri/posting/hiproa.cob b/rri/posting/hiproa.cob index 769d1288..6b4f3433 100644 --- a/rri/posting/hiproa.cob +++ b/rri/posting/hiproa.cob @@ -398,6 +398,7 @@ 01 SVC-TOTAL PIC S9(5)V99 VALUE 0. 01 PRIOR-TOT PIC S9(7)V99 VALUE 0. 01 CLP-AUTH PIC X(20) VALUE SPACE. + 01 SAVE-AUTH PIC X(20) VALUE SPACE. PROCEDURE DIVISION. 0005-START. @@ -622,7 +623,6 @@ MOVE 0 TO LQ-CNTR MOVE 0 TO SVC-TOTAL MOVE 0 TO OVERPAY-FLAG PAID-FLAG MISMATCH-FLAG - DISPLAY ">>> CLP-2 RESET" MOVE SPACE TO CLP-AUTH MOVE ALL ZEROES TO ALLW-TAB01. @@ -640,6 +640,7 @@ IF F1 = "SE*" MOVE FILEIN01 TO SAVEFILE01 + MOVE CLP-AUTH TO SAVE-AUTH GO TO P2-SVC-LOOP END-IF @@ -680,7 +681,6 @@ REF-0 REF-1 REF-2 ACCEPT OMITTED MOVE REF-2 TO CLP-AUTH - DISPLAY ">>> CAPTURED CLP-AUTH=[" CLP-AUTH "]" GO TO P1-NM1 END-IF @@ -696,6 +696,7 @@ IF F1 = "CLP" OR "SE*" MOVE FILEIN01 TO SAVEFILE01 + MOVE CLP-AUTH TO SAVE-AUTH GO TO P2-SVC-LOOP END-IF. @@ -1312,10 +1313,8 @@ IF MISMATCH-FLAG = 1 MOVE "MISMATCH " TO EF2 END-IF - MOVE CLP-AUTH TO EF-AUTH - DISPLAY ">>> AT WRITE CLP-AUTH=[" CLP-AUTH "] " - "EF-AUTH=[" EF-AUTH "]" ACCEPT OMITTED + MOVE SAVE-AUTH TO EF-AUTH MOVE SPACE TO ERROR-FILE01 WRITE ERROR-FILE01 FROM ERR01 From fa198266a9a5cbffe24542c547466710e4a649a0 Mon Sep 17 00:00:00 2001 From: stephen waite Date: Fri, 5 Jun 2026 11:28:23 -0400 Subject: [PATCH 68/78] remove accept omitted --- rri/posting/hiproa.cob | 2 -- 1 file changed, 2 deletions(-) diff --git a/rri/posting/hiproa.cob b/rri/posting/hiproa.cob index 6b4f3433..a055940a 100644 --- a/rri/posting/hiproa.cob +++ b/rri/posting/hiproa.cob @@ -679,7 +679,6 @@ MOVE SPACE TO REF01 UNSTRING FILEIN01 DELIMITED BY "*" INTO REF-0 REF-1 REF-2 - ACCEPT OMITTED MOVE REF-2 TO CLP-AUTH GO TO P1-NM1 END-IF @@ -1313,7 +1312,6 @@ IF MISMATCH-FLAG = 1 MOVE "MISMATCH " TO EF2 END-IF - ACCEPT OMITTED MOVE SAVE-AUTH TO EF-AUTH MOVE SPACE TO ERROR-FILE01 WRITE ERROR-FILE01 FROM ERR01 From bc8c02063694791da0bfe19bbd97fda13f10d578 Mon Sep 17 00:00:00 2001 From: stephen waite Date: Fri, 5 Jun 2026 11:31:12 -0400 Subject: [PATCH 69/78] debug --- rri/posting/hiproa.cob | 2 ++ 1 file changed, 2 insertions(+) diff --git a/rri/posting/hiproa.cob b/rri/posting/hiproa.cob index a055940a..44815444 100644 --- a/rri/posting/hiproa.cob +++ b/rri/posting/hiproa.cob @@ -1312,6 +1312,8 @@ IF MISMATCH-FLAG = 1 MOVE "MISMATCH " TO EF2 END-IF + DISPLAY "P1-NO-SVC SAVE-AUTH " SAVE-AUTH + ACCEPT OMITTED MOVE SAVE-AUTH TO EF-AUTH MOVE SPACE TO ERROR-FILE01 WRITE ERROR-FILE01 FROM ERR01 From daf19e16ff2ecd2e2e03a14218f90297add509d8 Mon Sep 17 00:00:00 2001 From: stephen waite Date: Fri, 5 Jun 2026 11:37:54 -0400 Subject: [PATCH 70/78] debug --- rri/posting/hiproa.cob | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/rri/posting/hiproa.cob b/rri/posting/hiproa.cob index 44815444..d3e7822a 100644 --- a/rri/posting/hiproa.cob +++ b/rri/posting/hiproa.cob @@ -1312,9 +1312,6 @@ IF MISMATCH-FLAG = 1 MOVE "MISMATCH " TO EF2 END-IF - DISPLAY "P1-NO-SVC SAVE-AUTH " SAVE-AUTH - ACCEPT OMITTED - MOVE SAVE-AUTH TO EF-AUTH MOVE SPACE TO ERROR-FILE01 WRITE ERROR-FILE01 FROM ERR01 @@ -1374,9 +1371,10 @@ * err-178 NEEDS DATES IN THE EF-PAYDATE FIELD IF OVERPAY-FLAG = 1 MOVE "OVERPAY " TO EF-AUTH - END-IF - IF PAID-FLAG = 1 + ELSE IF PAID-FLAG = 1 MOVE "PAID " TO EF-AUTH + ELSE + MOVE SAVE-AUTH TO EF-AUTH END-IF MOVE CLP-1 TO EF4 MOVE SPACE TO ALF8 From 5171b7c7bc4724877f66131dd44cd6918abf49bb Mon Sep 17 00:00:00 2001 From: stephen waite Date: Sat, 6 Jun 2026 09:58:38 -0400 Subject: [PATCH 71/78] use clp-1 for garno invalid read --- rri/posting/hiproa.cob | 2 ++ 1 file changed, 2 insertions(+) diff --git a/rri/posting/hiproa.cob b/rri/posting/hiproa.cob index d3e7822a..d32ac51f 100644 --- a/rri/posting/hiproa.cob +++ b/rri/posting/hiproa.cob @@ -781,6 +781,8 @@ MOVE CLP-1 TO G-GARNO READ GARFILE INVALID + MOVE SPACE TO G-GARNAME + MOVE CLP-1 TO G-GARNO GO TO P3-SVC-LOOP END-READ From ddcbf0d1bfc34d2cb1a225550c67ebbe0555a5a5 Mon Sep 17 00:00:00 2001 From: stephen waite Date: Sat, 6 Jun 2026 11:18:35 -0400 Subject: [PATCH 72/78] nsa flag and co-131 --- rri/posting/hiproa.cob | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/rri/posting/hiproa.cob b/rri/posting/hiproa.cob index d32ac51f..590e9104 100644 --- a/rri/posting/hiproa.cob +++ b/rri/posting/hiproa.cob @@ -378,14 +378,14 @@ 01 CAS-CODE-CHECK PIC X(5). 88 INS-REDUCE-CODE VALUE "A1 " "A2 " "B6 " "B9 " "B10 " "B13 " "24 " "42 " - "45 " "59 " "131 " "253 " "P12 " "P23 " "P24 ". + "45 " "59 " "253 " "P12 " "P23 " "P24 ". 88 DUMP50-ANY-CODE VALUE "50 " "109 " "167 " "B13 ". 88 DUMP50-CO-CODE VALUE "4 " "7 " "11 " "16 " "18 " "22 " "29 " "31 " "55 " "58 " "95 " - "96 " "97 " "146 " "151 " "197 " "222 " "226 " - "234 " "242 " "252 " "273 " "284 " "288 " "A1 " - "B11 " "B20 " "P12 " "P14 ". + "96 " "97 " "131 " "146 " "151 " "197 " "222 " + "226 " "234 " "242 " "252 " "273 " "284 " "288 " + "A1 " "B11 " "B20 " "P12 " "P14 ". 88 DUMP50-OA-CODE VALUE "18 " "95 " "226 " "A1 " "B11 " "B13 " "P8 ". 88 DUMP50-PI-CODE VALUE "5 " "11 " "96 " "97 " @@ -399,6 +399,7 @@ 01 PRIOR-TOT PIC S9(7)V99 VALUE 0. 01 CLP-AUTH PIC X(20) VALUE SPACE. 01 SAVE-AUTH PIC X(20) VALUE SPACE. + 01 NSA-FLAG PIC 9 VALUE 0. PROCEDURE DIVISION. 0005-START. @@ -859,6 +860,9 @@ MULTIPLY AMOUNT-X BY -1 GIVING PD-AMOUNT. PERFORM NO-SURPRISE. + IF NSA-FLAG = 1 + GO TO P5-SVC-LOOP-EXIT + END-IF MOVE FOUND-KEY(X) TO CHARCUR-KEY READ CHARCUR @@ -2025,6 +2029,7 @@ * GO TO P1-CLP. NO-SURPRISE. + MOVE 0 TO NSA-FLAG PERFORM VARYING Y FROM 1 BY 1 UNTIL Y > LQ-CNTR IF LQ-SVC(Y) = X MOVE SPACE TO FILEIN01 @@ -2039,6 +2044,7 @@ invalid continue end-read + MOVE 1 TO NSA-FLAG PERFORM P1-LOST-SVC end-if end-if From edb7b84f3dab72ebf03d0c08bcb676f732204b7e Mon Sep 17 00:00:00 2001 From: stephen waite Date: Sat, 6 Jun 2026 15:48:34 -0400 Subject: [PATCH 73/78] medfile from csv --- rri/fees/med007.cob | 21 +++++++++++++-------- 1 file changed, 13 insertions(+), 8 deletions(-) diff --git a/rri/fees/med007.cob b/rri/fees/med007.cob index 83bcb5c0..cd8d9e30 100644 --- a/rri/fees/med007.cob +++ b/rri/fees/med007.cob @@ -16,14 +16,7 @@ DATA DIVISION. FILE SECTION. FD FILEIN. - 01 FILEIN01. - 02 FI-1 PIC X. - 02 FILLER PIC X(5). - 02 FI-2 PIC X(5). - 02 FILLER PIC X(15). - 02 FI-3 PIC XX. - 02 FILLER PIC X(17). - 02 FI-4 PIC X(7). + 01 FILEIN01 PIC X(80). FD MEDFILE2020. 01 MEDFILE202001. 02 MED-KEY. @@ -43,6 +36,11 @@ 01 CENTX PIC XX. 01 RIGHT-4 pic X(4) JUST RIGHT. 01 X-AMT PIC 9(4)V99. + 01 WS-FILEIN. + 05 FI-1 PIC X. + 05 FI-2 PIC X(5). + 05 FI-3 PIC XX. + 05 FI-4 PIC X(7). PROCEDURE DIVISION. P0. OPEN OUTPUT MEDFILE2020 @@ -54,6 +52,13 @@ READ FILEIN AT END GO TO P99 END-READ + INITIALIZE WS-FILEIN + UNSTRING FILEIN01 DELIMITED BY "," + INTO FI-1 + FI-2 + FI-3 + FI-4 + END-UNSTRING. MOVE FI-4 TO FI-AMT MOVE FI-3 TO FI-MOD From 6943c24669b4dd76455d26b46f9f1bc18e157b41 Mon Sep 17 00:00:00 2001 From: stephen waite Date: Sat, 6 Jun 2026 16:15:04 -0400 Subject: [PATCH 74/78] 197 report --- rri/reports/adj197.cob | 195 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 195 insertions(+) create mode 100644 rri/reports/adj197.cob diff --git a/rri/reports/adj197.cob b/rri/reports/adj197.cob new file mode 100644 index 00000000..e646633a --- /dev/null +++ b/rri/reports/adj197.cob @@ -0,0 +1,195 @@ + * @package cms + * @link http://www.cmsvt.com + * @author s waite + * @copyright Copyright (c) 2026 cms + * @license https://github.com/openemr/openemr/blob/master/LICENSE GNU General Public License 3 + IDENTIFICATION DIVISION. + PROGRAM-ID. adj197. + * + * Reads CHARCUR charges with CC-PAYCODE = "197" (pending ins). + * For each, sums PAYCUR payments for the same account+claim + * (payments stored signed-negative), derives the balance due + * (CC-AMOUNT + TOTALPAY), looks up the Medicare allowed amount + * from MEDFILE2020 keyed by CC-PROC1, and reports the remaining + * amount: allowed less what has already been paid. Because + * payments are stored signed-negative: + * ADJ-AMT = MED-AMT - (-TOTALPAY) = MED-AMT + TOTALPAY + * Positive = still owed up to the allowed amount; negative = paid + * past the allowed (nothing to collect / possible refund). + * Report only. Posts nothing. + * + ENVIRONMENT DIVISION. + INPUT-OUTPUT SECTION. + FILE-CONTROL. + SELECT GARFILE ASSIGN TO "S30" ORGANIZATION IS INDEXED + ACCESS MODE IS DYNAMIC RECORD KEY IS G-GARNO + ALTERNATE RECORD KEY IS G-ACCT WITH DUPLICATES + LOCK MODE MANUAL. + SELECT CHARCUR ASSIGN TO "S35" ORGANIZATION IS INDEXED + ACCESS MODE IS DYNAMIC RECORD KEY IS CHARCUR-KEY + ALTERNATE RECORD KEY IS CC-PAYCODE WITH DUPLICATES + LOCK MODE MANUAL. + SELECT PAYCUR ASSIGN TO "S40" ORGANIZATION IS INDEXED + ACCESS MODE IS DYNAMIC RECORD KEY IS PAYCUR-KEY + LOCK MODE MANUAL. + SELECT MEDFILE2020 ASSIGN TO "S45" ORGANIZATION IS INDEXED + ACCESS MODE IS DYNAMIC RECORD KEY IS MED-KEY + LOCK MODE MANUAL. + SELECT REPORTF ASSIGN TO "S50" + ORGANIZATION IS LINE SEQUENTIAL. + DATA DIVISION. + FILE SECTION. + FD GARFILE. + COPY GARFILE.CPY. + FD CHARCUR. + COPY CHARCUR.CPY. + FD PAYCUR. + COPY PAYCUR.CPY. + FD MEDFILE2020. + 01 MEDFILE202001. + 02 MED-KEY. + 03 MED-KEY1 PIC X(5). + 03 MED-KEY2 PIC XX. + 02 MED-AMT PIC 9(4)V99. + FD REPORTF. + 01 REPORT-REC PIC X(132). + WORKING-STORAGE SECTION. + 01 WS-WORK. + 05 TOTALPAY PIC S9(7)V99 VALUE 0. + 05 BALANCE PIC S9(7)V99 VALUE 0. + 05 ADJ-AMT PIC S9(7)V99 VALUE 0. + 05 TOT-ADJ PIC S9(9)V99 VALUE 0. + 05 WS-NAME PIC X(25) VALUE SPACES. + 01 WS-COUNTS. + 05 CNT-197 PIC 9(7) VALUE 0. + 05 CNT-RPT PIC 9(7) VALUE 0. + 05 CNT-NOBAL PIC 9(7) VALUE 0. + 05 CNT-NOFEE PIC 9(7) VALUE 0. + 01 HDR-1. + 05 FILLER PIC X(45) VALUE + "PENDING INS 197 - ADJUSTMENT TO MED ALLOWED". + 01 HDR-2. + 05 FILLER PIC X(2) VALUE SPACES. + 05 FILLER PIC X(10) VALUE "ACCOUNT". + 05 FILLER PIC X(8) VALUE "CLAIM". + 05 FILLER PIC X(9) VALUE "PROC". + 05 FILLER PIC X(11) VALUE " CHARGE". + 05 FILLER PIC X(12) VALUE " PAID". + 05 FILLER PIC X(12) VALUE " BALANCE". + 05 FILLER PIC X(11) VALUE " ALLOWED". + 05 FILLER PIC X(12) VALUE " ADJ". + 05 FILLER PIC X(6) VALUE "NAME". + 01 DET-LINE. + 05 FILLER PIC X(2) VALUE SPACES. + 05 DL-ACCT PIC X(8). + 05 FILLER PIC X(2) VALUE SPACES. + 05 DL-CLAIM PIC X(6). + 05 FILLER PIC X(2) VALUE SPACES. + 05 DL-PROC PIC X(7). + 05 FILLER PIC X(2) VALUE SPACES. + 05 DL-CHARGE PIC ZZ,ZZ9.99. + 05 FILLER PIC X(2) VALUE SPACES. + 05 DL-PAID PIC -ZZ,ZZ9.99. + 05 FILLER PIC X(2) VALUE SPACES. + 05 DL-BAL PIC -ZZ,ZZ9.99. + 05 FILLER PIC X(2) VALUE SPACES. + 05 DL-ALLOW PIC ZZ,ZZ9.99. + 05 FILLER PIC X(2) VALUE SPACES. + 05 DL-ADJ PIC -ZZ,ZZ9.99. + 05 FILLER PIC X(2) VALUE SPACES. + 05 DL-NAME PIC X(25). + 01 TOT-LINE. + 05 FILLER PIC X(20) VALUE "TOTAL ADJUSTMENT: ". + 05 TL-ADJ PIC -Z,ZZZ,ZZ9.99. + PROCEDURE DIVISION. + MAIN. + OPEN INPUT GARFILE CHARCUR PAYCUR MEDFILE2020. + OPEN OUTPUT REPORTF. + WRITE REPORT-REC FROM HDR-1. + MOVE SPACES TO REPORT-REC. + WRITE REPORT-REC. + WRITE REPORT-REC FROM HDR-2. + MOVE "197" TO CC-PAYCODE. + START CHARCUR KEY NOT < CC-PAYCODE + INVALID KEY + DISPLAY "NO 197 CHARGES FOUND" + GO TO DONE + END-START. + NEXT-CHG. + READ CHARCUR NEXT AT END GO TO DONE END-READ. + IF CC-PAYCODE NOT = "197" GO TO DONE. + ADD 1 TO CNT-197. + * + * sum payments for this account + claim + * + MOVE 0 TO TOTALPAY. + MOVE CC-KEY8 TO PC-KEY8. + MOVE LOW-VALUES TO PC-KEY3. + START PAYCUR KEY NOT < PAYCUR-KEY + INVALID KEY GO TO EVAL + END-START. + PAY-LOOP. + READ PAYCUR NEXT AT END GO TO EVAL END-READ. + IF PC-KEY8 NOT = CC-KEY8 GO TO EVAL. + IF PC-CLAIM NOT = CC-CLAIM GO TO PAY-LOOP. + ADD PC-AMOUNT TO TOTALPAY. + GO TO PAY-LOOP. + EVAL. + COMPUTE BALANCE = CC-AMOUNT + TOTALPAY. + IF BALANCE NOT > 0 + ADD 1 TO CNT-NOBAL + GO TO NEXT-CHG. + * + * look up Medicare allowed by CC-PROC1 (cpt + modifier) + * + MOVE CC-PROC1 TO MED-KEY. + READ MEDFILE2020 + INVALID KEY + ADD 1 TO CNT-NOFEE + PERFORM WRITE-NOFEE + GO TO NEXT-CHG + END-READ. + COMPUTE ADJ-AMT = MED-AMT - (0 - TOTALPAY). + ADD 1 TO CNT-RPT. + ADD ADJ-AMT TO TOT-ADJ. + PERFORM WRITE-DETAIL. + GO TO NEXT-CHG. + WRITE-DETAIL. + MOVE SPACES TO WS-NAME. + MOVE CC-KEY8 TO G-GARNO. + READ GARFILE + INVALID KEY MOVE SPACES TO WS-NAME + NOT INVALID KEY MOVE G-GARNAME TO WS-NAME + END-READ. + MOVE CC-KEY8 TO DL-ACCT. + MOVE CC-CLAIM TO DL-CLAIM. + MOVE CC-PROC1 TO DL-PROC. + MOVE CC-AMOUNT TO DL-CHARGE. + MOVE TOTALPAY TO DL-PAID. + MOVE BALANCE TO DL-BAL. + MOVE MED-AMT TO DL-ALLOW. + MOVE ADJ-AMT TO DL-ADJ. + MOVE WS-NAME TO DL-NAME. + WRITE REPORT-REC FROM DET-LINE. + WRITE-NOFEE. + MOVE CC-KEY8 TO DL-ACCT. + MOVE CC-CLAIM TO DL-CLAIM. + MOVE CC-PROC1 TO DL-PROC. + MOVE CC-AMOUNT TO DL-CHARGE. + MOVE TOTALPAY TO DL-PAID. + MOVE BALANCE TO DL-BAL. + MOVE 0 TO DL-ALLOW. + MOVE 0 TO DL-ADJ. + MOVE "*** NO FEE SCHEDULE ENTRY" TO DL-NAME. + WRITE REPORT-REC FROM DET-LINE. + DONE. + MOVE SPACES TO REPORT-REC. + WRITE REPORT-REC. + MOVE TOT-ADJ TO TL-ADJ. + WRITE REPORT-REC FROM TOT-LINE. + DISPLAY "197 CHARGES READ: " CNT-197. + DISPLAY "REPORTED (ADJ): " CNT-RPT. + DISPLAY "NO BALANCE DUE: " CNT-NOBAL. + DISPLAY "NO FEE SCHED ENTRY: " CNT-NOFEE. + CLOSE GARFILE CHARCUR PAYCUR MEDFILE2020 REPORTF. + STOP RUN. From 0f54a21bcc3213e8fa2c5050c1f63da4839ae6b6 Mon Sep 17 00:00:00 2001 From: stephen waite Date: Sat, 6 Jun 2026 17:13:41 -0400 Subject: [PATCH 75/78] separate col for adj and correct due col --- rri/reports/adj197.cob | 64 +++++++++++++++++++++++++++--------------- 1 file changed, 41 insertions(+), 23 deletions(-) diff --git a/rri/reports/adj197.cob b/rri/reports/adj197.cob index e646633a..381bc509 100644 --- a/rri/reports/adj197.cob +++ b/rri/reports/adj197.cob @@ -7,14 +7,16 @@ PROGRAM-ID. adj197. * * Reads CHARCUR charges with CC-PAYCODE = "197" (pending ins). - * For each, sums PAYCUR payments for the same account+claim - * (payments stored signed-negative), derives the balance due - * (CC-AMOUNT + TOTALPAY), looks up the Medicare allowed amount - * from MEDFILE2020 keyed by CC-PROC1, and reports the remaining - * amount: allowed less what has already been paid. Because - * payments are stored signed-negative: - * ADJ-AMT = MED-AMT - (-TOTALPAY) = MED-AMT + TOTALPAY - * Positive = still owed up to the allowed amount; negative = paid + * For each, walks PAYCUR for the same account+claim and splits + * the (signed-negative) activity into two buckets: + * CASHPAID - everything except PC-DENIAL = "14" + * ADJ14 - the PC-DENIAL = "14" insurance adjustments + * Looks up the Medicare allowed amount from MEDFILE2020 keyed by + * CC-PROC1. DUE is the allowed less ALL credits posted - both + * cash and the "14" contractual adjustments reduce it: + * DUE-AMT = MED-AMT - (-TOTALPAY) = MED-AMT + TOTALPAY + * The INS-ADJ column breaks out the "14" portion for reference. + * Positive = still collectable up to allowed; negative = paid * past the allowed (nothing to collect / possible refund). * Report only. Posts nothing. * @@ -56,9 +58,12 @@ WORKING-STORAGE SECTION. 01 WS-WORK. 05 TOTALPAY PIC S9(7)V99 VALUE 0. + 05 CASHPAID PIC S9(7)V99 VALUE 0. + 05 ADJ14 PIC S9(7)V99 VALUE 0. 05 BALANCE PIC S9(7)V99 VALUE 0. - 05 ADJ-AMT PIC S9(7)V99 VALUE 0. - 05 TOT-ADJ PIC S9(9)V99 VALUE 0. + 05 DUE-AMT PIC S9(7)V99 VALUE 0. + 05 TOT-ADJ14 PIC S9(9)V99 VALUE 0. + 05 TOT-DUE PIC S9(9)V99 VALUE 0. 05 WS-NAME PIC X(25) VALUE SPACES. 01 WS-COUNTS. 05 CNT-197 PIC 9(7) VALUE 0. @@ -75,9 +80,10 @@ 05 FILLER PIC X(9) VALUE "PROC". 05 FILLER PIC X(11) VALUE " CHARGE". 05 FILLER PIC X(12) VALUE " PAID". + 05 FILLER PIC X(12) VALUE " INS-ADJ". 05 FILLER PIC X(12) VALUE " BALANCE". 05 FILLER PIC X(11) VALUE " ALLOWED". - 05 FILLER PIC X(12) VALUE " ADJ". + 05 FILLER PIC X(12) VALUE " DUE". 05 FILLER PIC X(6) VALUE "NAME". 01 DET-LINE. 05 FILLER PIC X(2) VALUE SPACES. @@ -91,16 +97,20 @@ 05 FILLER PIC X(2) VALUE SPACES. 05 DL-PAID PIC -ZZ,ZZ9.99. 05 FILLER PIC X(2) VALUE SPACES. + 05 DL-ADJ14 PIC -ZZ,ZZ9.99. + 05 FILLER PIC X(2) VALUE SPACES. 05 DL-BAL PIC -ZZ,ZZ9.99. 05 FILLER PIC X(2) VALUE SPACES. 05 DL-ALLOW PIC ZZ,ZZ9.99. 05 FILLER PIC X(2) VALUE SPACES. - 05 DL-ADJ PIC -ZZ,ZZ9.99. + 05 DL-DUE PIC -ZZ,ZZ9.99. 05 FILLER PIC X(2) VALUE SPACES. 05 DL-NAME PIC X(25). 01 TOT-LINE. - 05 FILLER PIC X(20) VALUE "TOTAL ADJUSTMENT: ". - 05 TL-ADJ PIC -Z,ZZZ,ZZ9.99. + 05 FILLER PIC X(20) VALUE "TOTAL INS-ADJ/DUE: ". + 05 TL-ADJ14 PIC -Z,ZZZ,ZZ9.99. + 05 FILLER PIC X(3) VALUE SPACES. + 05 TL-DUE PIC -Z,ZZZ,ZZ9.99. PROCEDURE DIVISION. MAIN. OPEN INPUT GARFILE CHARCUR PAYCUR MEDFILE2020. @@ -123,6 +133,7 @@ * sum payments for this account + claim * MOVE 0 TO TOTALPAY. + MOVE 0 TO ADJ14. MOVE CC-KEY8 TO PC-KEY8. MOVE LOW-VALUES TO PC-KEY3. START PAYCUR KEY NOT < PAYCUR-KEY @@ -133,9 +144,12 @@ IF PC-KEY8 NOT = CC-KEY8 GO TO EVAL. IF PC-CLAIM NOT = CC-CLAIM GO TO PAY-LOOP. ADD PC-AMOUNT TO TOTALPAY. + IF PC-DENIAL = "14" + ADD PC-AMOUNT TO ADJ14. GO TO PAY-LOOP. EVAL. - COMPUTE BALANCE = CC-AMOUNT + TOTALPAY. + COMPUTE BALANCE = CC-AMOUNT + TOTALPAY. + COMPUTE CASHPAID = TOTALPAY - ADJ14. IF BALANCE NOT > 0 ADD 1 TO CNT-NOBAL GO TO NEXT-CHG. @@ -149,9 +163,10 @@ PERFORM WRITE-NOFEE GO TO NEXT-CHG END-READ. - COMPUTE ADJ-AMT = MED-AMT - (0 - TOTALPAY). - ADD 1 TO CNT-RPT. - ADD ADJ-AMT TO TOT-ADJ. + COMPUTE DUE-AMT = MED-AMT - (0 - TOTALPAY). + ADD 1 TO CNT-RPT. + ADD ADJ14 TO TOT-ADJ14. + ADD DUE-AMT TO TOT-DUE. PERFORM WRITE-DETAIL. GO TO NEXT-CHG. WRITE-DETAIL. @@ -165,10 +180,11 @@ MOVE CC-CLAIM TO DL-CLAIM. MOVE CC-PROC1 TO DL-PROC. MOVE CC-AMOUNT TO DL-CHARGE. - MOVE TOTALPAY TO DL-PAID. + MOVE CASHPAID TO DL-PAID. + MOVE ADJ14 TO DL-ADJ14. MOVE BALANCE TO DL-BAL. MOVE MED-AMT TO DL-ALLOW. - MOVE ADJ-AMT TO DL-ADJ. + MOVE DUE-AMT TO DL-DUE. MOVE WS-NAME TO DL-NAME. WRITE REPORT-REC FROM DET-LINE. WRITE-NOFEE. @@ -176,16 +192,18 @@ MOVE CC-CLAIM TO DL-CLAIM. MOVE CC-PROC1 TO DL-PROC. MOVE CC-AMOUNT TO DL-CHARGE. - MOVE TOTALPAY TO DL-PAID. + MOVE CASHPAID TO DL-PAID. + MOVE ADJ14 TO DL-ADJ14. MOVE BALANCE TO DL-BAL. MOVE 0 TO DL-ALLOW. - MOVE 0 TO DL-ADJ. + MOVE 0 TO DL-DUE. MOVE "*** NO FEE SCHEDULE ENTRY" TO DL-NAME. WRITE REPORT-REC FROM DET-LINE. DONE. MOVE SPACES TO REPORT-REC. WRITE REPORT-REC. - MOVE TOT-ADJ TO TL-ADJ. + MOVE TOT-ADJ14 TO TL-ADJ14. + MOVE TOT-DUE TO TL-DUE. WRITE REPORT-REC FROM TOT-LINE. DISPLAY "197 CHARGES READ: " CNT-197. DISPLAY "REPORTED (ADJ): " CNT-RPT. From 67ff015e57186a2f3ef76e765e6cde9157fc5ae3 Mon Sep 17 00:00:00 2001 From: stephen waite Date: Sat, 6 Jun 2026 17:24:29 -0400 Subject: [PATCH 76/78] use cash paid instead of total pay for comparison with med allow --- rri/reports/adj197.cob | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/rri/reports/adj197.cob b/rri/reports/adj197.cob index 381bc509..f5637849 100644 --- a/rri/reports/adj197.cob +++ b/rri/reports/adj197.cob @@ -12,10 +12,11 @@ * CASHPAID - everything except PC-DENIAL = "14" * ADJ14 - the PC-DENIAL = "14" insurance adjustments * Looks up the Medicare allowed amount from MEDFILE2020 keyed by - * CC-PROC1. DUE is the allowed less ALL credits posted - both - * cash and the "14" contractual adjustments reduce it: - * DUE-AMT = MED-AMT - (-TOTALPAY) = MED-AMT + TOTALPAY - * The INS-ADJ column breaks out the "14" portion for reference. + * CC-PROC1. DUE is the allowed plus the cash paid (CASHPAID is + * signed-negative). The "14" contractual adjustments are shown + * separately in INS-ADJ and are NOT netted into DUE: + * DUE-AMT = MED-AMT + CASHPAID + * where CASHPAID = TOTALPAY - ADJ14. * Positive = still collectable up to allowed; negative = paid * past the allowed (nothing to collect / possible refund). * Report only. Posts nothing. @@ -163,7 +164,7 @@ PERFORM WRITE-NOFEE GO TO NEXT-CHG END-READ. - COMPUTE DUE-AMT = MED-AMT - (0 - TOTALPAY). + COMPUTE DUE-AMT = MED-AMT + CASHPAID. ADD 1 TO CNT-RPT. ADD ADJ14 TO TOT-ADJ14. ADD DUE-AMT TO TOT-DUE. From e8bc9945e9f9dd3edd268098b27248b63448c484 Mon Sep 17 00:00:00 2001 From: stephen waite Date: Mon, 8 Jun 2026 13:00:05 -0400 Subject: [PATCH 77/78] skip those with 03 payments --- rri/reports/adj197.cob | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/rri/reports/adj197.cob b/rri/reports/adj197.cob index f5637849..62e3e2a2 100644 --- a/rri/reports/adj197.cob +++ b/rri/reports/adj197.cob @@ -66,11 +66,13 @@ 05 TOT-ADJ14 PIC S9(9)V99 VALUE 0. 05 TOT-DUE PIC S9(9)V99 VALUE 0. 05 WS-NAME PIC X(25) VALUE SPACES. + 05 MCR-PAID PIC X VALUE "N". 01 WS-COUNTS. 05 CNT-197 PIC 9(7) VALUE 0. 05 CNT-RPT PIC 9(7) VALUE 0. 05 CNT-NOBAL PIC 9(7) VALUE 0. 05 CNT-NOFEE PIC 9(7) VALUE 0. + 05 CNT-MCRPAID PIC 9(7) VALUE 0. 01 HDR-1. 05 FILLER PIC X(45) VALUE "PENDING INS 197 - ADJUSTMENT TO MED ALLOWED". @@ -135,6 +137,7 @@ * MOVE 0 TO TOTALPAY. MOVE 0 TO ADJ14. + MOVE "N" TO MCR-PAID. MOVE CC-KEY8 TO PC-KEY8. MOVE LOW-VALUES TO PC-KEY3. START PAYCUR KEY NOT < PAYCUR-KEY @@ -147,8 +150,13 @@ ADD PC-AMOUNT TO TOTALPAY. IF PC-DENIAL = "14" ADD PC-AMOUNT TO ADJ14. + IF PC-PAYCODE = "003" + MOVE "Y" TO MCR-PAID. GO TO PAY-LOOP. EVAL. + IF MCR-PAID = "Y" + ADD 1 TO CNT-MCRPAID + GO TO NEXT-CHG. COMPUTE BALANCE = CC-AMOUNT + TOTALPAY. COMPUTE CASHPAID = TOTALPAY - ADJ14. IF BALANCE NOT > 0 @@ -210,5 +218,6 @@ DISPLAY "REPORTED (ADJ): " CNT-RPT. DISPLAY "NO BALANCE DUE: " CNT-NOBAL. DISPLAY "NO FEE SCHED ENTRY: " CNT-NOFEE. + DISPLAY "MEDICARE PAID (SKIP):" CNT-MCRPAID. CLOSE GARFILE CHARCUR PAYCUR MEDFILE2020 REPORTF. STOP RUN. From 6b3991e738d793903c0c0657e15bc6b4440c2127 Mon Sep 17 00:00:00 2001 From: stephen waite Date: Mon, 8 Jun 2026 13:17:49 -0400 Subject: [PATCH 78/78] add dos to report --- rri/reports/adj197.cob | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) diff --git a/rri/reports/adj197.cob b/rri/reports/adj197.cob index 62e3e2a2..56f3a31e 100644 --- a/rri/reports/adj197.cob +++ b/rri/reports/adj197.cob @@ -55,7 +55,7 @@ 03 MED-KEY2 PIC XX. 02 MED-AMT PIC 9(4)V99. FD REPORTF. - 01 REPORT-REC PIC X(132). + 01 REPORT-REC PIC X(140). WORKING-STORAGE SECTION. 01 WS-WORK. 05 TOTALPAY PIC S9(7)V99 VALUE 0. @@ -80,6 +80,7 @@ 05 FILLER PIC X(2) VALUE SPACES. 05 FILLER PIC X(10) VALUE "ACCOUNT". 05 FILLER PIC X(8) VALUE "CLAIM". + 05 FILLER PIC X(10) VALUE "DOS". 05 FILLER PIC X(9) VALUE "PROC". 05 FILLER PIC X(11) VALUE " CHARGE". 05 FILLER PIC X(12) VALUE " PAID". @@ -94,6 +95,8 @@ 05 FILLER PIC X(2) VALUE SPACES. 05 DL-CLAIM PIC X(6). 05 FILLER PIC X(2) VALUE SPACES. + 05 DL-DOS PIC X(8). + 05 FILLER PIC X(2) VALUE SPACES. 05 DL-PROC PIC X(7). 05 FILLER PIC X(2) VALUE SPACES. 05 DL-CHARGE PIC ZZ,ZZ9.99. @@ -187,6 +190,7 @@ END-READ. MOVE CC-KEY8 TO DL-ACCT. MOVE CC-CLAIM TO DL-CLAIM. + MOVE CC-DATE-T TO DL-DOS. MOVE CC-PROC1 TO DL-PROC. MOVE CC-AMOUNT TO DL-CHARGE. MOVE CASHPAID TO DL-PAID. @@ -199,6 +203,7 @@ WRITE-NOFEE. MOVE CC-KEY8 TO DL-ACCT. MOVE CC-CLAIM TO DL-CLAIM. + MOVE CC-DATE-T TO DL-DOS. MOVE CC-PROC1 TO DL-PROC. MOVE CC-AMOUNT TO DL-CHARGE. MOVE CASHPAID TO DL-PAID.