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

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

initial load of WorldVistAEHR
File size: 3.2 KB
Line 
1IBARXMQ ;LL/ELZ-RX COPAY RPC QUERY ROUTINE (MILL BILL) ;10-OCT-2000
2 ;;2.0;INTEGRATED BILLING;**150,156,186,199**;21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5EN ; main entry point for users to request a query of rx bills from all possible facilities
6 N DIC,X,Y,DFN,IBT,IBTFL,%,%ZIS,ZTSAVE,POP,ZTSK,DIR,IBDT,IBPAT,IBROOT
7 ;
8 ; select patient, and get pt info
9 N DPTNOFZY S DPTNOFZY=1 ;Suppress PATIENT file fuzzy lookups
10 S DIC="^DPT(",DIC(0)="AEMNQ" D ^DIC Q:Y<1 S DFN=+Y
11 D DEM^VADPT S IBPAT=VADM(1)_"^"_VA("BID") D KVAR^VADPT
12 ;
13 ; ask for month / year
14 S DIR(0)="D^::AEMP",DIR("A")="For What Month/Year" D ^DIR Q:Y<1
15 S IBDT=Y
16 ;
17 ; scan for patient to see if different facilities could be involved
18 S IBT=$$TFL^IBARXMU(DFN,.IBTFL)
19 ;
20 ; if multiple facilities ask if we should check
21 I IBT W !,"This patient could have Pharmacy Co-payment bills at other facilities",!,"Do you want to check those other facilities" S %=0 D YN^DICN S:%'=1 IBT=0 Q:%<0
22 ;
23 ; now for a device
24 S %ZIS="MQ" D ^%ZIS Q:POP
25 I $D(IO("Q")) D Q
26 . S ZTRTN="DQ^IBARXMQ",(ZTSAVE("DFN"),ZTSAVE("IB*"))=""
27 . S ZTDESC="PHARMACY BILLING SUMMARY"
28 . D ^%ZTLOAD,HOME^%ZIS K IO("Q") W !,"Task# ",ZTSK
29 ;
30DQ ; tasked entry point
31 ;
32 N IBD,IBER,X,IBX,IBC,IBB,IBU,DIRUT,IBE,IBP K ^TMP("IBARXM",$J)
33 ;
34 ; remote stuff, file locally
35 I IBT S IBX=0 F S IBX=$O(IBTFL(IBX)) Q:IBX<1 D
36 . W:'$D(ZTQUEUED) !,"Now sending query to ",$P(IBTFL(IBX),"^",2)," ..."
37 . D QUERY^IBARXMU(DFN,IBDT,+IBTFL(IBX),.IBD)
38 . I $P(IBD(0),"^")=-1!(-1=+IBD)!($P($G(IBD(1)),"^")=-1) S IBER=1 K IBD Q
39 . S X=1 F S X=$O(IBD(X)) Q:X<1 S IBD=$$ADD^IBARXMN(DFN,IBD(X))
40 . K IBD
41 ;
42 ; stuff on local file w/remote stuff, build tmp
43 S (IBC,IBX)=0 F S IBX=$O(^IBAM(354.71,"AD",DFN,IBDT,IBX)) Q:IBX<1 S IBC=IBC+1,IBD=^IBAM(354.71,IBX,0),^TMP("IBARXM",$J,$P(IBD,"^",3),IBC)=IBD
44 ;
45 ;
46PRINT ;
47 U IO
48 S (IBP,IBE,IBB,IBU)=0 D HEAD F S IBE=$O(^TMP("IBARXM",$J,IBE)) Q:IBE<1!($D(DIRUT)) S IBX=0 F S IBX=$O(^TMP("IBARXM",$J,IBE,IBX)) Q:IBX<1!($D(DIRUT)) D
49 . D:$Y+3>IOSL HEAD Q:$D(DIRUT)
50 . S IBD=^TMP("IBARXM",$J,IBE,IBX)
51 . W !,$E($P($$FAC^IBARXMU($$LKUP^XUAF4($P(IBD,"-"))),"^"),1,20)," (",+IBD,")"
52 . W ?28,$$FMTE^XLFDT(IBE,"2D")
53 . W ?39,$P(IBD,"^",9)
54 . W ?64,$J($P(IBD,"^",11),6,2)
55 . W ?74,$J($P(IBD,"^",12),6,2)
56 . S IBB=IBB+$P(IBD,"^",11),IBU=IBU+$P(IBD,"^",12)
57 I $D(DIRUT) G Q
58 W !!?62,"--------",?72,"--------"
59 W !?65,$J(IBB,5,2),?75,$J(IBU,5,2)
60 ;
61 ; update totals in the patient's account
62 X $S($D(IBER):"W !!,""Unable to perform all remote queries, totals will not be updated!""",IBT=0&($D(IBTFL)):"W !!,""No remote queries needed/performed, account not updated.""",1:"D ACCT^IBARXMN(DFN,IBB,IBU,IBDT,1)")
63 ;
64 I $E(IOST,1,2)="C-",'$D(DIRUT) N DIR,X,Y,DTOUT,DUOUT,DIROUT S DIR(0)="E" D ^DIR
65 ;
66Q K ^TMP("IBARXM",$J)
67 D ^%ZISC
68 S:$D(ZTQUEUED) ZTREQ="@"
69 Q
70 ;
71HEAD ; prints header info
72 N DIR,X,Y,DTOUT,DUOUT,DIROUT
73 I IBP>0,$E(IOST,1,2)="C-" S DIR(0)="E" D ^DIR Q:$D(DIRUT)
74 S IBP=IBP+1
75 W @IOF,!,"Medication Co-Pay Billing Summary",?IOM-10,"Page: ",IBP
76 W !,"Patient: ",$P(IBPAT,"^")," (",$P(IBPAT,"^",2),")",!
77 F X=0:1:IOM-1 W "-"
78 W !,"Station Date Brief Description Billed No Bill",! F X=0:1:IOM-1 W "-"
79 Q
Note: See TracBrowser for help on using the repository browser.