source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCEMMR.m@ 914

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

initial load of FOIAVistA 6/30/08 version
File size: 6.8 KB
Line 
1IBCEMMR ;ALB/ESG - IB MRA Report of Patients w/o Medicare WNR ;20-NOV-2003
2 ;;2.0;INTEGRATED BILLING;**155,366**;21-MAR-94;Build 3
3 ;
4 ; Find patients with Medicare supplemental insurance or Medigap
5 ; insurance (etc.) but who do not have MEDICARE (WNR) on file as
6 ; one of their insurances.
7 ;
8 Q
9 ;
10EN ; Entry Point
11 NEW IBMSORT
12 D SORT I 'IBMSORT G EX
13 D DEVICE
14EX ; Exit Point
15 Q
16 ;
17SORT ; Ask user how to sort the report
18 NEW CH,DIR,X,Y,DIRUT,DIROUT
19 W @IOF,!?20,"Patients Without MEDICARE (WNR) Insurance"
20 W !!?2,"This option finds patients who do not have active MEDICARE (WNR) insurance,"
21 W !?2,"but who do have active insurance with a Plan Type of Medigap, Carve-Out, or"
22 W !?2,"Medicare Secondary. In these cases, MEDICARE (WNR) should be primary."
23 W !!?2,"The insurances for all living patients will be analyzed, but"
24 W !?2,"you can determine how this information will be sorted."
25 S IBMSORT=""
26 W !
27 S CH="1:Patient Name;2:SSN - Last 4 Digits;3:Insurance Company;"
28 S CH=CH_"4:Type of Plan;5:Appointment Date"
29 S DIR(0)="SO^"_CH
30 S DIR("A")="Please enter the Sort Criteria"
31 S DIR("B")="Patient Name"
32 D ^DIR K DIR
33 I 'Y G SORTX
34 S IBMSORT=Y
35SORTX ;
36 Q
37 ;
38COMPILE ; Entry point for both background and foreground task execution
39 ;
40 NEW RTN,DFN,CNT,MS,DPT,PTNM,SSN,APPT,APDTE,A
41 NEW INS,GRP,PLN,INSNM,PLNTYP,SORT,X,IBNEXT
42 S RTN="IBCEMMR"
43 K ^TMP($J,RTN),^("IBCEPT"),^("IBSDNEXT"),^("IBDPT"),^("IBLAST")
44 S DFN=" ",CNT=0
45 F S DFN=$O(^DPT(DFN),-1) Q:'DFN!($G(ZTSTOP)) D
46 . S CNT=CNT+1
47 . I '$D(ZTQUEUED),CNT#500=0 U IO(0) W "." U IO
48 . I $D(ZTQUEUED),CNT#500=0,$$S^%ZTLOAD() S ZTSTOP=1 Q
49 . I $P($G(^DPT(DFN,.35)),U,1) Q ; date of death
50 . I '$$PTINS(DFN,.MS) Q ; eligible for report
51 . S ^TMP($J,"IBNEXT",DFN)=""
52 . S ^TMP($J,"IBLAST",DFN)=""
53 . S ^TMP($J,"IBDPT",DFN)=""
54 ;
55 S X=$$NEXT^IBSDU("^TMP($J,""IBNEXT"",")
56 S X=$$LAST^IBSDU("^TMP($J,""IBLAST"",")
57 ;
58 S DFN=0 F S DFN=$O(^TMP($J,"IBDPT",DFN)) Q:'DFN!($G(ZTSTOP)) D
59 . I '$D(ZTQUEUED),CNT#500=0 U IO(0) W "." U IO
60 . I $D(ZTQUEUED),CNT#500=0,$$S^%ZTLOAD() S ZTSTOP=1 Q
61 . I '$$PTINS(DFN,.MS) ; get MS data
62 . S DPT=$G(^DPT(DFN,0))
63 . S PTNM=$P(DPT,U,1)
64 . I PTNM="" S PTNM="~UNKNOWN"
65 . S SSN=$E($P(DPT,U,9),6,99)_" "
66 . I SSN="" S SSN="~UNK"
67 . S (APPT,IBNEXT)=$G(^TMP($J,"IBNEXT",DFN),"UNKNOWN")
68 . I 'APPT S APPT=$G(^TMP($J,"IBLAST",DFN),"UNKNOWN")
69 . S APDTE=$S(APPT:$$FMTE^XLFDT($P(APPT,"."),"2Z"),$L(IBNEXT):IBNEXT,$L(APPT):APPT,1:"N/A")
70 . S APPT=+APPT
71 . S A=0 F S A=$O(MS(A)) Q:'A D
72 .. S INS=+$P(MS(A),U,1),GRP=+$P(MS(A),U,2)
73 .. S PLN=+$P(MS(A),U,3)
74 .. S INSNM=$P($G(^DIC(36,INS,0)),U,1)
75 .. I INSNM="" S INSNM="~UNKNOWN"
76 .. S PLNTYP=$P($G(^IBE(355.1,PLN,0)),U,1)
77 .. I PLNTYP="" S PLNTYP="~UNKNOWN"
78 .. S SORT=$S(IBMSORT=1:PTNM,IBMSORT=2:SSN,IBMSORT=3:INSNM,IBMSORT=4:PLNTYP,IBMSORT=5:-APPT,1:PTNM)
79 .. S ^TMP($J,RTN,SORT,PTNM,DFN,A)=SSN_U_INSNM_U_PLNTYP_U_APDTE
80 .. Q
81 . Q
82 ;
83 I '$G(ZTSTOP) D PRINT ; print the report
84 D ^%ZISC ; close the device
85 K ^TMP($J,RTN),^("IBCEPT"),^("IBSDNEXT"),^("IBDPT"),^("IBLAST") ;cleanup
86 I $D(ZTQUEUED) S ZTREQ="@" ; purge the task record
87COMPX ;
88 Q
89 ;
90PRINT ; print the report to the device specified
91 N MAXCNT,CRT,PAGECNT,STOP,SORT,PTNM,DFN,A,DATA,DIR,X,Y,DIRUT,DIROUT,IBX
92 I IOST["C-" S MAXCNT=IOSL-3,CRT=1
93 E S MAXCNT=IOSL-6,CRT=0
94 S PAGECNT=0,STOP=0
95 ;
96 ; Check for no data
97 I '$D(^TMP($J,RTN)) D HEADER W !!?5,"No Data Found"
98 ;
99 S SORT=""
100 F S SORT=$O(^TMP($J,RTN,SORT)) Q:SORT="" D Q:STOP
101 . S PTNM=""
102 . F S PTNM=$O(^TMP($J,RTN,SORT,PTNM)) Q:PTNM="" D Q:STOP
103 .. S DFN=0
104 .. F S DFN=$O(^TMP($J,RTN,SORT,PTNM,DFN)) Q:'DFN D Q:STOP
105 ... S A=0
106 ... F S A=$O(^TMP($J,RTN,SORT,PTNM,DFN,A)) Q:'A D Q:STOP
107 .... S DATA=$G(^TMP($J,RTN,SORT,PTNM,DFN,A))
108 .... I $Y+1>MAXCNT!'PAGECNT D HEADER Q:STOP
109 .... W !,$E(PTNM,1,20),?23,$P(DATA,U,1),?30,$E($P(DATA,U,2),1,20)
110 .... W ?53,$E($P(DATA,U,3),1,13),?69,$P(DATA,U,4)
111 .... Q
112 ... Q
113 .. Q
114 . Q
115 ;
116 I STOP G PRINTX
117 W !!?30,"*** End of Report ***"
118 I CRT,'$D(ZTQUEUED) S DIR(0)="E" D ^DIR K DIR
119PRINTX ;
120 Q
121 ;
122HEADER ; page break and report header information
123 NEW LIN,HDR,TAB
124 S STOP=0
125 ; ask screen user if they want to continue
126 I CRT,PAGECNT>0,'$D(ZTQUEUED) D I STOP G HEADERX
127 . I MAXCNT<51 F LIN=1:1:(MAXCNT-$Y) W !
128 . S DIR(0)="E" D ^DIR K DIR
129 . I 'Y S STOP=1 Q
130 . Q
131 ;
132 S PAGECNT=PAGECNT+1
133 W @IOF,!,"Patients Without MEDICARE (WNR) Insurance"
134 S HDR="Page: "_PAGECNT
135 S TAB=80-$L(HDR)-1
136 W ?TAB,HDR
137 W !,"Sorted by ",$S(IBMSORT=1:"Patient Name",IBMSORT=2:"SSN - Last 4 Digits",IBMSORT=3:"Insurance Company",IBMSORT=4:"Type of Plan",IBMSORT=5:"Appointment Date",1:"Patient Name")
138 S HDR=$$FMTE^XLFDT($$NOW^XLFDT,"1Z")
139 S TAB=80-$L(HDR)-1
140 W ?TAB,HDR
141 W !,"Patient Name",?24,"SSN",?30,"Insurance Company"
142 W ?53,"Type of Plan",?69,"ApptDate"
143 W !,$$RJ^XLFSTR("",80,"=")
144 ;
145 ; check for stop request
146 I $D(ZTQUEUED),$$S^%ZTLOAD() D G HEADERX
147 . S (ZTSTOP,STOP)=1
148 . W !!!?5,"*** Report Halted by TaskManager Request ***"
149 . Q
150 ;
151HEADERX ;
152 Q
153 ;
154PTINS(DFN,MCRSUP) ; Function to determine if a patient should be
155 ; included in this report or not.
156 ; Input: DFN - patient ien
157 ; Output: Function value is either 0 (don't include) or 1 (include)
158 ; MCRSUP array pass by reference
159 ; MCRSUP(seq) = [1] insurance co ien pointer to file 36
160 ; [2] group pointer to file 355.3
161 ; [3] type of plan pointer to file 355.1
162 ;
163 NEW INCLUDE,INS,A,MCRWNR,MCRZ,IBINS,IBGRP,GP,TP,PLABBR
164 S INCLUDE=0 KILL MCRSUP
165 I '$G(DFN) G PTINSX
166 I '$D(^DPT(DFN)) G PTINSX
167 D ALLWNR^IBCNS1(DFN,"INS",DT)
168 S A=0,(MCRWNR,MCRZ)=0
169 F S A=$O(INS(A)) Q:'A D Q:MCRWNR
170 . S IBINS=$P($G(INS(A,0)),U,1)
171 . S IBGRP=$P($G(INS(A,0)),U,18)
172 . I $$MCRWNR^IBEFUNC(IBINS) S MCRWNR=1 Q ; Medicare WNR on file
173 . S GP=$G(INS(A,355.3)) ; group/plan info
174 . S TP=$P(GP,U,9),PLABBR="" ; type of plan pointer
175 . I TP S PLABBR=$P($G(^IBE(355.1,TP,0)),U,2) ; plan abbreviation
176 . I '$F(".MG.MS.COUT.","."_PLABBR_".") Q ; check plan
177 . S MCRZ=1 ; Medicare other on file
178 . S MCRSUP(A)=IBINS_U_IBGRP_U_TP
179 . Q
180 ;
181 ; If Medicare Other was found, but no Medicare WNR, then include it
182 I MCRZ,'MCRWNR S INCLUDE=1
183 ;
184PTINSX ;
185 I 'INCLUDE K MCRSUP
186 Q INCLUDE
187 ;
188 ;
189DEVICE ; This procedure displays a warning message and prompts for the
190 ; device on which to print the report.
191 ;
192 NEW ZTRTN,ZTDESC,ZTSAVE,POP
193 W *7,!!!?14,"*** WARNING ***"
194 W !?2,"This report takes a long time to compile!"
195 W !!?2,"The active insurance coverage for all living patients is analyzed."
196 W !!?2,"It is recommended that you queue this report to the background and"
197 W !?2,"run it after hours or on the weekend."
198 W !!?2,"This report is 80 characters wide."
199 W !
200 ;
201 S ZTRTN="COMPILE^IBCEMMR"
202 S ZTDESC="Patients without MEDICARE (WNR) Insurance"
203 S ZTSAVE("IBMSORT")=""
204 D EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE)
205DEVICEX ;
206 Q
207 ;
Note: See TracBrowser for help on using the repository browser.