| [613] | 1 | IBJDI21 ;ALB/CPM - VETERANS WITH UNVERIFIED ELIGIBILITY (CONT'D) ;16-DEC-96
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**118,249**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ; - Find inpatients treated within the user-specified date range.
|
|---|
| 6 | S IBD=IBBDT-.01 F S IBD=$O(^DGPM("ATT3",IBD)) Q:'IBD!(IBD\1>IBEDT) D Q:IBQ
|
|---|
| 7 | .S IBPM=0 F S IBPM=$O(^DGPM("ATT3",IBD,IBPM)) Q:'IBPM D Q:IBQ
|
|---|
| 8 | ..I IBPM#100=0 Q:$$STOP(.IBQ,"Unverified Eligibility Report")
|
|---|
| 9 | ..S IBPMD=$G(^DGPM(IBPM,0)) Q:'IBPMD
|
|---|
| 10 | ..I IBSORT S IBDIV=$$DIV(1,+$P(IBPMD,U,6)) Q:'$D(IB(IBDIV))
|
|---|
| 11 | ..S DFN=+$P(IBPMD,U,3) Q:'DFN
|
|---|
| 12 | ..;
|
|---|
| 13 | ..; - Process patient.
|
|---|
| 14 | ..I '$D(^TMP("IBJDI21",$J,DFN)) D PROC(DFN,"*",.IBQUERY)
|
|---|
| 15 | ;
|
|---|
| 16 | D CLOSE^IBSDU(.IBQUERY)
|
|---|
| 17 | I IBQ G ENQ
|
|---|
| 18 | ;
|
|---|
| 19 | ; - Find outpatients treated within the user-specified date range.
|
|---|
| 20 | D OUTPT("",IBBDT,IBEDT,"S:IBQ SDSTOP=1 I 'IBQ,$$ENCHK^IBJDI5(Y0) D ENC^IBJDI21(Y0,.IBQUERY1)","Unverified Eligibility Report",.IBQ,"IBJDI21",.IBQUERY)
|
|---|
| 21 | D CLOSE^IBSDU(.IBQUERY),CLOSE^IBSDU(.IBQUERY1)
|
|---|
| 22 | ;
|
|---|
| 23 | I IBQ G ENQ
|
|---|
| 24 | ;
|
|---|
| 25 | ; - Extract summary data.
|
|---|
| 26 | I $G(IBXTRACT) D G ENQ
|
|---|
| 27 | .F X="DEC","NOT","PEN","TOT","VER","VERO" S IB(X)=$G(IB("ALL",X))
|
|---|
| 28 | .D E^IBJDE(2,0)
|
|---|
| 29 | ;
|
|---|
| 30 | ; - If detail, look up next appt
|
|---|
| 31 | I IBRPT="D" S IBARRAY("SORT")="P",IBARRAY("FLDS")=1,IBARRAY(1)=$$NOW^XLFDT_";9999999",IBARRAY(4)="^TMP(""IBDFN"",$J,",IBCOUNT=$$SDAPI^SDAMA301(.IBARRAY)
|
|---|
| 32 | ;
|
|---|
| 33 | ; - Print the reports.
|
|---|
| 34 | S IBQ=0 D NOW^%DTC S IBRUN=$$DAT2^IBOUTL(%)
|
|---|
| 35 | S IBDIV="" F S IBDIV=$O(IB(IBDIV)) Q:IBDIV="" D Q:IBQ
|
|---|
| 36 | .S IBPAG=0 D:IBRPT="D" DET I 'IBQ D SUM,PAUSE
|
|---|
| 37 | ;
|
|---|
| 38 | ENQ Q
|
|---|
| 39 | ;
|
|---|
| 40 | OUTPT(DFN,IBBDT,IBEDT,IBCBK,IBMSG,IBQ,IBSUBSCR,IBQUERY,IBDIR) ;
|
|---|
| 41 | ; Input: DFN = IEN of patient if using PATIENT/DATE index, otherwise,
|
|---|
| 42 | ; if null or 0, DATE/TIME index will be used
|
|---|
| 43 | ; IBCBK = The MUMPS code to execute when valid enctr found
|
|---|
| 44 | ; IBBDT/IBEDT = The start/end dates
|
|---|
| 45 | ; IBMSG = The text to send to STOP PROCESSING CALL (if null, no
|
|---|
| 46 | ; call made)
|
|---|
| 47 | ; IBQ = Flag that says whether or not the process was stopped
|
|---|
| 48 | ; by user
|
|---|
| 49 | ; IBQUERY = The # of the QUERY OBJECT to be used to extract outpt
|
|---|
| 50 | ; visits
|
|---|
| 51 | ; IBDIR = Null to look forward, 'B' to look backward thru file
|
|---|
| 52 | ;
|
|---|
| 53 | N IBVAL,IBFILTER
|
|---|
| 54 | S IBVAL("BDT")=IBBDT,IBVAL("EDT")=IBEDT_".99" S:$G(DFN) IBVAL("DFN")=DFN
|
|---|
| 55 | ;
|
|---|
| 56 | ; - Look at parent encounters, completely checked out, check user
|
|---|
| 57 | ; requested to quit, process each pt only once if IBSUBSCR'=null
|
|---|
| 58 | S IBFILTER=""
|
|---|
| 59 | S IBCBK="I "_$S($G(IBSUBSCR)'="":"'$D(^TMP(IBSUBSCR,$J,+$P(Y0,U,2))),",1:"")_"'$P(Y0,U,6),$P(Y0,U,7),$S((Y#100)'=0:1,$G(IBMSG)="""":1,1:'$$STOP^IBJDI21(.IBQ,IBMSG))"_" "_IBCBK
|
|---|
| 60 | S IBDIR=$S($G(IBDIR)="":"",1:"BACKWARD")
|
|---|
| 61 | D SCAN^IBSDU($S($G(DFN):"PATIENT/DATE",1:"DATE/TIME"),.IBVAL,IBFILTER,IBCBK,0,.IBQUERY,IBDIR) K ^TMP("DIERR",$J)
|
|---|
| 62 | Q
|
|---|
| 63 | ;
|
|---|
| 64 | STOP(IBQ,MSG) ; - Check if user wants to stop.
|
|---|
| 65 | N Y,Y0 S IBQ=$$STOP^IBOUTL(MSG)
|
|---|
| 66 | Q IBQ
|
|---|
| 67 | ;
|
|---|
| 68 | ENC(IBOED,IBQUERY1) ; - Encounter extract for all patients loop.
|
|---|
| 69 | ; IBQUERY1 = the # of the QUERY to use to do the extract.
|
|---|
| 70 | ; Pre-set variables IB array, IBSORT are required.
|
|---|
| 71 | ;
|
|---|
| 72 | I IBSORT S IBDIV=$$DIV(0,+$P(IBOED,U,11)) Q:'$D(IB(IBDIV))
|
|---|
| 73 | D PROC(+$P(IBOED,U,2),"",.IBQUERY1) ; Process patient.
|
|---|
| 74 | Q
|
|---|
| 75 | ;
|
|---|
| 76 | PROC(DFN,IBIPC,IBQUERY) ; - Process each specific patient.
|
|---|
| 77 | ; Input: DFN = Pointer to the patient in file #2
|
|---|
| 78 | ; IBIPC = Inpatient treatment marker
|
|---|
| 79 | ; ("*"=Had inpat. treatment, null=No inpat. treatment)
|
|---|
| 80 | ; IBQUERY = The # of the QUERY OBJECT to be used to extract
|
|---|
| 81 | ; outpatient visits
|
|---|
| 82 | ;
|
|---|
| 83 | ; Pre-set variables IB array, IBDIV are required.
|
|---|
| 84 | ;
|
|---|
| 85 | I $$TESTP^IBJDI1(DFN) Q ; Test patient.
|
|---|
| 86 | D ELIG^VADPT I 'VAEL(4) G PRCQ ; Patient is not a vet.
|
|---|
| 87 | ;
|
|---|
| 88 | ; - Set patient index and 'total' accumulator.
|
|---|
| 89 | S ^TMP("IBJDI21",$J,DFN)="",IB(IBDIV,"TOT")=IB(IBDIV,"TOT")+1
|
|---|
| 90 | ;
|
|---|
| 91 | I $G(^DPT(DFN,.35)) S IB(IBDIV,"DEC")=IB(IBDIV,"DEC")+1 ; Deceased.
|
|---|
| 92 | ;
|
|---|
| 93 | ; - Elig. status is Verified, Pending, Re-pending, or null.
|
|---|
| 94 | S IBES=$P(VAEL(8),U)
|
|---|
| 95 | I IBES="V" D G PRCS:X'<730,PRCQ
|
|---|
| 96 | .S IB(IBDIV,"VER")=IB(IBDIV,"VER")+1
|
|---|
| 97 | .S IBESD=+$P($G(^DPT(DFN,.361)),U,2),X1=DT,X2=IBESD D ^%DTC
|
|---|
| 98 | .S:X'<730 IB(IBDIV,"VERO")=IB(IBDIV,"VERO")+1,^TMP("IBJDI23",$J,DFN)=" (on "_$$DAT1^IBOUTL(IBESD)_")"
|
|---|
| 99 | I IBES="P"!(IBES="R") S IB(IBDIV,"PEN")=IB(IBDIV,"PEN")+1 G PRCS
|
|---|
| 100 | S IB(IBDIV,"NOT")=IB(IBDIV,"NOT")+1
|
|---|
| 101 | ;
|
|---|
| 102 | PRCS I IBRPT="D" D SET(.IBQUERY)
|
|---|
| 103 | ;
|
|---|
| 104 | PRCQ K VA,VAERR,VAEL
|
|---|
| 105 | Q
|
|---|
| 106 | ;
|
|---|
| 107 | SET(IBQUERY) ; - Set up detailed information to appear on the report.
|
|---|
| 108 | ; Working variable definitions:
|
|---|
| 109 | ; IBLT = Last treatment date
|
|---|
| 110 | ; IBDN = Zero node of Patient file entry
|
|---|
| 111 | ; IBDOD = Patient's date of death (if any)
|
|---|
| 112 | ; IBNUMO = No. outpatient visits in date range
|
|---|
| 113 | ; IBNUMD = No. discharges in date range
|
|---|
| 114 | ; IBNEXT = Next scheduled treatment date
|
|---|
| 115 | ; IBQUERY = The # of the QUERY OBJECT to be used to extract outpatient
|
|---|
| 116 | ; visits
|
|---|
| 117 | ;
|
|---|
| 118 | S (IBNUMD,IBNUMO,IBLT)=0
|
|---|
| 119 | ;
|
|---|
| 120 | ; - Get # of discharges; look for LTD.
|
|---|
| 121 | S IBDT=0 F S IBDT=$O(^DGPM("ATID3",DFN,IBDT)) Q:'IBDT D
|
|---|
| 122 | .S IBDTF=9999999.9999999-IBDT\1
|
|---|
| 123 | .S:IBDTF>IBLT IBLT=IBDTF I IBDTF<IBBDT!(IBDTF>IBEDT) Q
|
|---|
| 124 | .S IBNUMD=IBNUMD+1
|
|---|
| 125 | ;
|
|---|
| 126 | ; - Get # of outpatient visits; look for LTD.
|
|---|
| 127 | D OUTPT(DFN,IBBDT,9991231,"S IBDTF=Y0\1 S:IBDTF>IBLT IBLT=IBDTF I IBDTF'<IBBDT,IBDTF'>IBEDT S IBNUMO=IBNUMO+1","","","",.IBQUERY)
|
|---|
| 128 | ;
|
|---|
| 129 | ; - If current inpatient, set LTD to today.
|
|---|
| 130 | I $G(^DPT(DFN,.105)) S IBLT=DT
|
|---|
| 131 | ;
|
|---|
| 132 | ; - Find next scheduled treatment date.
|
|---|
| 133 | S IBNEXT=""
|
|---|
| 134 | I $$GETICN^MPIF001(DFN) S ^TMP("IBDFN",$J,DFN)="" ;set tmp sched appt.
|
|---|
| 135 | S X=0 F S X=$O(^DGS(41.1,"B",DFN,X)) Q:'X D ; Scheduled adm.
|
|---|
| 136 | .S X1=$G(^DGS(41.1,X,0))
|
|---|
| 137 | .S X2=$P(X1,U,2)\1
|
|---|
| 138 | .I X2<DT Q ; Must be old scheduled admission.
|
|---|
| 139 | .I $P(X1,U,13) Q ; Sched adm is cancelled.
|
|---|
| 140 | .I $P(X1,U,17) Q ; Patient already admitted.
|
|---|
| 141 | .I X2>IBNEXT S IBNEXT=X2
|
|---|
| 142 | ;
|
|---|
| 143 | S IBDN=$G(^DPT(DFN,0))
|
|---|
| 144 | S IBDOD=$S(+$G(^DPT(DFN,.35)):$$DAT1^IBOUTL(+$G(^(.35))\1),1:"")
|
|---|
| 145 | ;
|
|---|
| 146 | S ^TMP("IBJDI22",$J,IBDIV,$E($P(IBDN,U),1,25)_IBIPC_"@@"_DFN)=$P(IBDN,U,9)_U_$E($P(VAEL(1),U,2),1,23)_U_IBES_U_IBNUMO_U_IBNUMD_U_IBLT_U_IBNEXT_U_IBDOD
|
|---|
| 147 | Q
|
|---|
| 148 | ;
|
|---|
| 149 | DIV(X,Y) ; - Return division name.
|
|---|
| 150 | ; Input: X=1-Inpatient, 0-Outpatient
|
|---|
| 151 | ; Y=IEN of file #42 (If X=1) or IEN of file #40.8 (If X=0)
|
|---|
| 152 | I X S Y=+$P($G(^DIC(42,Y,0)),U,11)
|
|---|
| 153 | S Z=$P($G(^DG(40.8,Y,0)),U) I Z="" S Z=$P($$SITE^VASITE,U,2)
|
|---|
| 154 | Q Z
|
|---|
| 155 | ;
|
|---|
| 156 | DET ; - Print the detailed report.
|
|---|
| 157 | D HDET Q:IBQ
|
|---|
| 158 | I '$D(^TMP("IBJDI22",$J,IBDIV)) W !!,"There were no patients treated in this date range with unverified eligibility." G DETQ
|
|---|
| 159 | ;
|
|---|
| 160 | S IBXX="" F S IBXX=$O(^TMP("IBJDI22",$J,IBDIV,IBXX)) Q:IBXX="" S IBX=^(IBXX) D Q:IBQ
|
|---|
| 161 | .I $Y>(IOSL-2) D PAUSE Q:IBQ D HDET Q:IBQ
|
|---|
| 162 | .W !,$P(IBXX,"@@"),?28,$$SSN($P(IBX,U)),?42,$P(IBX,U,2)
|
|---|
| 163 | .W ?67,$$ESTAT($P(IBX,U,3)),$G(^TMP("IBJDI23",$J,IBDIV,+$P(IBXX,"@@",2)))
|
|---|
| 164 | .W ?93,$J($P(IBX,U,4),3),?98,$J($P(IBX,U,5),3)
|
|---|
| 165 | .W ?104,$$DAT1^IBOUTL($P(IBX,U,6))
|
|---|
| 166 | .S IBCOUNT=$O(^TMP($J,"SDAMA301",+$P(IBXX,"@@",2),0))
|
|---|
| 167 | .S:IBCOUNT $P(IBX,"^",7)=$S('$P(IBX,"^",7):IBCOUNT,IBCOUNT<$P(IBX,"^",7):IBCOUNT,1:$P(IBX,"^",7))
|
|---|
| 168 | .W ?114,$$DAT1^IBOUTL($P(IBX,U,7))
|
|---|
| 169 | .W ?124,$P(IBX,U,8)
|
|---|
| 170 | ;
|
|---|
| 171 | DETQ I 'IBQ D PAUSE
|
|---|
| 172 | Q
|
|---|
| 173 | ;
|
|---|
| 174 | HDET ; - Write the detail report header.
|
|---|
| 175 | I $E(IOST,1,2)="C-"!(IBPAG) W @IOF,*13
|
|---|
| 176 | S IBPAG=IBPAG+1
|
|---|
| 177 | W !,"Veterans with Unverified Eligibilities",$S(IBDIV'="ALL":" for "_IBDIV,1:""),?80,"Run Date: ",IBRUN,?123,"Page: ",IBPAG
|
|---|
| 178 | W !,"Patients who were treated in the period ",$$DAT1^IBOUTL(IBBDT)," to ",$$DAT1^IBOUTL(IBEDT)
|
|---|
| 179 | W !?91,"# Opt # Last Nxt Sched Date of"
|
|---|
| 180 | W !,"Patient (*=Had inpt. care)",?28,"SSN",?42,"Primary Eligibility"
|
|---|
| 181 | W ?67,"Eligibility Status",?91,"Visits Disc Seen Visit/Adm Death"
|
|---|
| 182 | W !,$$DASH(IOM),!
|
|---|
| 183 | S IBQ=$$STOP(0,"Unverified Eligibility Report")
|
|---|
| 184 | Q
|
|---|
| 185 | ;
|
|---|
| 186 | SUM ; - Print the summary report.
|
|---|
| 187 | I $E(IOST,1,2)="C-"!(IBPAG) W @IOF,*13
|
|---|
| 188 | S IBPAG=IBPAG+1
|
|---|
| 189 | W !!?21,"VETERANS WITH UNVERIFIED ELIGIBILITY",!
|
|---|
| 190 | I IBDIV'="ALL" W ?(61-$L(IBDIV))\2,"SUMMARY REPORT for ",IBDIV
|
|---|
| 191 | E W ?33,"SUMMARY REPORT"
|
|---|
| 192 | W !!?19,"Patients treated from ",$$DAT1^IBOUTL(IBBDT)," - ",$$DAT1^IBOUTL(IBEDT)
|
|---|
| 193 | W !!?24,"Run Date: ",IBRUN,!?13,$$DASH(53),!!
|
|---|
| 194 | ;
|
|---|
| 195 | S IBPERV=$J($S('IB(IBDIV,"TOT"):0,1:IB(IBDIV,"VER")/IB(IBDIV,"TOT")*100),0,2)
|
|---|
| 196 | S IBPERP=$J($S('IB(IBDIV,"TOT"):0,1:IB(IBDIV,"PEN")/IB(IBDIV,"TOT")*100),0,2)
|
|---|
| 197 | S IBPERD=$J($S('IB(IBDIV,"TOT"):0,1:IB(IBDIV,"DEC")/IB(IBDIV,"TOT")*100),0,2)
|
|---|
| 198 | S IBPERO=$J($S('IB(IBDIV,"VER"):0,1:IB(IBDIV,"VERO")/IB(IBDIV,"VER")*100),0,2)
|
|---|
| 199 | W ?29,"Number of Patients Treated:",?58,$J(IB(IBDIV,"TOT"),5)
|
|---|
| 200 | W !?28,"Number of Deceased Patients:",?58,$J(IB(IBDIV,"DEC"),5),?67,"(",IBPERD,"%)"
|
|---|
| 201 | W !?11,"Number of Patients with Verified Eligibility:",?58,$J(IB(IBDIV,"VER"),5),?67,"(",IBPERV,"%)"
|
|---|
| 202 | W !?5,"Number of Patients Whose Verified Eligibility Date"
|
|---|
| 203 | W !?13,"is At Least 2 Years Old (from above total):",?58,$J(IB(IBDIV,"VERO"),5),?67,"(",IBPERO,"%)"
|
|---|
| 204 | W !?10,"Number of Patients with a Pending Eligibility:",?58,$J(IB(IBDIV,"PEN"),5),?67,"(",IBPERP,"%)"
|
|---|
| 205 | W !?24,"Number of Patients Not Verified:",?58,$J(IB(IBDIV,"NOT"),5),?67,"(",$J($S('IB(IBDIV,"TOT"):0,1:100-IBPERV-IBPERP),0,2),"%)"
|
|---|
| 206 | Q
|
|---|
| 207 | ;
|
|---|
| 208 | DASH(X) ; - Return a dashed line.
|
|---|
| 209 | Q $TR($J("",X)," ","=")
|
|---|
| 210 | ;
|
|---|
| 211 | PAUSE ; - Page break.
|
|---|
| 212 | I $E(IOST,1,2)'="C-" Q
|
|---|
| 213 | N IBX,DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
|
|---|
| 214 | F IBX=$Y:1:(IOSL-3) W !
|
|---|
| 215 | S DIR(0)="E" D ^DIR I $D(DIRUT)!($D(DUOUT)) S IBQ=1
|
|---|
| 216 | Q
|
|---|
| 217 | ;
|
|---|
| 218 | SSN(X) ; - Format the SSN.
|
|---|
| 219 | Q $S(X]"":$E(X,1,3)_"-"_$E(X,4,5)_"-"_$E(X,6,10),1:"")
|
|---|
| 220 | ;
|
|---|
| 221 | ESTAT(X) ; - Decode the eligibility status.
|
|---|
| 222 | Q $S(X="V":"VERIFIED",X="P":"PENDING VERIFICATION",X="R":"PENDING RE-VERIFICATION",1:"NOT VERIFIED")
|
|---|
