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

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

initial load of WorldVistAEHR

File size: 3.7 KB
Line 
1IBARXEI ;ALB/AAS - RX COPAY EXEMPTION INQUIRY ; 21-JAN-93
2 ;;2.0; INTEGRATED BILLING ;**34,199**; 21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5% I '$D(IOF) D HOME^%ZIS
6 ;
7PAT I $G(IBQUIT) G END
8 D END
9 S (IBPAG,IBQUIT)=0 D NOW^%DTC S Y=% D D^DIQ S IBPDAT=Y
10 ;
11 S DIC("W")="N IBX S IBX=$G(^IBA(354,+Y,0)) W ?32,"" "",$P($G(^DPT(+IBX,0)),U,9),?46,"" "",$$TEXT^IBARXEU0($P(IBX,U,4)),?59,"" "",$P($G(^IBE(354.2,+$P(IBX,U,5),0)),U)"
12 N DPTNOFZY S DPTNOFZY=1 ;Suppress PATIENT file fuzzy lookups
13 W ! S DIC="^DPT(",DIC("S")="I $D(^IBA(354,+Y,0))",DIC(0)="AEQM",DIC("A")="Select BILLING PATIENT: " D ^DIC K DIC
14 G:Y<1 END
15 S DFN=+Y,IBP=$$PT^IBEFUNC(DFN),IBPBN=$G(^IBA(354,DFN,0))
16 ;
17TYP ; -- inquire is active or all
18 S DIR("?")="Enter 1 or B to see a brief inquiry of all Active Exemptions or enter 2 or F to see a full inquiry of the entire exemption history"
19 S DIR(0)="SAOM^1:BRIEF;2:FULL",DIR("A")="(B)rief or (Full) Inquiry: ",DIR("B")="Brief"
20 D ^DIR K DIR G:$D(DIRUT)!($G(Y)<1) END S IBFULL=Y
21 ;
22DEV S %ZIS="QM" D ^%ZIS G:POP END
23 I $D(IO("Q")) K IO("Q") S ZTRTN="DQ^IBARXEI",ZTSAVE("IB*")="",ZTSAVE("DFN")="",ZTDESC="IB INQUIRE TO PATIENT EXEMPTION" D ^%ZTLOAD,HOME^%ZIS K ZTSK D END G PAT
24 U IO
25 ;
26DQ ;
27 K ^TMP($J)
28 D @IBFULL
29 I 'IBQUIT,$E(IOST,1,2)="C-" D PAUSE^IBOUTL
30 I '$D(ZTQUEUED) D END G PAT
31 G END
32 Q
33 ;
341 ; -- brief view active exemptions
35 D DISP^IBARXEX,STAT^IBARXEX
36 Q
37 ;
382 ; -- full view all exemptions
39 D HDR
40 S IBT=""
41 ;
42 ; -- build list in inverse effective date, inverse date/time added
43 F S IBT=$O(^IBA(354.1,"APIDT",DFN,IBT)) Q:'IBT S IBIDT="" F S IBIDT=$O(^IBA(354.1,"APIDT",DFN,IBT,IBIDT)) Q:'IBIDT S IBDA="" F S IBDA=$O(^IBA(354.1,"APIDT",DFN,IBT,IBIDT,IBDA)) Q:'IBDA!(IBQUIT) D SET
44 ;
45 ; -- print list
46 S IBIDT="" F S IBIDT=$O(^TMP($J,DFN,IBIDT)) Q:'IBIDT!(IBQUIT) S IBA="" F S IBA=$O(^TMP($J,DFN,IBIDT,IBA)) Q:'IBA!(IBQUIT) S IBDA="" F S IBDA=$O(^TMP($J,DFN,IBIDT,IBA,IBDA)) Q:'IBDA!(IBQUIT) S IBND=^(IBDA) D FULL
47 ;
48 Q
49 ;
50END K ^TMP($J) S ZTREQ="@" I $D(ZTQUEUED) Q
51 D ^%ZISC
52 K C,X,Y,DFN,DIC,DIR,DIRUT,ZTSK,ZTREQ,IBCNT,IBDA,IBDT,IBFULL,IBIDT,IBJ,IBND,IBP,IBPAG,IBPBN,IBPDAT,IBQUIT,IBSTAT,IBSTATR,IBT
53 Q
54 ;
55HDR ; -- print header for full inquiry
56 I IBPAG!($E(IOST,1,2)="C-") W @IOF
57 S IBPAG=IBPAG+1
58 W "Billing Exemption Inquiry",?(IOM-35),$P(IBPDAT,"@")," ",$P(IBPDAT,"@",2)," Page ",IBPAG
59 W !,$E($P(IBP,"^"),1,20)," ",$P(IBP,"^",3),?27,"Currently: ",$$TEXT^IBARXEU0($P(IBPBN,"^",4))_"-"_$P($G(^IBE(354.2,+$P(IBPBN,"^",5),0)),"^"),?65," ",$$DAT1^IBOUTL($P(IBPBN,"^",3))
60 W !,$TR($J(" ",IOM)," ","-")
61 Q
62 ;
63FULL ; -- print full inquiry for one exemption
64 I $Y>(IOSL-8) D PAUSE^IBOUTL Q:IBQUIT D HDR
65 I $G(IBND)="" W !,"Error, Missing Record - ",IBDA Q
66 S Y=+IBND D D^DIQ
67 W !,$S($P(IBND,"^",10):"**",1:" "),"Effective Date: ",Y
68 W ?36," Type: ",$P($P($P(^DD(354.1,.03,0),"^",3),$P(IBND,"^",3)_":",2),";",1)
69 W !," Status: ",$P($P($P(^DD(354.1,.04,0),"^",3),$P(IBND,"^",4)_":",2),";",1)
70 W ?36," Reason: ",$P($G(^IBE(354.2,+$P(IBND,"^",5),0)),"^")
71 W !," Active: ",$S($P(IBND,"^",10):"YES, ACTIVE",1:"NO, INACTIVE")
72 W ?36," User: ",$P($G(^VA(200,+$P(IBND,"^",7),0)),"^")
73 W !," How Added: ",$P($P($P(^DD(354.1,.06,0),"^",3),$P(IBND,"^",6)_":",2),";",1)
74 W ?36,"When Added: " S Y=$P(IBND,"^",8) D DT^DIQ
75 I $P(IBND,"^",13)'="" W !,"Charges Canceled: " S Y=$P(IBND,"^",13) D DT^DIQ W ?36," To: " S Y=$P(IBND,"^",14) D DT^DIQ
76 I $P(IBND,"^",15)'="" W !," Prior Threshold: " S Y=$P(IBND,"^",15) D DT^DIQ
77 I $G(DUZ(0))="@" W !," Patient DFN: ",$P(IBND,"^",2),?36,"Ex. Number: ",IBDA
78 W !
79 Q
80 ;
81SET ; -- built tmp array ==> ^tmp($j, dfn, -eff date, -date/time added, da)
82 N X
83 S X=$G(^IBA(354.1,+IBDA,0)) Q:X=""
84 S ^TMP($J,DFN,IBIDT,-$P(X,"^",8),IBDA)=X
85 Q
Note: See TracBrowser for help on using the repository browser.