IBRFN1.m

IBRFN1	;ALB/CPM - PASS PATIENT STATEMENT DATA TO A/R ; 24-FEB-93

	;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94

	;;Per VHA Directive 10-93-142, this routine should not be modified.

	;

STMT(TRAN)	; Pass clinical data to AR for the patient statement.

	;         Input:    TRAN -- AR Transaction number (ptr to #433)

	;         Returns:  ^TMP("IBRFN1",$J,n)=1^2^3^4^5^6^7^8 , where

	;

	;        -----------------------------------------------------------

	;       |          |                Transaction Type                |

	;       |----------|------------------------------------------------|

	;       |  Piece   |    Pharmacy    |  Outpatient  |   Inpatient    |

	;       |----------|----------------|--------------|----------------|

	;       |    1     |     IB Ref#    |    IB Ref#   |    IB Ref#     |

	;       |    2     |       Rx#      |  Visit Date  |    Adm Date    |

	;       |    3     |      Drug      |      --      | Bill From Date |

	;       |    4     |   Days Supply  |      --      |  Bill To Date  |

	;       |    5     |    Physician   |      --      |    Disc Date   |

	;       |    6     |    Quantity    |      --      |       --       |

	;       |    7     |Fill/Refill Date|      --      |       --       |

	;       |    8     |   Charge Amt   |  Charge Amt  |   Charge Amt   |

	;        -----------------------------------------------------------

	;

	Q:'$G(TRAN)  K ^TMP("IBRFN1",$J)

	N IBN,IBJ,IBND,IBBG,IBSL,IBPE

	S IBN=0 F IBJ=1:1 S IBN=$O(^IB("AT",TRAN,IBN)) Q:'IBN  D

	. S IBND=$G(^IB(IBN,0)),IBSL=$P(IBND,"^",4),IBCHG=$P(IBND,"^",7) Q:'IBND

	. I +IBSL=52 D RX Q

	. S IBBG=$P($G(^IBE(350.1,+$P(IBND,"^",3),0)),"^",11)

	. I IBBG=4 S ^TMP("IBRFN1",$J,IBJ)=+IBND_"^"_$P(IBND,"^",14)_"^^^^^^"_IBCHG Q

	. S IBPE=$G(^IB(+$P(IBND,"^",16),0)) S:+IBSL'=405 IBSL=$P(IBPE,"^",4)

	. I +IBSL=405 D INP Q

	. S ^TMP("IBRFN1",$J,IBJ)=+IBND_"^^"_$P(IBND,"^",14)_"^"_$P(IBND,"^",15)_"^^^^"_IBCHG

	Q

	;

RX	; Build array element for Pharmacy Co-pay charges.

	N %DT,I,IBRX,IBFILL,PSOFILL,PSONTALK,PSORX0,PSORX1,PSORXN,PSOTMP,VA,VAERR,X,Y,Z

	S IBRX=$P($P(IBSL,";"),":",2),IBFILL=+$P($P(IBSL,";",2),":",2)

	S X=IBRX_"^"_IBFILL,PSONTALK="" D EN^PSOCPVW

	S Z=+IBND F I=.01,6,8,4,7,22 S Z=Z_"^"_$G(PSOTMP(52,IBRX,I,"E"))

	S:IBFILL $P(Z,"^",7)=$G(PSOTMP(52.1,IBFILL,.01,"E"))

	S X=$P(Z,"^",7),%DT="" D ^%DT S $P(Z,"^",7)=$S(Y>0:Y,1:"")

	S ^TMP("IBRFN1",$J,IBJ)=Z_"^"_IBCHG

	Q

	;

INP	; Build array element for inpatient charges.

	N IBADM,IBDIS,IBFR,IBTO,PM,PM0,X,X1,X2

	S PM=+$P(IBSL,":",2),PM0=$G(^DGPM(PM,0))

	S IBADM=$S(PM0:+PM0\1,1:$P(IBPE,"^",17))

	S IBDIS=$S(PM0:$S($D(^DGPM(+$P(PM0,"^",17),0)):+^(0)\1,1:""),1:"")

	S IBFR=$P(IBND,"^",14),IBTO=$P(IBND,"^",15)

	; - check for per diems added through C/E/A which are off by one day

	I IBBG=3 S X1=IBTO,X2=IBFR D ^%DTC I X+1'=$P(IBND,"^",6) S X1=IBTO,X2=-1 D C^%DTC S IBTO=X

	S ^TMP("IBRFN1",$J,IBJ)=+IBND_"^"_IBADM_"^"_IBFR_"^"_IBTO_"^"_IBDIS_"^^^"_IBCHG

	Q

IBRFN1    ;ALB/CPM - PASS PATIENT STATEMENT DATA TO A/R ; 24-FEB-93

 +1       ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94

 +2       ;;Per VHA Directive 10-93-142, this routine should not be modified.

 +3       ;

STMT(TRAN) ; Pass clinical data to AR for the patient statement.

 +1       ;         Input:    TRAN -- AR Transaction number (ptr to #433)

 +2       ;         Returns:  ^TMP("IBRFN1",$J,n)=1^2^3^4^5^6^7^8 , where

 +3       ;

 +4       ;        -----------------------------------------------------------

 +5       ;       |          |                Transaction Type                |

 +6       ;       |----------|------------------------------------------------|

 +7       ;       |  Piece   |    Pharmacy    |  Outpatient  |   Inpatient    |

 +8       ;       |----------|----------------|--------------|----------------|

 +9       ;       |    1     |     IB Ref#    |    IB Ref#   |    IB Ref#     |

 +10      ;       |    2     |       Rx#      |  Visit Date  |    Adm Date    |

 +11      ;       |    3     |      Drug      |      --      | Bill From Date |

 +12      ;       |    4     |   Days Supply  |      --      |  Bill To Date  |

 +13      ;       |    5     |    Physician   |      --      |    Disc Date   |

 +14      ;       |    6     |    Quantity    |      --      |       --       |

 +15      ;       |    7     |Fill/Refill Date|      --      |       --       |

 +16      ;       |    8     |   Charge Amt   |  Charge Amt  |   Charge Amt   |

 +17      ;        -----------------------------------------------------------

 +18      ;

 +19       IF '$GET(TRAN)

               QUIT 

           KILL ^TMP("IBRFN1",$JOB)

 +20       NEW IBN,IBJ,IBND,IBBG,IBSL,IBPE

 +21       SET IBN=0

           FOR IBJ=1:1

               SET IBN=$ORDER(^IB("AT",TRAN,IBN))

               IF 'IBN

                   QUIT 

               Begin DoDot:1

 +22               SET IBND=$GET(^IB(IBN,0))

                   SET IBSL=$PIECE(IBND,"^",4)

                   SET IBCHG=$PIECE(IBND,"^",7)

                   IF 'IBND

                       QUIT 

 +23               IF +IBSL=52

                       DO RX

                       QUIT 

 +24               SET IBBG=$PIECE($GET(^IBE(350.1,+$PIECE(IBND,"^",3),0)),"^",11)

 +25               IF IBBG=4

                       SET ^TMP("IBRFN1",$JOB,IBJ)=+IBND_"^"_$PIECE(IBND,"^",14)_"^^^^^^"_IBCHG

                       QUIT 

 +26               SET IBPE=$GET(^IB(+$PIECE(IBND,"^",16),0))

                   IF +IBSL'=405

                       SET IBSL=$PIECE(IBPE,"^",4)

 +27               IF +IBSL=405

                       DO INP

                       QUIT 

 +28               SET ^TMP("IBRFN1",$JOB,IBJ)=+IBND_"^^"_$PIECE(IBND,"^",14)_"^"_$PIECE(IBND,"^",15)_"^^^^"_IBCHG

               End DoDot:1

 +29       QUIT 

 +30      ;

RX        ; Build array element for Pharmacy Co-pay charges.

 +1        NEW %DT,I,IBRX,IBFILL,PSOFILL,PSONTALK,PSORX0,PSORX1,PSORXN,PSOTMP,VA,VAERR,X,Y,Z

 +2        SET IBRX=$PIECE($PIECE(IBSL,";"),":",2)

           SET IBFILL=+$PIECE($PIECE(IBSL,";",2),":",2)

 +3        SET X=IBRX_"^"_IBFILL

           SET PSONTALK=""

           DO EN^PSOCPVW

 +4        SET Z=+IBND

           FOR I=.01,6,8,4,7,22

               SET Z=Z_"^"_$GET(PSOTMP(52,IBRX,I,"E"))

 +5        IF IBFILL

               SET $PIECE(Z,"^",7)=$GET(PSOTMP(52.1,IBFILL,.01,"E"))

 +6        SET X=$PIECE(Z,"^",7)

           SET %DT=""

           DO ^%DT

           SET $PIECE(Z,"^",7)=$SELECT(Y>0:Y,1:"")

 +7        SET ^TMP("IBRFN1",$JOB,IBJ)=Z_"^"_IBCHG

 +8        QUIT 

 +9       ;

INP       ; Build array element for inpatient charges.

 +1        NEW IBADM,IBDIS,IBFR,IBTO,PM,PM0,X,X1,X2

 +2        SET PM=+$PIECE(IBSL,":",2)

           SET PM0=$GET(^DGPM(PM,0))

 +3        SET IBADM=$SELECT(PM0:+PM0\1,1:$PIECE(IBPE,"^",17))

 +4        SET IBDIS=$SELECT(PM0:$SELECT($DATA(^DGPM(+$PIECE(PM0,"^",17),0)):+^(0)\1,1:""),1:"")

 +5        SET IBFR=$PIECE(IBND,"^",14)

           SET IBTO=$PIECE(IBND,"^",15)

 +6       ; - check for per diems added through C/E/A which are off by one day

 +7        IF IBBG=3

               SET X1=IBTO

               SET X2=IBFR

               DO ^%DTC

               IF X+1'=$PIECE(IBND,"^",6)

                   SET X1=IBTO

                   SET X2=-1

                   DO C^%DTC

                   SET IBTO=X

 +8        SET ^TMP("IBRFN1",$JOB,IBJ)=+IBND_"^"_IBADM_"^"_IBFR_"^"_IBTO_"^"_IBDIS_"^^^"_IBCHG

 +9        QUIT