| 1 | IBRFN1 ;ALB/CPM - PASS PATIENT STATEMENT DATA TO A/R ; 24-FEB-93
|
|---|
| 2 | ;;Version 2.0 ; INTEGRATED BILLING ;**27,57,52**; 21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | STMT(TRAN) ; Pass clinical data to AR for the patient statement.
|
|---|
| 6 | ; Input: TRAN -- AR Transaction number (ptr to #433)
|
|---|
| 7 | ; Returns: ^TMP("IBRFN1",$J,n)=1^2^3^4^5^6^7^8 , where
|
|---|
| 8 | ;
|
|---|
| 9 | ; -----------------------------------------------------------
|
|---|
| 10 | ; | | Transaction Type |
|
|---|
| 11 | ; |----------|------------------------------------------------|
|
|---|
| 12 | ; | Piece | Pharmacy | Outpatient | Inpatient |
|
|---|
| 13 | ; |----------|----------------|--------------|----------------|
|
|---|
| 14 | ; | 1 | IB Ref# | IB Ref# | IB Ref# |
|
|---|
| 15 | ; | 2 | Rx# | Visit Date | Adm Date |
|
|---|
| 16 | ; | 3 | Drug | -- | Bill From Date |
|
|---|
| 17 | ; | 4 | Days Supply | -- | Bill To Date |
|
|---|
| 18 | ; | 5 | Physician | -- | Disc Date |
|
|---|
| 19 | ; | 6 | Quantity | -- | -- |
|
|---|
| 20 | ; | 7 |Fill/Refill Date| -- | -- |
|
|---|
| 21 | ; | 8 | Charge Amt | Charge Amt | Charge Amt |
|
|---|
| 22 | ; -----------------------------------------------------------
|
|---|
| 23 | ;
|
|---|
| 24 | Q:'$G(TRAN) K ^TMP("IBRFN1",$J)
|
|---|
| 25 | N IBN,IBJ,IBND,IBBG,IBSL,IBPE,IBCHG
|
|---|
| 26 | S IBN=0 F IBJ=1:1 S IBN=$O(^IB("AT",TRAN,IBN)) Q:'IBN D
|
|---|
| 27 | . S IBND=$G(^IB(IBN,0)),IBSL=$P(IBND,"^",4),IBCHG=$P(IBND,"^",7) Q:'IBND
|
|---|
| 28 | . I +IBSL=52 D RX Q
|
|---|
| 29 | . S IBBG=$P($G(^IBE(350.1,+$P(IBND,"^",3),0)),"^",11)
|
|---|
| 30 | . I IBBG=4 S ^TMP("IBRFN1",$J,IBJ)=+IBND_"^"_$P(IBND,"^",14)_"^^^^^^"_IBCHG Q
|
|---|
| 31 | . S IBPE=$G(^IB(+$P(IBND,"^",16),0))
|
|---|
| 32 | . I +IBSL'=405,+IBSL'=45 S IBSL=$P(IBPE,"^",4)
|
|---|
| 33 | . I +IBSL=405!(+IBSL=45) D INP Q
|
|---|
| 34 | . S ^TMP("IBRFN1",$J,IBJ)=+IBND_"^^"_$P(IBND,"^",14)_"^"_$P(IBND,"^",15)_"^^^^"_IBCHG
|
|---|
| 35 | Q
|
|---|
| 36 | ;
|
|---|
| 37 | RX ; Build array element for Pharmacy Co-pay charges.
|
|---|
| 38 | N %DT,I,IBRX,IBFILL,PSOFILL,PSONTALK,PSORX0,PSORX1,PSORXN,PSOTMP,VA,VAERR,X,Y,Z
|
|---|
| 39 | S IBRX=$P($P(IBSL,";"),":",2),IBFILL=+$P($P(IBSL,";",2),":",2)
|
|---|
| 40 | S X=IBRX_"^"_IBFILL,PSONTALK="" D EN^PSOCPVW
|
|---|
| 41 | S Z=+IBND F I=.01,6,8,4,7,22 S Z=Z_"^"_$G(PSOTMP(52,IBRX,I,"E"))
|
|---|
| 42 | S:IBFILL $P(Z,"^",7)=$G(PSOTMP(52.1,IBFILL,.01,"E"))
|
|---|
| 43 | S X=$P(Z,"^",7),%DT="" D ^%DT S $P(Z,"^",7)=$S(Y>0:Y,1:"")
|
|---|
| 44 | S ^TMP("IBRFN1",$J,IBJ)=Z_"^"_IBCHG
|
|---|
| 45 | Q
|
|---|
| 46 | ;
|
|---|
| 47 | INP ; Build array element for inpatient charges.
|
|---|
| 48 | N IBADM,IBDIS,IBFR,IBTO,PM,PM0,X,X1,X2
|
|---|
| 49 | I +IBSL=405 D
|
|---|
| 50 | . S PM=+$P(IBSL,":",2),PM0=$G(^DGPM(PM,0))
|
|---|
| 51 | . S IBADM=$S(PM0:+PM0\1,1:$P(IBPE,"^",17))
|
|---|
| 52 | . S IBDIS=$S(PM0:$S($D(^DGPM(+$P(PM0,"^",17),0)):+^(0)\1,1:""),1:"")
|
|---|
| 53 | I +IBSL=45 D
|
|---|
| 54 | . S PM=+$P(IBSL,":",2),PM0=$G(^DGPT(PM,0))
|
|---|
| 55 | . S IBADM=$S(PM0:+$P(PM0,"^",2)\1,1:$P(IBPE,"^",17))
|
|---|
| 56 | . S IBDIS=$S($G(^DGPT(PM,70)):+^(70)\1,1:"")
|
|---|
| 57 | ;
|
|---|
| 58 | S IBFR=$P(IBND,"^",14),IBTO=$P(IBND,"^",15)
|
|---|
| 59 | ; - check for per diems added through C/E/A which are off by one day
|
|---|
| 60 | 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
|
|---|
| 61 | S ^TMP("IBRFN1",$J,IBJ)=+IBND_"^"_IBADM_"^"_IBFR_"^"_IBTO_"^"_IBDIS_"^^^"_IBCHG
|
|---|
| 62 | Q
|
|---|
| 63 | ;
|
|---|
| 64 | ;
|
|---|
| 65 | STMTB(BILL) ; AR Patient Statement Entry point for CHAMPVA Subsistence
|
|---|
| 66 | ; Input: BILL -- AR Bill number (field #.01 value of #430)
|
|---|
| 67 | ; Returns: Same output as described above in the Pharmacy
|
|---|
| 68 | ; and inpatient columns.
|
|---|
| 69 | ;
|
|---|
| 70 | Q:$G(BILL)="" K ^TMP("IBRFN1",$J)
|
|---|
| 71 | N IBN,IBJ,IBND,IBBG,IBSL,IBPE,IBCHG,IBAT
|
|---|
| 72 | S IBN=$O(^IB("ABIL",BILL,0)) Q:'IBN
|
|---|
| 73 | S IBND=$G(^IB(IBN,0)),IBSL=$P(IBND,"^",4),IBCHG=$P(IBND,"^",7) Q:'IBND
|
|---|
| 74 | S IBAT=$G(^IBE(350.1,+$P(IBND,"^",3),0)),IBBG=$P(IBAT,"^",11),IBJ=1
|
|---|
| 75 | I +IBSL=52 D RX Q
|
|---|
| 76 | I $P(IBAT,"^")["OPT COPAY" S ^TMP("IBRFN1",$J,IBJ)=+IBND_"^"_$P(IBND,"^",14)_"^^^^^^"_IBCHG Q
|
|---|
| 77 | S IBPE=$G(^IB(+$P(IBND,"^",16),0))
|
|---|
| 78 | I +IBSL'=405,+IBSL'=45 S IBSL=$P(IBPE,"^",4)
|
|---|
| 79 | I +IBSL=405!(+IBSL=45) D INP Q
|
|---|
| 80 | S ^TMP("IBRFN1",$J,IBJ)=+IBND_"^^"_$P(IBND,"^",14)_"^"_$P(IBND,"^",15)_"^^^^"_IBCHG
|
|---|
| 81 | Q
|
|---|
