ACKQR5.m

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 ---ACKQR5   9696     printed  Feb 18, 2025@23:59:03                                                                                                                                                                                                      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