| [613] | 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 | ; | 
|---|