ACKQR5 ;HCIOFO/BH -Statistics by EC Code ; [ 10/10/00 9:52 AM ]
;;3.0;QUASAR;**1**;Feb 11, 2000
;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
;
OPTN W @IOF,!,"This option produces a report listing clinic visits for a date range"
W !,"sorted by Event Capture procedure codes.",!
;
S ACKDIV=$$DIV^ACKQUTL2(3,.ACKDIV,"AI") G:+ACKDIV=0 EXIT
; Date's
D DTRANGE^ACKQRU G:$D(DIRUT) EXIT
S ACKRDR="Visits from "_ACKXBD_" to "_ACKXED
;
; Type of report: Returns-
; ACKASB="A","S","O" or a combination, ACKSS=1-6 (1=one clinician etc)
; ACKSTF(x) selected staff members
D PARAMS^ACKQRU G:$D(DIRUT) EXIT
;
DEV W !!,"The right margin for this report is 80."
W !,"You can queue it to run at a later time.",!
K %ZIS,IOP S %ZIS="QM",%ZIS("B")="" D ^%ZIS
I POP W !,"NO DEVICE SELECTED OR REPORT PRINTED." G EXIT
; Queue selected
I $D(IO("Q")) D G EXIT
. K IO("Q")
. S ZTRTN="DQ^ACKQR5",ZTDESC="QUASAR - A&SP EC PROCEDURE STATISTICS"
. S ZTSAVE("ACK*")="" D ^%ZTLOAD D HOME^%ZIS K ZTSK
;
DQ ; Queued entry point
; Vars required are:-
; ACKDIV() - selected divs, ACKBD,ACKXBD - beginning of date range (internal,external)
; ACKED,ACKXED - end of date range (internal, external)
; ACKASB - A=audio,S=speech,O=other,ASO=all three
; ACKSS - type of report (1=one clinician etc), ACKSTF(x) - selected providers
U IO
D NOW^%DTC S ACKCDT=$$NUMDT^ACKQUTL(%)_" at "_$$FTIME^ACKQUTL(%),ACKPG=0
K ^TMP("ACKQR5",$J),ACKT,ACKT2 S ACKT2=0
; $O thru visit file using the date index
F ACKD=ACKBD:0 S ACKD=$O(^ACK(509850.6,"B",ACKD)) Q:'ACKD!(ACKD>ACKED) D
. S ACKV=0 F S ACKV=$O(^ACK(509850.6,"B",ACKD,ACKV)) Q:'ACKV D STORE
D PRINT
;
EXIT ; Only way out
K ACK2,ACKASB,ACKBD,ACKC,ACKCDT,ACKCL,ACKCLI,ACKCLN,ACKCLNC,ACKEC
K ACKSORT,ACKD,ACKED,ACKHDR2,ACKI,ACKLINE,ACKLR,ACKOOP,ACKP,ACKPC
K ACKPCP,ACKPG,ACKRDR,ACKSS,ACKSTAFF,ACKSTF,ACKT,ACKV,ACKVSC,ACKXBD
K ACKXED,ACKT2,ACKCT,ACKVDIV,ACKOK,ACKHDR,ACKDIV,ACKHDR5,ACKSORT
K ACKECN,ACKVOL,ACKTXT,ACKQUIT,ZTSAVE,ZTSK,^TMP("ACKQR5",$J)
K %DT,%I,%ZIS,%T,DIRUT,DTOUT,DUOUT,I,JJ,SS,X,Y,ZTDESC,ZTIO,ZTRTN
W:$E(IOST)="C" @IOF D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
Q
STORE ;
S ACKHDR=^ACK(509850.6,ACKV,0),ACKHDR5=^ACK(509850.6,ACKV,5)
; Get div & make sure it was selected
S ACKVDIV=$P(ACKHDR5,U,1)
I '$D(ACKDIV(ACKVDIV)) Q
;
S ACKCLNC=+$P(ACKHDR,U,6) ; clinic IEN
Q:'ACKCLNC
S ACK2=$G(^ACK(509850.6,ACKV,2))
S ACKVSC=$P(ACK2,U) ; clinic stp code
; Determine sort order for visit stp code (will return zero if
; the visit is not to be included in the report)
S ACKSORT=$$STOPSORT^ACKQRU(ACKASB,ACKVSC) Q:'ACKSORT
;
; Check staff member selected for report
I (ACKSS=3)!(ACKSS=6) S ACKLR=$P(ACK2,U,4) Q:ACKLR="" Q:'$D(ACKSTF(ACKLR))
;
; Count the EC proc codes for visit
S ACKP=0 F S ACKP=$O(^ACK(509850.6,ACKV,7,ACKP)) Q:'ACKP D
. S ACKECN=$$GET1^DIQ(509850.615,ACKP_","_ACKV_",",.01,"I","","")
. S ACKVOL=$$GET1^DIQ(509850.615,ACKP_","_ACKV_",",.03,"I","","")
. S:ACKVOL<1 ACKVOL=1
. S ACKQUIT=0
. I ACKSS'=3,ACKSS'=6 D Q:ACKQUIT
. . S ACKLR=$$GET1^DIQ(509850.615,ACKP_","_ACKV_",",.05,"I","","")
. . I ACKLR="" S ACKLR=$$LEADROLE^ACKQUTL2(ACKV)
. . I ACKLR="" S ACKQUIT=1
. . I '$D(ACKSTF(ACKLR)) S ACKQUIT=1
. ;
. I '$D(^TMP("ACKQR5",$J,"EC",1,725,ACKECN_",")) D GETEC(ACKECN)
. S ACKEC=^TMP("ACKQR5",$J,"EC",1,725,ACKECN_",",1)
. I ACKEC="" Q
. ; Add to cnt of procs for stff member
. S ACKCT=+$G(^TMP("ACKQR5",$J,1,ACKVDIV,ACKSORT,ACKCLNC,ACKLR,ACKEC))
. S ^TMP("ACKQR5",$J,1,ACKVDIV,ACKSORT,ACKCLNC,ACKLR,ACKEC)=ACKCT+ACKVOL
. ; Add to cnt of EC procs for the stp code within div
. S ^TMP("ACKQR5",$J,0,ACKVDIV,ACKSORT,ACKEC)=$G(^TMP("ACKQR5",$J,0,ACKVDIV,ACKSORT,ACKEC))+ACKVOL
. ; Add to cnt of ec procs for all divs
. S ^TMP("ACKQR5",$J,2,ACKSORT,ACKEC)=$G(^TMP("ACKQR5",$J,2,ACKSORT,ACKEC))+ACKVOL
. ; Add to total cnt for the stp code, the div & grand total
. S ACKT(ACKVDIV,ACKSORT)=$G(ACKT(ACKVDIV,ACKSORT))+ACKVOL
. S ACKT(ACKVDIV)=$G(ACKT(ACKVDIV))+ACKVOL
. S ACKT2(ACKSORT)=$G(ACKT2(ACKSORT))+ACKVOL,ACKT2=ACKT2+ACKVOL
Q
GETEC(ACKECN) ; Get EC Proc code data and put in ^TMP
N ACKTMP,ACKEC S ACKTMP=$NA(^TMP("ACKQR5",$J,"EC",1))
D GETS^DIQ(725,ACKECN_",",".01;1","",ACKTMP,"ACKMSG")
S ACKEC=^TMP("ACKQR5",$J,"EC",1,725,ACKECN_",",1)
S ^TMP("ACKQR5",$J,"EC",2,ACKEC)=ACKECN
Q
ECDESC(ACKEC) ; Get ec Proc desc (short name)
N ACKECN S ACKECN=^TMP("ACKQR5",$J,"EC",2,ACKEC)
Q ^TMP("ACKQR5",$J,"EC",1,725,ACKECN_",",.01)
;
PRINT ; print report for each div
S ACKVDIV=""
I '$D(^TMP("ACKQR5",$J,1)) D Q
. D HDR
. W !!,"No data found for report specifications.",!!
. D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT)
F S ACKVDIV=$O(ACKDIV(ACKVDIV)) Q:ACKVDIV=""!($D(DIRUT)) D PRINT2 Q:$D(DIRUT)
I '$D(DIRUT) D TOTALS
Q
;
PRINT2 ; print for a single div
I '$D(^TMP("ACKQR5",$J,1,ACKVDIV)) D Q
. D HDR
. W !!,"No data found for report specifications.",!!
. D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT)
D HDR
S ACKSORT=""
F S ACKSORT=$O(^TMP("ACKQR5",$J,1,ACKVDIV,ACKSORT)) Q:(ACKSORT="")!($D(DIRUT)) D
.I $Y>(IOSL-9) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D HDR
.W !!,"STOP CODE: ",$$STOPNM^ACKQRU(ACKSORT)
.S ACKCLN="" F S ACKCLN=$O(^TMP("ACKQR5",$J,1,ACKVDIV,ACKSORT,ACKCLN)) Q:ACKCLN=""!($D(DIRUT)) D
..I $Y>(IOSL-7) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D HDR
..W !!?2,"CLINIC: ",$$GET1^DIQ(44,ACKCLN_",",.01)
..S ACKSTF=""
..F S ACKSTF=$O(^TMP("ACKQR5",$J,1,ACKVDIV,ACKSORT,ACKCLN,ACKSTF)) Q:ACKSTF=""!($D(DIRUT)) D
...I $Y>(IOSL-5) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D HDR
...W !!?2,$S("1^4"[ACKSS:"CLINICIAN: ","2^5"[ACKSS:"OTHER PROVIDER: ",1:"STUDENT: ")
...W $$CONVERT^ACKQUTL4(ACKSTF)
...S ACKEC=""
...F S ACKEC=$O(^TMP("ACKQR5",$J,1,ACKVDIV,ACKSORT,ACKCLN,ACKSTF,ACKEC)) Q:(ACKEC="")!($D(DIRUT)) D
....I $Y>(IOSL-3) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D HDR
....W !?5,ACKEC,?15,$$ECDESC(ACKEC),?55,"COUNT: "
....W $J(^TMP("ACKQR5",$J,1,ACKVDIV,ACKSORT,ACKCLN,ACKSTF,ACKEC),4)
Q:$D(DIRUT) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT)
SUMM ;
Q:'$D(^TMP("ACKQR5",$J,0)) D SUMHD
S ACKSORT=""
F S ACKSORT=$O(^TMP("ACKQR5",$J,0,ACKVDIV,ACKSORT)) Q:ACKSORT=""!($D(DIRUT)) D
.I $Y>(IOSL-5) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D SUMHD
.W !!,"STOP CODE: ",$$STOPNM^ACKQRU(ACKSORT)
.S ACKEC=""
.F S ACKEC=$O(^TMP("ACKQR5",$J,0,ACKVDIV,ACKSORT,ACKEC)) Q:(ACKEC="")!($D(DIRUT)) D
..I $Y>(IOSL-3) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D SUMHD
..W !?5,ACKEC,?15,$$ECDESC(ACKEC),?55,"COUNT: "
..W $J(^TMP("ACKQR5",$J,0,ACKVDIV,ACKSORT,ACKEC),4)
.Q:$D(DIRUT) I $Y>(IOSL-4) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D SUMHD
.Q:$D(DIRUT)
.W !!,"Total For ",$$STOPNM^ACKQRU(ACKSORT)
.W ?62,$J(ACKT(ACKVDIV,ACKSORT),4)
Q:$D(DIRUT) I $Y>(IOSL-4) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D SUMHD
Q:$D(DIRUT) W !!,"Total For Division: "_$$DIVNAME(ACKVDIV),?62,$J(ACKT(ACKVDIV),4)
Q:$D(DIRUT) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT)
Q
;
TOTALS ; Print final page of totals for all divs
Q:'$D(^TMP("ACKQR5",$J,2))
Q:$D(DIRUT)
I $O(ACKT(""))=$O(ACKT(""),-1) Q ; Must be only one div
D TOTLHD S ACKTXT="DIVISIONS: "
S ACKVDIV="" F S ACKVDIV=$O(ACKT(ACKVDIV)) Q:ACKVDIV="" D Q:$D(DIRUT)
. I $Y>(IOSL-3) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D TOTLHD
. W !,ACKTXT,?12,$$DIVNAME(ACKVDIV) S ACKTXT=""
S ACKSORT=""
F S ACKSORT=$O(^TMP("ACKQR5",$J,2,ACKSORT)) Q:ACKSORT=""!($D(DIRUT)) D
. I $Y>(IOSL-5) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D TOTLHD
. W !!,"STOP CODE: ",$$STOPNM^ACKQRU(ACKSORT)
. S ACKEC=""
. F S ACKEC=$O(^TMP("ACKQR5",$J,2,ACKSORT,ACKEC)) Q:(ACKEC="")!($D(DIRUT)) D
. . I $Y>(IOSL-3) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D TOTLHD
. . W !?5,ACKEC,?15,$$ECDESC(ACKEC),?55,"COUNT: "
. . W $J(^TMP("ACKQR5",$J,2,ACKSORT,ACKEC),4)
. I $Y>(IOSL-4) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D TOTLHD
. Q:$D(DIRUT)
. W !!,"Total For ",$$STOPNM^ACKQRU(ACKSORT)
. W ?62,$J(ACKT2(ACKSORT),4)
Q:$D(DIRUT) I $Y>(IOSL-4) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D TOTLHD
Q:$D(DIRUT) W !!,"Grand Total:",?62,$J(ACKT2,4)
Q:$D(DIRUT) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT)
Q
HDR ;
W:($E(IOST)="C")!(ACKPG>0) @IOF
S ACKPG=ACKPG+1
W "Printed: ",ACKCDT,?(IOM-8),"Page: ",ACKPG,!
W ! D CNTR^ACKQUTL("Audiology & Speech Pathology")
W ! D CNTR^ACKQUTL("EC Procedure Statistics")
W ! D CNTR^ACKQUTL("for")
I ACKSS<4 S X=$$STAFFNM($O(ACKSTF(0))) W ! D CNTR^ACKQUTL(X)
I ACKSS=4 W ! D CNTR^ACKQUTL("All Clinicians")
I ACKSS=5 W ! D CNTR^ACKQUTL("All Other Providers")
I ACKSS=6 W ! D CNTR^ACKQUTL("All Students")
W ! D CNTR^ACKQUTL("Covering "_ACKRDR)
I ACKVDIV]"" W ! D CNTR^ACKQUTL("For Division: "_$$DIVNAME(ACKVDIV))
S X="",$P(X,"-",IOM)="-" W !,X
Q
SUMHD ;
W:($E(IOST)="C")!(ACKPG>0) @IOF
S ACKPG=ACKPG+1
W "Printed: ",ACKCDT,?(IOM-8),"Page: ",ACKPG,!
W ! D CNTR^ACKQUTL("Audiology & Speech Pathology")
W ! D CNTR^ACKQUTL("EC Procedure Statistics")
W ! D CNTR^ACKQUTL("For Division: "_$$DIVNAME(ACKVDIV))
W ! D CNTR^ACKQUTL("Summary")
S X="",$P(X,"-",IOM)="-" W !,X
Q
TOTLHD ;
W:($E(IOST)="C")!(ACKPG>0) @IOF
S ACKPG=ACKPG+1
W "Printed: ",ACKCDT,?(IOM-8),"Page: ",ACKPG,!
W ! D CNTR^ACKQUTL("Audiology and Speech Pathology")
W ! D CNTR^ACKQUTL("EC Procedure Statistics")
W ! D CNTR^ACKQUTL("Summary")
S X="",$P(X,"-",IOM)="-" W !,X
Q
;
DIVNAME(ACKVDIV) ; Get div name
Q $$GET1^DIQ(40.8,ACKVDIV_",",.01)
;
STAFFNM(ACKSTF) ; Get staff name
Q $$MIXC^ACKQUTL($$CONVERT^ACKQUTL4(ACKSTF))
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HACKQR5 9696 printed Apr 09, 2024@21:35:38 Page 2
ACKQR5 ;HCIOFO/BH -Statistics by EC Code ; [ 10/10/00 9:52 AM ]
+1 ;;3.0;QUASAR;**1**;Feb 11, 2000
+2 ;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
+3 ;
OPTN WRITE @IOF,!,"This option produces a report listing clinic visits for a date range"
+1 WRITE !,"sorted by Event Capture procedure codes.",!
+2 ;
+3 SET ACKDIV=$$DIV^ACKQUTL2(3,.ACKDIV,"AI")
if +ACKDIV=0
GOTO EXIT
+4 ; Date's
+5 DO DTRANGE^ACKQRU
if $DATA(DIRUT)
GOTO EXIT
+6 SET ACKRDR="Visits from "_ACKXBD_" to "_ACKXED
+7 ;
+8 ; Type of report: Returns-
+9 ; ACKASB="A","S","O" or a combination, ACKSS=1-6 (1=one clinician etc)
+10 ; ACKSTF(x) selected staff members
+11 DO PARAMS^ACKQRU
if $DATA(DIRUT)
GOTO EXIT
+12 ;
DEV WRITE !!,"The right margin for this report is 80."
+1 WRITE !,"You can queue it to run at a later time.",!
+2 KILL %ZIS,IOP
SET %ZIS="QM"
SET %ZIS("B")=""
DO ^%ZIS
+3 IF POP
WRITE !,"NO DEVICE SELECTED OR REPORT PRINTED."
GOTO EXIT
+4 ; Queue selected
+5 IF $DATA(IO("Q"))
Begin DoDot:1
+6 KILL IO("Q")
+7 SET ZTRTN="DQ^ACKQR5"
SET ZTDESC="QUASAR - A&SP EC PROCEDURE STATISTICS"
+8 SET ZTSAVE("ACK*")=""
DO ^%ZTLOAD
DO HOME^%ZIS
KILL ZTSK
End DoDot:1
GOTO EXIT
+9 ;
DQ ; Queued entry point
+1 ; Vars required are:-
+2 ; ACKDIV() - selected divs, ACKBD,ACKXBD - beginning of date range (internal,external)
+3 ; ACKED,ACKXED - end of date range (internal, external)
+4 ; ACKASB - A=audio,S=speech,O=other,ASO=all three
+5 ; ACKSS - type of report (1=one clinician etc), ACKSTF(x) - selected providers
+6 USE IO
+7 DO NOW^%DTC
SET ACKCDT=$$NUMDT^ACKQUTL(%)_" at "_$$FTIME^ACKQUTL(%)
SET ACKPG=0
+8 KILL ^TMP("ACKQR5",$JOB),ACKT,ACKT2
SET ACKT2=0
+9 ; $O thru visit file using the date index
+10 FOR ACKD=ACKBD:0
SET ACKD=$ORDER(^ACK(509850.6,"B",ACKD))
if 'ACKD!(ACKD>ACKED)
QUIT
Begin DoDot:1
+11 SET ACKV=0
FOR
SET ACKV=$ORDER(^ACK(509850.6,"B",ACKD,ACKV))
if 'ACKV
QUIT
DO STORE
End DoDot:1
+12 DO PRINT
+13 ;
EXIT ; Only way out
+1 KILL ACK2,ACKASB,ACKBD,ACKC,ACKCDT,ACKCL,ACKCLI,ACKCLN,ACKCLNC,ACKEC
+2 KILL ACKSORT,ACKD,ACKED,ACKHDR2,ACKI,ACKLINE,ACKLR,ACKOOP,ACKP,ACKPC
+3 KILL ACKPCP,ACKPG,ACKRDR,ACKSS,ACKSTAFF,ACKSTF,ACKT,ACKV,ACKVSC,ACKXBD
+4 KILL ACKXED,ACKT2,ACKCT,ACKVDIV,ACKOK,ACKHDR,ACKDIV,ACKHDR5,ACKSORT
+5 KILL ACKECN,ACKVOL,ACKTXT,ACKQUIT,ZTSAVE,ZTSK,^TMP("ACKQR5",$JOB)
+6 KILL %DT,%I,%ZIS,%T,DIRUT,DTOUT,DUOUT,I,JJ,SS,X,Y,ZTDESC,ZTIO,ZTRTN
+7 if $EXTRACT(IOST)="C"
WRITE @IOF
DO ^%ZISC
if $DATA(ZTQUEUED)
SET ZTREQ="@"
+8 QUIT
STORE ;
+1 SET ACKHDR=^ACK(509850.6,ACKV,0)
SET ACKHDR5=^ACK(509850.6,ACKV,5)
+2 ; Get div & make sure it was selected
+3 SET ACKVDIV=$PIECE(ACKHDR5,U,1)
+4 IF '$DATA(ACKDIV(ACKVDIV))
QUIT
+5 ;
+6 ; clinic IEN
SET ACKCLNC=+$PIECE(ACKHDR,U,6)
+7 if 'ACKCLNC
QUIT
+8 SET ACK2=$GET(^ACK(509850.6,ACKV,2))
+9 ; clinic stp code
SET ACKVSC=$PIECE(ACK2,U)
+10 ; Determine sort order for visit stp code (will return zero if
+11 ; the visit is not to be included in the report)
+12 SET ACKSORT=$$STOPSORT^ACKQRU(ACKASB,ACKVSC)
if 'ACKSORT
QUIT
+13 ;
+14 ; Check staff member selected for report
+15 IF (ACKSS=3)!(ACKSS=6)
SET ACKLR=$PIECE(ACK2,U,4)
if ACKLR=""
QUIT
if '$DATA(ACKSTF(ACKLR))
QUIT
+16 ;
+17 ; Count the EC proc codes for visit
+18 SET ACKP=0
FOR
SET ACKP=$ORDER(^ACK(509850.6,ACKV,7,ACKP))
if 'ACKP
QUIT
Begin DoDot:1
+19 SET ACKECN=$$GET1^DIQ(509850.615,ACKP_","_ACKV_",",.01,"I","","")
+20 SET ACKVOL=$$GET1^DIQ(509850.615,ACKP_","_ACKV_",",.03,"I","","")
+21 if ACKVOL<1
SET ACKVOL=1
+22 SET ACKQUIT=0
+23 IF ACKSS'=3
IF ACKSS'=6
Begin DoDot:2
+24 SET ACKLR=$$GET1^DIQ(509850.615,ACKP_","_ACKV_",",.05,"I","","")
+25 IF ACKLR=""
SET ACKLR=$$LEADROLE^ACKQUTL2(ACKV)
+26 IF ACKLR=""
SET ACKQUIT=1
+27 IF '$DATA(ACKSTF(ACKLR))
SET ACKQUIT=1
End DoDot:2
if ACKQUIT
QUIT
+28 ;
+29 IF '$DATA(^TMP("ACKQR5",$JOB,"EC",1,725,ACKECN_","))
DO GETEC(ACKECN)
+30 SET ACKEC=^TMP("ACKQR5",$JOB,"EC",1,725,ACKECN_",",1)
+31 IF ACKEC=""
QUIT
+32 ; Add to cnt of procs for stff member
+33 SET ACKCT=+$GET(^TMP("ACKQR5",$JOB,1,ACKVDIV,ACKSORT,ACKCLNC,ACKLR,ACKEC))
+34 SET ^TMP("ACKQR5",$JOB,1,ACKVDIV,ACKSORT,ACKCLNC,ACKLR,ACKEC)=ACKCT+ACKVOL
+35 ; Add to cnt of EC procs for the stp code within div
+36 SET ^TMP("ACKQR5",$JOB,0,ACKVDIV,ACKSORT,ACKEC)=$GET(^TMP("ACKQR5",$JOB,0,ACKVDIV,ACKSORT,ACKEC))+ACKVOL
+37 ; Add to cnt of ec procs for all divs
+38 SET ^TMP("ACKQR5",$JOB,2,ACKSORT,ACKEC)=$GET(^TMP("ACKQR5",$JOB,2,ACKSORT,ACKEC))+ACKVOL
+39 ; Add to total cnt for the stp code, the div & grand total
+40 SET ACKT(ACKVDIV,ACKSORT)=$GET(ACKT(ACKVDIV,ACKSORT))+ACKVOL
+41 SET ACKT(ACKVDIV)=$GET(ACKT(ACKVDIV))+ACKVOL
+42 SET ACKT2(ACKSORT)=$GET(ACKT2(ACKSORT))+ACKVOL
SET ACKT2=ACKT2+ACKVOL
End DoDot:1
+43 QUIT
GETEC(ACKECN) ; Get EC Proc code data and put in ^TMP
+1 NEW ACKTMP,ACKEC
SET ACKTMP=$NAME(^TMP("ACKQR5",$JOB,"EC",1))
+2 DO GETS^DIQ(725,ACKECN_",",".01;1","",ACKTMP,"ACKMSG")
+3 SET ACKEC=^TMP("ACKQR5",$JOB,"EC",1,725,ACKECN_",",1)
+4 SET ^TMP("ACKQR5",$JOB,"EC",2,ACKEC)=ACKECN
+5 QUIT
ECDESC(ACKEC) ; Get ec Proc desc (short name)
+1 NEW ACKECN
SET ACKECN=^TMP("ACKQR5",$JOB,"EC",2,ACKEC)
+2 QUIT ^TMP("ACKQR5",$JOB,"EC",1,725,ACKECN_",",.01)
+3 ;
PRINT ; print report for each div
+1 SET ACKVDIV=""
+2 IF '$DATA(^TMP("ACKQR5",$JOB,1))
Begin DoDot:1
+3 DO HDR
+4 WRITE !!,"No data found for report specifications.",!!
+5 if $EXTRACT(IOST)="C"
DO PAUSE^ACKQUTL
if $DATA(DIRUT)
QUIT
End DoDot:1
QUIT
+6 FOR
SET ACKVDIV=$ORDER(ACKDIV(ACKVDIV))
if ACKVDIV=""!($DATA(DIRUT))
QUIT
DO PRINT2
if $DATA(DIRUT)
QUIT
+7 IF '$DATA(DIRUT)
DO TOTALS
+8 QUIT
+9 ;
PRINT2 ; print for a single div
+1 IF '$DATA(^TMP("ACKQR5",$JOB,1,ACKVDIV))
Begin DoDot:1
+2 DO HDR
+3 WRITE !!,"No data found for report specifications.",!!
+4 if $EXTRACT(IOST)="C"
DO PAUSE^ACKQUTL
if $DATA(DIRUT)
QUIT
End DoDot:1
QUIT
+5 DO HDR
+6 SET ACKSORT=""
+7 FOR
SET ACKSORT=$ORDER(^TMP("ACKQR5",$JOB,1,ACKVDIV,ACKSORT))
if (ACKSORT="")!($DATA(DIRUT))
QUIT
Begin DoDot:1
+8 IF $Y>(IOSL-9)
if $EXTRACT(IOST)="C"
DO PAUSE^ACKQUTL
if $DATA(DIRUT)
QUIT
DO HDR
+9 WRITE !!,"STOP CODE: ",$$STOPNM^ACKQRU(ACKSORT)
+10 SET ACKCLN=""
FOR
SET ACKCLN=$ORDER(^TMP("ACKQR5",$JOB,1,ACKVDIV,ACKSORT,ACKCLN))
if ACKCLN=""!($DATA(DIRUT))
QUIT
Begin DoDot:2
+11 IF $Y>(IOSL-7)
if $EXTRACT(IOST)="C"
DO PAUSE^ACKQUTL
if $DATA(DIRUT)
QUIT
DO HDR
+12 WRITE !!?2,"CLINIC: ",$$GET1^DIQ(44,ACKCLN_",",.01)
+13 SET ACKSTF=""
+14 FOR
SET ACKSTF=$ORDER(^TMP("ACKQR5",$JOB,1,ACKVDIV,ACKSORT,ACKCLN,ACKSTF))
if ACKSTF=""!($DATA(DIRUT))
QUIT
Begin DoDot:3
+15 IF $Y>(IOSL-5)
if $EXTRACT(IOST)="C"
DO PAUSE^ACKQUTL
if $DATA(DIRUT)
QUIT
DO HDR
+16 WRITE !!?2,$SELECT("1^4"[ACKSS:"CLINICIAN: ","2^5"[ACKSS:"OTHER PROVIDER: ",1:"STUDENT: ")
+17 WRITE $$CONVERT^ACKQUTL4(ACKSTF)
+18 SET ACKEC=""
+19 FOR
SET ACKEC=$ORDER(^TMP("ACKQR5",$JOB,1,ACKVDIV,ACKSORT,ACKCLN,ACKSTF,ACKEC))
if (ACKEC="")!($DATA(DIRUT))
QUIT
Begin DoDot:4
+20 IF $Y>(IOSL-3)
if $EXTRACT(IOST)="C"
DO PAUSE^ACKQUTL
if $DATA(DIRUT)
QUIT
DO HDR
+21 WRITE !?5,ACKEC,?15,$$ECDESC(ACKEC),?55,"COUNT: "
+22 WRITE $JUSTIFY(^TMP("ACKQR5",$JOB,1,ACKVDIV,ACKSORT,ACKCLN,ACKSTF,ACKEC),4)
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+23 if $DATA(DIRUT)
QUIT
if $EXTRACT(IOST)="C"
DO PAUSE^ACKQUTL
if $DATA(DIRUT)
QUIT
SUMM ;
+1 if '$DATA(^TMP("ACKQR5",$JOB,0))
QUIT
DO SUMHD
+2 SET ACKSORT=""
+3 FOR
SET ACKSORT=$ORDER(^TMP("ACKQR5",$JOB,0,ACKVDIV,ACKSORT))
if ACKSORT=""!($DATA(DIRUT))
QUIT
Begin DoDot:1
+4 IF $Y>(IOSL-5)
if $EXTRACT(IOST)="C"
DO PAUSE^ACKQUTL
if $DATA(DIRUT)
QUIT
DO SUMHD
+5 WRITE !!,"STOP CODE: ",$$STOPNM^ACKQRU(ACKSORT)
+6 SET ACKEC=""
+7 FOR
SET ACKEC=$ORDER(^TMP("ACKQR5",$JOB,0,ACKVDIV,ACKSORT,ACKEC))
if (ACKEC="")!($DATA(DIRUT))
QUIT
Begin DoDot:2
+8 IF $Y>(IOSL-3)
if $EXTRACT(IOST)="C"
DO PAUSE^ACKQUTL
if $DATA(DIRUT)
QUIT
DO SUMHD
+9 WRITE !?5,ACKEC,?15,$$ECDESC(ACKEC),?55,"COUNT: "
+10 WRITE $JUSTIFY(^TMP("ACKQR5",$JOB,0,ACKVDIV,ACKSORT,ACKEC),4)
End DoDot:2
+11 if $DATA(DIRUT)
QUIT
IF $Y>(IOSL-4)
if $EXTRACT(IOST)="C"
DO PAUSE^ACKQUTL
if $DATA(DIRUT)
QUIT
DO SUMHD
+12 if $DATA(DIRUT)
QUIT
+13 WRITE !!,"Total For ",$$STOPNM^ACKQRU(ACKSORT)
+14 WRITE ?62,$JUSTIFY(ACKT(ACKVDIV,ACKSORT),4)
End DoDot:1
+15 if $DATA(DIRUT)
QUIT
IF $Y>(IOSL-4)
if $EXTRACT(IOST)="C"
DO PAUSE^ACKQUTL
if $DATA(DIRUT)
QUIT
DO SUMHD
+16 if $DATA(DIRUT)
QUIT
WRITE !!,"Total For Division: "_$$DIVNAME(ACKVDIV),?62,$JUSTIFY(ACKT(ACKVDIV),4)
+17 if $DATA(DIRUT)
QUIT
if $EXTRACT(IOST)="C"
DO PAUSE^ACKQUTL
if $DATA(DIRUT)
QUIT
+18 QUIT
+19 ;
TOTALS ; Print final page of totals for all divs
+1 if '$DATA(^TMP("ACKQR5",$JOB,2))
QUIT
+2 if $DATA(DIRUT)
QUIT
+3 ; Must be only one div
IF $ORDER(ACKT(""))=$ORDER(ACKT(""),-1)
QUIT
+4 DO TOTLHD
SET ACKTXT="DIVISIONS: "
+5 SET ACKVDIV=""
FOR
SET ACKVDIV=$ORDER(ACKT(ACKVDIV))
if ACKVDIV=""
QUIT
Begin DoDot:1
+6 IF $Y>(IOSL-3)
if $EXTRACT(IOST)="C"
DO PAUSE^ACKQUTL
if $DATA(DIRUT)
QUIT
DO TOTLHD
+7 WRITE !,ACKTXT,?12,$$DIVNAME(ACKVDIV)
SET ACKTXT=""
End DoDot:1
if $DATA(DIRUT)
QUIT
+8 SET ACKSORT=""
+9 FOR
SET ACKSORT=$ORDER(^TMP("ACKQR5",$JOB,2,ACKSORT))
if ACKSORT=""!($DATA(DIRUT))
QUIT
Begin DoDot:1
+10 IF $Y>(IOSL-5)
if $EXTRACT(IOST)="C"
DO PAUSE^ACKQUTL
if $DATA(DIRUT)
QUIT
DO TOTLHD
+11 WRITE !!,"STOP CODE: ",$$STOPNM^ACKQRU(ACKSORT)
+12 SET ACKEC=""
+13 FOR
SET ACKEC=$ORDER(^TMP("ACKQR5",$JOB,2,ACKSORT,ACKEC))
if (ACKEC="")!($DATA(DIRUT))
QUIT
Begin DoDot:2
+14 IF $Y>(IOSL-3)
if $EXTRACT(IOST)="C"
DO PAUSE^ACKQUTL
if $DATA(DIRUT)
QUIT
DO TOTLHD
+15 WRITE !?5,ACKEC,?15,$$ECDESC(ACKEC),?55,"COUNT: "
+16 WRITE $JUSTIFY(^TMP("ACKQR5",$JOB,2,ACKSORT,ACKEC),4)
End DoDot:2
+17 IF $Y>(IOSL-4)
if $EXTRACT(IOST)="C"
DO PAUSE^ACKQUTL
if $DATA(DIRUT)
QUIT
DO TOTLHD
+18 if $DATA(DIRUT)
QUIT
+19 WRITE !!,"Total For ",$$STOPNM^ACKQRU(ACKSORT)
+20 WRITE ?62,$JUSTIFY(ACKT2(ACKSORT),4)
End DoDot:1
+21 if $DATA(DIRUT)
QUIT
IF $Y>(IOSL-4)
if $EXTRACT(IOST)="C"
DO PAUSE^ACKQUTL
if $DATA(DIRUT)
QUIT
DO TOTLHD
+22 if $DATA(DIRUT)
QUIT
WRITE !!,"Grand Total:",?62,$JUSTIFY(ACKT2,4)
+23 if $DATA(DIRUT)
QUIT
if $EXTRACT(IOST)="C"
DO PAUSE^ACKQUTL
if $DATA(DIRUT)
QUIT
+24 QUIT
HDR ;
+1 if ($EXTRACT(IOST)="C")!(ACKPG>0)
WRITE @IOF
+2 SET ACKPG=ACKPG+1
+3 WRITE "Printed: ",ACKCDT,?(IOM-8),"Page: ",ACKPG,!
+4 WRITE !
DO CNTR^ACKQUTL("Audiology & Speech Pathology")
+5 WRITE !
DO CNTR^ACKQUTL("EC Procedure Statistics")
+6 WRITE !
DO CNTR^ACKQUTL("for")
+7 IF ACKSS<4
SET X=$$STAFFNM($ORDER(ACKSTF(0)))
WRITE !
DO CNTR^ACKQUTL(X)
+8 IF ACKSS=4
WRITE !
DO CNTR^ACKQUTL("All Clinicians")
+9 IF ACKSS=5
WRITE !
DO CNTR^ACKQUTL("All Other Providers")
+10 IF ACKSS=6
WRITE !
DO CNTR^ACKQUTL("All Students")
+11 WRITE !
DO CNTR^ACKQUTL("Covering "_ACKRDR)
+12 IF ACKVDIV]""
WRITE !
DO CNTR^ACKQUTL("For Division: "_$$DIVNAME(ACKVDIV))
+13 SET X=""
SET $PIECE(X,"-",IOM)="-"
WRITE !,X
+14 QUIT
SUMHD ;
+1 if ($EXTRACT(IOST)="C")!(ACKPG>0)
WRITE @IOF
+2 SET ACKPG=ACKPG+1
+3 WRITE "Printed: ",ACKCDT,?(IOM-8),"Page: ",ACKPG,!
+4 WRITE !
DO CNTR^ACKQUTL("Audiology & Speech Pathology")
+5 WRITE !
DO CNTR^ACKQUTL("EC Procedure Statistics")
+6 WRITE !
DO CNTR^ACKQUTL("For Division: "_$$DIVNAME(ACKVDIV))
+7 WRITE !
DO CNTR^ACKQUTL("Summary")
+8 SET X=""
SET $PIECE(X,"-",IOM)="-"
WRITE !,X
+9 QUIT
TOTLHD ;
+1 if ($EXTRACT(IOST)="C")!(ACKPG>0)
WRITE @IOF
+2 SET ACKPG=ACKPG+1
+3 WRITE "Printed: ",ACKCDT,?(IOM-8),"Page: ",ACKPG,!
+4 WRITE !
DO CNTR^ACKQUTL("Audiology and Speech Pathology")
+5 WRITE !
DO CNTR^ACKQUTL("EC Procedure Statistics")
+6 WRITE !
DO CNTR^ACKQUTL("Summary")
+7 SET X=""
SET $PIECE(X,"-",IOM)="-"
WRITE !,X
+8 QUIT
+9 ;
DIVNAME(ACKVDIV) ; Get div name
+1 QUIT $$GET1^DIQ(40.8,ACKVDIV_",",.01)
+2 ;
STAFFNM(ACKSTF) ; Get staff name
+1 QUIT $$MIXC^ACKQUTL($$CONVERT^ACKQUTL4(ACKSTF))
