| 1 | IBJDIPR ;ALB/HMC - PERCENTAGE OF PATIENTS PREREGISTERED REPORT ;10-MAY-2004
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**272,305**;21-MAR-1994
|
|---|
| 3 | ;
|
|---|
| 4 | EN ; - Option entry point.
|
|---|
| 5 | ;
|
|---|
| 6 | D ENQ1
|
|---|
| 7 | W !!,"This report provides number of patients treated, the number of"
|
|---|
| 8 | W !,"patients pre-registered, % of patients pre-registered, number of"
|
|---|
| 9 | W !,"patients pre-registered past the pre-registration time frame,"
|
|---|
| 10 | W !,"number of patients never pre-registered, the clinic exclusions,"
|
|---|
| 11 | W !,"and the eligibility exclusions.",!!
|
|---|
| 12 | ;
|
|---|
| 13 | DATE D DATE^IBOUTL I IBBDT=""!(IBEDT="") G ENQ
|
|---|
| 14 | ;
|
|---|
| 15 | ;
|
|---|
| 16 | TIME ;Pre-Registration time frame, default is 180 days
|
|---|
| 17 | ;
|
|---|
| 18 | S DIR(0)="N^^I X'>0 K X"
|
|---|
| 19 | S DIR("A")="Pre-Registration time frame (days)" W !
|
|---|
| 20 | S DIR("B")=180
|
|---|
| 21 | S DIR("?")="^D THLP^IBJDIPR"
|
|---|
| 22 | D ^DIR
|
|---|
| 23 | S IBPRF=Y
|
|---|
| 24 | I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) G ENQ
|
|---|
| 25 | ;
|
|---|
| 26 | K DIR,DIROUT,DTOUT,DUOUT,DIRUT
|
|---|
| 27 | S DIR(0)="Y",DIR("B")="NO",DIR("?")="^D EHLP^IBJDIPR"
|
|---|
| 28 | S DIR("A")="Detailed list of Exclusions (Y/N)"
|
|---|
| 29 | D ^DIR
|
|---|
| 30 | S IBEXC=+Y
|
|---|
| 31 | I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) G ENQ
|
|---|
| 32 | K DIR,DIROUT,DTOUT,DUOUT,DIRUT
|
|---|
| 33 | ;
|
|---|
| 34 | W !!,"This report only requires an 80 column printer."
|
|---|
| 35 | W !!,"Note: This report may take a while to run."
|
|---|
| 36 | W !!,"You should queue this report to run after normal business hours.",!
|
|---|
| 37 | ;
|
|---|
| 38 | ; - Select a device.
|
|---|
| 39 | S %ZIS="QM" D ^%ZIS G:POP ENQ
|
|---|
| 40 | I $D(IO("Q")) D G ENQ
|
|---|
| 41 | .S ZTRTN="DQ^IBJDIPR",ZTDESC="IB - PERCENTAGE OF PATIENTS PREREGISTERED"
|
|---|
| 42 | .S ZTSAVE("IB*")=""
|
|---|
| 43 | .D ^%ZTLOAD
|
|---|
| 44 | .W !!,$S($D(ZTSK):"This job has been queued. The task number is "_ZTSK_".",1:"Unable to queue this job.")
|
|---|
| 45 | .K ZTSK,IO("Q") D HOME^%ZIS
|
|---|
| 46 | ;
|
|---|
| 47 | U IO
|
|---|
| 48 | ;
|
|---|
| 49 | DQ ; - Tasked entry point.
|
|---|
| 50 | ;
|
|---|
| 51 | N IBQUERY,IBQUERY1,DGNAM
|
|---|
| 52 | K IB,^TMP("IBJDIPR",$J),^TMP("IBJDIPR1",$J)
|
|---|
| 53 | ;
|
|---|
| 54 | ;Temporary global IBJDIPR contains outpatients found for date range in the outpatient encounter file"
|
|---|
| 55 | ;Temporary global IBJDIPR1 contains the clinic exclusions found in the MAS parameter file"
|
|---|
| 56 | ;
|
|---|
| 57 | S (IBQ,DGPREC,DGPREE)=0
|
|---|
| 58 | F I="TOT","PRE","PAST","NEVR" S IB(I)=0
|
|---|
| 59 | ;
|
|---|
| 60 | ;Build exclusion temporary file from MAS parameter file,
|
|---|
| 61 | ; ^DG(43 - dbia 4242
|
|---|
| 62 | ;
|
|---|
| 63 | ;Get clinic exclusions and clinic name from ^SC (Hospital location file)
|
|---|
| 64 | ;dbia 401
|
|---|
| 65 | S X="" F S X=$O(^DG(43,1,"DGPREC","B",X)) Q:X="" D
|
|---|
| 66 | . S DGNAM=$P($G(^SC(X,0)),U,1) I DGNAM="" Q
|
|---|
| 67 | . S ^TMP("IBJDIPR1",$J,"DGPREC",X)=""
|
|---|
| 68 | . S ^TMP("IBJDIPR1",$J,"DGPRECA",DGNAM_U_X)=X ;index sorted by name
|
|---|
| 69 | . S DGPREC=DGPREC+1
|
|---|
| 70 | ;
|
|---|
| 71 | ;Get eligibility exclusions and eligibility name from ^DIC(8 dbia 427
|
|---|
| 72 | ;
|
|---|
| 73 | S X="" F S X=$O(^DG(43,1,"DGPREE","B",X)) Q:X="" D
|
|---|
| 74 | . S DGNAM=$P($G(^DIC(8,X,0)),U,1) I DGNAM="" Q
|
|---|
| 75 | . S ^TMP("IBJDIPR1",$J,"DGPREE",X)=""
|
|---|
| 76 | . S ^TMP("IBJDIPR1",$J,"DGPREEA",DGNAM_U_X)=X ;index sorted by name
|
|---|
| 77 | . S DGPREE=DGPREE+1
|
|---|
| 78 | ;
|
|---|
| 79 | ; - Find outpatients treated within the user-specified date range.
|
|---|
| 80 | D OUTPT("",IBBDT,IBEDT,"S:IBQ SDSTOP=1 I 'IBQ,$$ENCHK^IBJDI5(Y0) D ENC^IBJDIPR(Y0)","Percentage of Patients Pre-registered",.IBQ,"IBJDIPR",.IBQUERY)
|
|---|
| 81 | D CLOSE^IBSDU(.IBQUERY),CLOSE^IBSDU(.IBQUERY1) I IBQ G ENQ
|
|---|
| 82 | ;
|
|---|
| 83 | ;Find pre-registered patients
|
|---|
| 84 | ;Use file 41.41 (^DGS), Pre-registration audit file
|
|---|
| 85 | ;dbia 4425
|
|---|
| 86 | ;
|
|---|
| 87 | S DFN=""
|
|---|
| 88 | F S DFN=$O(^TMP("IBJDIPR",$J,DFN)) Q:DFN="" D
|
|---|
| 89 | . S TRDAT=^TMP("IBJDIPR",$J,DFN) ;Get treatment date
|
|---|
| 90 | . S IB("TOT")=IB("TOT")+1 ;Total unique patients treated
|
|---|
| 91 | . S PRDAT=TRDAT+.0000001
|
|---|
| 92 | . S PRDAT=$O(^DGS(41.41,"ADC",DFN,PRDAT),-1) ;Most recent pre-reg date
|
|---|
| 93 | . I PRDAT="" S IB("NEVR")=IB("NEVR")+1 Q ;never pre-registered
|
|---|
| 94 | . I PRDAT<$$FMADD^XLFDT(TRDAT,-IBPRF) S IB("PAST")=IB("PAST")+1 Q ;past time frame
|
|---|
| 95 | . S IB("PRE")=IB("PRE")+1 ;pre-registered
|
|---|
| 96 | ;
|
|---|
| 97 | ; - Print the reports.
|
|---|
| 98 | ; QUIT if this is a electronic transmission to the ARC -IB patch 305
|
|---|
| 99 | Q:$G(IBARFLAG)
|
|---|
| 100 | S (IBQ,IBPAG)=0 D NOW^%DTC S IBRUN=$$DAT2^IBOUTL(%)
|
|---|
| 101 | I 'IBQ D SUM,PAUSE
|
|---|
| 102 | ENQ K ^TMP("IBJDIPR",$J),^TMP("IBJDIPR1",$J)
|
|---|
| 103 | I $D(ZTQUEUED) S ZTREQ="@" G ENQ1
|
|---|
| 104 | ;
|
|---|
| 105 | D ^%ZISC
|
|---|
| 106 | ENQ1 K IB,IBQ,IBBDT,IBEDT,IBD,IBPAG,IBRUN,IBOED,IBPRF
|
|---|
| 107 | K DFN,POP,I,X,X1,X2,Y,%,%ZIS,ZTDESC,ZTRTN,ZTSAVE,ZTREQ,ZTQUEUED
|
|---|
| 108 | K DIR,DIROUT,DTOUT,DUOUT,DIRUT
|
|---|
| 109 | K DGPREC,DGPREE,PRDAT,TRDAT,IBEXC,DGEE,DGEC,PCENT,TAB,DGNAM
|
|---|
| 110 | Q
|
|---|
| 111 | ;
|
|---|
| 112 | OUTPT(DFN,IBBDT,IBEDT,IBCBK,IBMSG,IBQ,IBSUBSCR,IBQUERY,IBDIR) ;
|
|---|
| 113 | ; Input: DFN = IEN of patient if using PATIENT/DATE index, otherwise,
|
|---|
| 114 | ; if null or 0, DATE/TIME index will be used
|
|---|
| 115 | ; IBCBK = The MUMPS code to execute when valid enctr found
|
|---|
| 116 | ; IBBDT/IBEDT = The start/end dates
|
|---|
| 117 | ; IBMSG = The text to send to STOP PROCESSING CALL (if null, no
|
|---|
| 118 | ; call made)
|
|---|
| 119 | ; IBQ = Flag that says whether or not the process was stopped
|
|---|
| 120 | ; by user
|
|---|
| 121 | ; IBQUERY = The # of the QUERY OBJECT to be used to extract outpt
|
|---|
| 122 | ; visits
|
|---|
| 123 | ; IBDIR = Null to look forward, 'B' to look backward thru file
|
|---|
| 124 | ;
|
|---|
| 125 | N IBVAL,IBFILTER
|
|---|
| 126 | S IBVAL("BDT")=IBBDT,IBVAL("EDT")=IBEDT_".99" S:$G(DFN) IBVAL("DFN")=DFN
|
|---|
| 127 | ;
|
|---|
| 128 | ; - Look at parent encounters, completely checked out, check user
|
|---|
| 129 | ; requested to quit, process each pt only once if IBSUBSCR'=null
|
|---|
| 130 | S IBFILTER=""
|
|---|
| 131 | S IBCBK="I '$P(Y0,U,6),$P(Y0,U,7),$S((Y#100)'=0:1,$G(IBMSG)="""":1,1:'$$STOP^IBJDI21(.IBQ,IBMSG))"_" "_IBCBK
|
|---|
| 132 | S IBDIR=$S($G(IBDIR)="":"",1:"BACKWARD")
|
|---|
| 133 | ;
|
|---|
| 134 | ;ibsdu will use ^SD(409.1), Standard encounter query, to process
|
|---|
| 135 | ;file 409.68 (^SCE) - dbia402 for outpatient encounter data.
|
|---|
| 136 | ;
|
|---|
| 137 | D SCAN^IBSDU($S($G(DFN):"PATIENT/DATE",1:"DATE/TIME"),.IBVAL,IBFILTER,IBCBK,0,.IBQUERY,IBDIR) K ^TMP("DIERR",$J)
|
|---|
| 138 | Q
|
|---|
| 139 | ;
|
|---|
| 140 | ENC(IBOED) ; - Encounter extract.
|
|---|
| 141 | ; Input: IBOED = Data from outpatient encounter file, ^SCE.
|
|---|
| 142 | ;
|
|---|
| 143 | S DFN=+$P(IBOED,U,2) I 'DFN Q
|
|---|
| 144 | ;Check exclusions
|
|---|
| 145 | I $P(IBOED,U,4)]"",$D(^TMP("IBJDIPR1",$J,"DGPREC",$P(IBOED,U,4))) Q ;Clinic exclusion
|
|---|
| 146 | I $P(IBOED,U,13)]"",$D(^TMP("IBJDIPR1",$J,"DGPREE",$P(IBOED,U,13))) Q ;Eligibility exclusion
|
|---|
| 147 | D PROC(DFN,IBOED) ; Process patient.
|
|---|
| 148 | Q
|
|---|
| 149 | ;
|
|---|
| 150 | PROC(DFN,IBOED) ; - Process each specific patient.
|
|---|
| 151 | ; Input: DFN = Pointer to the patient in file #2
|
|---|
| 152 | ; IBOED = Data from outpatient encounter file, ^SCE.
|
|---|
| 153 | ;
|
|---|
| 154 | ; Pre-set variables IB array, IBBDT, IBEDT are required.
|
|---|
| 155 | ;
|
|---|
| 156 | I $$TESTP^IBJDI1(DFN) Q ; Test patient.
|
|---|
| 157 | D ELIG^VADPT G:'VAEL(4) PRCQ ; Patient is not a vet.
|
|---|
| 158 | ;
|
|---|
| 159 | ; - Set patient index
|
|---|
| 160 | S ^TMP("IBJDIPR",$J,DFN)=$P(IBOED,U,1)
|
|---|
| 161 | ;
|
|---|
| 162 | PRCQ K VA,VAERR,VAEL
|
|---|
| 163 | Q
|
|---|
| 164 | ;
|
|---|
| 165 | SUM ; - Print the summary report.
|
|---|
| 166 | D HEAD Q:IBQ
|
|---|
| 167 | W !!?15,"Patients pre-registered from ",$$DAT1^IBOUTL(IBBDT)," - ",$$DAT1^IBOUTL(IBEDT)
|
|---|
| 168 | W !!?17,"Pre-registration time frame: ",$J(IBPRF,5)," days"
|
|---|
| 169 | W !!?24,"Run Date: ",IBRUN,!?10,$$DASH(55),!!
|
|---|
| 170 | ;
|
|---|
| 171 | W ?35,"*Number of Unique Patients Treated: ",$J(IB("TOT"),5)
|
|---|
| 172 | W !?1,"Unique Outpatients Pre-registered within pre-registration time frame: ",$J(IB("PRE"),5)
|
|---|
| 173 | S PCENT=0 I IB("TOT") S PCENT=(IB("PRE")/IB("TOT"))*100
|
|---|
| 174 | W !?47,"Percent Pre-registered: ",$J(PCENT,5,2),"%"
|
|---|
| 175 | W !!?3,"Unique Outpatients Pre-registered past pre-registration time frame: ",$J(IB("PAST"),5)
|
|---|
| 176 | W !?30,"Unique Outpatients never Pre-registered: ",$J(IB("NEVR"),5)
|
|---|
| 177 | W !!?8,"*Counts may not include all patients because of exclusions."
|
|---|
| 178 | W !!?37,"Number of Eligibility Exclusions: ",$J(DGPREE,5)
|
|---|
| 179 | W !!?42,"Number of Clinic Exclusions: ",$J(DGPREC,5)
|
|---|
| 180 | I 'IBEXC Q
|
|---|
| 181 | I DGPREE D
|
|---|
| 182 | .S DGEE=1
|
|---|
| 183 | .D PAUSE Q:IBQ D HEAD Q:IBQ
|
|---|
| 184 | .S X="" F I=1:1 S X=$O(^TMP("IBJDIPR1",$J,"DGPREEA",X)) Q:X="" D Q:IBQ
|
|---|
| 185 | ..I $Y>(IOSL-4) D PAUSE Q:IBQ D HEAD Q:IBQ
|
|---|
| 186 | ..S TAB=$S((I#2):10,1:45)
|
|---|
| 187 | ..W ?TAB,$E($P(X,U,1),1,30) W:'(I#2) !
|
|---|
| 188 | I DGPREC D
|
|---|
| 189 | .S DGEC=1,DGEE=0
|
|---|
| 190 | .S X="" F I=1:1 S X=$O(^TMP("IBJDIPR1",$J,"DGPRECA",X)) Q:X="" D Q:IBQ
|
|---|
| 191 | ..I I=1 D Q:IBQ
|
|---|
| 192 | ...I ($Y+4)>(IOSL-4) D PAUSE Q:IBQ D HEAD Q
|
|---|
| 193 | ...W !!?10,"Clinic Exclusions",!?9,$$DASH(19),!
|
|---|
| 194 | ..I $Y>(IOSL-4) D PAUSE Q:IBQ D HEAD Q:IBQ
|
|---|
| 195 | ..S TAB=$S((I#2):10,1:45)
|
|---|
| 196 | ..W ?TAB,$E($P(X,U,1),1,30) W:'(I#2) !
|
|---|
| 197 | Q
|
|---|
| 198 | ;
|
|---|
| 199 | HEAD ; - Report Header
|
|---|
| 200 | ;
|
|---|
| 201 | I $E(IOST,1,2)="C-"!(IBPAG) W @IOF,*13
|
|---|
| 202 | S IBPAG=IBPAG+1
|
|---|
| 203 | W !?21,"PERCENTAGE OF PATIENTS PRE-REGISTERED",?71,"Page: ",IBPAG
|
|---|
| 204 | I IBPAG=1 W !!?33,"SUMMARY REPORT" Q
|
|---|
| 205 | W !!?24,"Run Date: ",IBRUN,!?10,$$DASH(55),!!
|
|---|
| 206 | W !?10,"Listing of all Exclusions: ",!
|
|---|
| 207 | I $G(DGEE) W !!?10,"Eligibility Exclusions",!?9,$$DASH(24),!
|
|---|
| 208 | I $G(DGEC) W !!?10,"Clinic Exclusions",!?9,$$DASH(19),!
|
|---|
| 209 | S IBQ=$$STOP^IBOUTL("Percentage of Patients Pre-registered")
|
|---|
| 210 | Q
|
|---|
| 211 | ;
|
|---|
| 212 | DASH(X) ; - Return a dashed line.
|
|---|
| 213 | Q $TR($J("",X)," ","=")
|
|---|
| 214 | ;
|
|---|
| 215 | PAUSE ; - Page break.
|
|---|
| 216 | I $E(IOST,1,2)'="C-" Q
|
|---|
| 217 | N DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
|
|---|
| 218 | S DIR(0)="E" D ^DIR I $D(DIRUT)!($D(DUOUT)) S IBQ=1
|
|---|
| 219 | Q
|
|---|
| 220 | ;
|
|---|
| 221 | THLP ; - 'Pre-Registration time frame (days)' prompt
|
|---|
| 222 | ;
|
|---|
| 223 | W !!,"Number of days to search for pre-registered patients."
|
|---|
| 224 | W !,"Number of days must be greater that zero."
|
|---|
| 225 | W !,"Select '<CR>' to accept the default 180 days."
|
|---|
| 226 | W !?11,"'^' to quit."
|
|---|
| 227 | Q
|
|---|
| 228 | ;
|
|---|
| 229 | EHLP ; - 'Detailed list of Exclusions' prompt
|
|---|
| 230 | ;
|
|---|
| 231 | W !!,"Select '<CR>' to print only the number of eligibility and clinic exclusions."
|
|---|
| 232 | W !!?11,"'Y' to print list of all eligibility and clinic exclusions."
|
|---|
| 233 | W !?11,"'^' to quit."
|
|---|
| 234 | Q
|
|---|
| 235 | IBAR(IBBDT,IBEDT) ;Entry point for Vista IB AR data to ARC
|
|---|
| 236 | ;patch 305 - called by IBRFN4
|
|---|
| 237 | N IBPRF,IBEXC,IBARFLAG,IB,IBPERC,IBARDATA
|
|---|
| 238 | S IBPRF=180,IBEXC=0,IBARFLAG=1
|
|---|
| 239 | D DQ
|
|---|
| 240 | I 'IB("TOT") S IBPERC=0 G IBARD
|
|---|
| 241 | S IBPERC=IB("PRE")/IB("TOT")*100,IBPERC=$FN(IBPERC,"",2)
|
|---|
| 242 | IBARD S IBARDATA=IB("TOT")_U_IB("PRE")_U_IBPERC_U_IB("PAST")_U_IB("NEVR")
|
|---|
| 243 | Q IBARDATA
|
|---|
