RCDPEAD3 ;ALB/PJH - AUTO DECREASE ; 6/27/19 2:43pm
;;4.5;Accounts Receivable;**345,349**;Mar 20, 1995;Build 44
;Per VA Directive 6402, this routine should not be modified.
;Read ^IBM(361.1) via Private IA 4051
;
EN(RCDAY) ; EP - EN^RCDPEM. Auto Decrease - applies to auto-posted claims only
;
; INPUT RCDAY - Day to search for auto-posted but not decreased lines
; OUTPUT - Auto-decreases claims
;
N IEN350,IENS41,J,RC6AM,RCARRAY,RCBAL3RD,RCBILL,RCDAYS,RCERA,RCLINE,RCPAID,RCQIEN,RCRTYPE,RCSECS,STAT,STATUS,X
; Nightly process does not pass RCDAY. Default: Run for most recent business day minus RCDAYS delay
S RCDAYS=+$$GET1^DIQ(342,"1,",.15,"E")
I $G(RCDAY)="" D ;
. S RCSECS=$P($H,",",2)
. S RC6AM=21600
. S RCDAY=$$FMADD^XLFDT(DT,$S(RCSECS<RC6AM:-1-RCDAYS,1:-RCDAYS))
;
; Status of 1st Party Claim can be OPEN,ACTIVE
F J=16,42 S STAT(J)=""
;
; Scan "F" index of ERA file for ERA entries with AUTOPOST DATE field 344.41 #9 matching RCDAY
S RCERA=0
F S RCERA=$O(^RCY(344.4,"F",RCDAY,RCERA)) Q:'RCERA D
. ; Build index to scratchpad for this ERA
. K RCARRAY
. D BUILD^RCDPEAP(RCERA,.RCARRAY)
. ;
. ; Scan ERA DETAIL entries in #344.41 for auto-posted medical claims
. S RCLINE=0
. F S RCLINE=$O(^RCY(344.4,"F",RCDAY,RCERA,RCLINE)) Q:'RCLINE D
. . ; Process line
. . I $$GET1^DIQ(344.41,RCLINE_","_RCERA_",",10.01,"I") Q ; PRCA*4.5*349 - Already processed before
. . D EN2(RCERA,.RCARRAY,RCLINE)
. . D FLAG(RCERA,RCLINE) ; PRCA*4.5*349 - Flag line as having been processed
;
; Scan entries in RCDPE FIRST PARTY CHARGE QUEUE that could not be decreased due to existence of a pre-pay
S RCQIEN=0
F S RCQIEN=$O(^RCY(344.74,RCQIEN)) Q:'RCQIEN D ;
. S IEN350=$$GET1^DIQ(344.74,RCQIEN_",",.01,"I")
. S RCBILL=$$GET1^DIQ(344.74,RCQIEN_",",.02,"I")
. S IENS41=$$GET1^DIQ(344.74,RCQIEN_",",.04,"E")
. S (RCPAID,RCBAL3RD)=+$$GET1^DIQ(344.41,IENS41,.03)
. ; Access to file 350 DBIA4541.
. S STATUS=$$GET1^DIQ(350,IEN350_",",.05,"I")
. I STATUS'=8 D DEL74(RCQIEN) ; If charge is not on hold remove from queue, but continue with checks.
. I STATUS'=3,STATUS'=8 Q ; Charge not on hold or billed so quit
. ;
. ; On hold charge with no pre-pay. Release from hold.
. I STATUS=8 D ;
. . I $$PREPAY(IEN350)=1 Q ; Still has open pre-pay so quit
. . S IBNOS=IEN350,IBSEQNO=1,IBDUZ=.5
. . S DFN=$$GET1^DIQ(350,IEN350_",",.02,"I") ; DBIA4541
. . D ^IBR ; Call to ^IBR allowed by DBIA7007
. . D DEL74(RCQIEN) ; Charge released from hold, remove from queue.
. ;
. S STATUS=$$GET1^DIQ(350,IEN350_",",.05,"I")
. I STATUS'=3 Q
. ;
. S X=$$PROCESS(IEN350,RCBILL,RCPAID,.RCBAL3RD) ; Process this charge for attempted auto-decrease
;
Q
;
EN2(RCERA,RCARRAY,RCLINE) ; Auto-decrease selected lines
; Input: RCERA - ERA number
; RCARRAY - Array of ERA Scratchpad lines
; RCLINE - ERA line sequence
;
; Get claim number RCBILL for the ERA line using EOB #361.1 pointer
N AMT,COMMENT,COPAY,DEBT,DFN,EOBIEN,FDA,IBNOS,IBSEQNO,IBDUZ,PRCADB,PRCATY,QUIT
N RCBAL,RCBILL,RCCLAIM,RCCOPAY,RCGROUP,RCLST,RCSTATUS,RCSUB,RCTRANDA,RCTYP3,RCTYPE,STATUS
;
; Get amount paid on the line
S IENS41=RCLINE_","_RCERA_","
S (RCPAID,RCBAL3RD)=+$$GET1^DIQ(344.41,IENS41,.03)
;
; Quit if this is a no-payment line
I RCPAID=0 Q
;
; Get pointer to EOB file #361.1 from ERA DETAIL
S EOBIEN=$P($G(^RCY(344.4,RCERA,1,RCLINE,0)),U,2),RCBILL=0
;
; Get ^DGCR(399 pointer (DINUM for #430 file)
S:EOBIEN RCBILL=$P($G(^IBM(361.1,EOBIEN,0)),U) Q:'RCBILL
S RCTYP3=$$TYP^IBRFN(RCBILL) ; Get type of bill and only match with same type. DBIA 2031 covers call to TYP^IBRFN
;
; If claim has been split/edit and claim changed in APAR do not auto decrease - BOOKMARK - VERIFY WITH EPAY TEAM
Q:$$SPLIT^RCDPEAD(RCERA,RCLINE,RCBILL,.RCARRAY)
;
; Do not auto decrease if claim is referred to General Council
Q:$P($G(^PRCA(430,RCBILL,6)),U,4)]""
;
; Get copay details
K ^TMP("IBRBF",$J)
D RELBILL^IBRFN(RCBILL) ; Integration agreement DBIA3124
; Quit if no related 1st Party claim
I '$O(^TMP("IBRBF",$J,RCBILL,0)) Q
; Get COPAY amount and COPAY claim IEN for #430
;
S QUIT=0
S RCSUB=0
F S RCSUB=$O(^TMP("IBRBF",$J,RCBILL,RCSUB)) Q:'RCSUB D Q:QUIT ;
. S RCTYPE=$$GET1^DIQ(350,RCSUB_",",.03,"I") ; Access to file 350 covered by DBIA4541
. S RCGROUP=$$GET1^DIQ(350,RCSUB_",",".03:.11","I") ; Billing group 4=OPT COPAY, 5=RX COPAY
. I RCTYPE=""!(RCGROUP="") Q
. I $D(^RC(342,1,14,"ACE",1,RCTYPE)) D ; Action type is flagged for auto-decrease
. . I RCTYP3="O",RCGROUP'=4 Q ; Only match O/P claim with O/P charge
. . I RCTYP3="PH",RCGROUP'=5 Q ; Only match RX claim with RX charge
. . S RCLST(RCBILL,RCSUB)=""
. . ; If charge is on hold then release it.
. . S STATUS=$$GET1^DIQ(350,RCSUB_",",.05,"I") ; DBIA4541
. . I STATUS=8 D ; Charge is in on-hold, can it be released?
. . . I $$PREPAY(RCSUB)=1 D QUEUE(RCSUB,RCBILL,IENS41) Q ; Open prepay, queue the charge to check later
. . . S IBNOS=RCSUB,IBSEQNO=1,IBDUZ=.5
. . . S DFN=$$GET1^DIQ(350,RCSUB_",",.02,"I") ; DBIA4541
. . . D ^IBR ; Call to ^IBR allowed by DBIA7007
. . ;
. . S STATUS=$$GET1^DIQ(350,RCSUB_",",.05,"I") ; DBIA4541. Check status again, after release from hold.
. . I STATUS'=3 Q ; Status should be billed if charge was released.
. . ;
. . S QUIT=$$PROCESS(RCSUB,RCBILL,RCPAID,.RCBAL3RD) ; Process this charge for attempted auto-decrease
;
K ^TMP("IBRBF",$J)
Q
;
PROCESS(IEN350,RCBILL,RCPAID,RCBAL3RD) ; Process this charge for attempted auto-decrease
; Inputs: IEN350 - Internal entry number for charge in file #350
; RCBILL - Internal entry number for third party bill from file #399
; RCPAID - Amount paid on ERA line for this third party bill
; RCBAL3RD - Remaining balance on third party bill not yet used for auto-decrease of a copay
; Returns: 1 - quit loop after processing this record
; 0 - don't quit
;
; Get copay claim (external format)
S RETURN=0
S RCCLAIM=$$GET1^DIQ(350,IEN350_",",.11) ; DBIA4541
I RCCLAIM="" Q 0
S RCCOPAY=$O(^PRCA(430,"B",RCCLAIM,""))
I 'RCCOPAY Q 0
S STATUS=$P($G(^PRCA(430,RCCOPAY,0)),"^",8)
; Check 1st Party claim status vs list allowed for auto-decrease
I '$D(STAT(STATUS)) Q 0
;
; Get copay balance remaining
S COPAY=+$$GET1^DIQ(430,RCCOPAY_",",11)
; Quit if copay balance is zero
I COPAY=0 Q 0
; PRCA*4.5*349 - Only process auto-decrease if copay balance = (charge - (previous auto-decreases))
I +COPAY'=($$GET1^DIQ(350,IEN350_",",.07)-$$DECAMT(RCCOPAY)) Q 0 ; DBIA4541
;
; Get 1st party balance
S DEBT=$$GET1^DIQ(430,RCCOPAY_",",9,"I")
I 'DEBT Q 0
S PRCADB=$$GET1^DIQ(340,DEBT_",",.01,"I")
S PRCATY="ALL"
D COMP^PRCAAPR
S RCBAL=+$G(^TMP("PRCAAPR",$J,"C"))
K ^TMP("PRCAAPR",$J)
; Determine decrease amount
S AMT=$$AMT(RCBAL,RCBAL3RD,COPAY)
; Ignore zero amounts
Q:AMT'>0 0
; Decrease adjustment comment
D COMM1(.COMMENT,IEN350,RCBILL,AMT,RCPAID)
; Apply DECREASE ADJUSTMENT for COPAY
S RCTRANDA=$$INCDEC^RCBEUTR1(RCCOPAY,-AMT,.COMMENT,"","",0) Q:'RCTRANDA 0
; File third party bill on decrease adjustment transaction
K FDA
S FDA(433,RCTRANDA_",",94)=RCBILL
S FDA(433,RCTRANDA_",",42)=.5 ; Make sure PROCESSED BY is postmaster
D FILE^DIE("","FDA")
; Add a comment transaction to first party bill also.
S RCTRANDA=$$TRAN1(IEN350,RCBILL,RCCOPAY,AMT,RCPAID)
S RCTRANDA=$$TRAN3(IEN350,RCBILL,RCCOPAY,AMT,COPAY) ; Add third party bill comment Transaction
S RCBAL3RD=RCBAL3RD-AMT ; Take amount off the 3rd party payment and use for subsequent decrease.
I RCBAL3RD=0!(RCBAL3RD<0) S RETURN=1
Q RETURN
;
AMT(RCBAL,RCPAID,RCOPAY) ; Calculate Decrease Amount
;
; INPUT
; RCBAL - 1st Party Balance
; RCPAID - Amount Paid on 3rd Party claim
; RCOPAY - Copay amount
; OUTPUT
; Amount to decrease
;
; Existing credit balance on 1st party account
I RCBAL<0!(RCBAL=0) Q 0 ; Adjustment would leave the account in credit so don't do anything
I RCBAL<COPAY Q $S(RCPAID<RCBAL:RCPAID,1:RCBAL)
; Existing debit balance on 1st party account
Q $S(RCPAID<RCOPAY:RCPAID,1:RCOPAY)
;
SHOWTYP() ; EP - Display list of IB ACTION TYPE enabled for 1st party auto-decrease
; Input - None
; Output - To screen
N COUNT,FLAG,IEN2,TYPE,X
S COUNT=0
S FLAG=$$GET1^DIQ(342,"1,",.14,"I")
I FLAG D ; Only show enabled types if auto-decrease is on
. S IEN2=0
. F S IEN2=$O(^RC(342,1,14,IEN2)) Q:'IEN2 D ;
. . S FLAG=$$GET1^DIQ(342.014,IEN2_",1,",.02,"I")
. . I FLAG D ;
. . . I COUNT=0 W !!,"Charge types enabled for 1st party auto-decrease:"
. . . W !," "_$$GET1^DIQ(342.014,IEN2_",1,",.01,"E")
. . . S COUNT=COUNT+1
W !
Q
;
TRAN1(IEN350,IEN399,IEN430,AMT,RCPAID) ; File auto-decrease comment on first party AR
; Input: IEN350 - Internal entry number to IB Action (File #350)
; IEN399 - Internal entry number to Third Party Bill (Files #399 and #430)
; IEN430 - Internal entry number of First Party Bill (File #430)
; AMT - Amount of auto-decease
; RCPAID - Amount paid on third party bill
;
N BILL3,BILL430,COMMENT,FDA,IENS,RCDOS
S RCDOS=$$DOS(IEN350)
S BILL3=$$GET1^DIQ(399,IEN399_",",.01,"E")
S BILL430=$$GET1^DIQ(430,IEN399_",",.01,"E")
;
S RCTRANDA=$$ADD433^RCBEUTRA(IEN430,45) I 'RCTRANDA Q 0
;
S FDA(433,RCTRANDA_",",4)=2
S FDA(433,RCTRANDA_",",5.02)=BILL3_" PD $"_$FN(AMT,"",2)_" DOS:"_RCDOS
S FDA(433,RCTRANDA_",",11)=DT
S FDA(433,RCTRANDA_",",15)=0
S FDA(433,RCTRANDA_",",42)=.5
D FILE^DIE("","FDA")
;
S COMMENT(1)="THIRD PARTY PAYMENT RECIEVED ON BILL NUMBER "_BILL430_" = $"_$FN(RCPAID,"",2)
S COMMENT(2)="DOS:"_RCDOS_" "_$$RXMT(IEN350)
S COMMENT(3)="$"_$FN(AMT,"",2)_" AUTO-DECREASE APPLIED FOR CLAIMS MATCHING"
S COMMENT(4)=$$GET1^DIQ(200,".5,",.01,"E")
D WP^DIE(433,RCTRANDA_",",41,"","COMMENT")
L -^PRCA(433,RCTRANDA)
Q RCTRANDA
Q
;
TRAN3(IEN350,IEN399,IEN430,AMT,COPAY) ; File auto-decrease comment on third party AR
; Input: IEN350 - Internal entry number to IB Action (File #350)
; IEN399 - Internal entry number to Third Party Bill (Files #399 and #430)
; IEN430 - Internal entry number of First Party Bill (File #430)
; AMT - Amount of auto-decease
; COPAY - Copay amount being decreased
;
N BILL1,COMMENT,FDA,IENS,RCDOS
S RCDOS=$$DOS(IEN350)
S BILL1=$$GET1^DIQ(430,IEN430_",",.01,"E")
;
S RCTRANDA=$$ADD433^RCBEUTRA(IEN399,45) I 'RCTRANDA Q 0
;
S FDA(433,RCTRANDA_",",4)=2
S FDA(433,RCTRANDA_",",5.02)=BILL1_" offset $"_$FN(AMT,"",2)
S FDA(433,RCTRANDA_",",11)=DT
S FDA(433,RCTRANDA_",",15)=0
S FDA(433,RCTRANDA_",",42)=.5
D FILE^DIE("","FDA")
;
S COMMENT(1)="FIRST PARTY BILL # "_BILL1_" AUTO-DECREASED $"_$FN(AMT,"",2)_" FOR CLAIMS MATCHING"
S COMMENT(2)="DOS:"_RCDOS
S COMMENT(3)=$$GET1^DIQ(200,".5,",.01,"E")
D WP^DIE(433,RCTRANDA_",",41,"","COMMENT")
L -^PRCA(433,RCTRANDA)
Q RCTRANDA
;
COMM1(COMMENT,IEN350,IEN399,AMT,RCPAID) ; Build comment text for first party bill
; Input: IEN350 - Internal entry number to IB Action (File #350)
; IEN399 - Internal entry number to Third Party Bill (Files #399 and #430)
; AMT - Amount of auto-decease
; RCPAID - Amount paid on third party bill
; Output: COMMENT - Array passed by reference
N BILL3
S BILL3=$$GET1^DIQ(430,IEN399_",",.01,"E")
S COMMENT(1)="THIRD PARTY PAYMENT RECIEVED ON BILL NUMBER "_BILL3_" = $"_$FN(RCPAID,"",2)
S COMMENT(2)="DOS: "_$$DOS(IEN350)_" "_$$RXMT(IEN350)
S COMMENT(3)="$"_$FN(AMT,"",2)_" AUTO-DECREASE APPLIED FOR CLAIMS MATCHING"
S COMMENT(4)=$$GET1^DIQ(200,".5,",.01,"E")
Q
;
DOS(IEN350) ; Get Date of Service for charge
; Input: IEN350 - Intenal entry number of IB Action (file #350)
;
N FIELD,FILE,FROM,IEN,RETURN
S RETURN=""
S FROM=$$GET1^DIQ(350,IEN350_",",.04,"I") ; DBIA4541
S FILE=$P(FROM,":",1),IEN=+$P(FROM,":",2)
; Use issue date for prescription or date for o/p encounter
S FIELD=$S(FILE=52:1,FILE=409.68:.01,1:"")
I FIELD="" S FILE=350,FIELD=.17,IEN=IEN350 ; If not Rx or o/p use Event date from charge file
S RETURN=$$GET1^DIQ(FILE,IEN_",",FIELD,"I")
I RETURN'="" S RETURN=$$FMTE^XLFDT(RETURN,"2D")
Q RETURN
;
RXMT(IEN350) ; Return Rx # or "MT" for transaction comment line
; Input: IEN350 - Internal entry number of IB Action (file #350)
;
N FROM,RETURN
S RETURN="MT"
S FROM=$$GET1^DIQ(350,IEN350_",",.04,"I") ; DBIA4541
S FILE=$P(FROM,":",1),IEN=+$P(FROM,":",2)
I FILE=52 S RETURN="RX#: "_$$GET1^DIQ(FILE,IEN_",",.01,"E") ; RX #
Q RETURN
;
PREPAY(IEN350) ; Check for open pre-pay
; Input: IEN350 - Internal entry number of charge from IB ACTION file #350
; Returns: 1 - Patient has an open pre-payment
; 0 - No open pre-payment
; -1 - Error
N PIEN,RCDATA7,RCDEBTDA,RCPREDA,RCVPP,RETURN
S RETURN=0
S PIEN=$$GET1^DIQ(350,IEN350_",",.02,"I")
I 'PIEN Q -1
S RCVPP=PIEN_";DPT(" ; Variable pointer to debtor file 340
S RCDEBTDA=$O(^RCD(340,"B",RCVPP,0))
I 'RCDEBTDA Q -1
;
S RCPREDA=0
F S RCPREDA=$O(^PRCA(430,"AS",RCDEBTDA,42,RCPREDA)) Q:'RCPREDA!(RETURN'=0) D
. ;
. I $$GET1^DIQ(430,RCPREDA_",",2,"I")'=26 Q ; Not a prepayment
. I $$GET1^DIQ(430,RCPREDA_",",8,"E")'="OPEN" Q ; If CURRENT STATUS not "OPEN" skip
. I '$$GET1^DIQ(430,RCPREDA_",",71,"I") Q ; No balance on prepayment so skip.
. ;
. S RETURN=1
;
Q RETURN
;
QUEUE(IEN350,IEN399,IENS41) ; Place the charge in a queue from processing at a later date
; Input: IEN350 - Internal entry number of charge from IB ACTION file #350
; IEN399 - Internal entry number of third party bill from file 399 or 430
; IENS41 - Internal entry numbers of subfile 344.41 in format nnn,nnnnnnn,
; Output: New entry in file #344.74
;
N FDA,IENS
S IENS="+1,"
S FDA(344.74,IENS,.01)=IEN350
S FDA(344.74,IENS,.02)=IEN399
S FDA(344.74,IENS,.03)=$$NOW^XLFDT()
S FDA(344.74,IENS,.04)=IENS41
D UPDATE^DIE("","FDA")
Q
DEL74(IEN74) ; Delete FIRST PARTY CHARGE QUEUE entry
; Input: IEN74 - Internal entry number of file 344.74
; Output: None
N FDA
S FDA(344.74,IEN74_",",.01)="@"
D FILE^DIE("","FDA")
Q
;
; Subroutine added for PRCA*4.5*349
DECAMT(IEN430) ; Return amount that bill has been previously auto-decreased.
; Input: IEN430 - Internal Entry number of file #430
; Returns: Total amount of previous auto-decreases
N RETURN,TRANDA,TYPE
S RETURN=0
S TRANDA=""
F S TRANDA=$O(^PRCA(433,"C",IEN430,TRANDA)) Q:'TRANDA D ;
. I $$GET1^DIQ(433,TRANDA_",",12,"E")'="DECREASE ADJUSTMENT" Q
. I $$GET1^DIQ(433,TRANDA_",",42,"E")'="POSTMASTER" Q
. S RETURN=RETURN+$$GET1^DIQ(433,TRANDA_",",15,"E") ; Add auto-decrease amount to total
Q RETURN
;
; PRCA*4.5*349 - Subroutine added
FLAG(RCERA,RCLINE) ; Flag ERA detail line as having been checked or processed for 1st party auto-decrease
; Input: RCERA - Internal entry number of file 344.4
; RCLINE - Internal entry number of subfile 344.41
N FDA
S FDA(344.41,RCLINE_","_RCERA_",",10.01)=1
D FILE^DIE("","FDA")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEAD3 15261 printed Apr 09, 2024@20:50:07 Page 2
RCDPEAD3 ;ALB/PJH - AUTO DECREASE ; 6/27/19 2:43pm
+1 ;;4.5;Accounts Receivable;**345,349**;Mar 20, 1995;Build 44
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;Read ^IBM(361.1) via Private IA 4051
+4 ;
EN(RCDAY) ; EP - EN^RCDPEM. Auto Decrease - applies to auto-posted claims only
+1 ;
+2 ; INPUT RCDAY - Day to search for auto-posted but not decreased lines
+3 ; OUTPUT - Auto-decreases claims
+4 ;
+5 NEW IEN350,IENS41,J,RC6AM,RCARRAY,RCBAL3RD,RCBILL,RCDAYS,RCERA,RCLINE,RCPAID,RCQIEN,RCRTYPE,RCSECS,STAT,STATUS,X
+6 ; Nightly process does not pass RCDAY. Default: Run for most recent business day minus RCDAYS delay
+7 SET RCDAYS=+$$GET1^DIQ(342,"1,",.15,"E")
+8 ;
IF $GET(RCDAY)=""
Begin DoDot:1
+9 SET RCSECS=$PIECE($HOROLOG,",",2)
+10 SET RC6AM=21600
+11 SET RCDAY=$$FMADD^XLFDT(DT,$SELECT(RCSECS<RC6AM:-1-RCDAYS,1:-RCDAYS))
End DoDot:1
+12 ;
+13 ; Status of 1st Party Claim can be OPEN,ACTIVE
+14 FOR J=16,42
SET STAT(J)=""
+15 ;
+16 ; Scan "F" index of ERA file for ERA entries with AUTOPOST DATE field 344.41 #9 matching RCDAY
+17 SET RCERA=0
+18 FOR
SET RCERA=$ORDER(^RCY(344.4,"F",RCDAY,RCERA))
if 'RCERA
QUIT
Begin DoDot:1
+19 ; Build index to scratchpad for this ERA
+20 KILL RCARRAY
+21 DO BUILD^RCDPEAP(RCERA,.RCARRAY)
+22 ;
+23 ; Scan ERA DETAIL entries in #344.41 for auto-posted medical claims
+24 SET RCLINE=0
+25 FOR
SET RCLINE=$ORDER(^RCY(344.4,"F",RCDAY,RCERA,RCLINE))
if 'RCLINE
QUIT
Begin DoDot:2
+26 ; Process line
+27 ; PRCA*4.5*349 - Already processed before
IF $$GET1^DIQ(344.41,RCLINE_","_RCERA_",",10.01,"I")
QUIT
+28 DO EN2(RCERA,.RCARRAY,RCLINE)
+29 ; PRCA*4.5*349 - Flag line as having been processed
DO FLAG(RCERA,RCLINE)
End DoDot:2
End DoDot:1
+30 ;
+31 ; Scan entries in RCDPE FIRST PARTY CHARGE QUEUE that could not be decreased due to existence of a pre-pay
+32 SET RCQIEN=0
+33 ;
FOR
SET RCQIEN=$ORDER(^RCY(344.74,RCQIEN))
if 'RCQIEN
QUIT
Begin DoDot:1
+34 SET IEN350=$$GET1^DIQ(344.74,RCQIEN_",",.01,"I")
+35 SET RCBILL=$$GET1^DIQ(344.74,RCQIEN_",",.02,"I")
+36 SET IENS41=$$GET1^DIQ(344.74,RCQIEN_",",.04,"E")
+37 SET (RCPAID,RCBAL3RD)=+$$GET1^DIQ(344.41,IENS41,.03)
+38 ; Access to file 350 DBIA4541.
+39 SET STATUS=$$GET1^DIQ(350,IEN350_",",.05,"I")
+40 ; If charge is not on hold remove from queue, but continue with checks.
IF STATUS'=8
DO DEL74(RCQIEN)
+41 ; Charge not on hold or billed so quit
IF STATUS'=3
IF STATUS'=8
QUIT
+42 ;
+43 ; On hold charge with no pre-pay. Release from hold.
+44 ;
IF STATUS=8
Begin DoDot:2
+45 ; Still has open pre-pay so quit
IF $$PREPAY(IEN350)=1
QUIT
+46 SET IBNOS=IEN350
SET IBSEQNO=1
SET IBDUZ=.5
+47 ; DBIA4541
SET DFN=$$GET1^DIQ(350,IEN350_",",.02,"I")
+48 ; Call to ^IBR allowed by DBIA7007
DO ^IBR
+49 ; Charge released from hold, remove from queue.
DO DEL74(RCQIEN)
End DoDot:2
+50 ;
+51 SET STATUS=$$GET1^DIQ(350,IEN350_",",.05,"I")
+52 IF STATUS'=3
QUIT
+53 ;
+54 ; Process this charge for attempted auto-decrease
SET X=$$PROCESS(IEN350,RCBILL,RCPAID,.RCBAL3RD)
End DoDot:1
+55 ;
+56 QUIT
+57 ;
EN2(RCERA,RCARRAY,RCLINE) ; Auto-decrease selected lines
+1 ; Input: RCERA - ERA number
+2 ; RCARRAY - Array of ERA Scratchpad lines
+3 ; RCLINE - ERA line sequence
+4 ;
+5 ; Get claim number RCBILL for the ERA line using EOB #361.1 pointer
+6 NEW AMT,COMMENT,COPAY,DEBT,DFN,EOBIEN,FDA,IBNOS,IBSEQNO,IBDUZ,PRCADB,PRCATY,QUIT
+7 NEW RCBAL,RCBILL,RCCLAIM,RCCOPAY,RCGROUP,RCLST,RCSTATUS,RCSUB,RCTRANDA,RCTYP3,RCTYPE,STATUS
+8 ;
+9 ; Get amount paid on the line
+10 SET IENS41=RCLINE_","_RCERA_","
+11 SET (RCPAID,RCBAL3RD)=+$$GET1^DIQ(344.41,IENS41,.03)
+12 ;
+13 ; Quit if this is a no-payment line
+14 IF RCPAID=0
QUIT
+15 ;
+16 ; Get pointer to EOB file #361.1 from ERA DETAIL
+17 SET EOBIEN=$PIECE($GET(^RCY(344.4,RCERA,1,RCLINE,0)),U,2)
SET RCBILL=0
+18 ;
+19 ; Get ^DGCR(399 pointer (DINUM for #430 file)
+20 if EOBIEN
SET RCBILL=$PIECE($GET(^IBM(361.1,EOBIEN,0)),U)
if 'RCBILL
QUIT
+21 ; Get type of bill and only match with same type. DBIA 2031 covers call to TYP^IBRFN
SET RCTYP3=$$TYP^IBRFN(RCBILL)
+22 ;
+23 ; If claim has been split/edit and claim changed in APAR do not auto decrease - BOOKMARK - VERIFY WITH EPAY TEAM
+24 if $$SPLIT^RCDPEAD(RCERA,RCLINE,RCBILL,.RCARRAY)
QUIT
+25 ;
+26 ; Do not auto decrease if claim is referred to General Council
+27 if $PIECE($GET(^PRCA(430,RCBILL,6)),U,4)]""
QUIT
+28 ;
+29 ; Get copay details
+30 KILL ^TMP("IBRBF",$JOB)
+31 ; Integration agreement DBIA3124
DO RELBILL^IBRFN(RCBILL)
+32 ; Quit if no related 1st Party claim
+33 IF '$ORDER(^TMP("IBRBF",$JOB,RCBILL,0))
QUIT
+34 ; Get COPAY amount and COPAY claim IEN for #430
+35 ;
+36 SET QUIT=0
+37 SET RCSUB=0
+38 ;
FOR
SET RCSUB=$ORDER(^TMP("IBRBF",$JOB,RCBILL,RCSUB))
if 'RCSUB
QUIT
Begin DoDot:1
+39 ; Access to file 350 covered by DBIA4541
SET RCTYPE=$$GET1^DIQ(350,RCSUB_",",.03,"I")
+40 ; Billing group 4=OPT COPAY, 5=RX COPAY
SET RCGROUP=$$GET1^DIQ(350,RCSUB_",",".03:.11","I")
+41 IF RCTYPE=""!(RCGROUP="")
QUIT
+42 ; Action type is flagged for auto-decrease
IF $DATA(^RC(342,1,14,"ACE",1,RCTYPE))
Begin DoDot:2
+43 ; Only match O/P claim with O/P charge
IF RCTYP3="O"
IF RCGROUP'=4
QUIT
+44 ; Only match RX claim with RX charge
IF RCTYP3="PH"
IF RCGROUP'=5
QUIT
+45 SET RCLST(RCBILL,RCSUB)=""
+46 ; If charge is on hold then release it.
+47 ; DBIA4541
SET STATUS=$$GET1^DIQ(350,RCSUB_",",.05,"I")
+48 ; Charge is in on-hold, can it be released?
IF STATUS=8
Begin DoDot:3
+49 ; Open prepay, queue the charge to check later
IF $$PREPAY(RCSUB)=1
DO QUEUE(RCSUB,RCBILL,IENS41)
QUIT
+50 SET IBNOS=RCSUB
SET IBSEQNO=1
SET IBDUZ=.5
+51 ; DBIA4541
SET DFN=$$GET1^DIQ(350,RCSUB_",",.02,"I")
+52 ; Call to ^IBR allowed by DBIA7007
DO ^IBR
End DoDot:3
+53 ;
+54 ; DBIA4541. Check status again, after release from hold.
SET STATUS=$$GET1^DIQ(350,RCSUB_",",.05,"I")
+55 ; Status should be billed if charge was released.
IF STATUS'=3
QUIT
+56 ;
+57 ; Process this charge for attempted auto-decrease
SET QUIT=$$PROCESS(RCSUB,RCBILL,RCPAID,.RCBAL3RD)
End DoDot:2
End DoDot:1
if QUIT
QUIT
+58 ;
+59 KILL ^TMP("IBRBF",$JOB)
+60 QUIT
+61 ;
PROCESS(IEN350,RCBILL,RCPAID,RCBAL3RD) ; Process this charge for attempted auto-decrease
+1 ; Inputs: IEN350 - Internal entry number for charge in file #350
+2 ; RCBILL - Internal entry number for third party bill from file #399
+3 ; RCPAID - Amount paid on ERA line for this third party bill
+4 ; RCBAL3RD - Remaining balance on third party bill not yet used for auto-decrease of a copay
+5 ; Returns: 1 - quit loop after processing this record
+6 ; 0 - don't quit
+7 ;
+8 ; Get copay claim (external format)
+9 SET RETURN=0
+10 ; DBIA4541
SET RCCLAIM=$$GET1^DIQ(350,IEN350_",",.11)
+11 IF RCCLAIM=""
QUIT 0
+12 SET RCCOPAY=$ORDER(^PRCA(430,"B",RCCLAIM,""))
+13 IF 'RCCOPAY
QUIT 0
+14 SET STATUS=$PIECE($GET(^PRCA(430,RCCOPAY,0)),"^",8)
+15 ; Check 1st Party claim status vs list allowed for auto-decrease
+16 IF '$DATA(STAT(STATUS))
QUIT 0
+17 ;
+18 ; Get copay balance remaining
+19 SET COPAY=+$$GET1^DIQ(430,RCCOPAY_",",11)
+20 ; Quit if copay balance is zero
+21 IF COPAY=0
QUIT 0
+22 ; PRCA*4.5*349 - Only process auto-decrease if copay balance = (charge - (previous auto-decreases))
+23 ; DBIA4541
IF +COPAY'=($$GET1^DIQ(350,IEN350_",",.07)-$$DECAMT(RCCOPAY))
QUIT 0
+24 ;
+25 ; Get 1st party balance
+26 SET DEBT=$$GET1^DIQ(430,RCCOPAY_",",9,"I")
+27 IF 'DEBT
QUIT 0
+28 SET PRCADB=$$GET1^DIQ(340,DEBT_",",.01,"I")
+29 SET PRCATY="ALL"
+30 DO COMP^PRCAAPR
+31 SET RCBAL=+$GET(^TMP("PRCAAPR",$JOB,"C"))
+32 KILL ^TMP("PRCAAPR",$JOB)
+33 ; Determine decrease amount
+34 SET AMT=$$AMT(RCBAL,RCBAL3RD,COPAY)
+35 ; Ignore zero amounts
+36 if AMT'>0
QUIT 0
+37 ; Decrease adjustment comment
+38 DO COMM1(.COMMENT,IEN350,RCBILL,AMT,RCPAID)
+39 ; Apply DECREASE ADJUSTMENT for COPAY
+40 SET RCTRANDA=$$INCDEC^RCBEUTR1(RCCOPAY,-AMT,.COMMENT,"","",0)
if 'RCTRANDA
QUIT 0
+41 ; File third party bill on decrease adjustment transaction
+42 KILL FDA
+43 SET FDA(433,RCTRANDA_",",94)=RCBILL
+44 ; Make sure PROCESSED BY is postmaster
SET FDA(433,RCTRANDA_",",42)=.5
+45 DO FILE^DIE("","FDA")
+46 ; Add a comment transaction to first party bill also.
+47 SET RCTRANDA=$$TRAN1(IEN350,RCBILL,RCCOPAY,AMT,RCPAID)
+48 ; Add third party bill comment Transaction
SET RCTRANDA=$$TRAN3(IEN350,RCBILL,RCCOPAY,AMT,COPAY)
+49 ; Take amount off the 3rd party payment and use for subsequent decrease.
SET RCBAL3RD=RCBAL3RD-AMT
+50 IF RCBAL3RD=0!(RCBAL3RD<0)
SET RETURN=1
+51 QUIT RETURN
+52 ;
AMT(RCBAL,RCPAID,RCOPAY) ; Calculate Decrease Amount
+1 ;
+2 ; INPUT
+3 ; RCBAL - 1st Party Balance
+4 ; RCPAID - Amount Paid on 3rd Party claim
+5 ; RCOPAY - Copay amount
+6 ; OUTPUT
+7 ; Amount to decrease
+8 ;
+9 ; Existing credit balance on 1st party account
+10 ; Adjustment would leave the account in credit so don't do anything
IF RCBAL<0!(RCBAL=0)
QUIT 0
+11 IF RCBAL<COPAY
QUIT $SELECT(RCPAID<RCBAL:RCPAID,1:RCBAL)
+12 ; Existing debit balance on 1st party account
+13 QUIT $SELECT(RCPAID<RCOPAY:RCPAID,1:RCOPAY)
+14 ;
SHOWTYP() ; EP - Display list of IB ACTION TYPE enabled for 1st party auto-decrease
+1 ; Input - None
+2 ; Output - To screen
+3 NEW COUNT,FLAG,IEN2,TYPE,X
+4 SET COUNT=0
+5 SET FLAG=$$GET1^DIQ(342,"1,",.14,"I")
+6 ; Only show enabled types if auto-decrease is on
IF FLAG
Begin DoDot:1
+7 SET IEN2=0
+8 ;
FOR
SET IEN2=$ORDER(^RC(342,1,14,IEN2))
if 'IEN2
QUIT
Begin DoDot:2
+9 SET FLAG=$$GET1^DIQ(342.014,IEN2_",1,",.02,"I")
+10 ;
IF FLAG
Begin DoDot:3
+11 IF COUNT=0
WRITE !!,"Charge types enabled for 1st party auto-decrease:"
+12 WRITE !," "_$$GET1^DIQ(342.014,IEN2_",1,",.01,"E")
+13 SET COUNT=COUNT+1
End DoDot:3
End DoDot:2
End DoDot:1
+14 WRITE !
+15 QUIT
+16 ;
TRAN1(IEN350,IEN399,IEN430,AMT,RCPAID) ; File auto-decrease comment on first party AR
+1 ; Input: IEN350 - Internal entry number to IB Action (File #350)
+2 ; IEN399 - Internal entry number to Third Party Bill (Files #399 and #430)
+3 ; IEN430 - Internal entry number of First Party Bill (File #430)
+4 ; AMT - Amount of auto-decease
+5 ; RCPAID - Amount paid on third party bill
+6 ;
+7 NEW BILL3,BILL430,COMMENT,FDA,IENS,RCDOS
+8 SET RCDOS=$$DOS(IEN350)
+9 SET BILL3=$$GET1^DIQ(399,IEN399_",",.01,"E")
+10 SET BILL430=$$GET1^DIQ(430,IEN399_",",.01,"E")
+11 ;
+12 SET RCTRANDA=$$ADD433^RCBEUTRA(IEN430,45)
IF 'RCTRANDA
QUIT 0
+13 ;
+14 SET FDA(433,RCTRANDA_",",4)=2
+15 SET FDA(433,RCTRANDA_",",5.02)=BILL3_" PD $"_$FNUMBER(AMT,"",2)_" DOS:"_RCDOS
+16 SET FDA(433,RCTRANDA_",",11)=DT
+17 SET FDA(433,RCTRANDA_",",15)=0
+18 SET FDA(433,RCTRANDA_",",42)=.5
+19 DO FILE^DIE("","FDA")
+20 ;
+21 SET COMMENT(1)="THIRD PARTY PAYMENT RECIEVED ON BILL NUMBER "_BILL430_" = $"_$FNUMBER(RCPAID,"",2)
+22 SET COMMENT(2)="DOS:"_RCDOS_" "_$$RXMT(IEN350)
+23 SET COMMENT(3)="$"_$FNUMBER(AMT,"",2)_" AUTO-DECREASE APPLIED FOR CLAIMS MATCHING"
+24 SET COMMENT(4)=$$GET1^DIQ(200,".5,",.01,"E")
+25 DO WP^DIE(433,RCTRANDA_",",41,"","COMMENT")
+26 LOCK -^PRCA(433,RCTRANDA)
+27 QUIT RCTRANDA
+28 QUIT
+29 ;
TRAN3(IEN350,IEN399,IEN430,AMT,COPAY) ; File auto-decrease comment on third party AR
+1 ; Input: IEN350 - Internal entry number to IB Action (File #350)
+2 ; IEN399 - Internal entry number to Third Party Bill (Files #399 and #430)
+3 ; IEN430 - Internal entry number of First Party Bill (File #430)
+4 ; AMT - Amount of auto-decease
+5 ; COPAY - Copay amount being decreased
+6 ;
+7 NEW BILL1,COMMENT,FDA,IENS,RCDOS
+8 SET RCDOS=$$DOS(IEN350)
+9 SET BILL1=$$GET1^DIQ(430,IEN430_",",.01,"E")
+10 ;
+11 SET RCTRANDA=$$ADD433^RCBEUTRA(IEN399,45)
IF 'RCTRANDA
QUIT 0
+12 ;
+13 SET FDA(433,RCTRANDA_",",4)=2
+14 SET FDA(433,RCTRANDA_",",5.02)=BILL1_" offset $"_$FNUMBER(AMT,"",2)
+15 SET FDA(433,RCTRANDA_",",11)=DT
+16 SET FDA(433,RCTRANDA_",",15)=0
+17 SET FDA(433,RCTRANDA_",",42)=.5
+18 DO FILE^DIE("","FDA")
+19 ;
+20 SET COMMENT(1)="FIRST PARTY BILL # "_BILL1_" AUTO-DECREASED $"_$FNUMBER(AMT,"",2)_" FOR CLAIMS MATCHING"
+21 SET COMMENT(2)="DOS:"_RCDOS
+22 SET COMMENT(3)=$$GET1^DIQ(200,".5,",.01,"E")
+23 DO WP^DIE(433,RCTRANDA_",",41,"","COMMENT")
+24 LOCK -^PRCA(433,RCTRANDA)
+25 QUIT RCTRANDA
+26 ;
COMM1(COMMENT,IEN350,IEN399,AMT,RCPAID) ; Build comment text for first party bill
+1 ; Input: IEN350 - Internal entry number to IB Action (File #350)
+2 ; IEN399 - Internal entry number to Third Party Bill (Files #399 and #430)
+3 ; AMT - Amount of auto-decease
+4 ; RCPAID - Amount paid on third party bill
+5 ; Output: COMMENT - Array passed by reference
+6 NEW BILL3
+7 SET BILL3=$$GET1^DIQ(430,IEN399_",",.01,"E")
+8 SET COMMENT(1)="THIRD PARTY PAYMENT RECIEVED ON BILL NUMBER "_BILL3_" = $"_$FNUMBER(RCPAID,"",2)
+9 SET COMMENT(2)="DOS: "_$$DOS(IEN350)_" "_$$RXMT(IEN350)
+10 SET COMMENT(3)="$"_$FNUMBER(AMT,"",2)_" AUTO-DECREASE APPLIED FOR CLAIMS MATCHING"
+11 SET COMMENT(4)=$$GET1^DIQ(200,".5,",.01,"E")
+12 QUIT
+13 ;
DOS(IEN350) ; Get Date of Service for charge
+1 ; Input: IEN350 - Intenal entry number of IB Action (file #350)
+2 ;
+3 NEW FIELD,FILE,FROM,IEN,RETURN
+4 SET RETURN=""
+5 ; DBIA4541
SET FROM=$$GET1^DIQ(350,IEN350_",",.04,"I")
+6 SET FILE=$PIECE(FROM,":",1)
SET IEN=+$PIECE(FROM,":",2)
+7 ; Use issue date for prescription or date for o/p encounter
+8 SET FIELD=$SELECT(FILE=52:1,FILE=409.68:.01,1:"")
+9 ; If not Rx or o/p use Event date from charge file
IF FIELD=""
SET FILE=350
SET FIELD=.17
SET IEN=IEN350
+10 SET RETURN=$$GET1^DIQ(FILE,IEN_",",FIELD,"I")
+11 IF RETURN'=""
SET RETURN=$$FMTE^XLFDT(RETURN,"2D")
+12 QUIT RETURN
+13 ;
RXMT(IEN350) ; Return Rx # or "MT" for transaction comment line
+1 ; Input: IEN350 - Internal entry number of IB Action (file #350)
+2 ;
+3 NEW FROM,RETURN
+4 SET RETURN="MT"
+5 ; DBIA4541
SET FROM=$$GET1^DIQ(350,IEN350_",",.04,"I")
+6 SET FILE=$PIECE(FROM,":",1)
SET IEN=+$PIECE(FROM,":",2)
+7 ; RX #
IF FILE=52
SET RETURN="RX#: "_$$GET1^DIQ(FILE,IEN_",",.01,"E")
+8 QUIT RETURN
+9 ;
PREPAY(IEN350) ; Check for open pre-pay
+1 ; Input: IEN350 - Internal entry number of charge from IB ACTION file #350
+2 ; Returns: 1 - Patient has an open pre-payment
+3 ; 0 - No open pre-payment
+4 ; -1 - Error
+5 NEW PIEN,RCDATA7,RCDEBTDA,RCPREDA,RCVPP,RETURN
+6 SET RETURN=0
+7 SET PIEN=$$GET1^DIQ(350,IEN350_",",.02,"I")
+8 IF 'PIEN
QUIT -1
+9 ; Variable pointer to debtor file 340
SET RCVPP=PIEN_";DPT("
+10 SET RCDEBTDA=$ORDER(^RCD(340,"B",RCVPP,0))
+11 IF 'RCDEBTDA
QUIT -1
+12 ;
+13 SET RCPREDA=0
+14 FOR
SET RCPREDA=$ORDER(^PRCA(430,"AS",RCDEBTDA,42,RCPREDA))
if 'RCPREDA!(RETURN'=0)
QUIT
Begin DoDot:1
+15 ;
+16 ; Not a prepayment
IF $$GET1^DIQ(430,RCPREDA_",",2,"I")'=26
QUIT
+17 ; If CURRENT STATUS not "OPEN" skip
IF $$GET1^DIQ(430,RCPREDA_",",8,"E")'="OPEN"
QUIT
+18 ; No balance on prepayment so skip.
IF '$$GET1^DIQ(430,RCPREDA_",",71,"I")
QUIT
+19 ;
+20 SET RETURN=1
End DoDot:1
+21 ;
+22 QUIT RETURN
+23 ;
QUEUE(IEN350,IEN399,IENS41) ; Place the charge in a queue from processing at a later date
+1 ; Input: IEN350 - Internal entry number of charge from IB ACTION file #350
+2 ; IEN399 - Internal entry number of third party bill from file 399 or 430
+3 ; IENS41 - Internal entry numbers of subfile 344.41 in format nnn,nnnnnnn,
+4 ; Output: New entry in file #344.74
+5 ;
+6 NEW FDA,IENS
+7 SET IENS="+1,"
+8 SET FDA(344.74,IENS,.01)=IEN350
+9 SET FDA(344.74,IENS,.02)=IEN399
+10 SET FDA(344.74,IENS,.03)=$$NOW^XLFDT()
+11 SET FDA(344.74,IENS,.04)=IENS41
+12 DO UPDATE^DIE("","FDA")
+13 QUIT
DEL74(IEN74) ; Delete FIRST PARTY CHARGE QUEUE entry
+1 ; Input: IEN74 - Internal entry number of file 344.74
+2 ; Output: None
+3 NEW FDA
+4 SET FDA(344.74,IEN74_",",.01)="@"
+5 DO FILE^DIE("","FDA")
+6 QUIT
+7 ;
+8 ; Subroutine added for PRCA*4.5*349
DECAMT(IEN430) ; Return amount that bill has been previously auto-decreased.
+1 ; Input: IEN430 - Internal Entry number of file #430
+2 ; Returns: Total amount of previous auto-decreases
+3 NEW RETURN,TRANDA,TYPE
+4 SET RETURN=0
+5 SET TRANDA=""
+6 ;
FOR
SET TRANDA=$ORDER(^PRCA(433,"C",IEN430,TRANDA))
if 'TRANDA
QUIT
Begin DoDot:1
+7 IF $$GET1^DIQ(433,TRANDA_",",12,"E")'="DECREASE ADJUSTMENT"
QUIT
+8 IF $$GET1^DIQ(433,TRANDA_",",42,"E")'="POSTMASTER"
QUIT
+9 ; Add auto-decrease amount to total
SET RETURN=RETURN+$$GET1^DIQ(433,TRANDA_",",15,"E")
End DoDot:1
+10 QUIT RETURN
+11 ;
+12 ; PRCA*4.5*349 - Subroutine added
FLAG(RCERA,RCLINE) ; Flag ERA detail line as having been checked or processed for 1st party auto-decrease
+1 ; Input: RCERA - Internal entry number of file 344.4
+2 ; RCLINE - Internal entry number of subfile 344.41
+3 NEW FDA
+4 SET FDA(344.41,RCLINE_","_RCERA_",",10.01)=1
+5 DO FILE^DIE("","FDA")
+6 QUIT
