source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBARXEP.m

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

initial load of WorldVistAEHR

File size: 3.3 KB
Line 
1IBARXEP ;ALB/AAS - RX COPAY EXEMPTION PRINT BILLING PATIENTS ; 20-JAN-93
2 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5% ; -- print list of patient by status
6 K IBCNTE,BY
7 I '$D(IOF) D HOME^%ZIS
8 W @IOF,?20,"Print Patient Medication Copayment Exemptions",!!!
9 ;
10 S DIR("?")="Answer YES if you only want to print a statistical summary or answer NO if you want a list of patients plus the statistical summary."
11 S DIR(0)="Y",DIR("A")="Print Summary Only",DIR("B")="YES" D ^DIR K DIR
12 I $D(DIRUT) G END
13 S IBSUM=Y
14 I 'IBSUM W !!,"You will need a 132 column printer for this report!",!
15 W !! D BY G END:$G(BY)=""
16 S DIC="^IBA(354,",L=0,FR="?,?,?",TO="?,?,?"
17 S FLDS=$S(IBSUM:"[IB BILLING PATIENT SUMMARY]",1:"[IB BILLING PATIENT]")
18 S DHD="Patient Medication Copayment Exemption "_$S(IBSUM:"Statistics",1:"Report")
19 S DIOEND="D SUMMARY^IBARXEP"
20 ;
21 ; -- exclude deceased patients
22 I 'IBSUM S DIS(0)="I '+$G(^DPT(+D0,.35))"
23 ;
24 D EN1^DIP
25END K DIC,L,FLDS,DIOEND,FR,TO,BY,DHD,X,Y,IBCNTE,IBCNT,IBSUM,DUOUT,DIRUT
26 Q
27 ;
28 ;
29CNT ; -- set counts into ^tmp for summary report
30 N X,Y S X=$G(^IBA(354,D0,0)) Q:X=""
31 S Y=$P($G(^IBE(354.2,+$P(X,"^",5),0)),"^") Q:Y=""
32 S X=$P(X,"^",4) Q:X=""
33 S:'$D(IBCNTE(X,Y)) IBCNTE(X,Y)=0 S IBCNTE(X,Y)=IBCNTE(X,Y)+1
34 Q
35 ;
36BY ; -- sort by exemption reason or by exemption status
37 S DIR(0)="SMA^.04:EXEMPTION STATUS;.05:EXEMPTION REASON",DIR("A")="SORT BY: ",DIR("B")="EXEMPTION STATUS"
38 S DIR("?")="Sort by either Exemption Status (.04) or Exemption Reason (.05)"
39 D ^DIR K DIR I $D(DIRUT) Q
40 S BY=$S(Y=.05:"[IB BILLING PATIENT BY REASON]",Y=.04:"[IB BILLING PATIENT BY STATUS]",1:"")
41 Q
42 ;
43SUMMARY ; -- print summary page
44 N X,Y
45 W:'IBSUM !!,"===================================================="
46 S (X,Y)="",IBCNT(0)=0,IBCNT(1)=0
47 F S X=$O(IBCNTE(X)) Q:X="" S IBCNT=0 F S Y=$O(IBCNTE(X,Y)) Q:Y="" D
48 .;sub counts
49 .S IBCNT(X)=IBCNT(X)+IBCNTE(X,Y)
50 .S IBCNT=IBCNT+1
51 .;print line
52 .W:IBCNT=1 !,$S(X:"Exempt",1:"Non-Exempt")," Status:"
53 .W !?5,Y,?40,"= ",IBCNTE(X,Y)
54 W !
55 W:$D(IBCNTE(1)) !,"Total Exempt Patients",?40,"= ",IBCNT(1)
56 W:$D(IBCNTE(0)) !,"Total Non-Exempt Patients",?40,"= ",IBCNT(0)
57 ;
58 I IBSUM W !!!,"Statistics DO include counts from deceased patients."
59 I 'IBSUM W !!!,"Statistics and report DO NOT include deceased patients."
60 Q
61 ;
62NOINC ; -- print list of patient with no income data with address
63 ;
64 K IBCNTE,BY
65 I '$D(IOF) D HOME^%ZIS
66 W @IOF,?10,"Print Patients with NO INCOME DATA Medication Copayment Exemptions",!!!
67 ;
68 S IBSUM=0
69 S DIC="^IBA(354,",L=0,FR="?,?,?",TO="?,?,?"
70 S BY="[IB BILLING PAT W/INCOME]"
71 S FLDS="[IB BILLING PAT W/INCOME]"
72 S DHD="Patient with a NO INCOME DATA Medication Copayment Exemption Report"
73 ;S DIOEND="D SUMMARY^IBARXEP"
74 ;
75 ; -- exclude deceased patients
76 S DIS(0)="I '+$G(^DPT(+D0,.35))"
77 ;
78 D EN1^DIP
79NOINCQ K DIC,L,FLDS,DIOEND,FR,TO,BY,DHD,X,Y,IBCNTE,IBCNT,IBSUM,DUOUT,DIRUT
80 Q
81 ;
82EXADD ; -- print list of EXEMPT patients with address
83 ;
84 K IBCNTE,BY
85 I '$D(IOF) D HOME^%ZIS
86 W @IOF,?10,"Print List of Exempt Patients with Addresses",!!!
87 ;
88 S IBSUM=0
89 S DIC="^IBA(354,",L=0,FR="?,?,?",TO="?,?,?"
90 S BY="[IB EXEMPT PATIENTS]"
91 S FLDS="[IB PATIENT ADDRESSES]"
92 S DHD="List of Exempt Patients with Addresses"
93 ;
94 ; -- exclude deceased patients
95 S DIS(0)="I '+$G(^DPT(+D0,.35))"
96 ;
97 D EN1^DIP
98EXADDQ K DIC,L,FLDS,DIOEND,FR,TO,BY,DHD,X,Y,IBCNTE,IBCNT,IBSUM,DUOUT,DIRUT
99 Q
Note: See TracBrowser for help on using the repository browser.