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

RCDMCR4B.m

Go to the documentation of this file.
  1. RCDMCR4B ;ALB/YG - 0 - 40 Percent SC Change Reconciliation Report - Collect Data; Apr 9, 2019@21:06
  1. ;;4.5;Accounts Receivable;**347,414**;Mar 20, 1995;Build 2
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ; See RCDMCR4A for detailed description
  1. ;
  1. COLLECT(STOPIT,RDBEGDT,RDENDDT,VLSBEGDT,VLSENDDT,EOCBEGDT,EOCENDDT,RPTTYPE) ; Get the report data
  1. ;Input
  1. ; STOPIT - Passed Variable to determine if process is to be terminated
  1. ; BEGDT - Beginning Date (in past) to get Episode of Care data for.
  1. ; (Required)
  1. ; RDBEGDT - Rated Disability Change Beginning date, (Required)
  1. ; RDENDDT - Rated Disability Change Ending Date, (Required)
  1. ; VLSBEGDT - Vista Last Status Date Beginning date, (Required)
  1. ; VLSENDDT - Vista Last Status Date Ending Date, (Required)
  1. ; EOCBEGDT - Episodes Of Care Beginning date, (Required)
  1. ; EOCENDDT - Episodes Of Care Ending Date, (Required)
  1. ; RPTTYPE - Report Type (Summary / Detailed)
  1. ;Output
  1. ; STOPIT - Passed Variable set to 1 if process is to be terminated
  1. ; ^TMP($J,"RCDMCR4") with report data and summary data
  1. N RCDFN,DEBTOR,ARIEN,IBIEN,CTR,IBCNT,EOCDT,DFN,DMCELIG,EFFDT,NAME,SSN,VLSDT,SCPER
  1. N STATUS,OPTDT,DISCHDT,RXDT,OPTDT,RXDT,CHGAMT,OCC,BILLNO,RXNUM,RXNAM,DSTATUS,IBDATA
  1. N VAERR,VADM,VAEL,VAIP
  1. ;Quit if passed parameter variables not populated
  1. I $G(EOCBEGDT)'>0,$G(EOCENDDT)'>0,$G(VLSBEGDT)'>0,$G(VLSENDDT)'>0,$G(RDBEGDT)'>0,$G(RDENDDT)'>0 Q
  1. ;Get Rated Disability Data within passed RD change time frame
  1. ;*** call API to get all RD change data for given date period
  1. K ^TMP($J,"RDCHG")
  1. D RDCHG^DGENRDUA("",RDBEGDT,RDENDDT)
  1. S RCDFN=0
  1. F S RCDFN=$O(^TMP($J,"RDCHG",RCDFN)) Q:RCDFN'>0 D Q:$G(STOPIT)>0
  1. . ;Get AR Debtor info from file 340
  1. . S DEBTOR=0
  1. . F S DEBTOR=$O(^RCD(340,"B",RCDFN_";DPT(",DEBTOR)) Q:DEBTOR'>0 D Q:$G(STOPIT)>0
  1. . . ;Quit if Veteran is SC 50% to 100% or Receiving VA Pension or A&A
  1. . . S DFN=RCDFN
  1. . . S DMCELIG=$$DMCELIG^RCDMCUT1(RCDFN)
  1. . . Q:DMCELIG>0
  1. . . ; From what I can see, these two dates are not obtainable from VADPT calls - YG
  1. . . S VLSDT=$$GET1^DIQ(2,DFN_",",.3612,"I")
  1. . . ; as per customer, we don't want people who have no VLSDT
  1. . . I VLSDT="" Q
  1. . . S EFFDT=$$GET1^DIQ(2,DFN_",",.3014,"I")
  1. . . I $G(VLSDT)<VLSBEGDT Q
  1. . . I $G(VLSDT)>VLSENDDT Q
  1. . . I DFN'>0 D KVAR^VADPT Q
  1. . . D DEM^VADPT
  1. . . I $G(VAERR)>0 D KVAR^VADPT Q
  1. . . S NAME=$G(VADM(1))
  1. . . I NAME']"" D KVAR^VADPT Q
  1. . . S SSN=$P(VADM(2),U,1)
  1. . . ;Get Eligibility Data
  1. . . D ELIG^VADPT
  1. . . I $G(VAERR)>0 D KVAR^VADPT Q
  1. . . S SCPER=$P(VAEL(3),U,2)
  1. . . D KVAR^VADPT
  1. . . ;Get AR Bill Data that is within the last BEGDT time period
  1. . . ;for Bills with a current status of ACTIVE, OPEN, SUSPENDED, WRITE-OFF, COLLECTED/CLOSED, CANCELLATION, or IB Status of ON-HOLD
  1. . . K ^TMP($J,"RCDMCR4","ARIB")
  1. . . S ARIEN=0
  1. . . F S ARIEN=$O(^PRCA(430,"C",DEBTOR,ARIEN)) Q:ARIEN'>0 D Q:$G(STOPIT)>0
  1. . . . K IBDATA S IBDATA=0
  1. . . . S CTR=$G(CTR)+1 ;Counter
  1. . . . I CTR#500=0 S STOPIT=$$STOPIT^RCDMCUT2() Q:STOPIT
  1. . . . ; only look at 1st party bills
  1. . . . I '$$FIRSTPAR^RCDMCUT1(ARIEN) Q
  1. . . . S BILLNO=$$GET1^DIQ(430,ARIEN_",",.01)
  1. . . . I BILLNO']"" Q
  1. . . . S STATUS=$$GET1^DIQ(430,ARIEN_",",8,"E")
  1. . . . I "^ACTIVE^OPEN^SUSPENDED^WRITE-OFF^COLLECTED/CLOSED^CANCELLATION^"'[(U_STATUS_U) Q
  1. . . . K IBDATA S IBDATA=0
  1. . . . S IBIEN=""
  1. . . . F S IBIEN=$O(^IB("ABIL",BILLNO,IBIEN)) Q:'IBIEN S OUT=$$GETIB(IBIEN,0) I OUT,$P(OUT,U,5)'=10 S IBDATA=IBDATA+1,IBDATA(IBDATA)=OUT
  1. . . . I 'IBDATA Q
  1. . . . M ^TMP($J,"RCDMCR4","ARIB",BILLNO,"IBDATA")=IBDATA
  1. . . . S ^TMP($J,"RCDMCR4","ARIB",BILLNO,"STATUS")=STATUS
  1. . . S IBIEN=""
  1. . . F S IBIEN=$O(^IB("AH",RCDFN,IBIEN)) Q:IBIEN="" D Q:$G(STOPIT)>0
  1. . . . K IBDATA S IBDATA=0
  1. . . . S CTR=$G(CTR)+1 ;Counter
  1. . . . I CTR#500=0 S STOPIT=$$STOPIT^RCDMCUT2() Q:STOPIT
  1. . . . S BILLNO="/"_IBIEN
  1. . . . S OUT=$$GETIB(IBIEN,1) Q:'OUT Q:$P(OUT,U,5)=10
  1. . . . S IBDATA=1,IBDATA(1)=OUT
  1. . . . M ^TMP($J,"RCDMCR4","ARIB",BILLNO,"IBDATA")=IBDATA
  1. . . . S ^TMP($J,"RCDMCR4","ARIB",BILLNO,"STATUS")="ON HOLD"
  1. . . S BILLNO=""
  1. . . F S BILLNO=$O(^TMP($J,"RCDMCR4","ARIB",BILLNO)) Q:BILLNO="" D
  1. . . . K IBDATA M IBDATA=^TMP($J,"RCDMCR4","ARIB",BILLNO,"IBDATA")
  1. . . . S STATUS=^TMP($J,"RCDMCR4","ARIB",BILLNO,"STATUS")
  1. . . . S OCC=0
  1. . . . F S OCC=$O(^TMP($J,"RDCHG",RCDFN,OCC)) Q:OCC'>0 D
  1. . . . . N RDNODE,RDCHGDT,RDNAME,RDSEXTRE,RDORGDT
  1. . . . . S RDNODE=$G(^TMP($J,"RDCHG",RCDFN,OCC))
  1. . . . . S RDCHGDT=$P($P(RDNODE,U,1),".",1)
  1. . . . . S RDNAME=$P(RDNODE,U,3)
  1. . . . . S RDSEXTRE=$P(RDNODE,U,5)
  1. . . . . S:RDSEXTRE']"" RDSEXTRE=" "
  1. . . . . S RDORGDT=$P(RDNODE,U,7)
  1. . . . . S EFFDT=RDORGDT
  1. . . . . I RDNAME']"" Q
  1. . . . . F IBCNT=1:1:IBDATA D
  1. . . . . . ;IBDATA - Array of 1 ^ Outpatient Date ^ Discharge Date ^ RX/Refill Date ^ IB Status ^ RX NUM ^ RX Name ^ CHGAMT
  1. . . . . . S OPTDT=$P(IBDATA(IBCNT),U,2)
  1. . . . . . S DISCHDT=$P(IBDATA(IBCNT),U,3)
  1. . . . . . S RXDT=$P(IBDATA(IBCNT),U,4)
  1. . . . . . S RXNUM=$P(IBDATA(IBCNT),U,6)
  1. . . . . . S RXNAM=$P(IBDATA(IBCNT),U,7)
  1. . . . . . S CHGAMT=$P(IBDATA(IBCNT),U,8)
  1. . . . . . S DSTATUS=STATUS
  1. . . . . . ; Get EOC date and verify that it is later than Patient Effective Date
  1. . . . . . S EOCDT=""
  1. . . . . . I OPTDT>EOCDT S EOCDT=OPTDT
  1. . . . . . I DISCHDT>EOCDT S EOCDT=DISCHDT
  1. . . . . . I RXDT>EOCDT S EOCDT=RXDT
  1. . . . . . I EFFDT,EOCDT'>EFFDT Q
  1. . . . . . ;Skip is current EOC date for IB (OPTDT, DISCHDT or RXDT) is not within EOC date range
  1. . . . . . I EOCDT<EOCBEGDT Q
  1. . . . . . I EOCDT>EOCENDDT Q
  1. . . . . . ; TBD
  1. . . . . . I EFFDT="" S ^TMP($J,"RCDMCR4","DETAIL",NAME,SSN," ",RDNAME,RDSEXTRE," ",1)="NODATE"_U_U_U_U_U_SCPER_U_VLSDT Q
  1. . . . . . S DSTATUS=$S(DSTATUS="CANCELLATION":"ARCXLD",DSTATUS="COLLECTED/CLOSED":"C/C",1:DSTATUS)
  1. . . . . . S ^TMP($J,"RCDMCR4","DETAIL",NAME,SSN,RDCHGDT,RDNAME,RDSEXTRE,BILLNO,IBCNT)=RDORGDT_U_RXDT_U_OPTDT_U_DISCHDT_U_DSTATUS_U_SCPER_U_VLSDT_U_CHGAMT_U_RXNUM_U_RXNAM
  1. . . . . . S ^TMP($J,"RCDMCR4","SUMMARY",NAME,SSN)=SCPER
  1. K ^TMP($J,"RDCHG")
  1. K ^TMP($J,"RCDMCR4","ARIB")
  1. Q
  1. ;
  1. GETIB(IBIEN,IBMODE) ; Get all Outpatient Dates, Inpatient Dates and RX Dates/drugs
  1. ; Input:
  1. ; IBIEN - IEN of IB entry (File 350, ^IB)
  1. ; IBMODE - 0 if we are in AR mode, 1 if we are in IB mode.
  1. ; Output:
  1. ; 0 if we don't get anything out of this IB
  1. ; Othewise 1 ^ Outpatient Date ^ Discharge Date ^ RX/Refill Date ^ IB Status ^ RX NUM ^ RX Name ^ CHGAMT
  1. N IBDET,IENS,ACTTYPE,RESULT,DTBILLFR,BILGROUP,OPDT,DISCHARG,RXDT,STATUS,OUT,I0,PARENT,PARENTOK,DFN
  1. S OUT=0
  1. S I0=$G(^IB(IBIEN,0))
  1. S DFN=$P(I0,U,2)
  1. I 'DFN Q OUT
  1. S ACTTYPE=$P(I0,U,3)
  1. I $$GET1^DIQ(350.1,ACTTYPE_",",.01,"E")["URGENT CARE" Q OUT ; skip urgent care charges PRCA*4.5*414
  1. S DTBILLFR=$P(I0,U,14)
  1. S STATUS=$P(I0,U,5)
  1. S PARENT=$$PARENTC^RCDMCR5B(IBIEN),CHGAMT=$P($G(^IB(PARENT,0)),U,7)
  1. ;S CHGAMT=$$GET1^DIQ(350,$$PARENTC^RCDMCR5B(IBIEN)_",",.07,"I")
  1. ; only take parents if running in AR mode?
  1. S PARENT=$$PARENTE^RCDMCR5B(IBIEN)
  1. I +$G(IBMODE)=0 S PARENTOK=0 D I 'PARENTOK Q OUT
  1. . I IBIEN=PARENT S PARENTOK=1 Q
  1. . I $P(I0,U,11),$P(I0,U,11)'=$P(^IB(PARENT,0),U,11) S PARENTOK=1 ; it is OK to take a child IB if parent is not part of same bill.
  1. S RESULT=$P(^IB(PARENT,0),U,4)
  1. ;Quit if RESULTING FROM field is blank
  1. Q:RESULT="" OUT
  1. ;Get Billing Group in the IB Action Type File. If internal Set
  1. ;Code value is 4, then this is an Outpatient Visit (From STMT^IBRFN1)
  1. ;and can use Date Billed From for the Outpatient Visit Date
  1. S BILGROUP=$P($G(^IBE(350.1,+ACTTYPE,0)),U,11)
  1. ;Outpatient Event
  1. I BILGROUP=4!($P(RESULT,":",1)=44)!($P(RESULT,":",1)=409.68) D
  1. . I $P(RESULT,":",1)=44 S OPDT=$P($P(RESULT,";",2),":",2)
  1. . I $P(RESULT,":",1)=409.68 S OPDT=$P($G(^SCE(+$P(RESULT,":",2),0)),U)
  1. . I $G(OPDT)'>0 S OPDT=DTBILLFR
  1. . I OPDT S OUT=1_U_OPDT
  1. ;Inpatient Event
  1. I $P(RESULT,":",1)=405!($P(RESULT,":",1)=45) D
  1. . D KVAR^VADPT
  1. . S VAIP("E")=$P($P(RESULT,";",1),":",2)
  1. . ;Call to get Inpatient data
  1. . D IN5^VADPT
  1. . I VAERR>0 D KVAR^VADPT Q
  1. . S DISCHARG=$P($G(VAIP(17,1)),U,1)
  1. . I DISCHARG S OUT=1_U_U_DISCHARG
  1. . D KVAR^VADPT
  1. ;RX Event
  1. I $P(RESULT,":",1)=52 D
  1. . ;Set up for RX Refills
  1. . I $P(RESULT,";",2)]"" D
  1. . . N RXIEN,RXFIEN
  1. . . S RXFIEN=$P($P(RESULT,";",2),":",2),RXIEN=$P($P(RESULT,";",1),":",2)
  1. . . S RXDT=$P($G(^PSRX(RXIEN,1,RXFIEN,0)),U,18) ; released data
  1. . . S:RXDT="" RXDT=$P($G(^PSRX(RXIEN,1,RXFIEN,0)),U) ; refill date
  1. . . S RXNUM=$P($G(^PSRX(RXIEN,0)),U)
  1. . . S RXNAM=$P($G(^PSRX(RXIEN,0)),U,6) S:RXNAM RXNAM=$P($G(^PSDRUG(RXNAM,0)),U)
  1. . . I RXDT S OUT=1_U_U_U_RXDT_U_U_RXNUM_U_RXNAM
  1. . ;Set up for RX Data (No refill)
  1. . I $P(RESULT,";",2)']"" D
  1. . . N RXIEN
  1. . . S RXIEN=$P(RESULT,":",2)
  1. . . S RXDT=$P($G(^PSRX(RXIEN,2)),U,13) ; released date
  1. . . S:RXDT="" RXDT=$P($G(^PSRX(RXIEN,2)),U,2) ; fill date
  1. . . S:RXDT="" RXDT=$P($G(^PSRX(RXIEN,2)),U,5) ; dispensed date
  1. . . S RXNUM=$P($G(^PSRX(RXIEN,0)),U)
  1. . . S RXNAM=$P($G(^PSRX(RXIEN,0)),U,6) S:RXNAM RXNAM=$P($G(^PSDRUG(RXNAM,0)),U)
  1. . . I RXDT S OUT=1_U_U_U_RXDT_U_U_RXNUM_U_RXNAM
  1. I 'OUT Q OUT
  1. S $P(OUT,U,5)=STATUS
  1. S $P(OUT,U,8)=CHGAMT
  1. Q OUT