RCDMCR8C ;ALB/LB - Pension Report Exempt Charge Reconciliation Report - Input/output; Jun 16, 2021@14:23
;;4.5;Accounts Receivable;**384**;JUN 16, 2021;Build 29
;;Per VA Directive 6402, this routine should not be modified.
;
; Reference to PATIENT in ICR #7277
; Reference to INTEGRATED BILLING ACTION in ICR #4541
; Reference to IB ACTION TYPE in ICR #4538
; See RCDMCR8A for detailed description
;
GETSTRT(IBIEN) ; Get start date for InPatient / LTC
N IBSDT,RESULT S IBSDT="",RESULT=""
S RESULT=$P(^IB(IBIEN,0),U,4)
I +RESULT=405!(+RESULT=45) S IBSDT=$$GET1^DIQ(350,IBIEN_",",.14,"I")
Q IBSDT
;
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
N CHGAMT,RXNAM,RXNUM,VAERR,VAIP
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)
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 '$$GET1^DIQ(350,PARENT_",",.11,"I") S PARENT=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)'=$$GET1^DIQ(350,PARENT_",",.11,"I") 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)
I BILGROUP>6 Q OUT
;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
S OPDT=$P(I0,U,14) I 'OUT,RESULT'="",OPDT'="" S OUT=1_U_OPDT
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[HRCDMCR8C 3797 printed Apr 09, 2024@20:48:47 Page 2
RCDMCR8C ;ALB/LB - Pension Report Exempt Charge Reconciliation Report - Input/output; Jun 16, 2021@14:23
+1 ;;4.5;Accounts Receivable;**384**;JUN 16, 2021;Build 29
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; Reference to PATIENT in ICR #7277
+5 ; Reference to INTEGRATED BILLING ACTION in ICR #4541
+6 ; Reference to IB ACTION TYPE in ICR #4538
+7 ; See RCDMCR8A for detailed description
+8 ;
GETSTRT(IBIEN) ; Get start date for InPatient / LTC
+1 NEW IBSDT,RESULT
SET IBSDT=""
SET RESULT=""
+2 SET RESULT=$PIECE(^IB(IBIEN,0),U,4)
+3 IF +RESULT=405!(+RESULT=45)
SET IBSDT=$$GET1^DIQ(350,IBIEN_",",.14,"I")
+4 QUIT IBSDT
+5 ;
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 NEW CHGAMT,RXNAM,RXNUM,VAERR,VAIP
+9 SET OUT=0
+10 SET I0=$GET(^IB(IBIEN,0))
+11 SET DFN=$PIECE(I0,U,2)
+12 IF 'DFN
QUIT OUT
+13 SET ACTTYPE=$PIECE(I0,U,3)
+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 '$$GET1^DIQ(350,PARENT_",",.11,"I")
SET PARENT=IBIEN
+21 IF +$GET(IBMODE)=0
SET PARENTOK=0
Begin DoDot:1
+22 IF IBIEN=PARENT
SET PARENTOK=1
QUIT
+23 ; 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)'=$$GET1^DIQ(350,PARENT_",",.11,"I")
SET PARENTOK=1
End DoDot:1
IF 'PARENTOK
QUIT OUT
+24 SET RESULT=$PIECE(^IB(PARENT,0),U,4)
+25 ;Quit if RESULTING FROM field is blank
+26 if RESULT=""
QUIT OUT
+27 ;Get Billing Group in the IB Action Type File. If internal Set
+28 ;Code value is 4, then this is an Outpatient Visit (From STMT^IBRFN1)
+29 ;and can use Date Billed From for the Outpatient Visit Date
+30 SET BILGROUP=$PIECE($GET(^IBE(350.1,+ACTTYPE,0)),U,11)
+31 IF BILGROUP>6
QUIT OUT
+32 ;Outpatient Event
+33 IF BILGROUP=4!($PIECE(RESULT,":",1)=44)!($PIECE(RESULT,":",1)=409.68)
Begin DoDot:1
+34 IF $PIECE(RESULT,":",1)=44
SET OPDT=$PIECE($PIECE(RESULT,";",2),":",2)
+35 IF $PIECE(RESULT,":",1)=409.68
SET OPDT=$PIECE($GET(^SCE(+$PIECE(RESULT,":",2),0)),U)
+36 IF $GET(OPDT)'>0
SET OPDT=DTBILLFR
+37 IF OPDT
SET OUT=1_U_OPDT
End DoDot:1
+38 ;Inpatient Event
+39 IF $PIECE(RESULT,":",1)=405!($PIECE(RESULT,":",1)=45)
Begin DoDot:1
+40 DO KVAR^VADPT
+41 SET VAIP("E")=$PIECE($PIECE(RESULT,";",1),":",2)
+42 ;Call to get Inpatient data
+43 DO IN5^VADPT
+44 IF VAERR>0
DO KVAR^VADPT
QUIT
+45 SET DISCHARG=$PIECE($GET(VAIP(17,1)),U,1)
+46 IF DISCHARG
SET OUT=1_U_U_DISCHARG
+47 DO KVAR^VADPT
End DoDot:1
+48 ;RX Event
+49 IF $PIECE(RESULT,":",1)=52
Begin DoDot:1
+50 ;Set up for RX Refills
+51 IF $PIECE(RESULT,";",2)]""
Begin DoDot:2
+52 NEW RXIEN,RXFIEN
+53 SET RXFIEN=$PIECE($PIECE(RESULT,";",2),":",2)
SET RXIEN=$PIECE($PIECE(RESULT,";",1),":",2)
+54 ; released data
SET RXDT=$PIECE($GET(^PSRX(RXIEN,1,RXFIEN,0)),U,18)
+55 ; refill date
if RXDT=""
SET RXDT=$PIECE($GET(^PSRX(RXIEN,1,RXFIEN,0)),U)
+56 SET RXNUM=$PIECE($GET(^PSRX(RXIEN,0)),U)
+57 SET RXNAM=$PIECE($GET(^PSRX(RXIEN,0)),U,6)
if RXNAM
SET RXNAM=$PIECE($GET(^PSDRUG(RXNAM,0)),U)
+58 IF RXDT
SET OUT=1_U_U_U_RXDT_U_U_RXNUM_U_RXNAM
End DoDot:2
+59 ;Set up for RX Data (No refill)
+60 IF $PIECE(RESULT,";",2)']""
Begin DoDot:2
+61 NEW RXIEN
+62 SET RXIEN=$PIECE(RESULT,":",2)
+63 ; released date
SET RXDT=$PIECE($GET(^PSRX(RXIEN,2)),U,13)
+64 ; fill date
if RXDT=""
SET RXDT=$PIECE($GET(^PSRX(RXIEN,2)),U,2)
+65 ; dispensed date
if RXDT=""
SET RXDT=$PIECE($GET(^PSRX(RXIEN,2)),U,5)
+66 SET RXNUM=$PIECE($GET(^PSRX(RXIEN,0)),U)
+67 SET RXNAM=$PIECE($GET(^PSRX(RXIEN,0)),U,6)
if RXNAM
SET RXNAM=$PIECE($GET(^PSDRUG(RXNAM,0)),U)
+68 IF RXDT
SET OUT=1_U_U_U_RXDT_U_U_RXNUM_U_RXNAM
End DoDot:2
End DoDot:1
+69 SET OPDT=$PIECE(I0,U,14)
IF 'OUT
IF RESULT'=""
IF OPDT'=""
SET OUT=1_U_OPDT
+70 IF 'OUT
QUIT OUT
+71 SET $PIECE(OUT,U,5)=STATUS
+72 SET $PIECE(OUT,U,8)=CHGAMT
+73 QUIT OUT
