| 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 |  ;
 | 
|---|