RCDPEAD3 ;ALB/PJH - AUTO DECREASE ; 6/27/19 2:43pm
;;4.5;Accounts Receivable;**345,349,450**;Mar 20, 1995;Build 15
;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,IENS3441,J,MFIELD,MFILE,MIEN,MULT,RC6AM,RCARRAY,RCBAL3RD,RCBILL,RCDAYS,RCERA,RCLINE,RCPAID,RCQIEN,RCRTYPE,RCSECS
N 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
K ^TMP("RCQUEUE",$J) ; PRCA*4.5*450 add ^TMP global for tracking 3rd party balance amount
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")
. ; PRCA*4.5*450 Begin modified code block
. S IENS3441=$$GET1^DIQ(344.74,RCQIEN_",",.05,"E")
. I IENS41="",IENS3441="" Q ; No pointer to multiple
. I IENS41'="" S MIEN=IENS41,MFILE=344.41,MFIELD=.03
. I IENS3441'="" S MIEN=IENS3441,MFILE=344.01,MFIELD=.04
. S RCPAID=+$$GET1^DIQ(MFILE,MIEN,MFIELD)
. I '$D(^TMP("RCQUEUE",$J,MFILE,MIEN)) S ^TMP("RCQUEUE",$J,MFILE,MIEN)=RCPAID
. S RCBAL3RD=^TMP("RCQUEUE",$J,MFILE,MIEN)
. ; PRCA*4.5*450 End modified code block
. ; 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
. . N DFN,IBDUZ,IBNOS,IBSEQNO
. . 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
. S ^TMP("RCQUEUE",$J,MFILE,MIEN)=RCBAL3RD
K ^TMP("RCQUEUE",$J)
;
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,IENS41,PRCADB,PRCATY,QUIT
N RCBAL,RCBAL3RD,RCBILL,RCCLAIM,RCCOPAY,RCGROUP,RCLST,RCPAID,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,"E") ; Access to file 350 covered by DBIA4541
. S RCGROUP=$$GET1^DIQ(350,RCSUB_",",".03:.11","I")
. I RCTYPE=""!(RCGROUP="") Q
. ; PRCA*4.5*450 - Replace checks for bill type with subroutine call
. I $$TYPE(RCGROUP,RCTYPE,RCTYP3) D ;
. . 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
; STAT - Array of status' eligible for offset (assumed to be set in the calling subroutine)
; 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)
N RETURN
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(NAME) ; EP - Display list of IB ACTION TYPE enabled for 1st party auto-decrease
; Input - NAME, specify auto-post or manual
; Output - To screen
N FLAG
S FLAG=$$GET1^DIQ(342,"1,",.14,"I")
I FLAG D ; Only show enabled types if auto-decrease is on
. W !!,"Charge types enabled for 1st party auto-decrease",NAME ;PRCA*4.5*450 Add AUTO-POST or MANUAL
. W !," All Inpatient, Outpatient and Pharmacy, except ""CANCEL"" charges." ; PRCA*4.5*450 remove list and add free text explanation.
. 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,RCTRANDA
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")
;
; PRCA*4.5*450 Amend comments
S COMMENT(1)="3RD PARTY PAYMENT RECEIVED ON BILL NUMBER "_BILL430_" = $"_$FN(RCPAID,"",2)
S COMMENT(2)="DOS:"_RCDOS_" "_$$RXMT(IEN350)_" "
S COMMENT(3)="$"_$FN(AMT,"",2)_" COMPUTERIZED OFFSET APPLIED FOR CLAIMS"
S COMMENT(4)="MATCHING "_$$GET1^DIQ(200,".5,",.01,"E")
D WP^DIE(433,RCTRANDA_",",41,"","COMMENT")
L -^PRCA(433,RCTRANDA)
Q RCTRANDA
;
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,RCTRANDA
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")
;
; PRCA*4.5*450 Amend comments
S COMMENT(1)="1ST PARTY BILL # "_BILL1_" COMPUTERIZED OFFSET $"_$FN(AMT,"",2)
S COMMENT(2)=" FOR CLAIMS MATCHING DOS:"_RCDOS_" "_$$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)="3RD PARTY PAYMENT RECEIVED ON BILL NUMBER "_BILL3_" = $"_$FN(RCPAID,"",2)
S COMMENT(2)="DOS: "_$$DOS(IEN350)_" "_$$RXMT(IEN350)_" "
S COMMENT(3)="$"_$FN(AMT,"",2)_" COMPUTERIZED OFFSET APPLIED FOR CLAIMS"
S COMMENT(4)="MATCHING "_$$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,FROM2,IEN,RETURN
S RETURN=""
S FROM=$$GET1^DIQ(350,IEN350_",",.04,"I") ; DBIA4541
; PRCA*4.5*450 Add Refill and Inpatient to logic
S FROM2=$P(FROM,";",2),FROM=$P(FROM,";",1)
S FILE=$P(FROM,":",1),IEN=+$P(FROM,":",2)
I FILE=52,$P(FROM2,":",1)=1 S FILE=52.1,IEN=$P(FROM2,":",2)_","_$P(FROM,":",2)
; Use issue date for prescription or date for o/p encounter
S FIELD=$S(FILE=52:1,FILE=52.1:.01,FILE=409.68:.01,FILE=405:.01,FILE=45:2,1:"")
I FIELD="" S FILE=350,FIELD=.17,IEN=IEN350 ; If other package 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)
;
; prca*4.5*450 - Add I/P to comments
N FILE,IEN,FROM,RCGROUP,RETURN
S RCGROUP=$$GET1^DIQ(350,IEN350_",",".03:.11","I") ; Billing group
S RETURN=$S(RCGROUP=4:"MT",RCGROUP=5:"RX#: ",1:"IP")
I RCGROUP=5 D ;
. S FROM=$$GET1^DIQ(350,IEN350_",",.04,"I") ; DBIA4541
. S FILE=$P(FROM,":",1),IEN=+$P(FROM,":",2)
. I FILE=52 S RETURN=RETURN_$$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
; PRCA*4.5*450 - Subroutine added
TYPE(RCGROUP,RCTYPE,RCTYP3) ; Is this first party charge eligible for auto-offset - EP from RCDPEAD3 and 5
; Inputs
; RCGROUP - 1st party bill group. Set of codes from file 350.1 field .11
; RCTYPE - Name of IB ACTION TYPE from file 350.1
; RCTYP3 - 3rd party bill type as determined by $$TYP^IBRFN
; Returns 1 - Eligible, 0 - Not eligible
;
N RETURN
S RETURN=0
I ("^1^2^3^4^5^8^9^"[("^"_RCGROUP_"^")),RCTYPE'["CANCLE" D ; IP, OP or RX and not a cancellation
. I RCTYP3="O",RCGROUP=4 S RETURN=1 Q ; Only match O/P claim with O/P charge
. I RCTYP3="PH",RCGROUP=5 S RETURN=1 Q ; Only match RX claim with RX charge
. I RCTYP3="I",("^1^2^3^8^9^"[("^"_RCGROUP_"^")) S RETURN=1 ; Only match IP claim with IP charge
Q RETURN
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEAD3 17175 printed Jan 29, 2026@14:42:43 Page 2
RCDPEAD3 ;ALB/PJH - AUTO DECREASE ; 6/27/19 2:43pm
+1 ;;4.5;Accounts Receivable;**345,349,450**;Mar 20, 1995;Build 15
+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,IENS3441,J,MFIELD,MFILE,MIEN,MULT,RC6AM,RCARRAY,RCBAL3RD,RCBILL,RCDAYS,RCERA,RCLINE,RCPAID,RCQIEN,RCRTYPE,RCSECS
+6 NEW STAT,STATUS,X
+7 ; Nightly process does not pass RCDAY. Default: Run for most recent business day minus RCDAYS delay
+8 SET RCDAYS=+$$GET1^DIQ(342,"1,",.15,"E")
+9 ;
IF $GET(RCDAY)=""
Begin DoDot:1
+10 SET RCSECS=$PIECE($HOROLOG,",",2)
+11 SET RC6AM=21600
+12 SET RCDAY=$$FMADD^XLFDT(DT,$SELECT(RCSECS<RC6AM:-1-RCDAYS,1:-RCDAYS))
End DoDot:1
+13 ;
+14 ; Status of 1st Party Claim can be OPEN,ACTIVE
+15 FOR J=16,42
SET STAT(J)=""
+16 ;
+17 ; Scan "F" index of ERA file for ERA entries with AUTOPOST DATE field 344.41 #9 matching RCDAY
+18 SET RCERA=0
+19 FOR
SET RCERA=$ORDER(^RCY(344.4,"F",RCDAY,RCERA))
if 'RCERA
QUIT
Begin DoDot:1
+20 ; Build index to scratchpad for this ERA
+21 KILL RCARRAY
+22 DO BUILD^RCDPEAP(RCERA,.RCARRAY)
+23 ;
+24 ; Scan ERA DETAIL entries in #344.41 for auto-posted medical claims
+25 SET RCLINE=0
+26 FOR
SET RCLINE=$ORDER(^RCY(344.4,"F",RCDAY,RCERA,RCLINE))
if 'RCLINE
QUIT
Begin DoDot:2
+27 ; Process line
+28 ; PRCA*4.5*349 - Already processed before
IF $$GET1^DIQ(344.41,RCLINE_","_RCERA_",",10.01,"I")
QUIT
+29 DO EN2(RCERA,.RCARRAY,RCLINE)
+30 ; PRCA*4.5*349 - Flag line as having been processed
DO FLAG(RCERA,RCLINE)
End DoDot:2
End DoDot:1
+31 ;
+32 ; Scan entries in RCDPE FIRST PARTY CHARGE QUEUE that could not be decreased due to existence of a pre-pay
+33 ; PRCA*4.5*450 add ^TMP global for tracking 3rd party balance amount
KILL ^TMP("RCQUEUE",$JOB)
+34 SET RCQIEN=0
+35 ;
FOR
SET RCQIEN=$ORDER(^RCY(344.74,RCQIEN))
if 'RCQIEN
QUIT
Begin DoDot:1
+36 SET IEN350=$$GET1^DIQ(344.74,RCQIEN_",",.01,"I")
+37 SET RCBILL=$$GET1^DIQ(344.74,RCQIEN_",",.02,"I")
+38 SET IENS41=$$GET1^DIQ(344.74,RCQIEN_",",.04,"E")
+39 ; PRCA*4.5*450 Begin modified code block
+40 SET IENS3441=$$GET1^DIQ(344.74,RCQIEN_",",.05,"E")
+41 ; No pointer to multiple
IF IENS41=""
IF IENS3441=""
QUIT
+42 IF IENS41'=""
SET MIEN=IENS41
SET MFILE=344.41
SET MFIELD=.03
+43 IF IENS3441'=""
SET MIEN=IENS3441
SET MFILE=344.01
SET MFIELD=.04
+44 SET RCPAID=+$$GET1^DIQ(MFILE,MIEN,MFIELD)
+45 IF '$DATA(^TMP("RCQUEUE",$JOB,MFILE,MIEN))
SET ^TMP("RCQUEUE",$JOB,MFILE,MIEN)=RCPAID
+46 SET RCBAL3RD=^TMP("RCQUEUE",$JOB,MFILE,MIEN)
+47 ; PRCA*4.5*450 End modified code block
+48 ; Access to file 350 DBIA4541.
+49 SET STATUS=$$GET1^DIQ(350,IEN350_",",.05,"I")
+50 ; If charge is not on hold remove from queue, but continue with checks.
IF STATUS'=8
DO DEL74(RCQIEN)
+51 ; Charge not on hold or billed so quit
IF STATUS'=3
IF STATUS'=8
QUIT
+52 ;
+53 ; On hold charge with no pre-pay. Release from hold.
+54 ;
IF STATUS=8
Begin DoDot:2
+55 ; Still has open pre-pay so quit
IF $$PREPAY(IEN350)=1
QUIT
+56 NEW DFN,IBDUZ,IBNOS,IBSEQNO
+57 SET IBNOS=IEN350
SET IBSEQNO=1
SET IBDUZ=.5
+58 ; DBIA4541
SET DFN=$$GET1^DIQ(350,IEN350_",",.02,"I")
+59 ; Call to ^IBR allowed by DBIA7007
DO ^IBR
+60 ; Charge released from hold, remove from queue.
DO DEL74(RCQIEN)
End DoDot:2
+61 ;
+62 SET STATUS=$$GET1^DIQ(350,IEN350_",",.05,"I")
+63 IF STATUS'=3
QUIT
+64 ;
+65 ; Process this charge for attempted auto-decrease
SET X=$$PROCESS(IEN350,RCBILL,RCPAID,.RCBAL3RD)
+66 SET ^TMP("RCQUEUE",$JOB,MFILE,MIEN)=RCBAL3RD
End DoDot:1
+67 KILL ^TMP("RCQUEUE",$JOB)
+68 ;
+69 QUIT
+70 ;
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,IENS41,PRCADB,PRCATY,QUIT
+7 NEW RCBAL,RCBAL3RD,RCBILL,RCCLAIM,RCCOPAY,RCGROUP,RCLST,RCPAID,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,"E")
+40 SET RCGROUP=$$GET1^DIQ(350,RCSUB_",",".03:.11","I")
+41 IF RCTYPE=""!(RCGROUP="")
QUIT
+42 ; PRCA*4.5*450 - Replace checks for bill type with subroutine call
+43 ;
IF $$TYPE(RCGROUP,RCTYPE,RCTYP3)
Begin DoDot:2
+44 SET RCLST(RCBILL,RCSUB)=""
+45 ; If charge is on hold then release it.
+46 ; DBIA4541
SET STATUS=$$GET1^DIQ(350,RCSUB_",",.05,"I")
+47 ; Charge is in on-hold, can it be released?
IF STATUS=8
Begin DoDot:3
+48 ; Open prepay, queue the charge to check later
IF $$PREPAY(RCSUB)=1
DO QUEUE(RCSUB,RCBILL,IENS41)
QUIT
+49 SET IBNOS=RCSUB
SET IBSEQNO=1
SET IBDUZ=.5
+50 ; DBIA4541
SET DFN=$$GET1^DIQ(350,RCSUB_",",.02,"I")
+51 ; Call to ^IBR allowed by DBIA7007
DO ^IBR
End DoDot:3
+52 ;
+53 ; DBIA4541. Check status again, after release from hold.
SET STATUS=$$GET1^DIQ(350,RCSUB_",",.05,"I")
+54 ; Status should be billed if charge was released.
IF STATUS'=3
QUIT
+55 ;
+56 ; Process this charge for attempted auto-decrease
SET QUIT=$$PROCESS(RCSUB,RCBILL,RCPAID,.RCBAL3RD)
End DoDot:2
End DoDot:1
if QUIT
QUIT
+57 ;
+58 KILL ^TMP("IBRBF",$JOB)
+59 QUIT
+60 ;
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 ; STAT - Array of status' eligible for offset (assumed to be set in the calling subroutine)
+5 ; RCBAL3RD - Remaining balance on third party bill not yet used for auto-decrease of a copay
+6 ; Returns: 1 - quit loop after processing this record
+7 ; 0 - don't quit
+8 ;
+9 ; Get copay claim (external format)
+10 NEW RETURN
+11 SET RETURN=0
+12 ; DBIA4541
SET RCCLAIM=$$GET1^DIQ(350,IEN350_",",.11)
+13 IF RCCLAIM=""
QUIT 0
+14 SET RCCOPAY=$ORDER(^PRCA(430,"B",RCCLAIM,""))
+15 IF 'RCCOPAY
QUIT 0
+16 SET STATUS=$PIECE($GET(^PRCA(430,RCCOPAY,0)),"^",8)
+17 ; Check 1st Party claim status vs list allowed for auto-decrease
+18 IF '$DATA(STAT(STATUS))
QUIT 0
+19 ;
+20 ; Get copay balance remaining
+21 SET COPAY=+$$GET1^DIQ(430,RCCOPAY_",",11)
+22 ; Quit if copay balance is zero
+23 IF COPAY=0
QUIT 0
+24 ; PRCA*4.5*349 - Only process auto-decrease if copay balance = (charge - (previous auto-decreases))
+25 ; DBIA4541
IF +COPAY'=($$GET1^DIQ(350,IEN350_",",.07)-$$DECAMT(RCCOPAY))
QUIT 0
+26 ;
+27 ; Get 1st party balance
+28 SET DEBT=$$GET1^DIQ(430,RCCOPAY_",",9,"I")
+29 IF 'DEBT
QUIT 0
+30 SET PRCADB=$$GET1^DIQ(340,DEBT_",",.01,"I")
+31 SET PRCATY="ALL"
+32 DO COMP^PRCAAPR
+33 SET RCBAL=+$GET(^TMP("PRCAAPR",$JOB,"C"))
+34 KILL ^TMP("PRCAAPR",$JOB)
+35 ; Determine decrease amount
+36 SET AMT=$$AMT(RCBAL,RCBAL3RD,COPAY)
+37 ; Ignore zero amounts
+38 if AMT'>0
QUIT 0
+39 ; Decrease adjustment comment
+40 DO COMM1(.COMMENT,IEN350,RCBILL,AMT,RCPAID)
+41 ; Apply DECREASE ADJUSTMENT for COPAY
+42 SET RCTRANDA=$$INCDEC^RCBEUTR1(RCCOPAY,-AMT,.COMMENT,"","",0)
if 'RCTRANDA
QUIT 0
+43 ; File third party bill on decrease adjustment transaction
+44 KILL FDA
+45 SET FDA(433,RCTRANDA_",",94)=RCBILL
+46 ; Make sure PROCESSED BY is postmaster
SET FDA(433,RCTRANDA_",",42)=.5
+47 DO FILE^DIE("","FDA")
+48 ; Add a comment transaction to first party bill also.
+49 SET RCTRANDA=$$TRAN1(IEN350,RCBILL,RCCOPAY,AMT,RCPAID)
+50 ; Add third party bill comment Transaction
SET RCTRANDA=$$TRAN3(IEN350,RCBILL,RCCOPAY,AMT,COPAY)
+51 ; Take amount off the 3rd party payment and use for subsequent decrease.
SET RCBAL3RD=RCBAL3RD-AMT
+52 IF RCBAL3RD=0!(RCBAL3RD<0)
SET RETURN=1
+53 QUIT RETURN
+54 ;
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(NAME) ; EP - Display list of IB ACTION TYPE enabled for 1st party auto-decrease
+1 ; Input - NAME, specify auto-post or manual
+2 ; Output - To screen
+3 NEW FLAG
+4 SET FLAG=$$GET1^DIQ(342,"1,",.14,"I")
+5 ; Only show enabled types if auto-decrease is on
IF FLAG
Begin DoDot:1
+6 ;PRCA*4.5*450 Add AUTO-POST or MANUAL
WRITE !!,"Charge types enabled for 1st party auto-decrease",NAME
+7 ; PRCA*4.5*450 remove list and add free text explanation.
WRITE !," All Inpatient, Outpatient and Pharmacy, except ""CANCEL"" charges."
+8 WRITE !
End DoDot:1
+9 QUIT
+10 ;
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,RCTRANDA
+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 ; PRCA*4.5*450 Amend comments
+22 SET COMMENT(1)="3RD PARTY PAYMENT RECEIVED ON BILL NUMBER "_BILL430_" = $"_$FNUMBER(RCPAID,"",2)
+23 SET COMMENT(2)="DOS:"_RCDOS_" "_$$RXMT(IEN350)_" "
+24 SET COMMENT(3)="$"_$FNUMBER(AMT,"",2)_" COMPUTERIZED OFFSET APPLIED FOR CLAIMS"
+25 SET COMMENT(4)="MATCHING "_$$GET1^DIQ(200,".5,",.01,"E")
+26 DO WP^DIE(433,RCTRANDA_",",41,"","COMMENT")
+27 LOCK -^PRCA(433,RCTRANDA)
+28 QUIT RCTRANDA
+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,RCTRANDA
+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 ; PRCA*4.5*450 Amend comments
+21 SET COMMENT(1)="1ST PARTY BILL # "_BILL1_" COMPUTERIZED OFFSET $"_$FNUMBER(AMT,"",2)
+22 SET COMMENT(2)=" FOR CLAIMS MATCHING DOS:"_RCDOS_" "_$$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)="3RD PARTY PAYMENT RECEIVED ON BILL NUMBER "_BILL3_" = $"_$FNUMBER(RCPAID,"",2)
+9 SET COMMENT(2)="DOS: "_$$DOS(IEN350)_" "_$$RXMT(IEN350)_" "
+10 SET COMMENT(3)="$"_$FNUMBER(AMT,"",2)_" COMPUTERIZED OFFSET APPLIED FOR CLAIMS"
+11 SET COMMENT(4)="MATCHING "_$$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,FROM2,IEN,RETURN
+4 SET RETURN=""
+5 ; DBIA4541
SET FROM=$$GET1^DIQ(350,IEN350_",",.04,"I")
+6 ; PRCA*4.5*450 Add Refill and Inpatient to logic
+7 SET FROM2=$PIECE(FROM,";",2)
SET FROM=$PIECE(FROM,";",1)
+8 SET FILE=$PIECE(FROM,":",1)
SET IEN=+$PIECE(FROM,":",2)
+9 IF FILE=52
IF $PIECE(FROM2,":",1)=1
SET FILE=52.1
SET IEN=$PIECE(FROM2,":",2)_","_$PIECE(FROM,":",2)
+10 ; Use issue date for prescription or date for o/p encounter
+11 SET FIELD=$SELECT(FILE=52:1,FILE=52.1:.01,FILE=409.68:.01,FILE=405:.01,FILE=45:2,1:"")
+12 ; If other package use Event date from charge file
IF FIELD=""
SET FILE=350
SET FIELD=.17
SET IEN=IEN350
+13 SET RETURN=$$GET1^DIQ(FILE,IEN_",",FIELD,"I")
+14 IF RETURN'=""
SET RETURN=$$FMTE^XLFDT(RETURN,"2D")
+15 QUIT RETURN
+16 ;
RXMT(IEN350) ; Return Rx # or "MT" for transaction comment line
+1 ; Input: IEN350 - Internal entry number of IB Action (file #350)
+2 ;
+3 ; prca*4.5*450 - Add I/P to comments
+4 NEW FILE,IEN,FROM,RCGROUP,RETURN
+5 ; Billing group
SET RCGROUP=$$GET1^DIQ(350,IEN350_",",".03:.11","I")
+6 SET RETURN=$SELECT(RCGROUP=4:"MT",RCGROUP=5:"RX#: ",1:"IP")
+7 ;
IF RCGROUP=5
Begin DoDot:1
+8 ; DBIA4541
SET FROM=$$GET1^DIQ(350,IEN350_",",.04,"I")
+9 SET FILE=$PIECE(FROM,":",1)
SET IEN=+$PIECE(FROM,":",2)
+10 ; RX #
IF FILE=52
SET RETURN=RETURN_$$GET1^DIQ(FILE,IEN_",",.01,"E")
End DoDot:1
+11 QUIT RETURN
+12 ;
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
+7 ; PRCA*4.5*450 - Subroutine added
TYPE(RCGROUP,RCTYPE,RCTYP3) ; Is this first party charge eligible for auto-offset - EP from RCDPEAD3 and 5
+1 ; Inputs
+2 ; RCGROUP - 1st party bill group. Set of codes from file 350.1 field .11
+3 ; RCTYPE - Name of IB ACTION TYPE from file 350.1
+4 ; RCTYP3 - 3rd party bill type as determined by $$TYP^IBRFN
+5 ; Returns 1 - Eligible, 0 - Not eligible
+6 ;
+7 NEW RETURN
+8 SET RETURN=0
+9 ; IP, OP or RX and not a cancellation
IF ("^1^2^3^4^5^8^9^"[("^"_RCGROUP_"^"))
IF RCTYPE'["CANCLE"
Begin DoDot:1
+10 ; Only match O/P claim with O/P charge
IF RCTYP3="O"
IF RCGROUP=4
SET RETURN=1
QUIT
+11 ; Only match RX claim with RX charge
IF RCTYP3="PH"
IF RCGROUP=5
SET RETURN=1
QUIT
+12 ; Only match IP claim with IP charge
IF RCTYP3="I"
IF ("^1^2^3^8^9^"[("^"_RCGROUP_"^"))
SET RETURN=1
End DoDot:1
+13 QUIT RETURN
