| [613] | 1 | IBJDI3 ;ALB/CPM - NO EMPLOYER LISTING ; 17-DEC-96
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**69,91,98,100,118,123**;21-MAR-94
|
|---|
| 3 | ;
|
|---|
| 4 | EN ; - Option entry point.
|
|---|
| 5 | ;
|
|---|
| 6 | W !!,"This report provides a measure of the number of veteran patients who"
|
|---|
| 7 | W !,"have been identified as being employed, but have no employer on file.",!
|
|---|
| 8 | ;
|
|---|
| 9 | DATE D DATE^IBOUTL I IBBDT=""!(IBEDT="") G ENQ
|
|---|
| 10 | ;
|
|---|
| 11 | ; - Sort by division?
|
|---|
| 12 | S DIR(0)="Y",DIR("B")="NO",DIR("?")="^D DHLP^IBJDI3"
|
|---|
| 13 | S DIR("A")="Do you wish to sort this report by division" W !
|
|---|
| 14 | D ^DIR S IBSORT=+Y I $D(DIRUT)!$D(DTOUT)!$D(DUOUT)!$D(DIROUT) G ENQ
|
|---|
| 15 | K DIR,DIROUT,DTOUT,DUOUT,DIRUT
|
|---|
| 16 | ;
|
|---|
| 17 | I IBSORT D PSDR^IBODIV G:Y<0 ENQ ; Select division(s).
|
|---|
| 18 | ;
|
|---|
| 19 | ; - Select a detailed or summary report.
|
|---|
| 20 | D DS^IBJD I IBRPT["^" G ENQ
|
|---|
| 21 | ;
|
|---|
| 22 | I IBRPT="D" W !!,"You will need a 132 column printer for this report!"
|
|---|
| 23 | E W !!,"This report only requires an 80 column printer."
|
|---|
| 24 | ;
|
|---|
| 25 | W !!,"Note: This report may take a while to run."
|
|---|
| 26 | W !?6,"You should queue this report to run after normal business hours.",!
|
|---|
| 27 | ;
|
|---|
| 28 | ; - Select a device.
|
|---|
| 29 | S %ZIS="QM" D ^%ZIS G:POP ENQ
|
|---|
| 30 | I $D(IO("Q")) D G ENQ
|
|---|
| 31 | .S ZTRTN="DQ^IBJDI3",ZTDESC="IB - NO EMPLOYER LISTING"
|
|---|
| 32 | .F I="IB*","VAUTD","VAUTD(" S ZTSAVE(I)=""
|
|---|
| 33 | .D ^%ZTLOAD
|
|---|
| 34 | .W !!,$S($D(ZTSK):"This job has been queued. The task number is "_ZTSK_".",1:"Unable to queue this job.")
|
|---|
| 35 | .K ZTSK,IO("Q") D HOME^%ZIS
|
|---|
| 36 | ;
|
|---|
| 37 | U IO
|
|---|
| 38 | ;
|
|---|
| 39 | DQ ; - Tasked entry point.
|
|---|
| 40 | ;
|
|---|
| 41 | I $G(IBXTRACT) D E^IBJDE(3,1) ; Change extract status.
|
|---|
| 42 | ;
|
|---|
| 43 | N IBQUERY,IBQUERY1
|
|---|
| 44 | K IB,^TMP("IBJDI31",$J),^TMP("IBJDI32",$J)
|
|---|
| 45 | S IBC="DEC^NO^OK^TOT",IBQ=0
|
|---|
| 46 | I IBSORT D G INP
|
|---|
| 47 | .S I=0 F S I=$S(VAUTD:$O(^DG(40.8,I)),1:$O(VAUTD(I))) Q:'I D
|
|---|
| 48 | ..S J=$P($G(^DG(40.8,I,0)),U) F K=1:1:4 S IB(J,$P(IBC,U,K))=0
|
|---|
| 49 | S IBDIV="ALL" F I=1:1:4 S IB("ALL",$P(IBC,U,I))=0
|
|---|
| 50 | ;
|
|---|
| 51 | INP ; - Find inpatients treated within the user-specified date range.
|
|---|
| 52 | S IBD=IBBDT-.01 F S IBD=$O(^DGPM("ATT3",IBD)) Q:'IBD!(IBD\1>IBEDT) D Q:IBQ
|
|---|
| 53 | .S IBPM=0 F S IBPM=$O(^DGPM("ATT3",IBD,IBPM)) Q:'IBPM D Q:IBQ
|
|---|
| 54 | ..I IBPM#100=0 S IBQ=$$STOP^IBOUTL("No Employer Listing") Q:IBQ
|
|---|
| 55 | ..S IBPMD=$G(^DGPM(IBPM,0)) Q:'IBPMD S DFN=+$P(IBPMD,U,3) Q:'DFN
|
|---|
| 56 | ..I IBSORT S IBDIV=$$DIV^IBJDI21(1,+$P(IBPMD,U,6)) Q:'$D(IB(IBDIV))
|
|---|
| 57 | ..;
|
|---|
| 58 | ..; - Process patient.
|
|---|
| 59 | ..I '$D(^TMP("IBJDI31",$J,DFN)) D PROC(DFN,"*",.IBQUERY)
|
|---|
| 60 | ;
|
|---|
| 61 | D CLOSE^IBSDU(.IBQUERY) I IBQ G ENQ
|
|---|
| 62 | ;
|
|---|
| 63 | ; - Find outpatients treated within the user-specified date range.
|
|---|
| 64 | D OUTPT^IBJDI21("",IBBDT,IBEDT,"S:IBQ SDSTOP=1 I 'IBQ,$$ENCHK^IBJDI5(Y0) D ENC^IBJDI3(Y0,.IBQUERY1)","No Employer Listing",.IBQ,"IBJDI31",.IBQUERY)
|
|---|
| 65 | D CLOSE^IBSDU(.IBQUERY),CLOSE^IBSDU(.IBQUERY1) I IBQ G ENQ
|
|---|
| 66 | ;
|
|---|
| 67 | ; - Extract summary data.
|
|---|
| 68 | I $G(IBXTRACT) D G ENQ
|
|---|
| 69 | .F X="DEC","NO","OK","TOT" S IB(X)=$G(IB("ALL",X))
|
|---|
| 70 | .D E^IBJDE(3,0)
|
|---|
| 71 | ;
|
|---|
| 72 | ; - Print the reports.
|
|---|
| 73 | S (IBQ,IBPAG)=0 D NOW^%DTC S IBRUN=$$DAT2^IBOUTL(%)
|
|---|
| 74 | S IBDIV="" F S IBDIV=$O(IB(IBDIV)) Q:IBDIV="" D Q:IBQ
|
|---|
| 75 | . D:IBRPT="D" DET I 'IBQ D SUM,PAUSE
|
|---|
| 76 | ;
|
|---|
| 77 | ENQ K ^TMP("IBJDI31",$J),^TMP("IBJDI32",$J)
|
|---|
| 78 | I $D(ZTQUEUED) S ZTREQ="@" G ENQ1
|
|---|
| 79 | ;
|
|---|
| 80 | D ^%ZISC
|
|---|
| 81 | ENQ1 K IB,IBQ,IBBDT,IBEDT,IBRPT,IBC,IBD,IBDN,IBPAG,IBRUN,IBX,IBPER,IBEMP
|
|---|
| 82 | K IBDIV,IBDOD,IBSORT,IBLT,IBDT,IBES,IBDTF,IBPAT,IBXX,IBOE,IBOED,IBPM,IBPMD
|
|---|
| 83 | K VAUTD,DFN,POP,I,J,K,X,X1,X2,Y,%,%ZIS,ZTDESC,ZTRTN,ZTSAVE
|
|---|
| 84 | K DIR,DIROUT,DTOUT,DUOUT,DIRUT
|
|---|
| 85 | Q
|
|---|
| 86 | ;
|
|---|
| 87 | ENC(IBOED,IBQUERY1) ; - Encounter extract.
|
|---|
| 88 | ; IBQUERY1 = the # of the QUERY to use to do the extract.
|
|---|
| 89 | ; Pre-set variables IB array, IBSORT also required.
|
|---|
| 90 | ;
|
|---|
| 91 | S DFN=+$P(IBOED,U,2) I 'DFN Q
|
|---|
| 92 | I IBSORT S IBDIV=$$DIV^IBJDI21(0,+$P(IBOED,U,11)) Q:'$D(IB(IBDIV))
|
|---|
| 93 | D PROC(DFN,"",.IBQUERY1) ; Process patient.
|
|---|
| 94 | Q
|
|---|
| 95 | ;
|
|---|
| 96 | PROC(DFN,IBIPC,IBQUERY) ; - Process each specific patient.
|
|---|
| 97 | ; Input: DFN = Pointer to the patient in file #2
|
|---|
| 98 | ; IBIPC = Inpatient treatment marker
|
|---|
| 99 | ; ("*"=Had inpat. treatment, null=No inpat. treatment)
|
|---|
| 100 | ; IBQUERY = The # of the QUERY OBJECT to be used to extract
|
|---|
| 101 | ; outpatient visits. Be sure to close the query object
|
|---|
| 102 | ; when done
|
|---|
| 103 | ;
|
|---|
| 104 | ; Pre-set variables IB array, IBBDT, IBEDT, IBDIV, IBSORT are required.
|
|---|
| 105 | ;
|
|---|
| 106 | I $$TESTP^IBJDI1(DFN) Q ; Test patient.
|
|---|
| 107 | D ELIG^VADPT G:'VAEL(4) PRCQ ; Patient is not a vet.
|
|---|
| 108 | ;
|
|---|
| 109 | ; - Check if patient is deceased; get date of death.
|
|---|
| 110 | S IBDOD=$S(+$G(^DPT(DFN,.35)):^(.35)\1,1:"")
|
|---|
| 111 | I IBDOD S IB(IBDIV,"DEC")=IB(IBDIV,"DEC")+1
|
|---|
| 112 | ;
|
|---|
| 113 | ; - Set patient index and 'total patients' accumulator.
|
|---|
| 114 | S ^TMP("IBJDI31",$J,DFN)="",IB(IBDIV,"TOT")=IB(IBDIV,"TOT")+1
|
|---|
| 115 | ;
|
|---|
| 116 | S IBDN=$G(^DPT(DFN,0)),IBEMP=$G(^(.311)),IBES=$P(IBEMP,U,15)
|
|---|
| 117 | ;
|
|---|
| 118 | ; - Empl. status is null/unknown, employed (full/part), or retired
|
|---|
| 119 | ; AND no employer is specified.
|
|---|
| 120 | I $P(IBEMP,U)="",(IBES=""!("^1^2^5^9^"[("^"_IBES_"^"))) D G PRCQ
|
|---|
| 121 | .S IB(IBDIV,"NO")=IB(IBDIV,"NO")+1 I IBRPT="D" D SET(.IBQUERY)
|
|---|
| 122 | S IB(IBDIV,"OK")=IB(IBDIV,"OK")+1
|
|---|
| 123 | ;
|
|---|
| 124 | PRCQ K VA,VAERR,VAEL
|
|---|
| 125 | Q
|
|---|
| 126 | ;
|
|---|
| 127 | SET(IBQUERY) ; - Set up detailed information for pts to appear on the report.
|
|---|
| 128 | ; Input: IBQUERY = The # of the QUERY OBJECT to be used to extract
|
|---|
| 129 | ; outpatient visits
|
|---|
| 130 | ;
|
|---|
| 131 | ; Pre-set variable IBDIV is reqiured.
|
|---|
| 132 | ;
|
|---|
| 133 | ; - Find last treatment date (LTD).
|
|---|
| 134 | S (IBDT,IBLT)=0 F S IBDT=$O(^DGPM("ATID3",DFN,IBDT)) Q:+IBDT=0 D
|
|---|
| 135 | .S IBDTF=9999999.9999999-IBDT\1
|
|---|
| 136 | .S:IBDTF>IBLT IBLT=IBDTF Q:IBDTF<IBBDT!(IBDTF>IBEDT)
|
|---|
| 137 | ;
|
|---|
| 138 | ; - Look through outpatient encounters.
|
|---|
| 139 | D OUTPT^IBJDI21(DFN,IBBDT,IBEDT,"S IBOED=Y0,IBDT=+IBOED,IBDTF=IBDT\1 S:IBDTF>IBLT IBLT=IBDTF","","","",.IBQUERY)
|
|---|
| 140 | ;
|
|---|
| 141 | ; - If current inpatient, set LTD to today.
|
|---|
| 142 | I $G(^DPT(DFN,.105)) S IBLT=DT
|
|---|
| 143 | ;
|
|---|
| 144 | SETC S ^TMP("IBJDI32",$J,IBDIV,$P(IBDN,U)_IBIPC_"@@"_DFN)=$P(IBDN,U,9)_U_IBES_U_IBLT_U_IBDOD
|
|---|
| 145 | Q
|
|---|
| 146 | ;
|
|---|
| 147 | DIV(X) ; - Return division name.
|
|---|
| 148 | Q $P($G(^DG(40.8,X,0)),U)
|
|---|
| 149 | ;
|
|---|
| 150 | DET ; - Print the detailed report.
|
|---|
| 151 | D HDET Q:IBQ
|
|---|
| 152 | I '$D(^TMP("IBJDI32",$J,IBDIV)) W !!,"There were no patients treated in this date range missing an employer." G DETQ
|
|---|
| 153 | ;
|
|---|
| 154 | S IBXX="" F S IBXX=$O(^TMP("IBJDI32",$J,IBDIV,IBXX)) Q:IBXX="" S IBX=^(IBXX) D Q:IBQ
|
|---|
| 155 | .I $Y>(IOSL-4) D PAUSE Q:IBQ D HDET Q:IBQ
|
|---|
| 156 | .W !,$P(IBXX,"@@"),?34,$$SSN($P(IBX,U))
|
|---|
| 157 | .S X=$$EXPAND^IBJD(2,.31115,$P(IBX,U,2)) W ?50,$S(X="":"UNANSWERED",1:X)
|
|---|
| 158 | .W ?72,$$DAT2^IBOUTL($P(IBX,U,3)),?90,$$DAT2^IBOUTL($P(IBX,U,4))
|
|---|
| 159 | ;
|
|---|
| 160 | DETQ I 'IBQ D PAUSE
|
|---|
| 161 | Q
|
|---|
| 162 | ;
|
|---|
| 163 | HDET ; - Write the detail report header.
|
|---|
| 164 | I $E(IOST,1,2)="C-"!(IBPAG) W @IOF,*13
|
|---|
| 165 | S IBPAG=IBPAG+1
|
|---|
| 166 | W "No Employer Listing",$S(IBDIV'="ALL":" for "_IBDIV,1:""),?80,"Run Date: ",IBRUN,?123,"Page: ",IBPAG
|
|---|
| 167 | W !,"Patients without an employer treated in the period ",$$DAT1^IBOUTL(IBBDT)," to ",$$DAT1^IBOUTL(IBEDT)," ('*' = Had inpatient care)"
|
|---|
| 168 | W !,"Patient",?34,"SSN",?50,"Employment Status",?72,"Last Trmt Date",?90,"Date of Death"
|
|---|
| 169 | W !,$$DASH(132),!
|
|---|
| 170 | S IBQ=$$STOP^IBOUTL("No Employer Listing")
|
|---|
| 171 | Q
|
|---|
| 172 | ;
|
|---|
| 173 | SUM ; - Print the summary report.
|
|---|
| 174 | I $E(IOST,1,2)="C-"!(IBPAG) W @IOF,*13
|
|---|
| 175 | S IBPAG=IBPAG+1
|
|---|
| 176 | W !!?30,"NO EMPLOYER LISTING",?71,"Page: ",IBPAG,!
|
|---|
| 177 | I IBDIV'="ALL" W ?(61-$L(IBDIV))\2,"SUMMARY REPORT for ",IBDIV
|
|---|
| 178 | E W ?33,"SUMMARY REPORT"
|
|---|
| 179 | W !!?19,"Patients treated from ",$$DAT1^IBOUTL(IBBDT)," - ",$$DAT1^IBOUTL(IBEDT)
|
|---|
| 180 | W !!?24,"Run Date: ",IBRUN,!?17,$$DASH(45),!!
|
|---|
| 181 | ;
|
|---|
| 182 | S IBPER=$J($S('IB(IBDIV,"TOT"):0,1:IB(IBDIV,"NO")/IB(IBDIV,"TOT")*100),0,2)
|
|---|
| 183 | W ?24,"Number of Patients Treated:",?53,$J(IB(IBDIV,"TOT"),5)
|
|---|
| 184 | W !?23,"Number of Deceased Patients:",?53,$J(IB(IBDIV,"DEC"),5),?62,"(",$J($S('IB(IBDIV,"DEC"):0,1:IB(IBDIV,"DEC")/IB(IBDIV,"TOT")*100),0,2),"%)"
|
|---|
| 185 | W !?3,"Number of Patients Employed without an Employer:",?53,$J(IB(IBDIV,"NO"),5),$S(IB(IBDIV,"NO"):"*",1:""),?62,"(",IBPER,"%)"
|
|---|
| 186 | W !," Number of Patients Unemployed or with an Employer:",?53,$J(IB(IBDIV,"OK"),5),?62,"(",$J($S('IBPER:0,1:100-IBPER),0,2),"%)"
|
|---|
| 187 | I IB(IBDIV,"NO") D
|
|---|
| 188 | .W !!!!!?2,"*This is the total number of veterans who have no employer on file, but"
|
|---|
| 189 | .W !,?3,"have an employment status of Full-Time, Part-Time, Retired, Unknown or",!?3,"null."
|
|---|
| 190 | Q
|
|---|
| 191 | ;
|
|---|
| 192 | DASH(X) ; - Return a dashed line.
|
|---|
| 193 | Q $TR($J("",X)," ","=")
|
|---|
| 194 | ;
|
|---|
| 195 | PAUSE ; - Page break.
|
|---|
| 196 | I $E(IOST,1,2)'="C-" Q
|
|---|
| 197 | N IBX,DIR,DIRUT,DUOUT,DTOUT,DIROUT,X,Y
|
|---|
| 198 | F IBX=$Y:1:(IOSL-3) W !
|
|---|
| 199 | S DIR(0)="E" D ^DIR I $D(DIRUT)!($D(DUOUT)) S IBQ=1
|
|---|
| 200 | Q
|
|---|
| 201 | ;
|
|---|
| 202 | SSN(X) ; - Format the SSN.
|
|---|
| 203 | Q $S(X]"":$E(X,1,3)_"-"_$E(X,4,5)_"-"_$E(X,6,10),1:"")
|
|---|
| 204 | ;
|
|---|
| 205 | DHLP ; - 'Sort by division' prompt.
|
|---|
| 206 | W !!,"Select: '<CR>' to print the trend report without regard to"
|
|---|
| 207 | W !?15,"division"
|
|---|
| 208 | W !?11,"'Y' to select those divisions for which a separate"
|
|---|
| 209 | W !?15,"trend report should be created",!?11,"'^' to quit"
|
|---|
| 210 | Q
|
|---|
