| 1 | IBCEMMR ;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 | ; | 
|---|
| 10 | EN ; Entry Point | 
|---|
| 11 | NEW IBMSORT | 
|---|
| 12 | D SORT I 'IBMSORT G EX | 
|---|
| 13 | D DEVICE | 
|---|
| 14 | EX ; Exit Point | 
|---|
| 15 | Q | 
|---|
| 16 | ; | 
|---|
| 17 | SORT ; 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 | 
|---|
| 35 | SORTX ; | 
|---|
| 36 | Q | 
|---|
| 37 | ; | 
|---|
| 38 | COMPILE ; 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 | 
|---|
| 87 | COMPX ; | 
|---|
| 88 | Q | 
|---|
| 89 | ; | 
|---|
| 90 | PRINT ; 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 | 
|---|
| 119 | PRINTX ; | 
|---|
| 120 | Q | 
|---|
| 121 | ; | 
|---|
| 122 | HEADER ; 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 | ; | 
|---|
| 151 | HEADERX ; | 
|---|
| 152 | Q | 
|---|
| 153 | ; | 
|---|
| 154 | PTINS(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 | ; | 
|---|
| 184 | PTINSX ; | 
|---|
| 185 | I 'INCLUDE K MCRSUP | 
|---|
| 186 | Q INCLUDE | 
|---|
| 187 | ; | 
|---|
| 188 | ; | 
|---|
| 189 | DEVICE ; 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) | 
|---|
| 205 | DEVICEX ; | 
|---|
| 206 | Q | 
|---|
| 207 | ; | 
|---|