Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RCDMCR5B

RCDMCR5B.m

Go to the documentation of this file.
  1. RCDMCR5B ;HAF/ASF - First Party Charge IB Cancellation Reconciliation Report - Collect Data; Apr 9, 2019@21:06
  1. ;;4.5;Accounts Receivable;**347,361**;Mar 20, 1995;Build 6
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ; DBIA 4858 - GET1^PSOSI routine calls
  1. ; DBIA 4538 - Action Type File (350.1) lookup
  1. ; DBIA 4541 - Integrated Billing Action File lookups
  1. ; DBIA 5040 - Outpatient event date lookup for file 409.68
  1. ; DBIA 4434 - Action Status lookup
  1. ;
  1. ; See RCDMCR5A for detailed description
  1. ;
  1. COLLECT(STOPIT,CANBEGDT,CANENDDT,BILLPAYS) ; Get the report data
  1. ;Input
  1. ; STOPIT - Passed Variable to determine if process is to be terminated
  1. ; CANBEGDT - Cancellation Begin Date
  1. ; CANENDDT - Cancellation End Date
  1. ;Output
  1. ; STOPIT - Passed Variable set to 1 if process is to be terminated
  1. ; ^TMP($J,"RCDMCR5B") with report data and summary data
  1. N DFN,IBIEN,IB0,IB1,CTR,ARIEN,ACTTYPE,BILGROUP,RESULT,IBDATA
  1. N SERVDT,RXDT,NAME,SSN,RXDT,CHGAMT,BILLFRDT,PAID,TRIEN
  1. N BILLNO,RXNUM,RXNAM,CANCDT,CANCUSER,CANCREAS,PARENTE
  1. N VAERR,VADM,VAIP
  1. N APPR,RSC
  1. ;Quit if passed parameter variables not populated
  1. I $G(CANBEGDT)'>0,$G(CANENDDT)'>0 Q
  1. S CANCDT=CANBEGDT-.000001
  1. F S CANCDT=$O(^IB("D",CANCDT)) Q:CANCDT="" Q:CANCDT>(CANENDDT+1) D Q:$G(STOPIT)>0
  1. . S IBIEN=""
  1. . F S IBIEN=$O(^IB("D",CANCDT,IBIEN)) Q:IBIEN="" D Q:$G(STOPIT)>0
  1. . . S IB0=$G(^IB(IBIEN,0)),IB1=$G(^IB(IBIEN,1))
  1. . . S ACTTYPE=$P(IB0,U,3)
  1. . . I ACTTYPE="" Q
  1. . . ; SEQUENCE NUMBER (file 350.1, field .05) of 2 is CANCEL
  1. . . I $P($G(^IBE(350.1,ACTTYPE,0)),U,5)'=2 Q
  1. . . S DFN=$P(IB0,U,2)
  1. . . S CTR=$G(CTR)+1 ;Counter
  1. . . I CTR#500=0 S STOPIT=$$STOPIT^RCDMCUT2() Q:STOPIT
  1. . . S BILLNO=$P(IB0,U,11)
  1. . . I BILLNO="" Q
  1. . . ; ASF 8/10/19
  1. . . S ARIEN=$O(^PRCA(430,"B",BILLNO,""))
  1. . . I ARIEN'>0 Q
  1. . . ;Grab the existing Fund. If it doesn't exist, calculate it.
  1. . . S APPR=$$GET1^DIQ(430,ARIEN_",",203)
  1. . . I APPR="" S APPR=$$GETFUNDB^RCXFMSUF(ARIEN,1)
  1. . . ;Grab the existing RSC. If it doesn't exist, calculate it.
  1. . . S RSC=$$GET1^DIQ(430,ARIEN_",",255.1) ;Check for accrued RSC
  1. . . S:RSC="" RSC=$$GET1^DIQ(430,ARIEN_",",255) ;if no accrued RSC, check for non-accrued.
  1. . . S:RSC="" RSC=$$CALCRSC^RCXFMSUR(ARIEN) ;if neither present, calculate
  1. . . ; only look at 1st party bills
  1. . . I '$$FIRSTPAR^RCDMCUT1(ARIEN) Q
  1. . . ; BILLPAYS of 1 means only bills with an IB Bill Status of Cancelled and an AR status of Closed/Collected
  1. . . ; Otherwise, show all bills regardless of the payment status (IB Cancelled, and with any AR Status)
  1. . . ; Note: we no longer check Collected/Closed as per customer. Instead, we check if any transactions associated
  1. . . ; with this bill are payments.
  1. . . I BILLPAYS S PAID=0 D Q:'PAID
  1. . . . S TRIEN=""
  1. . . . F S TRIEN=$O(^PRCA(433,"C",ARIEN,TRIEN)) Q:TRIEN="" I $$GET1^DIQ(433,TRIEN_",",12,"E")?1"PAYMENT (".E S PAID=1 Q
  1. . . D DEM^VADPT
  1. . . I $G(VAERR)>0 D KVAR^VADPT Q
  1. . . S NAME=$G(VADM(1))
  1. . . I NAME']"" Q
  1. . . S SSN=$P(VADM(2),U,1)
  1. . . I SSN']"" Q
  1. . . S SERVDT="",RXDT="",RXNUM="",RXNAM="",CANCREAS="",CANCUSER="" K IBDATA
  1. . . S IENS=IBIEN_","
  1. . . D GETS^DIQ(350,IENS,".1;11","E","IBDATA") ;dbia 4541
  1. . . S BILLFRDT=$P(IB0,U,14)
  1. . . S CANCREAS=$G(IBDATA(350,IENS,.1,"E"))
  1. . . S CANCUSER=$G(IBDATA(350,IENS,11,"E"))
  1. . . I CANCUSER="" S CANCUSER="/"_$P(IB1,U)
  1. . . S BILGROUP=$$GET1^DIQ(350.1,+ACTTYPE_",",.11,"I") ;dbia 4538
  1. . . S RESULT=$P(IB0,U,4)
  1. . . S CHGAMT=$$GET1^DIQ(350,$$PARENTC(IBIEN)_",",.07) ;dbia 4541
  1. . . S PARENTE=$$PARENTE(IBIEN),RESULT=$$GET1^DIQ(350,PARENTE_",",.04,"I"),IENS=PARENTE_"," ;dbia 4541
  1. . . S SERVDT=""
  1. . . ;Inpatient Event
  1. . . I $P(RESULT,":",1)=405!($P(RESULT,":",1)=45) D
  1. . . . S VAIP("E")=$P($P(RESULT,";",1),":",2)
  1. . . . ;Call to get Inpatient data
  1. . . . D IN5^VADPT
  1. . . . Q:VAERR>0
  1. . . . S SERVDT=$P($G(VAIP(17,1)),U,1)
  1. . . . D KVAR^VADPT
  1. . . ;Outpatient Event
  1. . . I BILGROUP=4!($P(RESULT,":",1)=44)!($P(RESULT,":",1)=409.68) D
  1. . . . I $P(RESULT,":",1)=44 S SERVDT=$P($P(RESULT,";",2),":",2)
  1. . . . I $P(RESULT,":",1)=409.68 S SERVDT=$$GET1^DIQ(409.68,+$P(RESULT,":",2)_",",.01,"I") ;dbia 5040
  1. . . . I $G(SERVDT)'>0 S SERVDT=BILLFRDT
  1. . . I SERVDT="" S SERVDT=$$GET1^DIQ(350,IENS,.17,"I") ;dbia 4538
  1. . . ;RX Event
  1. . . I $P(RESULT,":",1)=52 D
  1. . . . N IENS
  1. . . . ;Set up for RX Refills
  1. . . . I $P(RESULT,";",2)]"" D
  1. . . . . S IENS=+$P($P(RESULT,";",2),":",2)_","_+$P($P(RESULT,";",1),":",2)_","
  1. . . . . S RXDT=$$GET1^PSODI(52.1,IENS,17,"I") ;dbia 4858
  1. . . . . S:$P(RXDT,U,2)'?7N.E RXDT=$$GET1^PSODI(52.1,IENS,.01,"I") ;dbia 4858
  1. . . . . I 'RXDT S RXDT="^"
  1. . . . . S RXNUM=$$GET1^PSODI(52,$P($P(RESULT,";",1),":",2)_",",.01,"I") ;dbia 4858
  1. . . . . I 'RXNUM S RXNUM="^"
  1. . . . . S RXNAM=$$GET1^PSODI(52,$P($P(RESULT,";",1),":",2)_",",6,"E") ;dbia 4858
  1. . . . . I 'RXNAM S RXNAM="^"
  1. . . . ;Set up for RX Data (No refill)
  1. . . . I $P(RESULT,";",2)']"" D
  1. . . . . S IENS=+$P($P(RESULT,";",1),":",2)_","
  1. . . . . S RXDT=$$GET1^PSODI(52,IENS,31,"I")
  1. . . . . S:$P(RXDT,U,2)'?7N.E RXDT=$$GET1^PSODI(52,IENS,22,"I") ;dbia 4858
  1. . . . . I 'RXDT S RXDT="^"
  1. . . . . S RXNUM=$$GET1^PSODI(52,IENS,.01,"I") ;dbia 4858
  1. . . . . I 'RXNUM S RXNUM="^"
  1. . . . . S RXNAM=$$GET1^PSODI(52,IENS,6,"E") ;dbia 4858
  1. . . . . I 'RXNAM S RXNAM="^"
  1. . . ; ASF 8/10/19
  1. . . S ^TMP($J,"RCDMCR5B","DETAIL",NAME,SSN,BILLNO,IBIEN)=SERVDT_U_$P(RXDT,U,2)_U_CHGAMT_U_$P(RXNUM,U,2)_U_$P(RXNAM,U,2)_U_CANCDT_U_CANCREAS_U_CANCUSER_U_APPR_U_RSC
  1. Q
  1. PARENTE(IBIEN) ; Go up the parenting event chain of IBIEN and return the original "parent"
  1. N NZ
  1. S NZ=$G(^IB(IBIEN,0))
  1. I $P(NZ,U,16)'="" Q $S(IBIEN=$P(NZ,U,16):IBIEN,1:$$PARENTE($P(NZ,U,16)))
  1. I $P(NZ,U,9)'="" Q $S(IBIEN=$P(NZ,U,9):IBIEN,1:$$PARENTE($P(NZ,U,9)))
  1. I $P(NZ,U,4)?1"350:".E Q $S(IBIEN=(+$P($P(NZ,U,4),":",2)):IBIEN,1:$$PARENTE($P($P(NZ,U,4),":",2)+0))
  1. Q IBIEN
  1. PARENTC(IBIEN) ; Go up the parenting charge chain of IBIEN and return the original "parent" charge
  1. N NZ
  1. S NZ=$G(^IB(IBIEN,0))
  1. I $P(NZ,U,9)'="" Q $S(IBIEN=$P(NZ,U,9):IBIEN,1:$$PARENTC($P(NZ,U,9)))
  1. I $P(NZ,U,4)?1"350:".E Q $S(IBIEN=(+$P($P(NZ,U,4),":",2)):IBIEN,1:$$PARENTC($P($P(NZ,U,4),":",2)+0))
  1. Q IBIEN