RCDMCR4B ;ALB/YG - 0 - 40 Percent SC Change Reconciliation Report - Collect Data; Apr 9, 2019@21:06
;;4.5;Accounts Receivable;**347,414**;Mar 20, 1995;Build 2
;;Per VA Directive 6402, this routine should not be modified.
;
; See RCDMCR4A for detailed description
;
COLLECT(STOPIT,RDBEGDT,RDENDDT,VLSBEGDT,VLSENDDT,EOCBEGDT,EOCENDDT,RPTTYPE) ; Get the report data
;Input
; STOPIT - Passed Variable to determine if process is to be terminated
; BEGDT - Beginning Date (in past) to get Episode of Care data for.
; (Required)
; RDBEGDT - Rated Disability Change Beginning date, (Required)
; RDENDDT - Rated Disability Change Ending Date, (Required)
; VLSBEGDT - Vista Last Status Date Beginning date, (Required)
; VLSENDDT - Vista Last Status Date Ending Date, (Required)
; EOCBEGDT - Episodes Of Care Beginning date, (Required)
; EOCENDDT - Episodes Of Care Ending Date, (Required)
; RPTTYPE - Report Type (Summary / Detailed)
;Output
; STOPIT - Passed Variable set to 1 if process is to be terminated
; ^TMP($J,"RCDMCR4") with report data and summary data
N RCDFN,DEBTOR,ARIEN,IBIEN,CTR,IBCNT,EOCDT,DFN,DMCELIG,EFFDT,NAME,SSN,VLSDT,SCPER
N STATUS,OPTDT,DISCHDT,RXDT,OPTDT,RXDT,CHGAMT,OCC,BILLNO,RXNUM,RXNAM,DSTATUS,IBDATA
N VAERR,VADM,VAEL,VAIP
;Quit if passed parameter variables not populated
I $G(EOCBEGDT)'>0,$G(EOCENDDT)'>0,$G(VLSBEGDT)'>0,$G(VLSENDDT)'>0,$G(RDBEGDT)'>0,$G(RDENDDT)'>0 Q
;Get Rated Disability Data within passed RD change time frame
;*** call API to get all RD change data for given date period
K ^TMP($J,"RDCHG")
D RDCHG^DGENRDUA("",RDBEGDT,RDENDDT)
S RCDFN=0
F S RCDFN=$O(^TMP($J,"RDCHG",RCDFN)) Q:RCDFN'>0 D Q:$G(STOPIT)>0
. ;Get AR Debtor info from file 340
. S DEBTOR=0
. F S DEBTOR=$O(^RCD(340,"B",RCDFN_";DPT(",DEBTOR)) Q:DEBTOR'>0 D Q:$G(STOPIT)>0
. . ;Quit if Veteran is SC 50% to 100% or Receiving VA Pension or A&A
. . S DFN=RCDFN
. . S DMCELIG=$$DMCELIG^RCDMCUT1(RCDFN)
. . Q:DMCELIG>0
. . ; From what I can see, these two dates are not obtainable from VADPT calls - YG
. . S VLSDT=$$GET1^DIQ(2,DFN_",",.3612,"I")
. . ; as per customer, we don't want people who have no VLSDT
. . I VLSDT="" Q
. . S EFFDT=$$GET1^DIQ(2,DFN_",",.3014,"I")
. . I $G(VLSDT)<VLSBEGDT Q
. . I $G(VLSDT)>VLSENDDT Q
. . I DFN'>0 D KVAR^VADPT Q
. . D DEM^VADPT
. . I $G(VAERR)>0 D KVAR^VADPT Q
. . S NAME=$G(VADM(1))
. . I NAME']"" D KVAR^VADPT Q
. . S SSN=$P(VADM(2),U,1)
. . ;Get Eligibility Data
. . D ELIG^VADPT
. . I $G(VAERR)>0 D KVAR^VADPT Q
. . S SCPER=$P(VAEL(3),U,2)
. . D KVAR^VADPT
. . ;Get AR Bill Data that is within the last BEGDT time period
. . ;for Bills with a current status of ACTIVE, OPEN, SUSPENDED, WRITE-OFF, COLLECTED/CLOSED, CANCELLATION, or IB Status of ON-HOLD
. . K ^TMP($J,"RCDMCR4","ARIB")
. . S ARIEN=0
. . F S ARIEN=$O(^PRCA(430,"C",DEBTOR,ARIEN)) Q:ARIEN'>0 D Q:$G(STOPIT)>0
. . . K IBDATA S IBDATA=0
. . . S CTR=$G(CTR)+1 ;Counter
. . . I CTR#500=0 S STOPIT=$$STOPIT^RCDMCUT2() Q:STOPIT
. . . ; only look at 1st party bills
. . . I '$$FIRSTPAR^RCDMCUT1(ARIEN) Q
. . . S BILLNO=$$GET1^DIQ(430,ARIEN_",",.01)
. . . I BILLNO']"" Q
. . . S STATUS=$$GET1^DIQ(430,ARIEN_",",8,"E")
. . . I "^ACTIVE^OPEN^SUSPENDED^WRITE-OFF^COLLECTED/CLOSED^CANCELLATION^"'[(U_STATUS_U) Q
. . . K IBDATA S IBDATA=0
. . . S IBIEN=""
. . . 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
. . . I 'IBDATA Q
. . . M ^TMP($J,"RCDMCR4","ARIB",BILLNO,"IBDATA")=IBDATA
. . . S ^TMP($J,"RCDMCR4","ARIB",BILLNO,"STATUS")=STATUS
. . S IBIEN=""
. . F S IBIEN=$O(^IB("AH",RCDFN,IBIEN)) Q:IBIEN="" D Q:$G(STOPIT)>0
. . . K IBDATA S IBDATA=0
. . . S CTR=$G(CTR)+1 ;Counter
. . . I CTR#500=0 S STOPIT=$$STOPIT^RCDMCUT2() Q:STOPIT
. . . S BILLNO="/"_IBIEN
. . . S OUT=$$GETIB(IBIEN,1) Q:'OUT Q:$P(OUT,U,5)=10
. . . S IBDATA=1,IBDATA(1)=OUT
. . . M ^TMP($J,"RCDMCR4","ARIB",BILLNO,"IBDATA")=IBDATA
. . . S ^TMP($J,"RCDMCR4","ARIB",BILLNO,"STATUS")="ON HOLD"
. . S BILLNO=""
. . F S BILLNO=$O(^TMP($J,"RCDMCR4","ARIB",BILLNO)) Q:BILLNO="" D
. . . K IBDATA M IBDATA=^TMP($J,"RCDMCR4","ARIB",BILLNO,"IBDATA")
. . . S STATUS=^TMP($J,"RCDMCR4","ARIB",BILLNO,"STATUS")
. . . S OCC=0
. . . F S OCC=$O(^TMP($J,"RDCHG",RCDFN,OCC)) Q:OCC'>0 D
. . . . N RDNODE,RDCHGDT,RDNAME,RDSEXTRE,RDORGDT
. . . . S RDNODE=$G(^TMP($J,"RDCHG",RCDFN,OCC))
. . . . S RDCHGDT=$P($P(RDNODE,U,1),".",1)
. . . . S RDNAME=$P(RDNODE,U,3)
. . . . S RDSEXTRE=$P(RDNODE,U,5)
. . . . S:RDSEXTRE']"" RDSEXTRE=" "
. . . . S RDORGDT=$P(RDNODE,U,7)
. . . . S EFFDT=RDORGDT
. . . . I RDNAME']"" Q
. . . . F IBCNT=1:1:IBDATA D
. . . . . ;IBDATA - Array of 1 ^ Outpatient Date ^ Discharge Date ^ RX/Refill Date ^ IB Status ^ RX NUM ^ RX Name ^ CHGAMT
. . . . . S OPTDT=$P(IBDATA(IBCNT),U,2)
. . . . . S DISCHDT=$P(IBDATA(IBCNT),U,3)
. . . . . S RXDT=$P(IBDATA(IBCNT),U,4)
. . . . . S RXNUM=$P(IBDATA(IBCNT),U,6)
. . . . . S RXNAM=$P(IBDATA(IBCNT),U,7)
. . . . . S CHGAMT=$P(IBDATA(IBCNT),U,8)
. . . . . S DSTATUS=STATUS
. . . . . ; Get EOC date and verify that it is later than Patient Effective Date
. . . . . S EOCDT=""
. . . . . I OPTDT>EOCDT S EOCDT=OPTDT
. . . . . I DISCHDT>EOCDT S EOCDT=DISCHDT
. . . . . I RXDT>EOCDT S EOCDT=RXDT
. . . . . I EFFDT,EOCDT'>EFFDT Q
. . . . . ;Skip is current EOC date for IB (OPTDT, DISCHDT or RXDT) is not within EOC date range
. . . . . I EOCDT<EOCBEGDT Q
. . . . . I EOCDT>EOCENDDT Q
. . . . . ; TBD
. . . . . I EFFDT="" S ^TMP($J,"RCDMCR4","DETAIL",NAME,SSN," ",RDNAME,RDSEXTRE," ",1)="NODATE"_U_U_U_U_U_SCPER_U_VLSDT Q
. . . . . S DSTATUS=$S(DSTATUS="CANCELLATION":"ARCXLD",DSTATUS="COLLECTED/CLOSED":"C/C",1:DSTATUS)
. . . . . 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
. . . . . S ^TMP($J,"RCDMCR4","SUMMARY",NAME,SSN)=SCPER
K ^TMP($J,"RDCHG")
K ^TMP($J,"RCDMCR4","ARIB")
Q
;
GETIB(IBIEN,IBMODE) ; Get all Outpatient Dates, Inpatient Dates and RX Dates/drugs
; Input:
; IBIEN - IEN of IB entry (File 350, ^IB)
; IBMODE - 0 if we are in AR mode, 1 if we are in IB mode.
; Output:
; 0 if we don't get anything out of this IB
; Othewise 1 ^ Outpatient Date ^ Discharge Date ^ RX/Refill Date ^ IB Status ^ RX NUM ^ RX Name ^ CHGAMT
N IBDET,IENS,ACTTYPE,RESULT,DTBILLFR,BILGROUP,OPDT,DISCHARG,RXDT,STATUS,OUT,I0,PARENT,PARENTOK,DFN
S OUT=0
S I0=$G(^IB(IBIEN,0))
S DFN=$P(I0,U,2)
I 'DFN Q OUT
S ACTTYPE=$P(I0,U,3)
I $$GET1^DIQ(350.1,ACTTYPE_",",.01,"E")["URGENT CARE" Q OUT ; skip urgent care charges PRCA*4.5*414
S DTBILLFR=$P(I0,U,14)
S STATUS=$P(I0,U,5)
S PARENT=$$PARENTC^RCDMCR5B(IBIEN),CHGAMT=$P($G(^IB(PARENT,0)),U,7)
;S CHGAMT=$$GET1^DIQ(350,$$PARENTC^RCDMCR5B(IBIEN)_",",.07,"I")
; only take parents if running in AR mode?
S PARENT=$$PARENTE^RCDMCR5B(IBIEN)
I +$G(IBMODE)=0 S PARENTOK=0 D I 'PARENTOK Q OUT
. I IBIEN=PARENT S PARENTOK=1 Q
. 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.
S RESULT=$P(^IB(PARENT,0),U,4)
;Quit if RESULTING FROM field is blank
Q:RESULT="" OUT
;Get Billing Group in the IB Action Type File. If internal Set
;Code value is 4, then this is an Outpatient Visit (From STMT^IBRFN1)
;and can use Date Billed From for the Outpatient Visit Date
S BILGROUP=$P($G(^IBE(350.1,+ACTTYPE,0)),U,11)
;Outpatient Event
I BILGROUP=4!($P(RESULT,":",1)=44)!($P(RESULT,":",1)=409.68) D
. I $P(RESULT,":",1)=44 S OPDT=$P($P(RESULT,";",2),":",2)
. I $P(RESULT,":",1)=409.68 S OPDT=$P($G(^SCE(+$P(RESULT,":",2),0)),U)
. I $G(OPDT)'>0 S OPDT=DTBILLFR
. I OPDT S OUT=1_U_OPDT
;Inpatient Event
I $P(RESULT,":",1)=405!($P(RESULT,":",1)=45) D
. D KVAR^VADPT
. S VAIP("E")=$P($P(RESULT,";",1),":",2)
. ;Call to get Inpatient data
. D IN5^VADPT
. I VAERR>0 D KVAR^VADPT Q
. S DISCHARG=$P($G(VAIP(17,1)),U,1)
. I DISCHARG S OUT=1_U_U_DISCHARG
. D KVAR^VADPT
;RX Event
I $P(RESULT,":",1)=52 D
. ;Set up for RX Refills
. I $P(RESULT,";",2)]"" D
. . N RXIEN,RXFIEN
. . S RXFIEN=$P($P(RESULT,";",2),":",2),RXIEN=$P($P(RESULT,";",1),":",2)
. . S RXDT=$P($G(^PSRX(RXIEN,1,RXFIEN,0)),U,18) ; released data
. . S:RXDT="" RXDT=$P($G(^PSRX(RXIEN,1,RXFIEN,0)),U) ; refill date
. . S RXNUM=$P($G(^PSRX(RXIEN,0)),U)
. . S RXNAM=$P($G(^PSRX(RXIEN,0)),U,6) S:RXNAM RXNAM=$P($G(^PSDRUG(RXNAM,0)),U)
. . I RXDT S OUT=1_U_U_U_RXDT_U_U_RXNUM_U_RXNAM
. ;Set up for RX Data (No refill)
. I $P(RESULT,";",2)']"" D
. . N RXIEN
. . S RXIEN=$P(RESULT,":",2)
. . S RXDT=$P($G(^PSRX(RXIEN,2)),U,13) ; released date
. . S:RXDT="" RXDT=$P($G(^PSRX(RXIEN,2)),U,2) ; fill date
. . S:RXDT="" RXDT=$P($G(^PSRX(RXIEN,2)),U,5) ; dispensed date
. . S RXNUM=$P($G(^PSRX(RXIEN,0)),U)
. . S RXNAM=$P($G(^PSRX(RXIEN,0)),U,6) S:RXNAM RXNAM=$P($G(^PSDRUG(RXNAM,0)),U)
. . I RXDT S OUT=1_U_U_U_RXDT_U_U_RXNUM_U_RXNAM
I 'OUT Q OUT
S $P(OUT,U,5)=STATUS
S $P(OUT,U,8)=CHGAMT
Q OUT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRCDMCR4B 9279 printed Oct 16, 2024@17:44:27 Page 2
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
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; See RCDMCR4A for detailed description
+5 ;
COLLECT(STOPIT,RDBEGDT,RDENDDT,VLSBEGDT,VLSENDDT,EOCBEGDT,EOCENDDT,RPTTYPE) ; Get the report data
+1 ;Input
+2 ; STOPIT - Passed Variable to determine if process is to be terminated
+3 ; BEGDT - Beginning Date (in past) to get Episode of Care data for.
+4 ; (Required)
+5 ; RDBEGDT - Rated Disability Change Beginning date, (Required)
+6 ; RDENDDT - Rated Disability Change Ending Date, (Required)
+7 ; VLSBEGDT - Vista Last Status Date Beginning date, (Required)
+8 ; VLSENDDT - Vista Last Status Date Ending Date, (Required)
+9 ; EOCBEGDT - Episodes Of Care Beginning date, (Required)
+10 ; EOCENDDT - Episodes Of Care Ending Date, (Required)
+11 ; RPTTYPE - Report Type (Summary / Detailed)
+12 ;Output
+13 ; STOPIT - Passed Variable set to 1 if process is to be terminated
+14 ; ^TMP($J,"RCDMCR4") with report data and summary data
+15 NEW RCDFN,DEBTOR,ARIEN,IBIEN,CTR,IBCNT,EOCDT,DFN,DMCELIG,EFFDT,NAME,SSN,VLSDT,SCPER
+16 NEW STATUS,OPTDT,DISCHDT,RXDT,OPTDT,RXDT,CHGAMT,OCC,BILLNO,RXNUM,RXNAM,DSTATUS,IBDATA
+17 NEW VAERR,VADM,VAEL,VAIP
+18 ;Quit if passed parameter variables not populated
+19 IF $GET(EOCBEGDT)'>0
IF $GET(EOCENDDT)'>0
IF $GET(VLSBEGDT)'>0
IF $GET(VLSENDDT)'>0
IF $GET(RDBEGDT)'>0
IF $GET(RDENDDT)'>0
QUIT
+20 ;Get Rated Disability Data within passed RD change time frame
+21 ;*** call API to get all RD change data for given date period
+22 KILL ^TMP($JOB,"RDCHG")
+23 DO RDCHG^DGENRDUA("",RDBEGDT,RDENDDT)
+24 SET RCDFN=0
+25 FOR
SET RCDFN=$ORDER(^TMP($JOB,"RDCHG",RCDFN))
if RCDFN'>0
QUIT
Begin DoDot:1
+26 ;Get AR Debtor info from file 340
+27 SET DEBTOR=0
+28 FOR
SET DEBTOR=$ORDER(^RCD(340,"B",RCDFN_";DPT(",DEBTOR))
if DEBTOR'>0
QUIT
Begin DoDot:2
+29 ;Quit if Veteran is SC 50% to 100% or Receiving VA Pension or A&A
+30 SET DFN=RCDFN
+31 SET DMCELIG=$$DMCELIG^RCDMCUT1(RCDFN)
+32 if DMCELIG>0
QUIT
+33 ; From what I can see, these two dates are not obtainable from VADPT calls - YG
+34 SET VLSDT=$$GET1^DIQ(2,DFN_",",.3612,"I")
+35 ; as per customer, we don't want people who have no VLSDT
+36 IF VLSDT=""
QUIT
+37 SET EFFDT=$$GET1^DIQ(2,DFN_",",.3014,"I")
+38 IF $GET(VLSDT)<VLSBEGDT
QUIT
+39 IF $GET(VLSDT)>VLSENDDT
QUIT
+40 IF DFN'>0
DO KVAR^VADPT
QUIT
+41 DO DEM^VADPT
+42 IF $GET(VAERR)>0
DO KVAR^VADPT
QUIT
+43 SET NAME=$GET(VADM(1))
+44 IF NAME']""
DO KVAR^VADPT
QUIT
+45 SET SSN=$PIECE(VADM(2),U,1)
+46 ;Get Eligibility Data
+47 DO ELIG^VADPT
+48 IF $GET(VAERR)>0
DO KVAR^VADPT
QUIT
+49 SET SCPER=$PIECE(VAEL(3),U,2)
+50 DO KVAR^VADPT
+51 ;Get AR Bill Data that is within the last BEGDT time period
+52 ;for Bills with a current status of ACTIVE, OPEN, SUSPENDED, WRITE-OFF, COLLECTED/CLOSED, CANCELLATION, or IB Status of ON-HOLD
+53 KILL ^TMP($JOB,"RCDMCR4","ARIB")
+54 SET ARIEN=0
+55 FOR
SET ARIEN=$ORDER(^PRCA(430,"C",DEBTOR,ARIEN))
if ARIEN'>0
QUIT
Begin DoDot:3
+56 KILL IBDATA
SET IBDATA=0
+57 ;Counter
SET CTR=$GET(CTR)+1
+58 IF CTR#500=0
SET STOPIT=$$STOPIT^RCDMCUT2()
if STOPIT
QUIT
+59 ; only look at 1st party bills
+60 IF '$$FIRSTPAR^RCDMCUT1(ARIEN)
QUIT
+61 SET BILLNO=$$GET1^DIQ(430,ARIEN_",",.01)
+62 IF BILLNO']""
QUIT
+63 SET STATUS=$$GET1^DIQ(430,ARIEN_",",8,"E")
+64 IF "^ACTIVE^OPEN^SUSPENDED^WRITE-OFF^COLLECTED/CLOSED^CANCELLATION^"'[(U_STATUS_U)
QUIT
+65 KILL IBDATA
SET IBDATA=0
+66 SET IBIEN=""
+67 FOR
SET IBIEN=$ORDER(^IB("ABIL",BILLNO,IBIEN))
if 'IBIEN
QUIT
SET OUT=$$GETIB(IBIEN,0)
IF OUT
IF $PIECE(OUT,U,5)'=10
SET IBDATA=IBDATA+1
SET IBDATA(IBDATA)=OUT
+68 IF 'IBDATA
QUIT
+69 MERGE ^TMP($JOB,"RCDMCR4","ARIB",BILLNO,"IBDATA")=IBDATA
+70 SET ^TMP($JOB,"RCDMCR4","ARIB",BILLNO,"STATUS")=STATUS
End DoDot:3
if $GET(STOPIT)>0
QUIT
+71 SET IBIEN=""
+72 FOR
SET IBIEN=$ORDER(^IB("AH",RCDFN,IBIEN))
if IBIEN=""
QUIT
Begin DoDot:3
+73 KILL IBDATA
SET IBDATA=0
+74 ;Counter
SET CTR=$GET(CTR)+1
+75 IF CTR#500=0
SET STOPIT=$$STOPIT^RCDMCUT2()
if STOPIT
QUIT
+76 SET BILLNO="/"_IBIEN
+77 SET OUT=$$GETIB(IBIEN,1)
if 'OUT
QUIT
if $PIECE(OUT,U,5)=10
QUIT
+78 SET IBDATA=1
SET IBDATA(1)=OUT
+79 MERGE ^TMP($JOB,"RCDMCR4","ARIB",BILLNO,"IBDATA")=IBDATA
+80 SET ^TMP($JOB,"RCDMCR4","ARIB",BILLNO,"STATUS")="ON HOLD"
End DoDot:3
if $GET(STOPIT)>0
QUIT
+81 SET BILLNO=""
+82 FOR
SET BILLNO=$ORDER(^TMP($JOB,"RCDMCR4","ARIB",BILLNO))
if BILLNO=""
QUIT
Begin DoDot:3
+83 KILL IBDATA
MERGE IBDATA=^TMP($JOB,"RCDMCR4","ARIB",BILLNO,"IBDATA")
+84 SET STATUS=^TMP($JOB,"RCDMCR4","ARIB",BILLNO,"STATUS")
+85 SET OCC=0
+86 FOR
SET OCC=$ORDER(^TMP($JOB,"RDCHG",RCDFN,OCC))
if OCC'>0
QUIT
Begin DoDot:4
+87 NEW RDNODE,RDCHGDT,RDNAME,RDSEXTRE,RDORGDT
+88 SET RDNODE=$GET(^TMP($JOB,"RDCHG",RCDFN,OCC))
+89 SET RDCHGDT=$PIECE($PIECE(RDNODE,U,1),".",1)
+90 SET RDNAME=$PIECE(RDNODE,U,3)
+91 SET RDSEXTRE=$PIECE(RDNODE,U,5)
+92 if RDSEXTRE']""
SET RDSEXTRE=" "
+93 SET RDORGDT=$PIECE(RDNODE,U,7)
+94 SET EFFDT=RDORGDT
+95 IF RDNAME']""
QUIT
+96 FOR IBCNT=1:1:IBDATA
Begin DoDot:5
+97 ;IBDATA - Array of 1 ^ Outpatient Date ^ Discharge Date ^ RX/Refill Date ^ IB Status ^ RX NUM ^ RX Name ^ CHGAMT
+98 SET OPTDT=$PIECE(IBDATA(IBCNT),U,2)
+99 SET DISCHDT=$PIECE(IBDATA(IBCNT),U,3)
+100 SET RXDT=$PIECE(IBDATA(IBCNT),U,4)
+101 SET RXNUM=$PIECE(IBDATA(IBCNT),U,6)
+102 SET RXNAM=$PIECE(IBDATA(IBCNT),U,7)
+103 SET CHGAMT=$PIECE(IBDATA(IBCNT),U,8)
+104 SET DSTATUS=STATUS
+105 ; Get EOC date and verify that it is later than Patient Effective Date
+106 SET EOCDT=""
+107 IF OPTDT>EOCDT
SET EOCDT=OPTDT
+108 IF DISCHDT>EOCDT
SET EOCDT=DISCHDT
+109 IF RXDT>EOCDT
SET EOCDT=RXDT
+110 IF EFFDT
IF EOCDT'>EFFDT
QUIT
+111 ;Skip is current EOC date for IB (OPTDT, DISCHDT or RXDT) is not within EOC date range
+112 IF EOCDT<EOCBEGDT
QUIT
+113 IF EOCDT>EOCENDDT
QUIT
+114 ; TBD
+115 IF EFFDT=""
SET ^TMP($JOB,"RCDMCR4","DETAIL",NAME,SSN," ",RDNAME,RDSEXTRE," ",1)="NODATE"_U_U_U_U_U_SCPER_U_VLSDT
QUIT
+116 SET DSTATUS=$SELECT(DSTATUS="CANCELLATION":"ARCXLD",DSTATUS="COLLECTED/CLOSED":"C/C",1:DSTATUS)
+117 SET ^TMP($JOB,"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
+118 SET ^TMP($JOB,"RCDMCR4","SUMMARY",NAME,SSN)=SCPER
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
if $GET(STOPIT)>0
QUIT
End DoDot:1
if $GET(STOPIT)>0
QUIT
+119 KILL ^TMP($JOB,"RDCHG")
+120 KILL ^TMP($JOB,"RCDMCR4","ARIB")
+121 QUIT
+122 ;
GETIB(IBIEN,IBMODE) ; Get all Outpatient Dates, Inpatient Dates and RX Dates/drugs
+1 ; Input:
+2 ; IBIEN - IEN of IB entry (File 350, ^IB)
+3 ; IBMODE - 0 if we are in AR mode, 1 if we are in IB mode.
+4 ; Output:
+5 ; 0 if we don't get anything out of this IB
+6 ; Othewise 1 ^ Outpatient Date ^ Discharge Date ^ RX/Refill Date ^ IB Status ^ RX NUM ^ RX Name ^ CHGAMT
+7 NEW IBDET,IENS,ACTTYPE,RESULT,DTBILLFR,BILGROUP,OPDT,DISCHARG,RXDT,STATUS,OUT,I0,PARENT,PARENTOK,DFN
+8 SET OUT=0
+9 SET I0=$GET(^IB(IBIEN,0))
+10 SET DFN=$PIECE(I0,U,2)
+11 IF 'DFN
QUIT OUT
+12 SET ACTTYPE=$PIECE(I0,U,3)
+13 ; skip urgent care charges PRCA*4.5*414
IF $$GET1^DIQ(350.1,ACTTYPE_",",.01,"E")["URGENT CARE"
QUIT OUT
+14 SET DTBILLFR=$PIECE(I0,U,14)
+15 SET STATUS=$PIECE(I0,U,5)
+16 SET PARENT=$$PARENTC^RCDMCR5B(IBIEN)
SET CHGAMT=$PIECE($GET(^IB(PARENT,0)),U,7)
+17 ;S CHGAMT=$$GET1^DIQ(350,$$PARENTC^RCDMCR5B(IBIEN)_",",.07,"I")
+18 ; only take parents if running in AR mode?
+19 SET PARENT=$$PARENTE^RCDMCR5B(IBIEN)
+20 IF +$GET(IBMODE)=0
SET PARENTOK=0
Begin DoDot:1
+21 IF IBIEN=PARENT
SET PARENTOK=1
QUIT
+22 ; it is OK to take a child IB if parent is not part of same bill.
IF $PIECE(I0,U,11)
IF $PIECE(I0,U,11)'=$PIECE(^IB(PARENT,0),U,11)
SET PARENTOK=1
End DoDot:1
IF 'PARENTOK
QUIT OUT
+23 SET RESULT=$PIECE(^IB(PARENT,0),U,4)
+24 ;Quit if RESULTING FROM field is blank
+25 if RESULT=""
QUIT OUT
+26 ;Get Billing Group in the IB Action Type File. If internal Set
+27 ;Code value is 4, then this is an Outpatient Visit (From STMT^IBRFN1)
+28 ;and can use Date Billed From for the Outpatient Visit Date
+29 SET BILGROUP=$PIECE($GET(^IBE(350.1,+ACTTYPE,0)),U,11)
+30 ;Outpatient Event
+31 IF BILGROUP=4!($PIECE(RESULT,":",1)=44)!($PIECE(RESULT,":",1)=409.68)
Begin DoDot:1
+32 IF $PIECE(RESULT,":",1)=44
SET OPDT=$PIECE($PIECE(RESULT,";",2),":",2)
+33 IF $PIECE(RESULT,":",1)=409.68
SET OPDT=$PIECE($GET(^SCE(+$PIECE(RESULT,":",2),0)),U)
+34 IF $GET(OPDT)'>0
SET OPDT=DTBILLFR
+35 IF OPDT
SET OUT=1_U_OPDT
End DoDot:1
+36 ;Inpatient Event
+37 IF $PIECE(RESULT,":",1)=405!($PIECE(RESULT,":",1)=45)
Begin DoDot:1
+38 DO KVAR^VADPT
+39 SET VAIP("E")=$PIECE($PIECE(RESULT,";",1),":",2)
+40 ;Call to get Inpatient data
+41 DO IN5^VADPT
+42 IF VAERR>0
DO KVAR^VADPT
QUIT
+43 SET DISCHARG=$PIECE($GET(VAIP(17,1)),U,1)
+44 IF DISCHARG
SET OUT=1_U_U_DISCHARG
+45 DO KVAR^VADPT
End DoDot:1
+46 ;RX Event
+47 IF $PIECE(RESULT,":",1)=52
Begin DoDot:1
+48 ;Set up for RX Refills
+49 IF $PIECE(RESULT,";",2)]""
Begin DoDot:2
+50 NEW RXIEN,RXFIEN
+51 SET RXFIEN=$PIECE($PIECE(RESULT,";",2),":",2)
SET RXIEN=$PIECE($PIECE(RESULT,";",1),":",2)
+52 ; released data
SET RXDT=$PIECE($GET(^PSRX(RXIEN,1,RXFIEN,0)),U,18)
+53 ; refill date
if RXDT=""
SET RXDT=$PIECE($GET(^PSRX(RXIEN,1,RXFIEN,0)),U)
+54 SET RXNUM=$PIECE($GET(^PSRX(RXIEN,0)),U)
+55 SET RXNAM=$PIECE($GET(^PSRX(RXIEN,0)),U,6)
if RXNAM
SET RXNAM=$PIECE($GET(^PSDRUG(RXNAM,0)),U)
+56 IF RXDT
SET OUT=1_U_U_U_RXDT_U_U_RXNUM_U_RXNAM
End DoDot:2
+57 ;Set up for RX Data (No refill)
+58 IF $PIECE(RESULT,";",2)']""
Begin DoDot:2
+59 NEW RXIEN
+60 SET RXIEN=$PIECE(RESULT,":",2)
+61 ; released date
SET RXDT=$PIECE($GET(^PSRX(RXIEN,2)),U,13)
+62 ; fill date
if RXDT=""
SET RXDT=$PIECE($GET(^PSRX(RXIEN,2)),U,2)
+63 ; dispensed date
if RXDT=""
SET RXDT=$PIECE($GET(^PSRX(RXIEN,2)),U,5)
+64 SET RXNUM=$PIECE($GET(^PSRX(RXIEN,0)),U)
+65 SET RXNAM=$PIECE($GET(^PSRX(RXIEN,0)),U,6)
if RXNAM
SET RXNAM=$PIECE($GET(^PSDRUG(RXNAM,0)),U)
+66 IF RXDT
SET OUT=1_U_U_U_RXDT_U_U_RXNUM_U_RXNAM
End DoDot:2
End DoDot:1
+67 IF 'OUT
QUIT OUT
+68 SET $PIECE(OUT,U,5)=STATUS
+69 SET $PIECE(OUT,U,8)=CHGAMT
+70 QUIT OUT
