RCDMCR8C.m

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 ---RCDMCR8C   3797     printed  Mar 13, 2025@20:48:25                                                                                                                                                                                                    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