| 1 | ACKQR5 ;HCIOFO/BH -Statistics by EC Code ; [ 10/10/00 9:52 AM ]
|
---|
| 2 | ;;3.0;QUASAR;**1**;Feb 11, 2000
|
---|
| 3 | ;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
|
---|
| 4 | ;
|
---|
| 5 | OPTN W @IOF,!,"This option produces a report listing clinic visits for a date range"
|
---|
| 6 | W !,"sorted by Event Capture procedure codes.",!
|
---|
| 7 | ;
|
---|
| 8 | S ACKDIV=$$DIV^ACKQUTL2(3,.ACKDIV,"AI") G:+ACKDIV=0 EXIT
|
---|
| 9 | ; Date's
|
---|
| 10 | D DTRANGE^ACKQRU G:$D(DIRUT) EXIT
|
---|
| 11 | S ACKRDR="Visits from "_ACKXBD_" to "_ACKXED
|
---|
| 12 | ;
|
---|
| 13 | ; Type of report: Returns-
|
---|
| 14 | ; ACKASB="A","S","O" or a combination, ACKSS=1-6 (1=one clinician etc)
|
---|
| 15 | ; ACKSTF(x) selected staff members
|
---|
| 16 | D PARAMS^ACKQRU G:$D(DIRUT) EXIT
|
---|
| 17 | ;
|
---|
| 18 | DEV W !!,"The right margin for this report is 80."
|
---|
| 19 | W !,"You can queue it to run at a later time.",!
|
---|
| 20 | K %ZIS,IOP S %ZIS="QM",%ZIS("B")="" D ^%ZIS
|
---|
| 21 | I POP W !,"NO DEVICE SELECTED OR REPORT PRINTED." G EXIT
|
---|
| 22 | ; Queue selected
|
---|
| 23 | I $D(IO("Q")) D G EXIT
|
---|
| 24 | . K IO("Q")
|
---|
| 25 | . S ZTRTN="DQ^ACKQR5",ZTDESC="QUASAR - A&SP EC PROCEDURE STATISTICS"
|
---|
| 26 | . S ZTSAVE("ACK*")="" D ^%ZTLOAD D HOME^%ZIS K ZTSK
|
---|
| 27 | ;
|
---|
| 28 | DQ ; Queued entry point
|
---|
| 29 | ; Vars required are:-
|
---|
| 30 | ; ACKDIV() - selected divs, ACKBD,ACKXBD - beginning of date range (internal,external)
|
---|
| 31 | ; ACKED,ACKXED - end of date range (internal, external)
|
---|
| 32 | ; ACKASB - A=audio,S=speech,O=other,ASO=all three
|
---|
| 33 | ; ACKSS - type of report (1=one clinician etc), ACKSTF(x) - selected providers
|
---|
| 34 | U IO
|
---|
| 35 | D NOW^%DTC S ACKCDT=$$NUMDT^ACKQUTL(%)_" at "_$$FTIME^ACKQUTL(%),ACKPG=0
|
---|
| 36 | K ^TMP("ACKQR5",$J),ACKT,ACKT2 S ACKT2=0
|
---|
| 37 | ; $O thru visit file using the date index
|
---|
| 38 | F ACKD=ACKBD:0 S ACKD=$O(^ACK(509850.6,"B",ACKD)) Q:'ACKD!(ACKD>ACKED) D
|
---|
| 39 | . S ACKV=0 F S ACKV=$O(^ACK(509850.6,"B",ACKD,ACKV)) Q:'ACKV D STORE
|
---|
| 40 | D PRINT
|
---|
| 41 | ;
|
---|
| 42 | EXIT ; Only way out
|
---|
| 43 | K ACK2,ACKASB,ACKBD,ACKC,ACKCDT,ACKCL,ACKCLI,ACKCLN,ACKCLNC,ACKEC
|
---|
| 44 | K ACKSORT,ACKD,ACKED,ACKHDR2,ACKI,ACKLINE,ACKLR,ACKOOP,ACKP,ACKPC
|
---|
| 45 | K ACKPCP,ACKPG,ACKRDR,ACKSS,ACKSTAFF,ACKSTF,ACKT,ACKV,ACKVSC,ACKXBD
|
---|
| 46 | K ACKXED,ACKT2,ACKCT,ACKVDIV,ACKOK,ACKHDR,ACKDIV,ACKHDR5,ACKSORT
|
---|
| 47 | K ACKECN,ACKVOL,ACKTXT,ACKQUIT,ZTSAVE,ZTSK,^TMP("ACKQR5",$J)
|
---|
| 48 | K %DT,%I,%ZIS,%T,DIRUT,DTOUT,DUOUT,I,JJ,SS,X,Y,ZTDESC,ZTIO,ZTRTN
|
---|
| 49 | W:$E(IOST)="C" @IOF D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
|
---|
| 50 | Q
|
---|
| 51 | STORE ;
|
---|
| 52 | S ACKHDR=^ACK(509850.6,ACKV,0),ACKHDR5=^ACK(509850.6,ACKV,5)
|
---|
| 53 | ; Get div & make sure it was selected
|
---|
| 54 | S ACKVDIV=$P(ACKHDR5,U,1)
|
---|
| 55 | I '$D(ACKDIV(ACKVDIV)) Q
|
---|
| 56 | ;
|
---|
| 57 | S ACKCLNC=+$P(ACKHDR,U,6) ; clinic IEN
|
---|
| 58 | Q:'ACKCLNC
|
---|
| 59 | S ACK2=$G(^ACK(509850.6,ACKV,2))
|
---|
| 60 | S ACKVSC=$P(ACK2,U) ; clinic stp code
|
---|
| 61 | ; Determine sort order for visit stp code (will return zero if
|
---|
| 62 | ; the visit is not to be included in the report)
|
---|
| 63 | S ACKSORT=$$STOPSORT^ACKQRU(ACKASB,ACKVSC) Q:'ACKSORT
|
---|
| 64 | ;
|
---|
| 65 | ; Check staff member selected for report
|
---|
| 66 | I (ACKSS=3)!(ACKSS=6) S ACKLR=$P(ACK2,U,4) Q:ACKLR="" Q:'$D(ACKSTF(ACKLR))
|
---|
| 67 | ;
|
---|
| 68 | ; Count the EC proc codes for visit
|
---|
| 69 | S ACKP=0 F S ACKP=$O(^ACK(509850.6,ACKV,7,ACKP)) Q:'ACKP D
|
---|
| 70 | . S ACKECN=$$GET1^DIQ(509850.615,ACKP_","_ACKV_",",.01,"I","","")
|
---|
| 71 | . S ACKVOL=$$GET1^DIQ(509850.615,ACKP_","_ACKV_",",.03,"I","","")
|
---|
| 72 | . S:ACKVOL<1 ACKVOL=1
|
---|
| 73 | . S ACKQUIT=0
|
---|
| 74 | . I ACKSS'=3,ACKSS'=6 D Q:ACKQUIT
|
---|
| 75 | . . S ACKLR=$$GET1^DIQ(509850.615,ACKP_","_ACKV_",",.05,"I","","")
|
---|
| 76 | . . I ACKLR="" S ACKLR=$$LEADROLE^ACKQUTL2(ACKV)
|
---|
| 77 | . . I ACKLR="" S ACKQUIT=1
|
---|
| 78 | . . I '$D(ACKSTF(ACKLR)) S ACKQUIT=1
|
---|
| 79 | . ;
|
---|
| 80 | . I '$D(^TMP("ACKQR5",$J,"EC",1,725,ACKECN_",")) D GETEC(ACKECN)
|
---|
| 81 | . S ACKEC=^TMP("ACKQR5",$J,"EC",1,725,ACKECN_",",1)
|
---|
| 82 | . I ACKEC="" Q
|
---|
| 83 | . ; Add to cnt of procs for stff member
|
---|
| 84 | . S ACKCT=+$G(^TMP("ACKQR5",$J,1,ACKVDIV,ACKSORT,ACKCLNC,ACKLR,ACKEC))
|
---|
| 85 | . S ^TMP("ACKQR5",$J,1,ACKVDIV,ACKSORT,ACKCLNC,ACKLR,ACKEC)=ACKCT+ACKVOL
|
---|
| 86 | . ; Add to cnt of EC procs for the stp code within div
|
---|
| 87 | . S ^TMP("ACKQR5",$J,0,ACKVDIV,ACKSORT,ACKEC)=$G(^TMP("ACKQR5",$J,0,ACKVDIV,ACKSORT,ACKEC))+ACKVOL
|
---|
| 88 | . ; Add to cnt of ec procs for all divs
|
---|
| 89 | . S ^TMP("ACKQR5",$J,2,ACKSORT,ACKEC)=$G(^TMP("ACKQR5",$J,2,ACKSORT,ACKEC))+ACKVOL
|
---|
| 90 | . ; Add to total cnt for the stp code, the div & grand total
|
---|
| 91 | . S ACKT(ACKVDIV,ACKSORT)=$G(ACKT(ACKVDIV,ACKSORT))+ACKVOL
|
---|
| 92 | . S ACKT(ACKVDIV)=$G(ACKT(ACKVDIV))+ACKVOL
|
---|
| 93 | . S ACKT2(ACKSORT)=$G(ACKT2(ACKSORT))+ACKVOL,ACKT2=ACKT2+ACKVOL
|
---|
| 94 | Q
|
---|
| 95 | GETEC(ACKECN) ; Get EC Proc code data and put in ^TMP
|
---|
| 96 | N ACKTMP,ACKEC S ACKTMP=$NA(^TMP("ACKQR5",$J,"EC",1))
|
---|
| 97 | D GETS^DIQ(725,ACKECN_",",".01;1","",ACKTMP,"ACKMSG")
|
---|
| 98 | S ACKEC=^TMP("ACKQR5",$J,"EC",1,725,ACKECN_",",1)
|
---|
| 99 | S ^TMP("ACKQR5",$J,"EC",2,ACKEC)=ACKECN
|
---|
| 100 | Q
|
---|
| 101 | ECDESC(ACKEC) ; Get ec Proc desc (short name)
|
---|
| 102 | N ACKECN S ACKECN=^TMP("ACKQR5",$J,"EC",2,ACKEC)
|
---|
| 103 | Q ^TMP("ACKQR5",$J,"EC",1,725,ACKECN_",",.01)
|
---|
| 104 | ;
|
---|
| 105 | PRINT ; print report for each div
|
---|
| 106 | S ACKVDIV=""
|
---|
| 107 | I '$D(^TMP("ACKQR5",$J,1)) D Q
|
---|
| 108 | . D HDR
|
---|
| 109 | . W !!,"No data found for report specifications.",!!
|
---|
| 110 | . D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT)
|
---|
| 111 | F S ACKVDIV=$O(ACKDIV(ACKVDIV)) Q:ACKVDIV=""!($D(DIRUT)) D PRINT2 Q:$D(DIRUT)
|
---|
| 112 | I '$D(DIRUT) D TOTALS
|
---|
| 113 | Q
|
---|
| 114 | ;
|
---|
| 115 | PRINT2 ; print for a single div
|
---|
| 116 | I '$D(^TMP("ACKQR5",$J,1,ACKVDIV)) D Q
|
---|
| 117 | . D HDR
|
---|
| 118 | . W !!,"No data found for report specifications.",!!
|
---|
| 119 | . D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT)
|
---|
| 120 | D HDR
|
---|
| 121 | S ACKSORT=""
|
---|
| 122 | F S ACKSORT=$O(^TMP("ACKQR5",$J,1,ACKVDIV,ACKSORT)) Q:(ACKSORT="")!($D(DIRUT)) D
|
---|
| 123 | .I $Y>(IOSL-9) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D HDR
|
---|
| 124 | .W !!,"STOP CODE: ",$$STOPNM^ACKQRU(ACKSORT)
|
---|
| 125 | .S ACKCLN="" F S ACKCLN=$O(^TMP("ACKQR5",$J,1,ACKVDIV,ACKSORT,ACKCLN)) Q:ACKCLN=""!($D(DIRUT)) D
|
---|
| 126 | ..I $Y>(IOSL-7) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D HDR
|
---|
| 127 | ..W !!?2,"CLINIC: ",$$GET1^DIQ(44,ACKCLN_",",.01)
|
---|
| 128 | ..S ACKSTF=""
|
---|
| 129 | ..F S ACKSTF=$O(^TMP("ACKQR5",$J,1,ACKVDIV,ACKSORT,ACKCLN,ACKSTF)) Q:ACKSTF=""!($D(DIRUT)) D
|
---|
| 130 | ...I $Y>(IOSL-5) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D HDR
|
---|
| 131 | ...W !!?2,$S("1^4"[ACKSS:"CLINICIAN: ","2^5"[ACKSS:"OTHER PROVIDER: ",1:"STUDENT: ")
|
---|
| 132 | ...W $$CONVERT^ACKQUTL4(ACKSTF)
|
---|
| 133 | ...S ACKEC=""
|
---|
| 134 | ...F S ACKEC=$O(^TMP("ACKQR5",$J,1,ACKVDIV,ACKSORT,ACKCLN,ACKSTF,ACKEC)) Q:(ACKEC="")!($D(DIRUT)) D
|
---|
| 135 | ....I $Y>(IOSL-3) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D HDR
|
---|
| 136 | ....W !?5,ACKEC,?15,$$ECDESC(ACKEC),?55,"COUNT: "
|
---|
| 137 | ....W $J(^TMP("ACKQR5",$J,1,ACKVDIV,ACKSORT,ACKCLN,ACKSTF,ACKEC),4)
|
---|
| 138 | Q:$D(DIRUT) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT)
|
---|
| 139 | SUMM ;
|
---|
| 140 | Q:'$D(^TMP("ACKQR5",$J,0)) D SUMHD
|
---|
| 141 | S ACKSORT=""
|
---|
| 142 | F S ACKSORT=$O(^TMP("ACKQR5",$J,0,ACKVDIV,ACKSORT)) Q:ACKSORT=""!($D(DIRUT)) D
|
---|
| 143 | .I $Y>(IOSL-5) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D SUMHD
|
---|
| 144 | .W !!,"STOP CODE: ",$$STOPNM^ACKQRU(ACKSORT)
|
---|
| 145 | .S ACKEC=""
|
---|
| 146 | .F S ACKEC=$O(^TMP("ACKQR5",$J,0,ACKVDIV,ACKSORT,ACKEC)) Q:(ACKEC="")!($D(DIRUT)) D
|
---|
| 147 | ..I $Y>(IOSL-3) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D SUMHD
|
---|
| 148 | ..W !?5,ACKEC,?15,$$ECDESC(ACKEC),?55,"COUNT: "
|
---|
| 149 | ..W $J(^TMP("ACKQR5",$J,0,ACKVDIV,ACKSORT,ACKEC),4)
|
---|
| 150 | .Q:$D(DIRUT) I $Y>(IOSL-4) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D SUMHD
|
---|
| 151 | .Q:$D(DIRUT)
|
---|
| 152 | .W !!,"Total For ",$$STOPNM^ACKQRU(ACKSORT)
|
---|
| 153 | .W ?62,$J(ACKT(ACKVDIV,ACKSORT),4)
|
---|
| 154 | Q:$D(DIRUT) I $Y>(IOSL-4) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D SUMHD
|
---|
| 155 | Q:$D(DIRUT) W !!,"Total For Division: "_$$DIVNAME(ACKVDIV),?62,$J(ACKT(ACKVDIV),4)
|
---|
| 156 | Q:$D(DIRUT) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT)
|
---|
| 157 | Q
|
---|
| 158 | ;
|
---|
| 159 | TOTALS ; Print final page of totals for all divs
|
---|
| 160 | Q:'$D(^TMP("ACKQR5",$J,2))
|
---|
| 161 | Q:$D(DIRUT)
|
---|
| 162 | I $O(ACKT(""))=$O(ACKT(""),-1) Q ; Must be only one div
|
---|
| 163 | D TOTLHD S ACKTXT="DIVISIONS: "
|
---|
| 164 | S ACKVDIV="" F S ACKVDIV=$O(ACKT(ACKVDIV)) Q:ACKVDIV="" D Q:$D(DIRUT)
|
---|
| 165 | . I $Y>(IOSL-3) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D TOTLHD
|
---|
| 166 | . W !,ACKTXT,?12,$$DIVNAME(ACKVDIV) S ACKTXT=""
|
---|
| 167 | S ACKSORT=""
|
---|
| 168 | F S ACKSORT=$O(^TMP("ACKQR5",$J,2,ACKSORT)) Q:ACKSORT=""!($D(DIRUT)) D
|
---|
| 169 | . I $Y>(IOSL-5) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D TOTLHD
|
---|
| 170 | . W !!,"STOP CODE: ",$$STOPNM^ACKQRU(ACKSORT)
|
---|
| 171 | . S ACKEC=""
|
---|
| 172 | . F S ACKEC=$O(^TMP("ACKQR5",$J,2,ACKSORT,ACKEC)) Q:(ACKEC="")!($D(DIRUT)) D
|
---|
| 173 | . . I $Y>(IOSL-3) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D TOTLHD
|
---|
| 174 | . . W !?5,ACKEC,?15,$$ECDESC(ACKEC),?55,"COUNT: "
|
---|
| 175 | . . W $J(^TMP("ACKQR5",$J,2,ACKSORT,ACKEC),4)
|
---|
| 176 | . I $Y>(IOSL-4) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D TOTLHD
|
---|
| 177 | . Q:$D(DIRUT)
|
---|
| 178 | . W !!,"Total For ",$$STOPNM^ACKQRU(ACKSORT)
|
---|
| 179 | . W ?62,$J(ACKT2(ACKSORT),4)
|
---|
| 180 | Q:$D(DIRUT) I $Y>(IOSL-4) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D TOTLHD
|
---|
| 181 | Q:$D(DIRUT) W !!,"Grand Total:",?62,$J(ACKT2,4)
|
---|
| 182 | Q:$D(DIRUT) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT)
|
---|
| 183 | Q
|
---|
| 184 | HDR ;
|
---|
| 185 | W:($E(IOST)="C")!(ACKPG>0) @IOF
|
---|
| 186 | S ACKPG=ACKPG+1
|
---|
| 187 | W "Printed: ",ACKCDT,?(IOM-8),"Page: ",ACKPG,!
|
---|
| 188 | W ! D CNTR^ACKQUTL("Audiology & Speech Pathology")
|
---|
| 189 | W ! D CNTR^ACKQUTL("EC Procedure Statistics")
|
---|
| 190 | W ! D CNTR^ACKQUTL("for")
|
---|
| 191 | I ACKSS<4 S X=$$STAFFNM($O(ACKSTF(0))) W ! D CNTR^ACKQUTL(X)
|
---|
| 192 | I ACKSS=4 W ! D CNTR^ACKQUTL("All Clinicians")
|
---|
| 193 | I ACKSS=5 W ! D CNTR^ACKQUTL("All Other Providers")
|
---|
| 194 | I ACKSS=6 W ! D CNTR^ACKQUTL("All Students")
|
---|
| 195 | W ! D CNTR^ACKQUTL("Covering "_ACKRDR)
|
---|
| 196 | I ACKVDIV]"" W ! D CNTR^ACKQUTL("For Division: "_$$DIVNAME(ACKVDIV))
|
---|
| 197 | S X="",$P(X,"-",IOM)="-" W !,X
|
---|
| 198 | Q
|
---|
| 199 | SUMHD ;
|
---|
| 200 | W:($E(IOST)="C")!(ACKPG>0) @IOF
|
---|
| 201 | S ACKPG=ACKPG+1
|
---|
| 202 | W "Printed: ",ACKCDT,?(IOM-8),"Page: ",ACKPG,!
|
---|
| 203 | W ! D CNTR^ACKQUTL("Audiology & Speech Pathology")
|
---|
| 204 | W ! D CNTR^ACKQUTL("EC Procedure Statistics")
|
---|
| 205 | W ! D CNTR^ACKQUTL("For Division: "_$$DIVNAME(ACKVDIV))
|
---|
| 206 | W ! D CNTR^ACKQUTL("Summary")
|
---|
| 207 | S X="",$P(X,"-",IOM)="-" W !,X
|
---|
| 208 | Q
|
---|
| 209 | TOTLHD ;
|
---|
| 210 | W:($E(IOST)="C")!(ACKPG>0) @IOF
|
---|
| 211 | S ACKPG=ACKPG+1
|
---|
| 212 | W "Printed: ",ACKCDT,?(IOM-8),"Page: ",ACKPG,!
|
---|
| 213 | W ! D CNTR^ACKQUTL("Audiology and Speech Pathology")
|
---|
| 214 | W ! D CNTR^ACKQUTL("EC Procedure Statistics")
|
---|
| 215 | W ! D CNTR^ACKQUTL("Summary")
|
---|
| 216 | S X="",$P(X,"-",IOM)="-" W !,X
|
---|
| 217 | Q
|
---|
| 218 | ;
|
---|
| 219 | DIVNAME(ACKVDIV) ; Get div name
|
---|
| 220 | Q $$GET1^DIQ(40.8,ACKVDIV_",",.01)
|
---|
| 221 | ;
|
---|
| 222 | STAFFNM(ACKSTF) ; Get staff name
|
---|
| 223 | Q $$MIXC^ACKQUTL($$CONVERT^ACKQUTL4(ACKSTF))
|
---|