source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBRFN1.m@ 691

Last change on this file since 691 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.9 KB
Line 
1IBRFN1 ;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 ;
5STMT(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 ;
37RX ; 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 ;
47INP ; 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 ;
65STMTB(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
Note: See TracBrowser for help on using the repository browser.