RCDPEAD1 ;OIFO-BAYPINES/PJH - AUTO-DECREASE REPORT ;Nov 23, 2014@12:48:50
;;4.5;Accounts Receivable;**298,318,326,345,349**;Mar 20, 1995;Build 44
;;Per VA Directive 6402, this routine should not be modified.
;
CARCS(A1,A2,A3,CARCS) ; Get CARC Auto-Decrease data
; Input: A1 - "EXCEL" if exporting to excel
; Internal fileman date if not exporting to excel
; A2 - Excel Line Counter if exporting to excel
; External Claim number is sorting by claim
; External Payer Name if sorting by Payer
; External Patient Name if sorting by Patient Name
; A3 - Record Counter
; CARCS - ^ delimited string of CARC information
; See SAVE for a complete description
; Output: ^TMP("RCDPEADP",$J,A1,A2,A3,A4) - C1^C2^C3^C4 Where:
; - A1 - "EXCEL" if exporting to excel
; Internal fileman date if not exporting to excel
; A2 - Excel Line Counter if exporting to excel
; External Claim number is sorting by claim
; External Payer Name if sorting by Payer
; External Patient Name if sorting by Patient Name
; A3 - Record Counter
; A4 - CARC Counter
; C1 - CARC Code (file 361.111, field .01)
; C2 - Decrease Amount (file 361.111, field .02)
; C3 - Quantity (file 361.111, field .03)
; C4 - Reason (file 361.111, field .04)
N AMT,CARC,CCTR,OCARC,QUANT,REASON,XX
;
; Loop through all of the valid CARCs found in the EOB record
F CCTR=1:1:$L(CARCS,"^") D
. S OCARC=$P(CARCS,"^",CCTR)
. S CARC=$P(OCARC,";",2) ; CARC Code
. S AMT=$P(OCARC,";",1) ; Amount
. S QUANT=$P(OCARC,";",3) ; Quantity
. S REASON=$P(OCARC,";",4) ; Reason Text
. S XX=CARC_"^"_AMT_"^"_QUANT_"^"_REASON
. S ^TMP("RCDPEADP",$J,A1,A2,A3,CCTR)=XX
Q
;
COMPILE(INPUTS,RCVAUTD,DTOTAL,GTOTAL) ; EP Generate the Auto-Decrease report ^TMP array
; Input: INPUTS - A1^A2^A3^...^An Where:
; A1 - 1 - All divisions selected
; 2 - Selected divisions
; A2 - C - Sort by Claim
; P - Sort by Payer
; N - Sort by Patient Name
; A3 - F - First to Last Sort Order
; L - Last to First Sort Order
; A4 - B1|B2
; B1 - Auto-Post Start Date
; B2 - Auto-Post End Date
; A5 - 1 - Output to Excel
; 2 - Otherwise
; RCVAUTD - Array of selected Divisions
; Only passed if A1=2
; Output: DTOTAL() - Array of totals by Auto-Post Date
; GTOTAL - Grand totals
; ^TMP("RCDPEADP",$J) - Array of report data
; See SAVE for a full description
N AMT,ADDATE,CARCS,END,ERAIEN,EOBIEN,EXCEL,RCTR,RCRZ,RCSORT,RCTYPE,RCZERO
N STA,STNAM,STNUM,WHICH,XX ; PRCA*4.5*345 - Added WHICH
;
S XX=$P(INPUTS,"^",4) ; Auto-Post Date range
S ADDATE=$$FMADD^XLFDT($P(XX,"|",1),-1)
S END=$P(XX,"|",2) ; Auto-Post End Date
S RCTR=0 ; Record counter
S EXCEL=$P(INPUTS,"^",5) ; 1 output to Excel, 0 otherwise
S RCSORT=$P(INPUTS,"^",2) ; Sort Type
S RCTYPE=$P(INPUTS,"^",7) ; PRCA*4.5*326 Payer Type
;
; ^RCY(344.4,0) = "ELECTRONIC REMITTANCE ADVICE^344.4I^"
; G cross-ref. REGULAR WHOLE FILE (#344.4)
; Field: AUTO-POST DATE (344.41,9)
; Scan G index for ERA within date range
F S ADDATE=$O(^RCY(344.4,"G",ADDATE)) Q:'ADDATE Q:(ADDATE\1)>END D
. S ERAIEN=""
. F D Q:'ERAIEN
. . S ERAIEN=$O(^RCY(344.4,"G",ADDATE,ERAIEN))
. . Q:'ERAIEN
. . D ERASTA(ERAIEN,.STA,.STNUM,.STNAM) ; Check for valid Division
. . I $P(INPUTS,"^",1)=2,'$D(RCVAUTD(STA)) Q ; Not a valid Division
. . I RCTYPE'="A",'$$ISTYPE^RCDPEU1(344.4,ERAIEN,RCTYPE) Q ; PRCA*4.5*326 - Not a valid payer type
. . S XX=$$ISTYPE^RCDPEU1(344.4,ERAIEN,"T") ; PRCA*4.5*349 - Added line
. . I XX S WHICH=3 ; PRCA*4.5*349 - Check if this is TRICARE ERA
. . E S WHICH=$S($$PHARM^RCDPEAP1(ERAIEN):2,1:1) ; Else it must be a Medical or Rx ERA
. . ;
. . ; Scan index for auto-decreased claim lines within the ERA
. . ; and Save claim line detail to ^TMP global
. . S RCRZ=""
. . F D Q:'RCRZ
. . . S RCRZ=$O(^RCY(344.4,"G",ADDATE,ERAIEN,RCRZ))
. . . Q:'RCRZ
. . . S EOBIEN=$$GET1^DIQ(344.41,RCRZ_","_ERAIEN_",",.02,"I")
. . . ; Check if this decrease was for a zero line
. . . S RCZERO=0 ; PRCA*4.5*326
. . . I +$$GET1^DIQ(344.41,RCRZ_","_ERAIEN_",",.03)=0 S RCZERO=1 ; PRCA*4.5*326
. . . ; Get amount decreased
. . . S AMT=+$$GET1^DIQ(344.41,RCRZ_","_ERAIEN_",",8)
. . . ;
. . . ; Find all Claim level and Claim line level CARCs
. . . S CARCS=$$CARCLMT^RCDPEAD(EOBIEN,RCZERO,WHICH,1,ADDATE) ; PRCA*4.5*345 - Added WHICH
. . . S CARCS=$$MAX(CARCS,AMT) ; PRCA*4.5*326 - remove any CARCs which were not decreased
. . . Q:+CARCS=0 ; No CARCs found
. . . D SAVE^RCDPEADP(ADDATE,ERAIEN,RCRZ,EXCEL,RCSORT,CARCS,.RCTR,STNAM,STNUM)
Q
;
ERASTA(ERAIEN,STA,STNUM,STNAM) ; Get the station for this ERA
; Input: ERAIEN - Internal IEN for file 344.4
; Output: STA - Internal Station IEN
; STNUM - Station Number
; STNAM - Station Name
N ERAEOB,ERABILL,STAIEN
S (ERAEOB,ERABILL)=""
S (STA,STNUM,STNAM)="UNKNOWN"
S ERAEOB=$$GET1^DIQ(344.41,"1,"_ERAIEN_",",.02,"I")
Q:'ERAEOB
S ERABILL=$$GET1^DIQ(361.1,ERAEOB,.01,"I")
Q:'ERABILL
S STAIEN=$$GET1^DIQ(399,ERABILL,.22,"I")
Q:'STAIEN
S STA=STAIEN
S STNAM=$$EXTERNAL^DILFD(399,.22,,STA)
S STNUM=$$GET1^DIQ(40.8,STAIEN,1,"I")
Q
;
HDR(EXCEL,HDRINFO,PAGE,NOLINE) ; Print the report header
; Input: EXCEL - 1 if output to Excel, 0 otherwise
; HDRINFO() - Array of Header information
; PAGE - Current Page Number
; NOLINE - 1 to not display Claim line header
; Optional, defaults to 0
; Output: PAGE - Updated Page Number (if EXCEL=0)
N DIV,MSG,SUB,XX,Y,Z0,Z1
S:'$D(NOLINE) NOLINE=0
I EXCEL D Q
. W !,"STATION^STATION NUMBER^CLAIM #^PATIENT NAME^PAYER^DECREASE AMOUNT^DATE^CARC"
. W "^DECREASE AMT^#^REASON"
;
S PAGE=PAGE+1
W @IOF
S MSG(1)=" EDI Lockbox Auto-Decrease Adjustment Report "
S MSG(1)=MSG(1)_" Page: "_PAGE
S MSG(2)=" Run Date: "_HDRINFO("RUNDATE")
S Z0="Divisions: "_HDRINFO("DIVISIONS")
S MSG(3)=$S($L(Z0)<75:$J("",75-$L(Z0)\2),1:"")_Z0
S XX=" (Date Decrease Applied)"
S MSG(4)=" Date Range: "_HDRINFO("START")_" - "_HDRINFO("END")_XX
S MSG(5)=$E(HDRINFO("SORT")_$J("",46),1,44)_" "_HDRINFO("TYPE") ; ; PRCA*4.5*326
S MSG(6)=""
I 'NOLINE D
. S MSG(7)="Claim # Patient Name Payer Decrease Amt Date "
. S MSG(8)="============================================================================"
D EN^DDIOL(.MSG)
Q
;
HINFO(INPUTS,HDRINFO) ;Get header information
; Input: INPUTS - See REPORT^RCDPEADP for a complete description
; HDRINFO - Return array - passed by reference
; Output: HDRINFO - Formatted header array for ListMan
N XX
S XX=$P(INPUTS,"^",4) ; Auto-Post Date range
S HDRINFO("START")=$$FMTE^XLFDT($P(XX,"|",1),"2SZ")
S HDRINFO("END")=$$FMTE^XLFDT($P(XX,"|",2),"2SZ")
S HDRINFO("RUNDATE")=$$FMTE^XLFDT($$NOW^XLFDT,"2SZ")
s XX=$P(INPUTS,"^",2) ; Sort Type
S HDRINFO("SORT")="SORTED BY: "_$S(XX="C":"CLAIM",XX="P":"PAYER",1:"PATIENT NAME")
S XX=$S($P(INPUTS,"^",3)="L":"LAST TO FIRST",1:"FIRST TO LAST")
S HDRINFO("SORT")=HDRINFO("SORT")_" - "_XX
; Format Division filter
S XX=$P(INPUTS,"^",1) ; XX=1 - All Divisions, 2- selected
S HDRINFO("DIVISIONS")=$S(XX=2:$$LINE^RCDPEAD2(.RCVAUTD),1:"ALL")
; PRCA*4.5*326 - Add M/P/T filter to report
S XX=$P(INPUTS,"^",7) ; M/P/T/A = Medical/Pharmacy/Tricare/All
S HDRINFO("TYPE")="MEDICAL/PHARMACY/TRICARE: "
S HDRINFO("TYPE")=HDRINFO("TYPE")_$S(XX="M":"MEDICAL",XX="P":"PHARMACY",XX="T":"TRICARE",1:"ALL")
Q
;
LMAN(DATA,A1,A2,A3,XX) ; Format and save List Manager line
; Input: DATA - ERA line adjustment total
; A1,A2,A3 - ^TMP("RCDPEAP") subscripts
; XX - List Counter for ^TMP("RCDPE_ADP",$J)
N CARCAMT,CCTR,DATA1,Y
S Y=$E($P(DATA,U,3),1,12) ; Claim #
S $E(Y,15)=$E($P(DATA,U,4),1,20) ; Patient Name
S $E(Y,37)=$E($P(DATA,U,5),1,19) ; Payer Name
S $E(Y,55)=$J($P(DATA,U,6),12,2) ; Auto-Decrease Amount
S $E(Y,69)=$P(DATA,U,7) ; Auto-Decrease Date
S ^TMP("RCDPE_ADP",$J,XX)=Y,XX=XX+1
S ^TMP("RCDPE_ADP",$J,XX)=" ",XX=XX+1
S ^TMP("RCDPE_ADP",$J,XX)=" CARC Decrease Amt # Reason",XX=XX+1
S ^TMP("RCDPE_ADP",$J,XX)=" -------------------- ------------- ---- -----------------------------",XX=XX+1
S CCTR=0
F S CCTR=$O(^TMP("RCDPEADP",$J,A1,A2,A3,CCTR)) Q:'CCTR D
. ;Display a line for each CARC adjustment on the line
. S DATA1=$G(^TMP("RCDPEADP",$J,A1,A2,A3,CCTR)),CARCAMT=$P(DATA1,U,2)
. S Y=" "_$E($P(DATA1,U,1),1,20) ; CARC
. S $E(Y,27)=$J($P(DATA1,U,2),12,2) ; Decrease Amount
. S $E(Y,42)=$J($P(DATA1,U,3),4) ; Quantity
. S $E(Y,48)=$E($P(DATA1,U,4),1,32) ; Reason
. S ^TMP("RCDPE_ADP",$J,XX)=Y,XX=XX+1
S ^TMP("RCDPE_ADP",$J,XX)=" ",XX=XX+1
Q
;
LMOUT(INPUT,RCVAUTD,IO) ; EP Output report to Listman
; Input: INPUT - See REPORT for a complete description
; RCVAUTD - Array of selected Divisions
; Only passed if A1=2
; IO - Output device array
; Output: ^TMP("RCDPE_LAR",$J,CTR)=Line - Array of display lines (no headers)
; for output to Listman
; Only set when A7-1
N HDR,HDRINFO,XX,Z0
D REPORT^RCDPEADP(INPUT,.RCVAUTD,.IO) ; Get the lines to be displayed
D HINFO(INPUT,.HDRINFO)
S HDR("TITLE")="AUTO-DECREASE REPORT"
S HDR(1)=" RUN DATE: "_HDRINFO("RUNDATE")
S Z0="DIVISIONS: "_HDRINFO("DIVISIONS")
S HDR(2)=$S($L(Z0)<75:$J("",75-$L(Z0)\2),1:"")_Z0
S XX=" (DATE DECREASE APPLIED)"
S HDR(3)=" DATE RANGE: "_HDRINFO("START")_" - "_HDRINFO("END")_XX
S HDR(4)=$E(HDRINFO("SORT")_$J("",46),1,44)_" "_HDRINFO("TYPE") ; PRCA*4.5*326
S HDR(5)=""
S HDR(6)=""
S HDR(7)="CLAIM # PATIENT NAME PAYER DECREASE AMT DATE "
D LMRPT^RCDPEARL(.HDR,$NA(^TMP("RCDPE_ADP",$J))) ; Generate ListMan display
;
K ^TMP("RCDPEADP",$J),^TMP($J,"RCDPEADP"),^TMP("RCDPE_ADP",$J)
Q
;
TOTALD(EXCEL,HDRINFO,PAGE,STOP,DAY,DTOTAL) ; Totals for a single day
; Input: EXCEL - 1 if output to Excel, 0 otherwise
; HDRINFO() - Array of header information
; PAGE - Current Page Number
; DAY - Internal Fileman date to display totals for
; DTOTAL() - Array of totals by day
; IOSL - Page length
; Output: PAGE - Updated Page Number (if a new header is displayed)
; STOP - 1 if displaying to screen and user asked to stop
N DAMT,DCNT,Y
I 'EXCEL,$Y>(IOSL-4) D
. D ASK^RCDPEADP(.STOP,0)
. Q:STOP
. D HDR(EXCEL,.HDRINFO,.PAGE)
Q:STOP
S DCNT=$P(DTOTAL(DAY),U),DAMT=$P(DTOTAL(DAY),U,2)
S Y="**Totals for Date: "_$$FMTE^XLFDT(DAY,"2Z")
S $E(Y,35)=" # of Decrease Adjustments: "_DCNT
W !!,Y
S Y="",$E(Y,28)="Total Amount of Decrease Adjustments: $"_$J(DAMT,3,2)
W !,Y
Q
;
;TOTALS ; Print totals for EXCEL
;N DAY,DAMT,DCNT
;S DAY=""
;F S DAY=$O(DTOTAL(DAY)) Q:'DAY D Q:STOP
;.;Day totals
;.D TOTALD(DAY)
;;Grand totals
;D TOTALG
;Q
;
TOTALG(EXCEL,HDRINFO,PAGE,GTOTAL,STOP) ; Overall report total
; Input: EXCEL - 1 if output to Excel, 0 otherwise
; HDRINFO() - Array of header information
; PAGE - Current Page Number
; GTOTAL() - Grand Totals for report
; IOSL - Page length
; Output: PAGE - Updated Page Number (if a new header is displayed)
N Y
I 'EXCEL,$Y>(IOSL-6) D
. D ASK^RCDPEADP(.STOP,0)
. Q:STOP
. D HDR(EXCEL,.HDRINFO,.PAGE)
Q:STOP
W !!,"**** Totals for Date Range: # of Decrease Adjustments: "_+$P(GTOTAL,U,1)
S Y="",$E(Y,28)="Total Amount of Decrease Adjustments: $"_$J((+$P(GTOTAL,U,2)),3,2)
W !,Y,!
Q
;
; BEGIN - PRCA*4.5*326
MAX(RCINP,RCMAX) ; Input CARCs and remove any over what was actually auto-decreased
; INPUT - RCINP - list of all CARCs on EEOB
; RCMAX - total amount auto-decreased on claim
; OUTPUT - RCOUT - list of CARCs actually auto-decreased
;
N J,RCIARR,RCITEM,RCJ,RCK,RCNT,RCOUT,RCTOT
;
S RCOUT=""
; Order CARCs for Auto-Decrease in largest to smallest amount order
F J=1:1 S RCITEM=$P(RCINP,U,J) Q:RCITEM="" S RCIARR(-($P(RCITEM,";",1)),J)=RCITEM
Q:$D(RCIARR)<10 RCOUT ; Quit if CARC adjustment array doesn't have any elements to process
;
; Get top limit for auto-decrease
;S RCMAX=+$$GET1^DIQ(344.61,"1,",.05)
; Only include CARCs if the decrease total is less than or equal to claim maximum
S RCJ="",RCTOT=0,RCNT=0
F S RCJ=$O(RCIARR(RCJ)) Q:RCJ="" D
.S RCK=""
.F S RCK=$O(RCIARR(RCJ,RCK)) Q:RCK="" D
..S RCTOT=RCTOT+$P(RCIARR(RCJ,RCK),";")
..Q:RCTOT>RCMAX
..S RCNT=RCNT+1
..S $P(RCOUT,U,RCNT)=RCIARR(RCJ,RCK)
Q RCOUT
;END - PRCA*4.5*326
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEAD1 14526 printed Apr 09, 2024@20:53:12 Page 2
RCDPEAD1 ;OIFO-BAYPINES/PJH - AUTO-DECREASE REPORT ;Nov 23, 2014@12:48:50
+1 ;;4.5;Accounts Receivable;**298,318,326,345,349**;Mar 20, 1995;Build 44
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
CARCS(A1,A2,A3,CARCS) ; Get CARC Auto-Decrease data
+1 ; Input: A1 - "EXCEL" if exporting to excel
+2 ; Internal fileman date if not exporting to excel
+3 ; A2 - Excel Line Counter if exporting to excel
+4 ; External Claim number is sorting by claim
+5 ; External Payer Name if sorting by Payer
+6 ; External Patient Name if sorting by Patient Name
+7 ; A3 - Record Counter
+8 ; CARCS - ^ delimited string of CARC information
+9 ; See SAVE for a complete description
+10 ; Output: ^TMP("RCDPEADP",$J,A1,A2,A3,A4) - C1^C2^C3^C4 Where:
+11 ; - A1 - "EXCEL" if exporting to excel
+12 ; Internal fileman date if not exporting to excel
+13 ; A2 - Excel Line Counter if exporting to excel
+14 ; External Claim number is sorting by claim
+15 ; External Payer Name if sorting by Payer
+16 ; External Patient Name if sorting by Patient Name
+17 ; A3 - Record Counter
+18 ; A4 - CARC Counter
+19 ; C1 - CARC Code (file 361.111, field .01)
+20 ; C2 - Decrease Amount (file 361.111, field .02)
+21 ; C3 - Quantity (file 361.111, field .03)
+22 ; C4 - Reason (file 361.111, field .04)
+23 NEW AMT,CARC,CCTR,OCARC,QUANT,REASON,XX
+24 ;
+25 ; Loop through all of the valid CARCs found in the EOB record
+26 FOR CCTR=1:1:$LENGTH(CARCS,"^")
Begin DoDot:1
+27 SET OCARC=$PIECE(CARCS,"^",CCTR)
+28 ; CARC Code
SET CARC=$PIECE(OCARC,";",2)
+29 ; Amount
SET AMT=$PIECE(OCARC,";",1)
+30 ; Quantity
SET QUANT=$PIECE(OCARC,";",3)
+31 ; Reason Text
SET REASON=$PIECE(OCARC,";",4)
+32 SET XX=CARC_"^"_AMT_"^"_QUANT_"^"_REASON
+33 SET ^TMP("RCDPEADP",$JOB,A1,A2,A3,CCTR)=XX
End DoDot:1
+34 QUIT
+35 ;
COMPILE(INPUTS,RCVAUTD,DTOTAL,GTOTAL) ; EP Generate the Auto-Decrease report ^TMP array
+1 ; Input: INPUTS - A1^A2^A3^...^An Where:
+2 ; A1 - 1 - All divisions selected
+3 ; 2 - Selected divisions
+4 ; A2 - C - Sort by Claim
+5 ; P - Sort by Payer
+6 ; N - Sort by Patient Name
+7 ; A3 - F - First to Last Sort Order
+8 ; L - Last to First Sort Order
+9 ; A4 - B1|B2
+10 ; B1 - Auto-Post Start Date
+11 ; B2 - Auto-Post End Date
+12 ; A5 - 1 - Output to Excel
+13 ; 2 - Otherwise
+14 ; RCVAUTD - Array of selected Divisions
+15 ; Only passed if A1=2
+16 ; Output: DTOTAL() - Array of totals by Auto-Post Date
+17 ; GTOTAL - Grand totals
+18 ; ^TMP("RCDPEADP",$J) - Array of report data
+19 ; See SAVE for a full description
+20 NEW AMT,ADDATE,CARCS,END,ERAIEN,EOBIEN,EXCEL,RCTR,RCRZ,RCSORT,RCTYPE,RCZERO
+21 ; PRCA*4.5*345 - Added WHICH
NEW STA,STNAM,STNUM,WHICH,XX
+22 ;
+23 ; Auto-Post Date range
SET XX=$PIECE(INPUTS,"^",4)
+24 SET ADDATE=$$FMADD^XLFDT($PIECE(XX,"|",1),-1)
+25 ; Auto-Post End Date
SET END=$PIECE(XX,"|",2)
+26 ; Record counter
SET RCTR=0
+27 ; 1 output to Excel, 0 otherwise
SET EXCEL=$PIECE(INPUTS,"^",5)
+28 ; Sort Type
SET RCSORT=$PIECE(INPUTS,"^",2)
+29 ; PRCA*4.5*326 Payer Type
SET RCTYPE=$PIECE(INPUTS,"^",7)
+30 ;
+31 ; ^RCY(344.4,0) = "ELECTRONIC REMITTANCE ADVICE^344.4I^"
+32 ; G cross-ref. REGULAR WHOLE FILE (#344.4)
+33 ; Field: AUTO-POST DATE (344.41,9)
+34 ; Scan G index for ERA within date range
+35 FOR
SET ADDATE=$ORDER(^RCY(344.4,"G",ADDATE))
if 'ADDATE
QUIT
if (ADDATE\1)>END
QUIT
Begin DoDot:1
+36 SET ERAIEN=""
+37 FOR
Begin DoDot:2
+38 SET ERAIEN=$ORDER(^RCY(344.4,"G",ADDATE,ERAIEN))
+39 if 'ERAIEN
QUIT
+40 ; Check for valid Division
DO ERASTA(ERAIEN,.STA,.STNUM,.STNAM)
+41 ; Not a valid Division
IF $PIECE(INPUTS,"^",1)=2
IF '$DATA(RCVAUTD(STA))
QUIT
+42 ; PRCA*4.5*326 - Not a valid payer type
IF RCTYPE'="A"
IF '$$ISTYPE^RCDPEU1(344.4,ERAIEN,RCTYPE)
QUIT
+43 ; PRCA*4.5*349 - Added line
SET XX=$$ISTYPE^RCDPEU1(344.4,ERAIEN,"T")
+44 ; PRCA*4.5*349 - Check if this is TRICARE ERA
IF XX
SET WHICH=3
+45 ; Else it must be a Medical or Rx ERA
IF '$TEST
SET WHICH=$SELECT($$PHARM^RCDPEAP1(ERAIEN):2,1:1)
+46 ;
+47 ; Scan index for auto-decreased claim lines within the ERA
+48 ; and Save claim line detail to ^TMP global
+49 SET RCRZ=""
+50 FOR
Begin DoDot:3
+51 SET RCRZ=$ORDER(^RCY(344.4,"G",ADDATE,ERAIEN,RCRZ))
+52 if 'RCRZ
QUIT
+53 SET EOBIEN=$$GET1^DIQ(344.41,RCRZ_","_ERAIEN_",",.02,"I")
+54 ; Check if this decrease was for a zero line
+55 ; PRCA*4.5*326
SET RCZERO=0
+56 ; PRCA*4.5*326
IF +$$GET1^DIQ(344.41,RCRZ_","_ERAIEN_",",.03)=0
SET RCZERO=1
+57 ; Get amount decreased
+58 SET AMT=+$$GET1^DIQ(344.41,RCRZ_","_ERAIEN_",",8)
+59 ;
+60 ; Find all Claim level and Claim line level CARCs
+61 ; PRCA*4.5*345 - Added WHICH
SET CARCS=$$CARCLMT^RCDPEAD(EOBIEN,RCZERO,WHICH,1,ADDATE)
+62 ; PRCA*4.5*326 - remove any CARCs which were not decreased
SET CARCS=$$MAX(CARCS,AMT)
+63 ; No CARCs found
if +CARCS=0
QUIT
+64 DO SAVE^RCDPEADP(ADDATE,ERAIEN,RCRZ,EXCEL,RCSORT,CARCS,.RCTR,STNAM,STNUM)
End DoDot:3
if 'RCRZ
QUIT
End DoDot:2
if 'ERAIEN
QUIT
End DoDot:1
+65 QUIT
+66 ;
ERASTA(ERAIEN,STA,STNUM,STNAM) ; Get the station for this ERA
+1 ; Input: ERAIEN - Internal IEN for file 344.4
+2 ; Output: STA - Internal Station IEN
+3 ; STNUM - Station Number
+4 ; STNAM - Station Name
+5 NEW ERAEOB,ERABILL,STAIEN
+6 SET (ERAEOB,ERABILL)=""
+7 SET (STA,STNUM,STNAM)="UNKNOWN"
+8 SET ERAEOB=$$GET1^DIQ(344.41,"1,"_ERAIEN_",",.02,"I")
+9 if 'ERAEOB
QUIT
+10 SET ERABILL=$$GET1^DIQ(361.1,ERAEOB,.01,"I")
+11 if 'ERABILL
QUIT
+12 SET STAIEN=$$GET1^DIQ(399,ERABILL,.22,"I")
+13 if 'STAIEN
QUIT
+14 SET STA=STAIEN
+15 SET STNAM=$$EXTERNAL^DILFD(399,.22,,STA)
+16 SET STNUM=$$GET1^DIQ(40.8,STAIEN,1,"I")
+17 QUIT
+18 ;
HDR(EXCEL,HDRINFO,PAGE,NOLINE) ; Print the report header
+1 ; Input: EXCEL - 1 if output to Excel, 0 otherwise
+2 ; HDRINFO() - Array of Header information
+3 ; PAGE - Current Page Number
+4 ; NOLINE - 1 to not display Claim line header
+5 ; Optional, defaults to 0
+6 ; Output: PAGE - Updated Page Number (if EXCEL=0)
+7 NEW DIV,MSG,SUB,XX,Y,Z0,Z1
+8 if '$DATA(NOLINE)
SET NOLINE=0
+9 IF EXCEL
Begin DoDot:1
+10 WRITE !,"STATION^STATION NUMBER^CLAIM #^PATIENT NAME^PAYER^DECREASE AMOUNT^DATE^CARC"
+11 WRITE "^DECREASE AMT^#^REASON"
End DoDot:1
QUIT
+12 ;
+13 SET PAGE=PAGE+1
+14 WRITE @IOF
+15 SET MSG(1)=" EDI Lockbox Auto-Decrease Adjustment Report "
+16 SET MSG(1)=MSG(1)_" Page: "_PAGE
+17 SET MSG(2)=" Run Date: "_HDRINFO("RUNDATE")
+18 SET Z0="Divisions: "_HDRINFO("DIVISIONS")
+19 SET MSG(3)=$SELECT($LENGTH(Z0)<75:$JUSTIFY("",75-$LENGTH(Z0)\2),1:"")_Z0
+20 SET XX=" (Date Decrease Applied)"
+21 SET MSG(4)=" Date Range: "_HDRINFO("START")_" - "_HDRINFO("END")_XX
+22 ; ; PRCA*4.5*326
SET MSG(5)=$EXTRACT(HDRINFO("SORT")_$JUSTIFY("",46),1,44)_" "_HDRINFO("TYPE")
+23 SET MSG(6)=""
+24 IF 'NOLINE
Begin DoDot:1
+25 SET MSG(7)="Claim # Patient Name Payer Decrease Amt Date "
+26 SET MSG(8)="============================================================================"
End DoDot:1
+27 DO EN^DDIOL(.MSG)
+28 QUIT
+29 ;
HINFO(INPUTS,HDRINFO) ;Get header information
+1 ; Input: INPUTS - See REPORT^RCDPEADP for a complete description
+2 ; HDRINFO - Return array - passed by reference
+3 ; Output: HDRINFO - Formatted header array for ListMan
+4 NEW XX
+5 ; Auto-Post Date range
SET XX=$PIECE(INPUTS,"^",4)
+6 SET HDRINFO("START")=$$FMTE^XLFDT($PIECE(XX,"|",1),"2SZ")
+7 SET HDRINFO("END")=$$FMTE^XLFDT($PIECE(XX,"|",2),"2SZ")
+8 SET HDRINFO("RUNDATE")=$$FMTE^XLFDT($$NOW^XLFDT,"2SZ")
+9 ; Sort Type
SET XX=$PIECE(INPUTS,"^",2)
+10 SET HDRINFO("SORT")="SORTED BY: "_$SELECT(XX="C":"CLAIM",XX="P":"PAYER",1:"PATIENT NAME")
+11 SET XX=$SELECT($PIECE(INPUTS,"^",3)="L":"LAST TO FIRST",1:"FIRST TO LAST")
+12 SET HDRINFO("SORT")=HDRINFO("SORT")_" - "_XX
+13 ; Format Division filter
+14 ; XX=1 - All Divisions, 2- selected
SET XX=$PIECE(INPUTS,"^",1)
+15 SET HDRINFO("DIVISIONS")=$SELECT(XX=2:$$LINE^RCDPEAD2(.RCVAUTD),1:"ALL")
+16 ; PRCA*4.5*326 - Add M/P/T filter to report
+17 ; M/P/T/A = Medical/Pharmacy/Tricare/All
SET XX=$PIECE(INPUTS,"^",7)
+18 SET HDRINFO("TYPE")="MEDICAL/PHARMACY/TRICARE: "
+19 SET HDRINFO("TYPE")=HDRINFO("TYPE")_$SELECT(XX="M":"MEDICAL",XX="P":"PHARMACY",XX="T":"TRICARE",1:"ALL")
+20 QUIT
+21 ;
LMAN(DATA,A1,A2,A3,XX) ; Format and save List Manager line
+1 ; Input: DATA - ERA line adjustment total
+2 ; A1,A2,A3 - ^TMP("RCDPEAP") subscripts
+3 ; XX - List Counter for ^TMP("RCDPE_ADP",$J)
+4 NEW CARCAMT,CCTR,DATA1,Y
+5 ; Claim #
SET Y=$EXTRACT($PIECE(DATA,U,3),1,12)
+6 ; Patient Name
SET $EXTRACT(Y,15)=$EXTRACT($PIECE(DATA,U,4),1,20)
+7 ; Payer Name
SET $EXTRACT(Y,37)=$EXTRACT($PIECE(DATA,U,5),1,19)
+8 ; Auto-Decrease Amount
SET $EXTRACT(Y,55)=$JUSTIFY($PIECE(DATA,U,6),12,2)
+9 ; Auto-Decrease Date
SET $EXTRACT(Y,69)=$PIECE(DATA,U,7)
+10 SET ^TMP("RCDPE_ADP",$JOB,XX)=Y
SET XX=XX+1
+11 SET ^TMP("RCDPE_ADP",$JOB,XX)=" "
SET XX=XX+1
+12 SET ^TMP("RCDPE_ADP",$JOB,XX)=" CARC Decrease Amt # Reason"
SET XX=XX+1
+13 SET ^TMP("RCDPE_ADP",$JOB,XX)=" -------------------- ------------- ---- -----------------------------"
SET XX=XX+1
+14 SET CCTR=0
+15 FOR
SET CCTR=$ORDER(^TMP("RCDPEADP",$JOB,A1,A2,A3,CCTR))
if 'CCTR
QUIT
Begin DoDot:1
+16 ;Display a line for each CARC adjustment on the line
+17 SET DATA1=$GET(^TMP("RCDPEADP",$JOB,A1,A2,A3,CCTR))
SET CARCAMT=$PIECE(DATA1,U,2)
+18 ; CARC
SET Y=" "_$EXTRACT($PIECE(DATA1,U,1),1,20)
+19 ; Decrease Amount
SET $EXTRACT(Y,27)=$JUSTIFY($PIECE(DATA1,U,2),12,2)
+20 ; Quantity
SET $EXTRACT(Y,42)=$JUSTIFY($PIECE(DATA1,U,3),4)
+21 ; Reason
SET $EXTRACT(Y,48)=$EXTRACT($PIECE(DATA1,U,4),1,32)
+22 SET ^TMP("RCDPE_ADP",$JOB,XX)=Y
SET XX=XX+1
End DoDot:1
+23 SET ^TMP("RCDPE_ADP",$JOB,XX)=" "
SET XX=XX+1
+24 QUIT
+25 ;
LMOUT(INPUT,RCVAUTD,IO) ; EP Output report to Listman
+1 ; Input: INPUT - See REPORT for a complete description
+2 ; RCVAUTD - Array of selected Divisions
+3 ; Only passed if A1=2
+4 ; IO - Output device array
+5 ; Output: ^TMP("RCDPE_LAR",$J,CTR)=Line - Array of display lines (no headers)
+6 ; for output to Listman
+7 ; Only set when A7-1
+8 NEW HDR,HDRINFO,XX,Z0
+9 ; Get the lines to be displayed
DO REPORT^RCDPEADP(INPUT,.RCVAUTD,.IO)
+10 DO HINFO(INPUT,.HDRINFO)
+11 SET HDR("TITLE")="AUTO-DECREASE REPORT"
+12 SET HDR(1)=" RUN DATE: "_HDRINFO("RUNDATE")
+13 SET Z0="DIVISIONS: "_HDRINFO("DIVISIONS")
+14 SET HDR(2)=$SELECT($LENGTH(Z0)<75:$JUSTIFY("",75-$LENGTH(Z0)\2),1:"")_Z0
+15 SET XX=" (DATE DECREASE APPLIED)"
+16 SET HDR(3)=" DATE RANGE: "_HDRINFO("START")_" - "_HDRINFO("END")_XX
+17 ; PRCA*4.5*326
SET HDR(4)=$EXTRACT(HDRINFO("SORT")_$JUSTIFY("",46),1,44)_" "_HDRINFO("TYPE")
+18 SET HDR(5)=""
+19 SET HDR(6)=""
+20 SET HDR(7)="CLAIM # PATIENT NAME PAYER DECREASE AMT DATE "
+21 ; Generate ListMan display
DO LMRPT^RCDPEARL(.HDR,$NAME(^TMP("RCDPE_ADP",$JOB)))
+22 ;
+23 KILL ^TMP("RCDPEADP",$JOB),^TMP($JOB,"RCDPEADP"),^TMP("RCDPE_ADP",$JOB)
+24 QUIT
+25 ;
TOTALD(EXCEL,HDRINFO,PAGE,STOP,DAY,DTOTAL) ; Totals for a single day
+1 ; Input: EXCEL - 1 if output to Excel, 0 otherwise
+2 ; HDRINFO() - Array of header information
+3 ; PAGE - Current Page Number
+4 ; DAY - Internal Fileman date to display totals for
+5 ; DTOTAL() - Array of totals by day
+6 ; IOSL - Page length
+7 ; Output: PAGE - Updated Page Number (if a new header is displayed)
+8 ; STOP - 1 if displaying to screen and user asked to stop
+9 NEW DAMT,DCNT,Y
+10 IF 'EXCEL
IF $Y>(IOSL-4)
Begin DoDot:1
+11 DO ASK^RCDPEADP(.STOP,0)
+12 if STOP
QUIT
+13 DO HDR(EXCEL,.HDRINFO,.PAGE)
End DoDot:1
+14 if STOP
QUIT
+15 SET DCNT=$PIECE(DTOTAL(DAY),U)
SET DAMT=$PIECE(DTOTAL(DAY),U,2)
+16 SET Y="**Totals for Date: "_$$FMTE^XLFDT(DAY,"2Z")
+17 SET $EXTRACT(Y,35)=" # of Decrease Adjustments: "_DCNT
+18 WRITE !!,Y
+19 SET Y=""
SET $EXTRACT(Y,28)="Total Amount of Decrease Adjustments: $"_$JUSTIFY(DAMT,3,2)
+20 WRITE !,Y
+21 QUIT
+22 ;
+23 ;TOTALS ; Print totals for EXCEL
+24 ;N DAY,DAMT,DCNT
+25 ;S DAY=""
+26 ;F S DAY=$O(DTOTAL(DAY)) Q:'DAY D Q:STOP
+27 ;.;Day totals
+28 ;.D TOTALD(DAY)
+29 ;;Grand totals
+30 ;D TOTALG
+31 ;Q
+32 ;
TOTALG(EXCEL,HDRINFO,PAGE,GTOTAL,STOP) ; Overall report total
+1 ; Input: EXCEL - 1 if output to Excel, 0 otherwise
+2 ; HDRINFO() - Array of header information
+3 ; PAGE - Current Page Number
+4 ; GTOTAL() - Grand Totals for report
+5 ; IOSL - Page length
+6 ; Output: PAGE - Updated Page Number (if a new header is displayed)
+7 NEW Y
+8 IF 'EXCEL
IF $Y>(IOSL-6)
Begin DoDot:1
+9 DO ASK^RCDPEADP(.STOP,0)
+10 if STOP
QUIT
+11 DO HDR(EXCEL,.HDRINFO,.PAGE)
End DoDot:1
+12 if STOP
QUIT
+13 WRITE !!,"**** Totals for Date Range: # of Decrease Adjustments: "_+$PIECE(GTOTAL,U,1)
+14 SET Y=""
SET $EXTRACT(Y,28)="Total Amount of Decrease Adjustments: $"_$JUSTIFY((+$PIECE(GTOTAL,U,2)),3,2)
+15 WRITE !,Y,!
+16 QUIT
+17 ;
+18 ; BEGIN - PRCA*4.5*326
MAX(RCINP,RCMAX) ; Input CARCs and remove any over what was actually auto-decreased
+1 ; INPUT - RCINP - list of all CARCs on EEOB
+2 ; RCMAX - total amount auto-decreased on claim
+3 ; OUTPUT - RCOUT - list of CARCs actually auto-decreased
+4 ;
+5 NEW J,RCIARR,RCITEM,RCJ,RCK,RCNT,RCOUT,RCTOT
+6 ;
+7 SET RCOUT=""
+8 ; Order CARCs for Auto-Decrease in largest to smallest amount order
+9 FOR J=1:1
SET RCITEM=$PIECE(RCINP,U,J)
if RCITEM=""
QUIT
SET RCIARR(-($PIECE(RCITEM,";",1)),J)=RCITEM
+10 ; Quit if CARC adjustment array doesn't have any elements to process
if $DATA(RCIARR)<10
QUIT RCOUT
+11 ;
+12 ; Get top limit for auto-decrease
+13 ;S RCMAX=+$$GET1^DIQ(344.61,"1,",.05)
+14 ; Only include CARCs if the decrease total is less than or equal to claim maximum
+15 SET RCJ=""
SET RCTOT=0
SET RCNT=0
+16 FOR
SET RCJ=$ORDER(RCIARR(RCJ))
if RCJ=""
QUIT
Begin DoDot:1
+17 SET RCK=""
+18 FOR
SET RCK=$ORDER(RCIARR(RCJ,RCK))
if RCK=""
QUIT
Begin DoDot:2
+19 SET RCTOT=RCTOT+$PIECE(RCIARR(RCJ,RCK),";")
+20 if RCTOT>RCMAX
QUIT
+21 SET RCNT=RCNT+1
+22 SET $PIECE(RCOUT,U,RCNT)=RCIARR(RCJ,RCK)
End DoDot:2
End DoDot:1
+23 QUIT RCOUT
+24 ;END - PRCA*4.5*326
