ACKQR1 ;AUG/JLTP,AEM BIR/PTD HCIOFO/AG -Patients by City [ 12/07/95 9:52 AM ]
;;3.0;QUASAR;;Feb 11, 2000
;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
;
OPTN ;Introduce option.
W @IOF,!,"This option generates a patient count report for a selected date range."
W !,"The report shows the number of patients seen, sorted by city of residence.",!
;
; get division
S ACKDIV=$$DIV^ACKQUTL2(3,.ACKDIV,"AI") G:+ACKDIV=0 EXIT
; get date range
D DTRANGE^ACKQRU G:$D(DIRUT) EXIT
S ACKRDR="Visits from "_ACKXBD_" to "_ACKXED
;
;
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^ACKQR1",ZTDESC="QUASAR - A&SP PATIENTS BY CITY"
. S ZTSAVE("ACK*")="" D ^%ZTLOAD D HOME^%ZIS K ZTSK
;
DQ ;Entry point when queued.
; variables required at this point are:-
; ACKDIV() - selected divisions
; ACKBD,ACKXBD - beginning of date range (internal,external)
; ACKED,ACKXED - end of date range (internal,external)
;
U IO
S ACKLINE="",$P(ACKLINE,"-",IOM)="-"
D NOW^%DTC S ACKXDT=$$NUMDT^ACKQUTL(%)_" at "_$$FTIME^ACKQUTL(%)
K ^TMP("ACKQR1",$J)
; walk down the visits using the date index
S ACKD=ACKBD F 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 ;ALWAYS EXIT HERE
K %DT,%T,%ZIS,ACKBD,ACKCL,ACKCSC,ACKCTY,ACKD,ACKED,ACKI
K ACKLINE,ACKPG,ACKRDR,ACKST,ACKTOT,ACKUNIQ,ACKV,ACKX,ACKXBD
K ACKXDT,ACKXED,DFN,ACKDIV,ACKHDR,ACK2,ACKHDR5,ACKVDIV,ACKVSC
K ACKSORT,ACKCT,ACKNEW,ACKTXT
K DIRUT,DTOUT,DUOUT,VA,VAERR,VAPA,X,Y,ZTDESC,ZTIO,ZTRTN,ZTSAVE
K ZTSK,^TMP("ACKQR1",$J)
W:$E(IOST)="C" @IOF D ^%ZISC S:$D(ZTQUEUED) ZTREQ="@"
Q
STORE ;
S ACKHDR=^ACK(509850.6,ACKV,0),ACK2=$G(^ACK(509850.6,ACKV,2))
S ACKHDR5=^ACK(509850.6,ACKV,5)
; get division and check against selected divisions
S ACKVDIV=$P(ACKHDR5,U,1)
I '$D(ACKDIV(ACKVDIV)) Q
; get visit stop code
S ACKVSC=$P(ACK2,U,1)
; get sort value for visit stop
S ACKSORT=$$STOPSORT^ACKQRU("B",ACKVSC)
; get patient data
S DFN=+$P(ACKHDR,U,2)
D ADD^VADPT
S ACKCTY=VAPA(4)
S ACKST=$$STATEABR(+VAPA(5))
Q:ACKCTY=""!(ACKST="")
; get visit clinic
S ACKCL=$P(ACKHDR,U,6)
;
; add to temp file counts
;
; add to totals for city,state for the division
I '$D(^TMP("ACKQR1",$J,1,ACKVDIV,ACKCL,ACKSORT,ACKST,ACKCTY,DFN)) D
. S ACKCT=+$G(^TMP("ACKQR1",$J,1,ACKVDIV,ACKCL,ACKSORT,ACKST,ACKCTY))
. S ^TMP("ACKQR1",$J,1,ACKVDIV,ACKCL,ACKSORT,ACKST,ACKCTY)=ACKCT+1
. S ^TMP("ACKQR1",$J,1,ACKVDIV,ACKCL,ACKSORT,ACKST,ACKCTY,DFN)=""
;
; add to totals for for the stop code in the division
I '$D(^TMP("ACKQR1",$J,2,ACKVDIV,ACKSORT,DFN)) D
. S ACKCT=+$G(^TMP("ACKQR1",$J,2,ACKVDIV,ACKSORT))
. S ^TMP("ACKQR1",$J,2,ACKVDIV,ACKSORT)=ACKCT+1
. S ^TMP("ACKQR1",$J,2,ACKVDIV,ACKSORT,DFN)=""
;
; add to totals for the city,state across all divisions
I '$D(^TMP("ACKQR1",$J,3,ACKSORT,ACKST,ACKCTY,DFN)) D
. S ACKCT=+$G(^TMP("ACKQR1",$J,3,ACKSORT,ACKST,ACKCTY))
. S ^TMP("ACKQR1",$J,3,ACKSORT,ACKST,ACKCTY)=ACKCT+1
. S ^TMP("ACKQR1",$J,3,ACKSORT,ACKST,ACKCTY,DFN)=""
;
; add to totals for the stop code across all divisions
I '$D(^TMP("ACKQR1",$J,4,ACKSORT,DFN)) D
. S ACKCT=+$G(^TMP("ACKQR1",$J,4,ACKSORT))
. S ^TMP("ACKQR1",$J,4,ACKSORT)=ACKCT+1
. S ^TMP("ACKQR1",$J,4,ACKSORT,DFN)=""
;
Q
PRINT ;
S ACKPG=0,ACKVDIV=""
F S ACKVDIV=$O(ACKDIV(ACKVDIV)) Q:ACKVDIV="" D PRINT2 Q:$D(DIRUT)
I '$D(DIRUT) D TOTALS
Q
PRINT2 ; print data for a single division
I '$D(^TMP("ACKQR1",$J,1,ACKVDIV)) D Q
. D HDR W !!,"No data found for report specifications.",!!
. I $E(IOST)="C" D PAUSE^ACKQUTL Q:$D(DIRUT)
D HDR
S ACKCL=""
F S ACKCL=$O(^TMP("ACKQR1",$J,1,ACKVDIV,ACKCL)) Q:ACKCL=""!($D(DIRUT)) D
.I $Y>(IOSL-7) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D HDR
.W !!,"CLINIC: ",$$CLINICNM(ACKCL)
.S ACKSORT=""
.F S ACKSORT=$O(^TMP("ACKQR1",$J,1,ACKVDIV,ACKCL,ACKSORT)) Q:ACKSORT=""!($D(DIRUT)) D
..I $Y>(IOSL-5) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D HDR
..W !!,"STOP CODE: ",$$STOPNM^ACKQRU(ACKSORT)
..S ACKST=""
..F S ACKST=$O(^TMP("ACKQR1",$J,1,ACKVDIV,ACKCL,ACKSORT,ACKST)) Q:ACKST=""!($D(DIRUT)) D
...S ACKCTY=""
...F S ACKCTY=$O(^TMP("ACKQR1",$J,1,ACKVDIV,ACKCL,ACKSORT,ACKST,ACKCTY)) Q:ACKCTY=""!($D(DIRUT)) D
....S ACKUNIQ=^TMP("ACKQR1",$J,1,ACKVDIV,ACKCL,ACKSORT,ACKST,ACKCTY)
....I $Y>(IOSL-3) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D HDR
....W !,?5,ACKCTY_", "_ACKST,":",?35,$J(ACKUNIQ,5)," patient"_$S(ACKUNIQ=1:"",1:"s")
SCTOTS ;
Q:'$D(^TMP("ACKQR1",$J,2))
S ACKNEW=0
I $Y>(IOSL-8) S ACKNEW=1 D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D HDR
W !
I 'ACKNEW W !,ACKLINE ; don't print this line if we've just thrown a page
W !,"STOP CODE TOTALS:",!
S ACKSORT=""
F S ACKSORT=$O(^TMP("ACKQR1",$J,2,ACKVDIV,ACKSORT)) Q:ACKSORT="" D
. W !,$$STOPNM^ACKQRU(ACKSORT)
. S ACKTOT=+$G(^TMP("ACKQR1",$J,2,ACKVDIV,ACKSORT))
. W ?35,$J(ACKTOT,5)," patient"_$S(ACKTOT=1:"",1:"s")
;
Q:$D(DIRUT)
I $E(IOST)="C" D PAUSE^ACKQUTL Q:$D(DIRUT)
Q
;
TOTALS ; print the final page of totals across all divisions
Q:'$D(^TMP("ACKQR1",$J,3))
I $O(ACKDIV(""))=$O(ACKDIV(""),-1) Q ; there must be only one division
D TOTLHD S ACKTXT="DIVISIONS:"
S ACKVDIV="" F S ACKVDIV=$O(ACKDIV(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("ACKQR1",$J,3,ACKSORT)) Q:ACKSORT="" D Q:$D(DIRUT)
. I $Y>(IOSL-5) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D TOTLHD
. W !!,"STOP CODE:",$$STOPNM^ACKQRU(ACKSORT)
. S ACKST=""
. F S ACKST=$O(^TMP("ACKQR1",$J,3,ACKSORT,ACKST)) Q:ACKST="" D Q:$D(DIRUT)
. . S ACKCTY=""
. . F S ACKCTY=$O(^TMP("ACKQR1",$J,3,ACKSORT,ACKST,ACKCTY)) Q:ACKCTY="" D Q:$D(DIRUT)
. . . I $Y>(IOSL-3) D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D TOTLHD
. . . S ACKCT=^TMP("ACKQR1",$J,3,ACKSORT,ACKST,ACKCTY)
. . . W !?5,ACKCTY,", ",ACKST,":",?35,$J(ACKCT,5)," patient",$S(ACKCT=1:"",1:"s")
Q:'$D(^TMP("ACKQR1",$J,4))
S ACKNEW=0
I $Y>(IOSL-8) S ACKNEW=1 D:$E(IOST)="C" PAUSE^ACKQUTL Q:$D(DIRUT) D HDR
W !
I 'ACKNEW W !,ACKLINE ; don't print this line if we've just thrown a page
W !,"STOP CODE TOTALS:",!
S ACKSORT=""
F S ACKSORT=$O(^TMP("ACKQR1",$J,4,ACKSORT)) Q:ACKSORT="" D
. W !,$$STOPNM^ACKQRU(ACKSORT),":"
. S ACKTOT=+$G(^TMP("ACKQR1",$J,4,ACKSORT))
. W ?35,$J(ACKTOT,5)," patient"_$S(ACKTOT=1:"",1:"s")
;
Q:$D(DIRUT)
I $E(IOST)="C" D PAUSE^ACKQUTL Q:$D(DIRUT)
Q
HDR ;
W:($E(IOST)="C")!(ACKPG>0) @IOF
S ACKPG=ACKPG+1
W "Printed: ",ACKXDT,?(IOM-8),"Page: ",ACKPG,!
W ! D CNTR^ACKQUTL("Audiology & Speech Pathology")
W ! D CNTR^ACKQUTL("Unique Patients by City")
W ! D CNTR^ACKQUTL(ACKRDR)
I ACKVDIV]"" W ! D CNTR^ACKQUTL("For Division: "_$$DIVNAME(ACKVDIV))
W !,ACKLINE
Q
;
TOTLHD ; print header for totals page
S ACKPG=ACKPG+1
W @IOF,"Printed: ",ACKXDT,?(IOM-8),"Page: ",ACKPG,!
W ! D CNTR^ACKQUTL("Audiology & Speech Pathology")
W ! D CNTR^ACKQUTL("Unique Patients by City")
W ! D CNTR^ACKQUTL(ACKRDR)
W ! D CNTR^ACKQUTL("Summary")
W !,ACKLINE
Q
;
DIVNAME(ACKVDIV) ; determine division name
Q $$GET1^DIQ(40.8,ACKVDIV_",",.01)
;
CLINICNM(ACKCL) ; determine clinic name
Q $$GET1^DIQ(44,ACKCL_",",.01)
;
STATEABR(ACKST) ; get State abbreviation
Q $$GET1^DIQ(5,ACKST_",",1)
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HACKQR1 7744 printed Sep 23, 2025@20:08:49 Page 2
ACKQR1 ;AUG/JLTP,AEM BIR/PTD HCIOFO/AG -Patients by City [ 12/07/95 9:52 AM ]
+1 ;;3.0;QUASAR;;Feb 11, 2000
+2 ;Per VHA Directive 10-93-142, this routine SHOULD NOT be modified.
+3 ;
OPTN ;Introduce option.
+1 WRITE @IOF,!,"This option generates a patient count report for a selected date range."
+2 WRITE !,"The report shows the number of patients seen, sorted by city of residence.",!
+3 ;
+4 ; get division
+5 SET ACKDIV=$$DIV^ACKQUTL2(3,.ACKDIV,"AI")
if +ACKDIV=0
GOTO EXIT
+6 ; get date range
+7 DO DTRANGE^ACKQRU
if $DATA(DIRUT)
GOTO EXIT
+8 SET ACKRDR="Visits from "_ACKXBD_" to "_ACKXED
+9 ;
+10 ;
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^ACKQR1"
SET ZTDESC="QUASAR - A&SP PATIENTS BY CITY"
+8 SET ZTSAVE("ACK*")=""
DO ^%ZTLOAD
DO HOME^%ZIS
KILL ZTSK
End DoDot:1
GOTO EXIT
+9 ;
DQ ;Entry point when queued.
+1 ; variables required at this point are:-
+2 ; ACKDIV() - selected divisions
+3 ; ACKBD,ACKXBD - beginning of date range (internal,external)
+4 ; ACKED,ACKXED - end of date range (internal,external)
+5 ;
+6 USE IO
+7 SET ACKLINE=""
SET $PIECE(ACKLINE,"-",IOM)="-"
+8 DO NOW^%DTC
SET ACKXDT=$$NUMDT^ACKQUTL(%)_" at "_$$FTIME^ACKQUTL(%)
+9 KILL ^TMP("ACKQR1",$JOB)
+10 ; walk down the visits using the date index
+11 SET ACKD=ACKBD
FOR
SET ACKD=$ORDER(^ACK(509850.6,"B",ACKD))
if 'ACKD!(ACKD>ACKED)
QUIT
Begin DoDot:1
+12 SET ACKV=0
FOR
SET ACKV=$ORDER(^ACK(509850.6,"B",ACKD,ACKV))
if 'ACKV
QUIT
DO STORE
End DoDot:1
+13 DO PRINT
+14 ;
EXIT ;ALWAYS EXIT HERE
+1 KILL %DT,%T,%ZIS,ACKBD,ACKCL,ACKCSC,ACKCTY,ACKD,ACKED,ACKI
+2 KILL ACKLINE,ACKPG,ACKRDR,ACKST,ACKTOT,ACKUNIQ,ACKV,ACKX,ACKXBD
+3 KILL ACKXDT,ACKXED,DFN,ACKDIV,ACKHDR,ACK2,ACKHDR5,ACKVDIV,ACKVSC
+4 KILL ACKSORT,ACKCT,ACKNEW,ACKTXT
+5 KILL DIRUT,DTOUT,DUOUT,VA,VAERR,VAPA,X,Y,ZTDESC,ZTIO,ZTRTN,ZTSAVE
+6 KILL ZTSK,^TMP("ACKQR1",$JOB)
+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 ACK2=$GET(^ACK(509850.6,ACKV,2))
+2 SET ACKHDR5=^ACK(509850.6,ACKV,5)
+3 ; get division and check against selected divisions
+4 SET ACKVDIV=$PIECE(ACKHDR5,U,1)
+5 IF '$DATA(ACKDIV(ACKVDIV))
QUIT
+6 ; get visit stop code
+7 SET ACKVSC=$PIECE(ACK2,U,1)
+8 ; get sort value for visit stop
+9 SET ACKSORT=$$STOPSORT^ACKQRU("B",ACKVSC)
+10 ; get patient data
+11 SET DFN=+$PIECE(ACKHDR,U,2)
+12 DO ADD^VADPT
+13 SET ACKCTY=VAPA(4)
+14 SET ACKST=$$STATEABR(+VAPA(5))
+15 if ACKCTY=""!(ACKST="")
QUIT
+16 ; get visit clinic
+17 SET ACKCL=$PIECE(ACKHDR,U,6)
+18 ;
+19 ; add to temp file counts
+20 ;
+21 ; add to totals for city,state for the division
+22 IF '$DATA(^TMP("ACKQR1",$JOB,1,ACKVDIV,ACKCL,ACKSORT,ACKST,ACKCTY,DFN))
Begin DoDot:1
+23 SET ACKCT=+$GET(^TMP("ACKQR1",$JOB,1,ACKVDIV,ACKCL,ACKSORT,ACKST,ACKCTY))
+24 SET ^TMP("ACKQR1",$JOB,1,ACKVDIV,ACKCL,ACKSORT,ACKST,ACKCTY)=ACKCT+1
+25 SET ^TMP("ACKQR1",$JOB,1,ACKVDIV,ACKCL,ACKSORT,ACKST,ACKCTY,DFN)=""
End DoDot:1
+26 ;
+27 ; add to totals for for the stop code in the division
+28 IF '$DATA(^TMP("ACKQR1",$JOB,2,ACKVDIV,ACKSORT,DFN))
Begin DoDot:1
+29 SET ACKCT=+$GET(^TMP("ACKQR1",$JOB,2,ACKVDIV,ACKSORT))
+30 SET ^TMP("ACKQR1",$JOB,2,ACKVDIV,ACKSORT)=ACKCT+1
+31 SET ^TMP("ACKQR1",$JOB,2,ACKVDIV,ACKSORT,DFN)=""
End DoDot:1
+32 ;
+33 ; add to totals for the city,state across all divisions
+34 IF '$DATA(^TMP("ACKQR1",$JOB,3,ACKSORT,ACKST,ACKCTY,DFN))
Begin DoDot:1
+35 SET ACKCT=+$GET(^TMP("ACKQR1",$JOB,3,ACKSORT,ACKST,ACKCTY))
+36 SET ^TMP("ACKQR1",$JOB,3,ACKSORT,ACKST,ACKCTY)=ACKCT+1
+37 SET ^TMP("ACKQR1",$JOB,3,ACKSORT,ACKST,ACKCTY,DFN)=""
End DoDot:1
+38 ;
+39 ; add to totals for the stop code across all divisions
+40 IF '$DATA(^TMP("ACKQR1",$JOB,4,ACKSORT,DFN))
Begin DoDot:1
+41 SET ACKCT=+$GET(^TMP("ACKQR1",$JOB,4,ACKSORT))
+42 SET ^TMP("ACKQR1",$JOB,4,ACKSORT)=ACKCT+1
+43 SET ^TMP("ACKQR1",$JOB,4,ACKSORT,DFN)=""
End DoDot:1
+44 ;
+45 QUIT
PRINT ;
+1 SET ACKPG=0
SET ACKVDIV=""
+2 FOR
SET ACKVDIV=$ORDER(ACKDIV(ACKVDIV))
if ACKVDIV=""
QUIT
DO PRINT2
if $DATA(DIRUT)
QUIT
+3 IF '$DATA(DIRUT)
DO TOTALS
+4 QUIT
PRINT2 ; print data for a single division
+1 IF '$DATA(^TMP("ACKQR1",$JOB,1,ACKVDIV))
Begin DoDot:1
+2 DO HDR
WRITE !!,"No data found for report specifications.",!!
+3 IF $EXTRACT(IOST)="C"
DO PAUSE^ACKQUTL
if $DATA(DIRUT)
QUIT
End DoDot:1
QUIT
+4 DO HDR
+5 SET ACKCL=""
+6 FOR
SET ACKCL=$ORDER(^TMP("ACKQR1",$JOB,1,ACKVDIV,ACKCL))
if ACKCL=""!($DATA(DIRUT))
QUIT
Begin DoDot:1
+7 IF $Y>(IOSL-7)
if $EXTRACT(IOST)="C"
DO PAUSE^ACKQUTL
if $DATA(DIRUT)
QUIT
DO HDR
+8 WRITE !!,"CLINIC: ",$$CLINICNM(ACKCL)
+9 SET ACKSORT=""
+10 FOR
SET ACKSORT=$ORDER(^TMP("ACKQR1",$JOB,1,ACKVDIV,ACKCL,ACKSORT))
if ACKSORT=""!($DATA(DIRUT))
QUIT
Begin DoDot:2
+11 IF $Y>(IOSL-5)
if $EXTRACT(IOST)="C"
DO PAUSE^ACKQUTL
if $DATA(DIRUT)
QUIT
DO HDR
+12 WRITE !!,"STOP CODE: ",$$STOPNM^ACKQRU(ACKSORT)
+13 SET ACKST=""
+14 FOR
SET ACKST=$ORDER(^TMP("ACKQR1",$JOB,1,ACKVDIV,ACKCL,ACKSORT,ACKST))
if ACKST=""!($DATA(DIRUT))
QUIT
Begin DoDot:3
+15 SET ACKCTY=""
+16 FOR
SET ACKCTY=$ORDER(^TMP("ACKQR1",$JOB,1,ACKVDIV,ACKCL,ACKSORT,ACKST,ACKCTY))
if ACKCTY=""!($DATA(DIRUT))
QUIT
Begin DoDot:4
+17 SET ACKUNIQ=^TMP("ACKQR1",$JOB,1,ACKVDIV,ACKCL,ACKSORT,ACKST,ACKCTY)
+18 IF $Y>(IOSL-3)
if $EXTRACT(IOST)="C"
DO PAUSE^ACKQUTL
if $DATA(DIRUT)
QUIT
DO HDR
+19 WRITE !,?5,ACKCTY_", "_ACKST,":",?35,$JUSTIFY(ACKUNIQ,5)," patient"_$SELECT(ACKUNIQ=1:"",1:"s")
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
SCTOTS ;
+1 if '$DATA(^TMP("ACKQR1",$JOB,2))
QUIT
+2 SET ACKNEW=0
+3 IF $Y>(IOSL-8)
SET ACKNEW=1
if $EXTRACT(IOST)="C"
DO PAUSE^ACKQUTL
if $DATA(DIRUT)
QUIT
DO HDR
+4 WRITE !
+5 ; don't print this line if we've just thrown a page
IF 'ACKNEW
WRITE !,ACKLINE
+6 WRITE !,"STOP CODE TOTALS:",!
+7 SET ACKSORT=""
+8 FOR
SET ACKSORT=$ORDER(^TMP("ACKQR1",$JOB,2,ACKVDIV,ACKSORT))
if ACKSORT=""
QUIT
Begin DoDot:1
+9 WRITE !,$$STOPNM^ACKQRU(ACKSORT)
+10 SET ACKTOT=+$GET(^TMP("ACKQR1",$JOB,2,ACKVDIV,ACKSORT))
+11 WRITE ?35,$JUSTIFY(ACKTOT,5)," patient"_$SELECT(ACKTOT=1:"",1:"s")
End DoDot:1
+12 ;
+13 if $DATA(DIRUT)
QUIT
+14 IF $EXTRACT(IOST)="C"
DO PAUSE^ACKQUTL
if $DATA(DIRUT)
QUIT
+15 QUIT
+16 ;
TOTALS ; print the final page of totals across all divisions
+1 if '$DATA(^TMP("ACKQR1",$JOB,3))
QUIT
+2 ; there must be only one division
IF $ORDER(ACKDIV(""))=$ORDER(ACKDIV(""),-1)
QUIT
+3 DO TOTLHD
SET ACKTXT="DIVISIONS:"
+4 SET ACKVDIV=""
FOR
SET ACKVDIV=$ORDER(ACKDIV(ACKVDIV))
if ACKVDIV=""
QUIT
Begin DoDot:1
+5 IF $Y>(IOSL-3)
if $EXTRACT(IOST)="C"
DO PAUSE^ACKQUTL
if $DATA(DIRUT)
QUIT
DO TOTLHD
+6 WRITE !,ACKTXT,?12,$$DIVNAME(ACKVDIV)
SET ACKTXT=""
End DoDot:1
if $DATA(DIRUT)
QUIT
+7 SET ACKSORT=""
+8 FOR
SET ACKSORT=$ORDER(^TMP("ACKQR1",$JOB,3,ACKSORT))
if ACKSORT=""
QUIT
Begin DoDot:1
+9 IF $Y>(IOSL-5)
if $EXTRACT(IOST)="C"
DO PAUSE^ACKQUTL
if $DATA(DIRUT)
QUIT
DO TOTLHD
+10 WRITE !!,"STOP CODE:",$$STOPNM^ACKQRU(ACKSORT)
+11 SET ACKST=""
+12 FOR
SET ACKST=$ORDER(^TMP("ACKQR1",$JOB,3,ACKSORT,ACKST))
if ACKST=""
QUIT
Begin DoDot:2
+13 SET ACKCTY=""
+14 FOR
SET ACKCTY=$ORDER(^TMP("ACKQR1",$JOB,3,ACKSORT,ACKST,ACKCTY))
if ACKCTY=""
QUIT
Begin DoDot:3
+15 IF $Y>(IOSL-3)
if $EXTRACT(IOST)="C"
DO PAUSE^ACKQUTL
if $DATA(DIRUT)
QUIT
DO TOTLHD
+16 SET ACKCT=^TMP("ACKQR1",$JOB,3,ACKSORT,ACKST,ACKCTY)
+17 WRITE !?5,ACKCTY,", ",ACKST,":",?35,$JUSTIFY(ACKCT,5)," patient",$SELECT(ACKCT=1:"",1:"s")
End DoDot:3
if $DATA(DIRUT)
QUIT
End DoDot:2
if $DATA(DIRUT)
QUIT
End DoDot:1
if $DATA(DIRUT)
QUIT
+18 if '$DATA(^TMP("ACKQR1",$JOB,4))
QUIT
+19 SET ACKNEW=0
+20 IF $Y>(IOSL-8)
SET ACKNEW=1
if $EXTRACT(IOST)="C"
DO PAUSE^ACKQUTL
if $DATA(DIRUT)
QUIT
DO HDR
+21 WRITE !
+22 ; don't print this line if we've just thrown a page
IF 'ACKNEW
WRITE !,ACKLINE
+23 WRITE !,"STOP CODE TOTALS:",!
+24 SET ACKSORT=""
+25 FOR
SET ACKSORT=$ORDER(^TMP("ACKQR1",$JOB,4,ACKSORT))
if ACKSORT=""
QUIT
Begin DoDot:1
+26 WRITE !,$$STOPNM^ACKQRU(ACKSORT),":"
+27 SET ACKTOT=+$GET(^TMP("ACKQR1",$JOB,4,ACKSORT))
+28 WRITE ?35,$JUSTIFY(ACKTOT,5)," patient"_$SELECT(ACKTOT=1:"",1:"s")
End DoDot:1
+29 ;
+30 if $DATA(DIRUT)
QUIT
+31 IF $EXTRACT(IOST)="C"
DO PAUSE^ACKQUTL
if $DATA(DIRUT)
QUIT
+32 QUIT
HDR ;
+1 if ($EXTRACT(IOST)="C")!(ACKPG>0)
WRITE @IOF
+2 SET ACKPG=ACKPG+1
+3 WRITE "Printed: ",ACKXDT,?(IOM-8),"Page: ",ACKPG,!
+4 WRITE !
DO CNTR^ACKQUTL("Audiology & Speech Pathology")
+5 WRITE !
DO CNTR^ACKQUTL("Unique Patients by City")
+6 WRITE !
DO CNTR^ACKQUTL(ACKRDR)
+7 IF ACKVDIV]""
WRITE !
DO CNTR^ACKQUTL("For Division: "_$$DIVNAME(ACKVDIV))
+8 WRITE !,ACKLINE
+9 QUIT
+10 ;
TOTLHD ; print header for totals page
+1 SET ACKPG=ACKPG+1
+2 WRITE @IOF,"Printed: ",ACKXDT,?(IOM-8),"Page: ",ACKPG,!
+3 WRITE !
DO CNTR^ACKQUTL("Audiology & Speech Pathology")
+4 WRITE !
DO CNTR^ACKQUTL("Unique Patients by City")
+5 WRITE !
DO CNTR^ACKQUTL(ACKRDR)
+6 WRITE !
DO CNTR^ACKQUTL("Summary")
+7 WRITE !,ACKLINE
+8 QUIT
+9 ;
DIVNAME(ACKVDIV) ; determine division name
+1 QUIT $$GET1^DIQ(40.8,ACKVDIV_",",.01)
+2 ;
CLINICNM(ACKCL) ; determine clinic name
+1 QUIT $$GET1^DIQ(44,ACKCL_",",.01)
+2 ;
STATEABR(ACKST) ; get State abbreviation
+1 QUIT $$GET1^DIQ(5,ACKST_",",1)
+2 ;
