RCDPEAD5 ;TAS/CJE - 1ST PARTY AUTO DECREASE ; 6/27/19 2:43pm
;;4.5;Accounts Receivable;**450**;Mar 20, 1995;Build 15
;Per VA Directive 6402, this routine should not be modified.
;Read ^IBM(361.1) via Private IA 4051
;
OFFSET(IEN344) ; EP - PROCESS^RCDPRPL3 - First Party Auto Decrease for manually posted claims.
N FDA,IEN01,J,RCDATE,RCTYPE,STAT,TYPES
I '$$GET1^DIQ(342,"1,",.17,"I") Q ; Auto-Decrease of manually posted payments is switched off
D TYPES(.TYPES) ; Event types to process
S RCTYPE=$$GET1^DIQ(344,IEN344_",",.04,"E")
I RCTYPE="" Q
I '$D(TYPES(RCTYPE)) Q ; Only specified event types are eligible for processing
S RCDATE=$$GET1^DIQ(344,IEN344_",",.2,"E")
I RCDATE'="" Q ; Receipt processed for autodecrease previously
;
; Status of 1st Party Claim can be OPEN,ACTIVE
F J=16,42 S STAT(J)=""
;
; Iterate through the claims on the receipt and check for associated first party co-pays
S IEN01=0
F S IEN01=$O(^RCY(344,IEN344,1,IEN01)) Q:'IEN01 D ;
. N CLAIM,RCBILL,RCPAID,RCTYP3,REC
. S REC=$G(^RCY(344,IEN344,1,IEN01,0))
. S CLAIM=$P(REC,"^",3)
. I $P(CLAIM,";",2)'="PRCA(430," Q ; Not a pointer to an AR
. I '$D(^DGCR(399,+CLAIM,0)) Q ; Not a 3rd party claim
. S RCBILL=+CLAIM
. S RCTYP3=$$TYP^IBRFN(RCBILL) ; Get type of bill and only match with same type. DBIA 2031 covers call to TYP^IBRFN
. ; 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
. S RCPAID=$$GET1^DIQ(344.01,IEN01_","_IEN344_",",.04,"I")
. D EN2(RCBILL,RCTYP3,IEN01_","_IEN344_",",RCPAID)
. ;
. K ^TMP("IBRBF",$J)
;
; Mark this receipt as processsed for 1st party auto decrease
K FDA
S FDA(344,IEN344_",",.2)=$$NOW^XLFDT()
D FILE^DIE("","FDA")
;
Q
EN2(RCBILL,RCTYP3,IENS344,RCPAID) ; Check one third party claim from the receipt for copay offsets
; Inputs : RCBILL - Internal entry number of 3rd party bill in files 399 and 430
; RCTYP3 - Type of claim for RCBILL to match vs copay
; IENS344 - Internal entry numbers for subfile 344.01 in format nnn,nnnnnnn,
; RCPAID - Amount paid on the 3rd party claim on this receipt transaction
; and therefore avaialble for offset of copays.
;
N DFN,IBDUZ,IBNOS,IBSEQNO,QUIT,RCBAL3RD,RCGROUP,RCLST,RCSUB,RCTYPE,STATUS
S QUIT=0
S RCSUB=0
S RCBAL3RD=RCPAID
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") ; Billing group 4=OPT COPAY, 5=RX COPAY
. I RCTYPE=""!(RCGROUP="") Q
. I $$TYPE^RCDPEAD3(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^RCDPEAD3(RCSUB)=1 D QUEUE(RCSUB,RCBILL,IENS344) 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^RCDPEAD3(RCSUB,RCBILL,RCPAID,.RCBAL3RD) ; Process this charge for attempted auto-decrease
Q
;
TYPES(RETURN) ; Create array of specific AR EVENT TYPES that we included
S RETURN("CASH PAYMENT")=""
S RETURN("CHAMPVA")=""
S RETURN("CHECK/MO PAYMENT")=""
S RETURN("CREDIT CARD PAYMENT")=""
S RETURN("EDI LOCKBOX")=""
S RETURN("LOCKBOX")=""
S RETURN("OGC-CHK")=""
S RETURN("OGC-EFT")=""
S RETURN("REGIONAL COUNSEL PAYMENT")=""
S RETURN("TDA PAYMENT")=""
Q
;
QUEUE(IEN350,IEN399,IENS344) ; 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
; IENS344 - Internal entry numbers of subfile 344.01 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,.05)=IENS344
D UPDATE^DIE("","FDA")
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDPEAD5 4635 printed Jan 29, 2026@14:42:45 Page 2
RCDPEAD5 ;TAS/CJE - 1ST PARTY AUTO DECREASE ; 6/27/19 2:43pm
+1 ;;4.5;Accounts Receivable;**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 ;
OFFSET(IEN344) ; EP - PROCESS^RCDPRPL3 - First Party Auto Decrease for manually posted claims.
+1 NEW FDA,IEN01,J,RCDATE,RCTYPE,STAT,TYPES
+2 ; Auto-Decrease of manually posted payments is switched off
IF '$$GET1^DIQ(342,"1,",.17,"I")
QUIT
+3 ; Event types to process
DO TYPES(.TYPES)
+4 SET RCTYPE=$$GET1^DIQ(344,IEN344_",",.04,"E")
+5 IF RCTYPE=""
QUIT
+6 ; Only specified event types are eligible for processing
IF '$DATA(TYPES(RCTYPE))
QUIT
+7 SET RCDATE=$$GET1^DIQ(344,IEN344_",",.2,"E")
+8 ; Receipt processed for autodecrease previously
IF RCDATE'=""
QUIT
+9 ;
+10 ; Status of 1st Party Claim can be OPEN,ACTIVE
+11 FOR J=16,42
SET STAT(J)=""
+12 ;
+13 ; Iterate through the claims on the receipt and check for associated first party co-pays
+14 SET IEN01=0
+15 ;
FOR
SET IEN01=$ORDER(^RCY(344,IEN344,1,IEN01))
if 'IEN01
QUIT
Begin DoDot:1
+16 NEW CLAIM,RCBILL,RCPAID,RCTYP3,REC
+17 SET REC=$GET(^RCY(344,IEN344,1,IEN01,0))
+18 SET CLAIM=$PIECE(REC,"^",3)
+19 ; Not a pointer to an AR
IF $PIECE(CLAIM,";",2)'="PRCA(430,"
QUIT
+20 ; Not a 3rd party claim
IF '$DATA(^DGCR(399,+CLAIM,0))
QUIT
+21 SET RCBILL=+CLAIM
+22 ; Get type of bill and only match with same type. DBIA 2031 covers call to TYP^IBRFN
SET RCTYP3=$$TYP^IBRFN(RCBILL)
+23 ; Do not auto decrease if claim is referred to General Council
+24 if $PIECE($GET(^PRCA(430,RCBILL,6)),U,4)]""
QUIT
+25 ; Get copay details
+26 KILL ^TMP("IBRBF",$JOB)
+27 ; Integration agreement DBIA3124
DO RELBILL^IBRFN(RCBILL)
+28 ; Quit if no related 1st Party claim
+29 IF '$ORDER(^TMP("IBRBF",$JOB,RCBILL,0))
QUIT
+30 SET RCPAID=$$GET1^DIQ(344.01,IEN01_","_IEN344_",",.04,"I")
+31 DO EN2(RCBILL,RCTYP3,IEN01_","_IEN344_",",RCPAID)
+32 ;
+33 KILL ^TMP("IBRBF",$JOB)
End DoDot:1
+34 ;
+35 ; Mark this receipt as processsed for 1st party auto decrease
+36 KILL FDA
+37 SET FDA(344,IEN344_",",.2)=$$NOW^XLFDT()
+38 DO FILE^DIE("","FDA")
+39 ;
+40 QUIT
EN2(RCBILL,RCTYP3,IENS344,RCPAID) ; Check one third party claim from the receipt for copay offsets
+1 ; Inputs : RCBILL - Internal entry number of 3rd party bill in files 399 and 430
+2 ; RCTYP3 - Type of claim for RCBILL to match vs copay
+3 ; IENS344 - Internal entry numbers for subfile 344.01 in format nnn,nnnnnnn,
+4 ; RCPAID - Amount paid on the 3rd party claim on this receipt transaction
+5 ; and therefore avaialble for offset of copays.
+6 ;
+7 NEW DFN,IBDUZ,IBNOS,IBSEQNO,QUIT,RCBAL3RD,RCGROUP,RCLST,RCSUB,RCTYPE,STATUS
+8 SET QUIT=0
+9 SET RCSUB=0
+10 SET RCBAL3RD=RCPAID
+11 ;
FOR
SET RCSUB=$ORDER(^TMP("IBRBF",$JOB,RCBILL,RCSUB))
if 'RCSUB
QUIT
Begin DoDot:1
+12 ; Access to file 350 covered by DBIA4541
SET RCTYPE=$$GET1^DIQ(350,RCSUB_",",.03,"E")
+13 ; Billing group 4=OPT COPAY, 5=RX COPAY
SET RCGROUP=$$GET1^DIQ(350,RCSUB_",",".03:.11","I")
+14 IF RCTYPE=""!(RCGROUP="")
QUIT
+15 ;
IF $$TYPE^RCDPEAD3(RCGROUP,RCTYPE,RCTYP3)
Begin DoDot:2
+16 SET RCLST(RCBILL,RCSUB)=""
+17 ; If charge is on hold then release it.
+18 ; DBIA4541
SET STATUS=$$GET1^DIQ(350,RCSUB_",",.05,"I")
+19 ; Charge is in on-hold, can it be released?
IF STATUS=8
Begin DoDot:3
+20 ; Open prepay, queue the charge to check later
IF $$PREPAY^RCDPEAD3(RCSUB)=1
DO QUEUE(RCSUB,RCBILL,IENS344)
QUIT
+21 SET IBNOS=RCSUB
SET IBSEQNO=1
SET IBDUZ=.5
+22 ; DBIA4541
SET DFN=$$GET1^DIQ(350,RCSUB_",",.02,"I")
+23 ; Call to ^IBR allowed by DBIA7007
DO ^IBR
End DoDot:3
+24 ;
+25 ; DBIA4541. Check status again, after release from hold.
SET STATUS=$$GET1^DIQ(350,RCSUB_",",.05,"I")
+26 ; Status should be billed if charge was released.
IF STATUS'=3
QUIT
+27 ;
+28 ; Process this charge for attempted auto-decrease
SET QUIT=$$PROCESS^RCDPEAD3(RCSUB,RCBILL,RCPAID,.RCBAL3RD)
End DoDot:2
End DoDot:1
if QUIT
QUIT
+29 QUIT
+30 ;
TYPES(RETURN) ; Create array of specific AR EVENT TYPES that we included
+1 SET RETURN("CASH PAYMENT")=""
+2 SET RETURN("CHAMPVA")=""
+3 SET RETURN("CHECK/MO PAYMENT")=""
+4 SET RETURN("CREDIT CARD PAYMENT")=""
+5 SET RETURN("EDI LOCKBOX")=""
+6 SET RETURN("LOCKBOX")=""
+7 SET RETURN("OGC-CHK")=""
+8 SET RETURN("OGC-EFT")=""
+9 SET RETURN("REGIONAL COUNSEL PAYMENT")=""
+10 SET RETURN("TDA PAYMENT")=""
+11 QUIT
+12 ;
QUEUE(IEN350,IEN399,IENS344) ; 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 ; IENS344 - Internal entry numbers of subfile 344.01 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,.05)=IENS344
+12 DO UPDATE^DIE("","FDA")
+13 QUIT
