ACKQR2.m

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 ---ACKQR2   9923     printed  Feb 18, 2025@23:59                                                                                                                                                                                                         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: "