ACKQR2 ;AUG/JLTP BIR/PTD HCIOFO/AG -Statistics by Procedure ; [ 12/07/95 9:52 AM ]
;;3.0;QUASAR;**1,8,22**;Feb 11, 2000;Build 5
;Per VHA Directive 2004-038, this routine SHOULD NOT be modified.
;
;
;
; Reference/ICR
; $$CPT^ICPTMOD - 1995
;
;
OPTN W @IOF,!,"This option produces a report listing clinic visits for a date range"
W !,"sorted by CPT-4 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 combo, 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^ACKQR2",ZTDESC="QUASAR - A&SP PROCEDURE STATISTICS"
. S ZTSAVE("ACK*")="" D ^%ZTLOAD D HOME^%ZIS K ZTSK
;
DQ ; Queued entry
; Vars required :-
; ACKDIV() - selected divs, ACKBD,ACKXBD - beginning date range (int,ext)
; ACKED,ACKXED - end date range (int, ext)
; ACKASB - A=audio,S=speech,O=other,ASO=all three
; ACKSS - type of report (1=one clinician etc), ACKSTF(x) - selected prvds
U IO
D NOW^%DTC S ACKCDT=$$NUMDT^ACKQUTL(%)_" at "_$$FTIME^ACKQUTL(%),ACKPG=0
K ^TMP("ACKQR2",$J),ACKT,ACKT2 S ACKT2=0
; $O thru visit file using 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 ; 1 way out
K ACK2,ACKASB,ACKBD,ACKC,ACKCDT,ACKCL,ACKCLI,ACKCLN,ACKCLNC,ACKCPT
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 ACKCPTN,ACKVOL,ACKTXT,ACKQUIT,ZTSAVE,ZTSK,^TMP("ACKQR2",$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 isnt to be included in report
S ACKSORT=$$STOPSORT^ACKQRU(ACKASB,ACKVSC) Q:'ACKSORT
;
; Check stff member for report
I (ACKSS=3)!(ACKSS=6) S ACKLR=$P(ACK2,U,4) Q:ACKLR="" Q:'$D(ACKSTF(ACKLR))
;
; Count the proc codes for visit
S ACKP=0 F S ACKP=$O(^ACK(509850.6,ACKV,3,ACKP)) Q:'ACKP D
. S ACKQQPN=$$GET1^DIQ(509850.61,ACKP_","_ACKV_",",.07,"I","","")
. I ACKQQPN'="" Q ; Has a Pointer to EC code therefore created by EC
. S ACKCPTN=$$GET1^DIQ(509850.61,ACKP_","_ACKV_",",.01,"I","","")
. S ACKVOL=$$GET1^DIQ(509850.61,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.61,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("ACKQR2",$J,"CPT",1,81,ACKCPTN_",")) D GETCPT(ACKCPTN)
. S ACKCPT=^TMP("ACKQR2",$J,"CPT",1,81,ACKCPTN_",",.01)
. I ACKCPT="" Q
. ; Add to cnt of procs for stff member
. S ACKCT=+$G(^TMP("ACKQR2",$J,1,ACKVDIV,ACKSORT,ACKCLNC,ACKLR,ACKCPT))
. S ^TMP("ACKQR2",$J,1,ACKVDIV,ACKSORT,ACKCLNC,ACKLR,ACKCPT)=ACKCT+ACKVOL
. ; Add to cnt of procs for the stp code within div
. S ^TMP("ACKQR2",$J,0,ACKVDIV,ACKSORT,ACKCPT)=$G(^TMP("ACKQR2",$J,0,ACKVDIV,ACKSORT,ACKCPT))+ACKVOL
. ; Add to cnt of procs for all divs
. S ^TMP("ACKQR2",$J,2,ACKSORT,ACKCPT)=$G(^TMP("ACKQR2",$J,2,ACKSORT,ACKCPT))+ACKVOL
. ; Add to tot cnt for the stp code, the div & grand tot
. 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
GETCPT(ACKCPTN) ; Get Proc code data & put in ^TMP
N ACKCPT
;ACKQ*3.0*22 updated api
S ^TMP("ACKQR2",$J,"CPT",1,81,ACKCPTN_",",.01)=$P($$CPT^ICPTCOD(ACKCPTN),U,2)
S ACKCPT=^TMP("ACKQR2",$J,"CPT",1,81,ACKCPTN_",",.01)
S ^TMP("ACKQR2",$J,"CPT",1,81,ACKCPTN_",",2)=$$PROCTXT^ACKQUTL8(ACKCPTN,"")
S ^TMP("ACKQR2",$J,"CPT",2,ACKCPT)=ACKCPTN
Q
CPTDESC(ACKCPT) ; Get Proc desc
N ACKCPTN S ACKCPTN=^TMP("ACKQR2",$J,"CPT",2,ACKCPT)
Q ^TMP("ACKQR2",$J,"CPT",1,81,ACKCPTN_",",2)
;
PRINT ; print report 4 each div
S ACKVDIV=""
I '$D(^TMP("ACKQR2",$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 single div
I '$D(^TMP("ACKQR2",$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("ACKQR2",$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("ACKQR2",$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("ACKQR2",$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 ACKCPT=""
...F S ACKCPT=$O(^TMP("ACKQR2",$J,1,ACKVDIV,ACKSORT,ACKCLN,ACKSTF,ACKCPT)) Q:(ACKCPT="")!($D(DIRUT)) D
....I $Y>(IOSL-3) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D HDR
....W !?5,ACKCPT,?15,$$CPTDESC(ACKCPT),?55,"COUNT: "
....W $J(^TMP("ACKQR2",$J,1,ACKVDIV,ACKSORT,ACKCLN,ACKSTF,ACKCPT),4)
Q:$D(DIRUT) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT)
SUMM ;
Q:'$D(^TMP("ACKQR2",$J,0)) D SUMHD
S ACKSORT=""
F S ACKSORT=$O(^TMP("ACKQR2",$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 ACKCPT=""
.F S ACKCPT=$O(^TMP("ACKQR2",$J,0,ACKVDIV,ACKSORT,ACKCPT)) Q:(ACKCPT="")!($D(DIRUT)) D
..I $Y>(IOSL-3) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D SUMHD
..W !?5,ACKCPT,?15,$$CPTDESC(ACKCPT),?55,"COUNT: "
..W $J(^TMP("ACKQR2",$J,0,ACKVDIV,ACKSORT,ACKCPT),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 tots 4 all divs
Q:'$D(^TMP("ACKQR2",$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("ACKQR2",$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 ACKCPT=""
. F S ACKCPT=$O(^TMP("ACKQR2",$J,2,ACKSORT,ACKCPT)) Q:(ACKCPT="")!($D(DIRUT)) D
. . I $Y>(IOSL-3) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D TOTLHD
. . W !?5,ACKCPT,?15,$$CPTDESC(ACKCPT),?55,"COUNT: "
. . W $J(^TMP("ACKQR2",$J,2,ACKSORT,ACKCPT),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("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("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("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[HACKQR2 9923 printed Apr 09, 2024@21:34:43 Page 2
ACKQR2 ;AUG/JLTP BIR/PTD HCIOFO/AG -Statistics by Procedure ; [ 12/07/95 9:52 AM ]
+1 ;;3.0;QUASAR;**1,8,22**;Feb 11, 2000;Build 5
+2 ;Per VHA Directive 2004-038, this routine SHOULD NOT be modified.
+3 ;
+4 ;
+5 ;
+6 ; Reference/ICR
+7 ; $$CPT^ICPTMOD - 1995
+8 ;
+9 ;
OPTN WRITE @IOF,!,"This option produces a report listing clinic visits for a date range"
+1 WRITE !,"sorted by CPT-4 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 combo, 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^ACKQR2"
SET ZTDESC="QUASAR - A&SP PROCEDURE STATISTICS"
+8 SET ZTSAVE("ACK*")=""
DO ^%ZTLOAD
DO HOME^%ZIS
KILL ZTSK
End DoDot:1
GOTO EXIT
+9 ;
DQ ; Queued entry
+1 ; Vars required :-
+2 ; ACKDIV() - selected divs, ACKBD,ACKXBD - beginning date range (int,ext)
+3 ; ACKED,ACKXED - end date range (int, ext)
+4 ; ACKASB - A=audio,S=speech,O=other,ASO=all three
+5 ; ACKSS - type of report (1=one clinician etc), ACKSTF(x) - selected prvds
+6 USE IO
+7 DO NOW^%DTC
SET ACKCDT=$$NUMDT^ACKQUTL(%)_" at "_$$FTIME^ACKQUTL(%)
SET ACKPG=0
+8 KILL ^TMP("ACKQR2",$JOB),ACKT,ACKT2
SET ACKT2=0
+9 ; $O thru visit file using 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 ; 1 way out
+1 KILL ACK2,ACKASB,ACKBD,ACKC,ACKCDT,ACKCL,ACKCLI,ACKCLN,ACKCLNC,ACKCPT
+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 ACKCPTN,ACKVOL,ACKTXT,ACKQUIT,ZTSAVE,ZTSK,^TMP("ACKQR2",$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 isnt to be included in report
+12 SET ACKSORT=$$STOPSORT^ACKQRU(ACKASB,ACKVSC)
if 'ACKSORT
QUIT
+13 ;
+14 ; Check stff member 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 proc codes for visit
+18 SET ACKP=0
FOR
SET ACKP=$ORDER(^ACK(509850.6,ACKV,3,ACKP))
if 'ACKP
QUIT
Begin DoDot:1
+19 SET ACKQQPN=$$GET1^DIQ(509850.61,ACKP_","_ACKV_",",.07,"I","","")
+20 ; Has a Pointer to EC code therefore created by EC
IF ACKQQPN'=""
QUIT
+21 SET ACKCPTN=$$GET1^DIQ(509850.61,ACKP_","_ACKV_",",.01,"I","","")
+22 SET ACKVOL=$$GET1^DIQ(509850.61,ACKP_","_ACKV_",",.03,"I","","")
+23 if ACKVOL<1
SET ACKVOL=1
+24 SET ACKQUIT=0
+25 IF ACKSS'=3
IF ACKSS'=6
Begin DoDot:2
+26 SET ACKLR=$$GET1^DIQ(509850.61,ACKP_","_ACKV_",",.05,"I","","")
+27 IF ACKLR=""
SET ACKLR=$$LEADROLE^ACKQUTL2(ACKV)
+28 IF ACKLR=""
SET ACKQUIT=1
+29 IF '$DATA(ACKSTF(ACKLR))
SET ACKQUIT=1
End DoDot:2
if ACKQUIT
QUIT
+30 ;
+31 IF '$DATA(^TMP("ACKQR2",$JOB,"CPT",1,81,ACKCPTN_","))
DO GETCPT(ACKCPTN)
+32 SET ACKCPT=^TMP("ACKQR2",$JOB,"CPT",1,81,ACKCPTN_",",.01)
+33 IF ACKCPT=""
QUIT
+34 ; Add to cnt of procs for stff member
+35 SET ACKCT=+$GET(^TMP("ACKQR2",$JOB,1,ACKVDIV,ACKSORT,ACKCLNC,ACKLR,ACKCPT))
+36 SET ^TMP("ACKQR2",$JOB,1,ACKVDIV,ACKSORT,ACKCLNC,ACKLR,ACKCPT)=ACKCT+ACKVOL
+37 ; Add to cnt of procs for the stp code within div
+38 SET ^TMP("ACKQR2",$JOB,0,ACKVDIV,ACKSORT,ACKCPT)=$GET(^TMP("ACKQR2",$JOB,0,ACKVDIV,ACKSORT,ACKCPT))+ACKVOL
+39 ; Add to cnt of procs for all divs
+40 SET ^TMP("ACKQR2",$JOB,2,ACKSORT,ACKCPT)=$GET(^TMP("ACKQR2",$JOB,2,ACKSORT,ACKCPT))+ACKVOL
+41 ; Add to tot cnt for the stp code, the div & grand tot
+42 SET ACKT(ACKVDIV,ACKSORT)=$GET(ACKT(ACKVDIV,ACKSORT))+ACKVOL
+43 SET ACKT(ACKVDIV)=$GET(ACKT(ACKVDIV))+ACKVOL
+44 SET ACKT2(ACKSORT)=$GET(ACKT2(ACKSORT))+ACKVOL
SET ACKT2=ACKT2+ACKVOL
End DoDot:1
+45 QUIT
GETCPT(ACKCPTN) ; Get Proc code data & put in ^TMP
+1 NEW ACKCPT
+2 ;ACKQ*3.0*22 updated api
+3 SET ^TMP("ACKQR2",$JOB,"CPT",1,81,ACKCPTN_",",.01)=$PIECE($$CPT^ICPTCOD(ACKCPTN),U,2)
+4 SET ACKCPT=^TMP("ACKQR2",$JOB,"CPT",1,81,ACKCPTN_",",.01)
+5 SET ^TMP("ACKQR2",$JOB,"CPT",1,81,ACKCPTN_",",2)=$$PROCTXT^ACKQUTL8(ACKCPTN,"")
+6 SET ^TMP("ACKQR2",$JOB,"CPT",2,ACKCPT)=ACKCPTN
+7 QUIT
CPTDESC(ACKCPT) ; Get Proc desc
+1 NEW ACKCPTN
SET ACKCPTN=^TMP("ACKQR2",$JOB,"CPT",2,ACKCPT)
+2 QUIT ^TMP("ACKQR2",$JOB,"CPT",1,81,ACKCPTN_",",2)
+3 ;
PRINT ; print report 4 each div
+1 SET ACKVDIV=""
+2 IF '$DATA(^TMP("ACKQR2",$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 single div
+1 IF '$DATA(^TMP("ACKQR2",$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("ACKQR2",$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("ACKQR2",$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("ACKQR2",$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 ACKCPT=""
+19 FOR
SET ACKCPT=$ORDER(^TMP("ACKQR2",$JOB,1,ACKVDIV,ACKSORT,ACKCLN,ACKSTF,ACKCPT))
if (ACKCPT="")!($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,ACKCPT,?15,$$CPTDESC(ACKCPT),?55,"COUNT: "
+22 WRITE $JUSTIFY(^TMP("ACKQR2",$JOB,1,ACKVDIV,ACKSORT,ACKCLN,ACKSTF,ACKCPT),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("ACKQR2",$JOB,0))
QUIT
DO SUMHD
+2 SET ACKSORT=""
+3 FOR
SET ACKSORT=$ORDER(^TMP("ACKQR2",$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 ACKCPT=""
+7 FOR
SET ACKCPT=$ORDER(^TMP("ACKQR2",$JOB,0,ACKVDIV,ACKSORT,ACKCPT))
if (ACKCPT="")!($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,ACKCPT,?15,$$CPTDESC(ACKCPT),?55,"COUNT: "
+10 WRITE $JUSTIFY(^TMP("ACKQR2",$JOB,0,ACKVDIV,ACKSORT,ACKCPT),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 tots 4 all divs
+1 if '$DATA(^TMP("ACKQR2",$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("ACKQR2",$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 ACKCPT=""
+13 FOR
SET ACKCPT=$ORDER(^TMP("ACKQR2",$JOB,2,ACKSORT,ACKCPT))
if (ACKCPT="")!($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,ACKCPT,?15,$$CPTDESC(ACKCPT),?55,"COUNT: "
+16 WRITE $JUSTIFY(^TMP("ACKQR2",$JOB,2,ACKSORT,ACKCPT),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("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("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
+10 ;
TOTLHD if ($EXTRACT(IOST)="C")!(ACKPG>0)
WRITE @IOF
+1 SET ACKPG=ACKPG+1
+2 WRITE "Printed: ",ACKCDT,?(IOM-8),"Page: ",ACKPG,!
+3 WRITE !
DO CNTR^ACKQUTL("Audiology and Speech Pathology")
+4 WRITE !
DO CNTR^ACKQUTL("Procedure Statistics")
+5 WRITE !
DO CNTR^ACKQUTL("Summary")
+6 SET X=""
SET $PIECE(X,"-",IOM)="-"
WRITE !,X
+7 QUIT
DIVNAME(ACKVDIV) ; Get div name
+1 QUIT $$GET1^DIQ(40.8,ACKVDIV_",",.01)
STAFFNM(ACKSTF) ; Get staff name
+1 QUIT $$MIXC^ACKQUTL($$CONVERT^ACKQUTL4(ACKSTF))
