- 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 Feb 18, 2025@23:09:59 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