| 1 | IBCNERP1 ;DAOU/BHS - IBCNE USER IF IIV RESPONSE REPORT ;03-JUN-2002 | 
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**184,271**;21-MAR-94 | 
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified. | 
|---|
| 4 | ; | 
|---|
| 5 | ; IIV - Insurance Identification and Verification Interface | 
|---|
| 6 | ; | 
|---|
| 7 | ; Input parameters: N/A | 
|---|
| 8 | ; Other relevant variables ZTSAVED for queueing: | 
|---|
| 9 | ;  IBCNERTN = "IBCNERP1" (current routine name for queueing the | 
|---|
| 10 | ;   COMPILE process) | 
|---|
| 11 | ;  IBCNESPC("BEGDT")=start dt for rpt | 
|---|
| 12 | ;  IBCNESPC("ENDDT")=end dt for rpt | 
|---|
| 13 | ;  IBCNESPC("PYR")=payer ien (365.12) or "" for all payers | 
|---|
| 14 | ;  IBCNESPC("SORT")=1 (Payer name) OR 2 (Patient name) | 
|---|
| 15 | ;  IBCNESPC("PAT")=patient ien (2) or "" for all patients | 
|---|
| 16 | ;  IBCNESPC("TYPE")=A (All Responses) for date range OR M (Most Recent | 
|---|
| 17 | ;   Responses) for date range (by unique Payer/Pat pair) | 
|---|
| 18 | ;  IBCNESPC("TRCN")=Trace #^IEN, if non-null all other params are null | 
|---|
| 19 | ;  IBCNESPC("RFLAG")=Report Flag used to indicate which report is being | 
|---|
| 20 | ;   run.  Response Report (0), Inactive Report (1), or Ambiguous | 
|---|
| 21 | ;   Report (2). | 
|---|
| 22 | ;  IBCNESPC("DTEXP")=Expiration date used in the inactive policy report | 
|---|
| 23 | ; | 
|---|
| 24 | ; Only call this routine at a tag | 
|---|
| 25 | Q | 
|---|
| 26 | EN(IPRF) ; Main entry pt | 
|---|
| 27 | ; Init vars | 
|---|
| 28 | N STOP,IBCNERTN,POP,IBCNESPC | 
|---|
| 29 | S IBCNESPC("RFLAG")=$G(IPRF) | 
|---|
| 30 | ; | 
|---|
| 31 | S STOP=0 | 
|---|
| 32 | S IBCNERTN="IBCNERP1" | 
|---|
| 33 | W @IOF | 
|---|
| 34 | W !,"IIV ",$S(IPRF=1:"Inactive Policy",IPRF=2:"Ambiguous Policy",1:"Response")," Report",! | 
|---|
| 35 | I $G(IPRF) D | 
|---|
| 36 | . W !,"Please select a date range to view ",$S(IPRF=1:"inactive",1:"ambiguous")," policy information that the IIV" | 
|---|
| 37 | . W !,"process turned up while attempting to discover previously unknown" | 
|---|
| 38 | . W !,"insurance policies. (Date range selection is based on the date that" | 
|---|
| 39 | . W !,"IIV receives the response from the payer.)" | 
|---|
| 40 | ; | 
|---|
| 41 | I '$G(IPRF) D | 
|---|
| 42 | . W !,"Insurance verification and identification responses are received daily." | 
|---|
| 43 | . W !,"Please select a date range in which responses were received to view the" | 
|---|
| 44 | . W !,"associated response detail.  Otherwise, select a Trace # to view specific" | 
|---|
| 45 | . W !,"response detail." | 
|---|
| 46 | ; | 
|---|
| 47 | ; Rpt by Date Range or Trace # | 
|---|
| 48 | R05 I '$G(IPRF) D RTYPE I STOP G:$$STOP EXIT G R05 | 
|---|
| 49 | ; If rpt by Trace # - no other criteria is necessary | 
|---|
| 50 | I $G(IBCNESPC("TRCN")) G R100 | 
|---|
| 51 | ; Date Range params | 
|---|
| 52 | R10 D DTRANGE I STOP G:$$STOP EXIT G R05 | 
|---|
| 53 | ; Payer Selection param | 
|---|
| 54 | R20 D PYRSEL I STOP G:$$STOP EXIT G R10 | 
|---|
| 55 | ; Patient Selection param | 
|---|
| 56 | R30 D PTSEL I STOP G:$$STOP EXIT G R20 | 
|---|
| 57 | ; Type of data to return param | 
|---|
| 58 | R40 D TYPE I STOP G:$$STOP EXIT G R30 | 
|---|
| 59 | ; How far back do you want the expiration date | 
|---|
| 60 | R45 I $G(IPRF)=1 D DTEXP I STOP G:$$STOP EXIT G R40 | 
|---|
| 61 | ; Sort by param - Payer or Patient | 
|---|
| 62 | R50 D SORT I STOP G:$$STOP EXIT G R45 | 
|---|
| 63 | ; Select output device | 
|---|
| 64 | R100 D DEVICE(IBCNERTN,.IBCNESPC) I STOP G:$$STOP EXIT G:$G(IBCNESPC("TRCN"))'="" R05 G R50 | 
|---|
| 65 | G EXIT | 
|---|
| 66 | ; | 
|---|
| 67 | EXIT ; Exit pt | 
|---|
| 68 | Q | 
|---|
| 69 | ; | 
|---|
| 70 | ; | 
|---|
| 71 | COMPILE(IBCNERTN,IBCNESPC) ; | 
|---|
| 72 | ; Entry point called from EN^XUTMDEVQ in either direct or queued mode. | 
|---|
| 73 | ; Input params: | 
|---|
| 74 | ;  IBCNERTN = Routine name for ^TMP($J,... | 
|---|
| 75 | ;  IBCNESPC = Array passed by ref of the report params | 
|---|
| 76 | ; | 
|---|
| 77 | ; Init scratch globals | 
|---|
| 78 | K ^TMP($J,IBCNERTN),^TMP($J,IBCNERTN_"X") | 
|---|
| 79 | ; Compile | 
|---|
| 80 | I IBCNERTN="IBCNERP1" D EN^IBCNERP2(IBCNERTN,.IBCNESPC) | 
|---|
| 81 | I IBCNERTN="IBCNERP4" D EN^IBCNERP5(IBCNERTN,.IBCNESPC) | 
|---|
| 82 | I IBCNERTN="IBCNERP7" D EN^IBCNERP8(IBCNERTN,.IBCNESPC) | 
|---|
| 83 | ; Print | 
|---|
| 84 | I '$G(ZTSTOP) D | 
|---|
| 85 | . I IBCNERTN="IBCNERP1" D EN3^IBCNERPA(IBCNERTN,.IBCNESPC) | 
|---|
| 86 | . I IBCNERTN="IBCNERP4" D EN6^IBCNERPA(IBCNERTN,.IBCNESPC) | 
|---|
| 87 | . I IBCNERTN="IBCNERP7" D EN^IBCNERP9(IBCNERTN,.IBCNESPC) | 
|---|
| 88 | ; Close device | 
|---|
| 89 | D ^%ZISC | 
|---|
| 90 | ; Kill scratch globals | 
|---|
| 91 | K ^TMP($J,IBCNERTN),^TMP($J,IBCNERTN_"X") | 
|---|
| 92 | ; Purge task record | 
|---|
| 93 | I $D(ZTQUEUED) S ZTREQ="@" | 
|---|
| 94 | ; | 
|---|
| 95 | COMPILX ; COMPILE exit pt | 
|---|
| 96 | Q | 
|---|
| 97 | ; | 
|---|
| 98 | STOP() ; Determine if user wants to exit out of the whole option | 
|---|
| 99 | ; Init vars | 
|---|
| 100 | N DIR,X,Y,DIRUT | 
|---|
| 101 | ; | 
|---|
| 102 | W ! | 
|---|
| 103 | S DIR(0)="Y" | 
|---|
| 104 | S DIR("A")="Do you want to exit out of this option entirely" | 
|---|
| 105 | S DIR("B")="YES" | 
|---|
| 106 | S DIR("?",1)="  Enter YES to immediately exit out of this option." | 
|---|
| 107 | S DIR("?")="  Enter NO to return to the previous question." | 
|---|
| 108 | D ^DIR K DIR | 
|---|
| 109 | I $D(DIRUT) S (STOP,Y)=1 G STOPX | 
|---|
| 110 | I 'Y S STOP=0 | 
|---|
| 111 | ; | 
|---|
| 112 | STOPX ; STOP exit pt | 
|---|
| 113 | Q Y | 
|---|
| 114 | ; | 
|---|
| 115 | DTRANGE ; Determine start and end dates for date range param | 
|---|
| 116 | ; Init vars | 
|---|
| 117 | N X,Y,DIRUT | 
|---|
| 118 | ; | 
|---|
| 119 | W ! | 
|---|
| 120 | ; | 
|---|
| 121 | S DIR(0)="D^:-NOW:EX" | 
|---|
| 122 | S DIR("A")="Start DATE" | 
|---|
| 123 | S DIR("?",1)="   Please enter a valid date for which an IIV Response" | 
|---|
| 124 | S DIR("?")="   would have been received. Future dates are not allowed." | 
|---|
| 125 | D ^DIR K DIR | 
|---|
| 126 | I $D(DIRUT) S STOP=1 G DTRANGX | 
|---|
| 127 | S IBCNESPC("BEGDT")=Y | 
|---|
| 128 | ; End date | 
|---|
| 129 | DTRANG1 S DIR(0)="DA^"_Y_":-NOW:EX" | 
|---|
| 130 | S DIR("A")="  End DATE:  " | 
|---|
| 131 | S DIR("?",1)="   Please enter a valid date for which an IIV Response" | 
|---|
| 132 | S DIR("?",2)="   would have been received.  This date must not precede" | 
|---|
| 133 | S DIR("?")="   the Start Date.  Future dates are not allowed." | 
|---|
| 134 | D ^DIR K DIR | 
|---|
| 135 | I $D(DIRUT) S STOP=1 G DTRANGX | 
|---|
| 136 | S IBCNESPC("ENDDT")=Y | 
|---|
| 137 | ; | 
|---|
| 138 | DTRANGX ; DTRANGE exit pt | 
|---|
| 139 | Q | 
|---|
| 140 | ; | 
|---|
| 141 | PYRSEL ; Select one payer or ALL - File #365.12 | 
|---|
| 142 | ; Init vars | 
|---|
| 143 | NEW DIC,DTOUT,DUOUT,X,Y | 
|---|
| 144 | ; | 
|---|
| 145 | W ! | 
|---|
| 146 | S DIC(0)="ABEQ" | 
|---|
| 147 | S DIC("A")=$$FO^IBCNEUT1("Payer or <Return> for All Payers: ",40,"R") | 
|---|
| 148 | ; Do not allow selection of '~NO PAYER' and non-IIV payers | 
|---|
| 149 | S DIC("S")="I ($P(^(0),U,1)'=""~NO PAYER""),$$PYRAPP^IBCNEUT5(""IIV"",$G(Y))'=""""" | 
|---|
| 150 | S DIC="^IBE(365.12," | 
|---|
| 151 | D ^DIC | 
|---|
| 152 | I $D(DUOUT)!$D(DTOUT) S STOP=1 G PYRSELX | 
|---|
| 153 | ; If nothing was selected (Y=-1), select ALL payers | 
|---|
| 154 | S IBCNESPC("PYR")=$S(Y=-1:"",1:$P(Y,U,1)) | 
|---|
| 155 | ; | 
|---|
| 156 | PYRSELX ; PYRSEL exit pt | 
|---|
| 157 | Q | 
|---|
| 158 | ; | 
|---|
| 159 | PTSEL ; Select one patient or ALL - File #2 | 
|---|
| 160 | ; Init vars | 
|---|
| 161 | NEW DIC,DTOUT,DUOUT,X,Y | 
|---|
| 162 | ; Patient lookup | 
|---|
| 163 | W ! | 
|---|
| 164 | S DIC(0)="AEQM" | 
|---|
| 165 | S DIC("A")=$$FO^IBCNEUT1("Patient or <Return> for All Patients: ",40,"R") | 
|---|
| 166 | S DIC="^DPT(" | 
|---|
| 167 | D ^DIC | 
|---|
| 168 | I $D(DUOUT)!$D(DTOUT) S STOP=1 G PTSELX | 
|---|
| 169 | ; If nothing was selected (Y=-1), select ALL patients | 
|---|
| 170 | S IBCNESPC("PAT")=$S(Y=-1:"",1:$P(Y,U,1)) | 
|---|
| 171 | ; | 
|---|
| 172 | PTSELX ; PTSEL exit pt | 
|---|
| 173 | Q | 
|---|
| 174 | ; | 
|---|
| 175 | TYPE ; Prompt to select to display All or Most Recent Responses for | 
|---|
| 176 | ; Patient/Payer combos | 
|---|
| 177 | ; Init vars | 
|---|
| 178 | N DIR,X,Y,DIRUT | 
|---|
| 179 | ; | 
|---|
| 180 | S DIR(0)="S^A:All Responses;M:Most Recent Responses" | 
|---|
| 181 | S DIR("A")="Select the type of responses to display" | 
|---|
| 182 | S DIR("B")="A" | 
|---|
| 183 | S DIR("?",1)="  A - All responses from the payer during the date range will be" | 
|---|
| 184 | S DIR("?",2)="      displayed for each unique payer/patient combination." | 
|---|
| 185 | S DIR("?",3)="      (Default)" | 
|---|
| 186 | S DIR("?",4)="  M - Only the most recently received response from the payer" | 
|---|
| 187 | S DIR("?",5)="      during the date range will be displayed for each unique" | 
|---|
| 188 | S DIR("?")="      payer/patient combination." | 
|---|
| 189 | D ^DIR K DIR | 
|---|
| 190 | I $D(DIRUT) S STOP=1 G TYPEX | 
|---|
| 191 | S IBCNESPC("TYPE")=Y | 
|---|
| 192 | ; | 
|---|
| 193 | TYPEX ; TYPE exit pt | 
|---|
| 194 | Q | 
|---|
| 195 | ; | 
|---|
| 196 | DTEXP ; Prompt for oldest expiration date to pull for. | 
|---|
| 197 | ; Init Vars | 
|---|
| 198 | N Y,DIRUT,TODAY | 
|---|
| 199 | ; | 
|---|
| 200 | W ! | 
|---|
| 201 | ; | 
|---|
| 202 | S DIR(0)="D^:-NOW:EX" | 
|---|
| 203 | S DIR("A")="Earliest Policy Expiration Date to Select From" | 
|---|
| 204 | S DIR("B")="T-365" | 
|---|
| 205 | S DIR("?",1)=" Please enter a valid date in the past. Any policy with a reported" | 
|---|
| 206 | S DIR("?")=" expiration date prior to this date will not be selected." | 
|---|
| 207 | D ^DIR K DIR | 
|---|
| 208 | I $D(DIRUT) S STOP=1 G DTEXPX | 
|---|
| 209 | S IBCNESPC("DTEXP")=Y | 
|---|
| 210 | ; | 
|---|
| 211 | DTEXPX ; DTEXP Exit | 
|---|
| 212 | Q | 
|---|
| 213 | ; | 
|---|
| 214 | SORT ; Prompt to allow users to sort the report by Payer(default) or | 
|---|
| 215 | ;  Patient | 
|---|
| 216 | ; Init vars | 
|---|
| 217 | N DIR,X,Y,DIRUT | 
|---|
| 218 | ; | 
|---|
| 219 | S DIR(0)="S^1:Payer Name;2:Patient Name" | 
|---|
| 220 | S DIR("A")="Select the primary sort field" | 
|---|
| 221 | S DIR("B")=1 | 
|---|
| 222 | S DIR("?",1)="  1 - Payer Name is the primary sort, Patient Name is secondary." | 
|---|
| 223 | S DIR("?",2)="      (Default)" | 
|---|
| 224 | S DIR("?")="  2 - Patient Name is the primary sort, Payer Name is secondary." | 
|---|
| 225 | D ^DIR K DIR | 
|---|
| 226 | I $D(DIRUT) S STOP=1 G SORTX | 
|---|
| 227 | S IBCNESPC("SORT")=Y | 
|---|
| 228 | ; | 
|---|
| 229 | SORTX ; SORT exit pt | 
|---|
| 230 | Q | 
|---|
| 231 | ; | 
|---|
| 232 | RTYPE ; Prompt to allow users to report by date range or Trace # | 
|---|
| 233 | ; Init vars | 
|---|
| 234 | N D,DIC,DIR,X,Y,DIRUT,DTOUT,DUOUT | 
|---|
| 235 | ; | 
|---|
| 236 | S DIR(0)="S^1:Report by Date Range;2:Report by Trace #" | 
|---|
| 237 | S DIR("A")="Select the type of report to generate" | 
|---|
| 238 | S DIR("B")=1 | 
|---|
| 239 | S DIR("?",1)="  1 - Generate report by date range, payer range, patient range" | 
|---|
| 240 | S DIR("?",2)="      and All or Most Recent responses for payer/patient." | 
|---|
| 241 | S DIR("?",3)="      (Default)" | 
|---|
| 242 | S DIR("?",4)="  2 - Generate report for a specific Trace # which corresponds" | 
|---|
| 243 | S DIR("?")="      to an unique response." | 
|---|
| 244 | D ^DIR K DIR | 
|---|
| 245 | I $D(DIRUT) S STOP=1 G RTYPEX | 
|---|
| 246 | I Y=1 S IBCNESPC("TRCN")="" G RTYPEX | 
|---|
| 247 | ; | 
|---|
| 248 | ; Allow user to select Trace # from x-ref "C" | 
|---|
| 249 | W ! | 
|---|
| 250 | S DIC(0)="AEVZSQ" | 
|---|
| 251 | S DIC="^IBCN(365,",D="C",DIC("A")="Enter Trace # for report: " | 
|---|
| 252 | S DIC("W")="N IBX S IBX=$P($G(^(0)),U,2,3) W:$P(IBX,U,1) $P($G(^DPT($P(IBX,U,1),0)),U,1) W:$P(IBX,U,2) ""  ""_$P($G(^IBE(365.12,$P(IBX,U,2),0)),U,1)" | 
|---|
| 253 | D IX^DIC K DIC | 
|---|
| 254 | I $D(DTOUT)!$D(DUOUT) S STOP=1 G RTYPEX | 
|---|
| 255 | I 'Y!(Y<0) S STOP=1 G RTYPEX | 
|---|
| 256 | S IBCNESPC("TRCN")=$P(Y(0),U,9)_"^"_$P(Y,U,1) | 
|---|
| 257 | ; | 
|---|
| 258 | RTYPEX ; RTYPE exit pt | 
|---|
| 259 | Q | 
|---|
| 260 | ; | 
|---|
| 261 | DEVICE(IBCNERTN,IBCNESPC) ; Device Handler and possible TaskManager calls | 
|---|
| 262 | ; | 
|---|
| 263 | ; Input params: | 
|---|
| 264 | ;  IBCNERTN = Routine name for ^TMP($J,... | 
|---|
| 265 | ;  IBCNESPC = Array passed by ref of the report params | 
|---|
| 266 | ; | 
|---|
| 267 | ; Init vars | 
|---|
| 268 | N ZTRTN,ZTDESC,ZTSAVE,POP | 
|---|
| 269 | ; | 
|---|
| 270 | I IBCNERTN="IBCNERP4" W !!!,"*** This report is 132 characters wide ***",! | 
|---|
| 271 | S ZTRTN="COMPILE^IBCNERP1("""_IBCNERTN_""",.IBCNESPC)" | 
|---|
| 272 | S ZTDESC="IBCNE IIV "_$S(IBCNERTN="IBCNERP1":"Response",1:"Payer")_" Report" | 
|---|
| 273 | S ZTSAVE("IBCNESPC(")="" | 
|---|
| 274 | S ZTSAVE("IBCNERTN")="" | 
|---|
| 275 | D EN^XUTMDEVQ(ZTRTN,ZTDESC,.ZTSAVE) | 
|---|
| 276 | I POP S STOP=1 | 
|---|
| 277 | ; | 
|---|
| 278 | DEVICEX ; DEVICE exit pt | 
|---|
| 279 | Q | 
|---|
| 280 | ; | 
|---|