APCLCR1 ; IHS/CMI/LAB - visits by provider ;
;;2.0;IHS PCC SUITE;**2**;MAY 14, 2009
;
START ;
I '$G(DUZ(2)) W $C(7),$C(7),!!,"SITE NOT SET IN DUZ(2) - NOTIFY SITE MANAGER!!",!! K APCLSITE Q
D XIT
S APCLJOB=$J,APCLBTH=$H
D INFORM
GETDATES ;
BD ;
W !!
S DIR(0)="D^::EP",DIR("A")="Enter Beginning Visit Date",DIR("?")="Enter the beginning visit date for the search." D ^DIR K DIR S:$D(DUOUT) DIRUT=1
G:$D(DIRUT) XIT
S APCLBD=Y D DD^%DT S APCLBDD=Y
ED ;
S DIR(0)="DA^::EP",DIR("A")="Enter Ending Visit Date: " D ^DIR K DIR S:$D(DUOUT) DIRUT=1
G:$D(DIRUT) XIT
I Y<APCLBD W !,"Ending date must be greater than or equal to beginning date!" G ED
S APCLED=Y
S X1=APCLBD,X2=-1 D C^%DTC S APCLSD=X
LOC ;
K APCLLOCT,APCLLOC,APCLQ
S DIR(0)="S^A:ALL Locations/Facilities;S:One SERVICE UNIT'S Locations/Facilities;O:ONE Location/Facility;T:A Taxonomy or Set of Locations/Facilities",DIR("A")="Include Visits to Which Location/Facilities",DIR("B")="A"
S DIR("A")="Enter a code indicating what LOCATIONS/FACILITIES are of interest",DIR("B")="O" K DA D ^DIR K DIR,DA
G:$D(DIRUT) GETDATES
S APCLLOCT=Y
I APCLLOCT="A" K APCLLOC G CLINIC
D @APCLLOCT
G:$D(APCLQ) LOC
CLINIC ;
S X="CLINIC",DIC="^AMQQ(5,",DIC(0)="FM",DIC("S")="I $P(^(0),U,14)" D ^DIC K DIC,DA I Y=-1 W "OOPS - QMAN NOT CURRENT - QUITTING" G XIT
D PEP^AMQQGTX0(+Y,"APCLCLNT(")
I '$D(APCLCLNT) G GETDATES
I $D(APCLCLNT("*")) K APCLCLNT
DISC ;
S X="DISCIPLINE",DIC="^AMQQ(5,",DIC(0)="FM",DIC("S")="I $P(^(0),U,14)" D ^DIC K DIC,DA I Y=-1 W "OOPS - QMAN NOT CURRENT - QUITTING" G XIT
D PEP^AMQQGTX0(+Y,"APCLDISP(")
I '$D(APCLDISP) G CLINIC
I $D(APCLDISP("*")) K APCLDISP
ZIS ;
DEMO ;
D DEMOCHK^APCLUTL(.APCLDEMO)
I APCLDEMO=-1 G DISC
S XBRP="PRINT^APCLCR1",XBRC="PROC^APCLCR1",XBRX="XIT^APCLCR1",XBNS="APCL"
D ^XBDBQUE
D XIT
Q
ERR W $C(7),$C(7),!,"Must be a valid date and be Today or earlier. Time not allowed!" Q
XIT ;
D EN^XBVK("APCL")
D ^XBFMK
Q
;
INFORM ;
W:$D(IOF) @IOF
W !,"This report will list a count of all visits to clinics that"
W !,"are within a taxonony of clinics you identify. The report"
W !,"will be a tally of all primary and secondary providers"
W !,"on those visits. Only those provider disciplines that are"
W !,"within the discipline taxonomy you select will be talled."
Q
;
PROC ;EP - called from xbdbque
S APCLBT=$H
K ^XTMP("APCLCR1",APCLJOB,APCLBTH)
D XTMP^APCLOSUT("APCLCR1","PCC VISIT/PROVIDER TALLY")
S APCLVCNT=0 K APCLPSCT
;
V ; Run by visit date
S APCLODAT=APCLSD_".9999" F S APCLODAT=$O(^AUPNVSIT("B",APCLODAT)) Q:APCLODAT=""!((APCLODAT\1)>APCLED) D V1
;
END ;
S APCLET=$H
Q
V1 ;
;count only visits with service category of A, O, R, S
S APCLVDFN="" F S APCLVDFN=$O(^AUPNVSIT("B",APCLODAT,APCLVDFN)) Q:APCLVDFN'=+APCLVDFN I $D(^AUPNVSIT(APCLVDFN,0)),$P(^(0),U,9),'$P(^(0),U,11) S APCLVREC=^(0) D PROC1
Q
PROC1 ;
;I $P(APCLVREC,U,6)'=APCLLOC Q ;not correct location
S (APCLLOE,L)=$P(APCLVREC,U,6)
Q:$$DEMO^APCLUTL($P(APCLVREC,U,5),$G(APCLDEMO))
Q:L=""
I $D(APCLLOC),'$D(APCLLOC(L)) Q ;not a facility of interest
S APCLCLIN=$P(APCLVREC,U,8)
Q:APCLCLIN=""
I $D(APCLCLIN),'$D(APCLCLNT(APCLCLIN)) Q
;go through all providers
S APCLX=0 F S APCLX=$O(^AUPNVPRV("AD",APCLVDFN,APCLX)) Q:APCLX'=+APCLX D
.S Y=$P($G(^AUPNVPRV(APCLX,0)),U)
.Q:Y=""
.S D=$P($G(^VA(200,Y,"PS")),U,5)
.Q:D=""
.I $D(APCLDISP),'$D(APCLDISP(D)) Q
.S P=$P(^AUPNVPRV(APCLX,0),U,4) I P="" S P="S"
.S APCLPSCT(P)=$G(APCLPSCT(P))+1
.S ^XTMP("APCLCR1",APCLJOB,APCLBTH,"DATA",P,$P(^VA(200,Y,0),U),Y)=$G(^XTMP("APCLCR1",APCLJOB,APCLBTH,"DATA",P,$P(^VA(200,Y,0),U),Y))+1
.S ^XTMP("APCLCR1",APCLJOB,APCLBTH,"DATALOC",P,$P(^VA(200,Y,0),U),Y,APCLLOE)=$G(^XTMP("APCLCR1",APCLJOB,APCLBTH,"DATALOC",P,$P(^VA(200,Y,0),U),Y,APCLLOE))+1
.I $D(^XTMP("APCLCR1",APCLJOB,APCLBTH,"VISITS",APCLVDFN)) Q
.S APCLVCNT=APCLVCNT+1,^XTMP("APCLCR1",APCLJOB,APCLBTH,"VISITS",APCLVDFN)=""
.Q
Q
PRINT ;EP - called from xbdbque
D COVPAGE
S APCLPG=0 K APCLQUIT
D HEAD
I '$D(^XTMP("APCLCR1",APCLJOB,APCLBTH,"DATA")) W !!,"No visits to report.",! D DONE Q
W !!,"Total PCC Primary Provider Workload Count:",?45,$J($G(APCLPSCT("P")),7)
W !,"Total PCC Secondary Provider Workload Count:",?45,$J($G(APCLPSCT("S")),7)
W !,"Total PCC Provider Workload Count:",?45,$J(($G(APCLPSCT("P"))+$G(APCLPSCT("S"))),7)
W !!,"Total Number of Visits: ",?45,$J(APCLVCNT,7)
W !!,"PRIMARY PROVIDERS",?35,"# OF VISITS",!
S APCLX="" F S APCLX=$O(^XTMP("APCLCR1",APCLJOB,APCLBTH,"DATA","P",APCLX)) Q:APCLX=""!($D(APCLQUIT)) D
.S APCLY=0 F S APCLY=$O(^XTMP("APCLCR1",APCLJOB,APCLBTH,"DATA","P",APCLX,APCLY)) Q:APCLY'=+APCLY!($D(APCLQUIT)) D
..I $Y>(IOSL-2) D HEAD Q:$D(APCLQUIT)
..W !?3,APCLX,?35,$J(^XTMP("APCLCR1",APCLJOB,APCLBTH,"DATA","P",APCLX,APCLY),6)
..Q:APCLLOCT="O"
..S APCLZ=0 F S APCLZ=$O(^XTMP("APCLCR1",APCLJOB,APCLBTH,"DATALOC","P",APCLX,APCLY,APCLZ)) Q:APCLZ'=+APCLZ!($D(APCLQUIT)) D
...I $Y>(IOSL-2) D HEAD Q:$D(APCLQUIT)
...W !?6,$P(^AUTTLOC(APCLZ,0),U,7),?14,$J(^XTMP("APCLCR1",APCLJOB,APCLBTH,"DATALOC","P",APCLX,APCLY,APCLZ),6)
..Q
.Q
W !!,"SECONDARY PROVIDERS",?35,"# OF VISITS",!
S APCLX="" F S APCLX=$O(^XTMP("APCLCR1",APCLJOB,APCLBTH,"DATA","S",APCLX)) Q:APCLX=""!($D(APCLQUIT)) D
.S APCLY=0 F S APCLY=$O(^XTMP("APCLCR1",APCLJOB,APCLBTH,"DATA","S",APCLX,APCLY)) Q:APCLY'=+APCLY!($D(APCLQUIT)) D
..I $Y>(IOSL-2) D HEAD Q:$D(APCLQUIT)
..W !?3,APCLX,?35,$J(^XTMP("APCLCR1",APCLJOB,APCLBTH,"DATA","S",APCLX,APCLY),6)
..Q:APCLLOCT="O"
..S APCLZ=0 F S APCLZ=$O(^XTMP("APCLCR1",APCLJOB,APCLBTH,"DATALOC","S",APCLX,APCLY,APCLZ)) Q:APCLZ'=+APCLZ!($D(APCLQUIT)) D
...I $Y>(IOSL-2) D HEAD Q:$D(APCLQUIT)
...W !?6,$P(^AUTTLOC(APCLZ,0),U,7),?14,$J(^XTMP("APCLCR1",APCLJOB,APCLBTH,"DATALOC","S",APCLX,APCLY,APCLZ),6)
..Q
.Q
DONE ;
D DONE^APCLOSUT
K ^XTMP("APCLCR1",APCLJOB,APCLBTH)
Q
COVPAGE ;
W:$D(IOF) @IOF
W !!,$$CJ^XLFSTR("Tally of Selected Primary and Secondary Providers for selected Clinic Visits",80),!
W !,$$CJ^XLFSTR("Visit Dates: "_$$FMTE^XLFDT(APCLBD)_"-"_$$FMTE^XLFDT(APCLED),80),!
I '$D(APCLLOC) W !!,"Locations: ALL"
I $D(APCLLOC) W !!,"Locations:"
S X=0 F S X=$O(APCLLOC(X)) Q:X'=+X W:$Y>(IOSL-2) @IOF,!,"Cover page (con't)",!! W !?10,$P(^DIC(4,X,0),U)
I '$D(APCLCLNT) W !!,"Clinics: ALL"
I $D(APCLCLNT) W !!,"Clinics:"
S X=0 F S X=$O(APCLCLNT(X)) Q:X'=+X W:$Y>(IOSL-2) @IOF,!,"Cover page (con't)",!! W !?10,$P(^DIC(40.7,X,0),U)
I '$D(APCLDISP) W !!,"Disciplines: ALL"
I $D(APCLDISP) W !!,"Disciplines:"
S X=0 F S X=$O(APCLDISP(X)) Q:X'=+X W:$Y>(IOSL-2) @IOF,!,"Cover page (con't)",!! W !?10,$P(^DIC(7,X,0),U)
Q
HEAD I 'APCLPG G HEAD1
I $E(IOST)="C",IO=IO(0) W ! S DIR(0)="EO" D ^DIR K DIR I Y=0!(Y="^")!($D(DTOUT)) S APCLQUIT="" Q
HEAD1 ;
W:$D(IOF) @IOF S APCLPG=APCLPG+1
W !?58,$$FMTE^XLFDT(DT),?72,"Page ",APCLPG,!
W $$CJ^XLFSTR("TALLY OF SELECTED PRIMARY AND SECONDARY PROVIDERS FOR SELECTED CLINIC VISITS",80),!
W $$CJ^XLFSTR("Visit Dates: "_$$FMTE^XLFDT(APCLBD)_"-"_$$FMTE^XLFDT(APCLED),80),!
I '$D(APCLLOC) W $$CJ^XLFSTR("FOR: ALL Locations",80),!
I APCLLOCT="O" W $$CJ^XLFSTR("FOR: "_$P(^DIC(4,$O(APCLLOC(0)),0),U),80),!
I APCLLOCT="S" W $$CJ^XLFSTR("FOR: "_$P(^AUTTSU(APCLSU,0),U)_" Service Unit",80),!
I APCLLOCT="T" W $$CJ^XLFSTR("FOR: A taxonomy or selected set of locations",80),!
W $$REPEAT^XLFSTR("-",80),!
Q
O ;
W ! S DIC("A")="Which Facility: ",DIC="^AUTTLOC(",DIC(0)="AEMQ" D ^DIC K DIC,DA I Y<0 S APCLQ=1 Q
S APCLLOC(+Y)=""
Q
S ;all communities within APCLSU su
S DIC="^AUTTSU(",DIC("B")=$$VAL^XBDIQ1(9999999.06,DUZ(2),.05),DIC(0)="AEMQ",DIC("A")="Which SERVICE UNIT: " D ^DIC K DIC
I Y=-1 S APCLQ="" Q
S APCLSU=+Y
W !!,"Gathering up all the facilities..."
S X=0 F S X=$O(^AUTTLOC(X)) Q:X'=+X I $P(^AUTTLOC(X,0),U,5)=+Y S APCLLOC(X)=""
Q
T ;taxonomy - call qman interface
K APCLLOC
S X="ENCOUNTER LOCATION",DIC="^AMQQ(5,",DIC(0)="FM",DIC("S")="I $P(^(0),U,14)" D ^DIC K DIC,DA I Y=-1 W "OOPS - QMAN NOT CURRENT - QUITTING" S APCLQ=1 Q
D PEP^AMQQGTX0(+Y,"APCLLOC(")
I '$D(APCLLOC) S APCLQ=1 Q
I $D(APCLLOC("*")) K APCLLOC W !!,$C(7),$C(7),"ALL locations is NOT an option with this report",! G T
S X="" F S X=$O(APCLLOC(X)) Q:X="" S APCLLOC(X)=""
Q
APCLCR1 ; IHS/CMI/LAB - visits by provider ;
+1 ;;2.0;IHS PCC SUITE;**2**;MAY 14, 2009
+2 ;
START ;
+1 IF '$GET(DUZ(2))
WRITE $CHAR(7),$CHAR(7),!!,"SITE NOT SET IN DUZ(2) - NOTIFY SITE MANAGER!!",!!
KILL APCLSITE
QUIT
+2 DO XIT
+3 SET APCLJOB=$JOB
SET APCLBTH=$HOROLOG
+4 DO INFORM
GETDATES ;
BD ;
+1 WRITE !!
+2 SET DIR(0)="D^::EP"
SET DIR("A")="Enter Beginning Visit Date"
SET DIR("?")="Enter the beginning visit date for the search."
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+3 IF $DATA(DIRUT)
GOTO XIT
+4 SET APCLBD=Y
DO DD^%DT
SET APCLBDD=Y
ED ;
+1 SET DIR(0)="DA^::EP"
SET DIR("A")="Enter Ending Visit Date: "
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET DIRUT=1
+2 IF $DATA(DIRUT)
GOTO XIT
+3 IF Y<APCLBD
WRITE !,"Ending date must be greater than or equal to beginning date!"
GOTO ED
+4 SET APCLED=Y
+5 SET X1=APCLBD
SET X2=-1
DO C^%DTC
SET APCLSD=X
LOC ;
+1 KILL APCLLOCT,APCLLOC,APCLQ
+2 SET DIR(0)="S^A:ALL Locations/Facilities;S:One SERVICE UNIT'S Locations/Facilities;O:ONE Location/Facility;T:A Taxonomy or Set of Locations/Facilities"
SET DIR("A")="Include Visits to Which Location/Facilities"
SET DIR("B")="A"
+3 SET DIR("A")="Enter a code indicating what LOCATIONS/FACILITIES are of interest"
SET DIR("B")="O"
KILL DA
DO ^DIR
KILL DIR,DA
+4 IF $DATA(DIRUT)
GOTO GETDATES
+5 SET APCLLOCT=Y
+6 IF APCLLOCT="A"
KILL APCLLOC
GOTO CLINIC
+7 DO @APCLLOCT
+8 IF $DATA(APCLQ)
GOTO LOC
CLINIC ;
+1 SET X="CLINIC"
SET DIC="^AMQQ(5,"
SET DIC(0)="FM"
SET DIC("S")="I $P(^(0),U,14)"
DO ^DIC
KILL DIC,DA
IF Y=-1
WRITE "OOPS - QMAN NOT CURRENT - QUITTING"
GOTO XIT
+2 DO PEP^AMQQGTX0(+Y,"APCLCLNT(")
+3 IF '$DATA(APCLCLNT)
GOTO GETDATES
+4 IF $DATA(APCLCLNT("*"))
KILL APCLCLNT
DISC ;
+1 SET X="DISCIPLINE"
SET DIC="^AMQQ(5,"
SET DIC(0)="FM"
SET DIC("S")="I $P(^(0),U,14)"
DO ^DIC
KILL DIC,DA
IF Y=-1
WRITE "OOPS - QMAN NOT CURRENT - QUITTING"
GOTO XIT
+2 DO PEP^AMQQGTX0(+Y,"APCLDISP(")
+3 IF '$DATA(APCLDISP)
GOTO CLINIC
+4 IF $DATA(APCLDISP("*"))
KILL APCLDISP
ZIS ;
DEMO ;
+1 DO DEMOCHK^APCLUTL(.APCLDEMO)
+2 IF APCLDEMO=-1
GOTO DISC
+3 SET XBRP="PRINT^APCLCR1"
SET XBRC="PROC^APCLCR1"
SET XBRX="XIT^APCLCR1"
SET XBNS="APCL"
+4 DO ^XBDBQUE
+5 DO XIT
+6 QUIT
ERR WRITE $CHAR(7),$CHAR(7),!,"Must be a valid date and be Today or earlier. Time not allowed!"
QUIT
XIT ;
+1 DO EN^XBVK("APCL")
+2 DO ^XBFMK
+3 QUIT
+4 ;
INFORM ;
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !,"This report will list a count of all visits to clinics that"
+3 WRITE !,"are within a taxonony of clinics you identify. The report"
+4 WRITE !,"will be a tally of all primary and secondary providers"
+5 WRITE !,"on those visits. Only those provider disciplines that are"
+6 WRITE !,"within the discipline taxonomy you select will be talled."
+7 QUIT
+8 ;
PROC ;EP - called from xbdbque
+1 SET APCLBT=$HOROLOG
+2 KILL ^XTMP("APCLCR1",APCLJOB,APCLBTH)
+3 DO XTMP^APCLOSUT("APCLCR1","PCC VISIT/PROVIDER TALLY")
+4 SET APCLVCNT=0
KILL APCLPSCT
+5 ;
V ; Run by visit date
+1 SET APCLODAT=APCLSD_".9999"
FOR
SET APCLODAT=$ORDER(^AUPNVSIT("B",APCLODAT))
IF APCLODAT=""!((APCLODAT\1)>APCLED)
QUIT
DO V1
+2 ;
END ;
+1 SET APCLET=$HOROLOG
+2 QUIT
V1 ;
+1 ;count only visits with service category of A, O, R, S
+2 SET APCLVDFN=""
FOR
SET APCLVDFN=$ORDER(^AUPNVSIT("B",APCLODAT,APCLVDFN))
IF APCLVDFN'=+APCLVDFN
QUIT
IF $DATA(^AUPNVSIT(APCLVDFN,0))
IF $PIECE(^(0),U,9)
IF '$PIECE(^(0),U,11)
SET APCLVREC=^(0)
DO PROC1
+3 QUIT
PROC1 ;
+1 ;I $P(APCLVREC,U,6)'=APCLLOC Q ;not correct location
+2 SET (APCLLOE,L)=$PIECE(APCLVREC,U,6)
+3 IF $$DEMO^APCLUTL($PIECE(APCLVREC,U,5),$GET(APCLDEMO))
QUIT
+4 IF L=""
QUIT
+5 ;not a facility of interest
IF $DATA(APCLLOC)
IF '$DATA(APCLLOC(L))
QUIT
+6 SET APCLCLIN=$PIECE(APCLVREC,U,8)
+7 IF APCLCLIN=""
QUIT
+8 IF $DATA(APCLCLIN)
IF '$DATA(APCLCLNT(APCLCLIN))
QUIT
+9 ;go through all providers
+10 SET APCLX=0
FOR
SET APCLX=$ORDER(^AUPNVPRV("AD",APCLVDFN,APCLX))
IF APCLX'=+APCLX
QUIT
Begin DoDot:1
+11 SET Y=$PIECE($GET(^AUPNVPRV(APCLX,0)),U)
+12 IF Y=""
QUIT
+13 SET D=$PIECE($GET(^VA(200,Y,"PS")),U,5)
+14 IF D=""
QUIT
+15 IF $DATA(APCLDISP)
IF '$DATA(APCLDISP(D))
QUIT
+16 SET P=$PIECE(^AUPNVPRV(APCLX,0),U,4)
IF P=""
SET P="S"
+17 SET APCLPSCT(P)=$GET(APCLPSCT(P))+1
+18 SET ^XTMP("APCLCR1",APCLJOB,APCLBTH,"DATA",P,$PIECE(^VA(200,Y,0),U),Y)=$GET(^XTMP("APCLCR1",APCLJOB,APCLBTH,"DATA",P,$PIECE(^VA(200,Y,0),U),Y))+1
+19 SET ^XTMP("APCLCR1",APCLJOB,APCLBTH,"DATALOC",P,$PIECE(^VA(200,Y,0),U),Y,APCLLOE)=$GET(^XTMP("APCLCR1",APCLJOB,APCLBTH,"DATALOC",P,$PIECE(^VA(200,Y,0),U),Y,APCLLOE))+1
+20 IF $DATA(^XTMP("APCLCR1",APCLJOB,APCLBTH,"VISITS",APCLVDFN))
QUIT
+21 SET APCLVCNT=APCLVCNT+1
SET ^XTMP("APCLCR1",APCLJOB,APCLBTH,"VISITS",APCLVDFN)=""
+22 QUIT
End DoDot:1
+23 QUIT
PRINT ;EP - called from xbdbque
+1 DO COVPAGE
+2 SET APCLPG=0
KILL APCLQUIT
+3 DO HEAD
+4 IF '$DATA(^XTMP("APCLCR1",APCLJOB,APCLBTH,"DATA"))
WRITE !!,"No visits to report.",!
DO DONE
QUIT
+5 WRITE !!,"Total PCC Primary Provider Workload Count:",?45,$JUSTIFY($GET(APCLPSCT("P")),7)
+6 WRITE !,"Total PCC Secondary Provider Workload Count:",?45,$JUSTIFY($GET(APCLPSCT("S")),7)
+7 WRITE !,"Total PCC Provider Workload Count:",?45,$JUSTIFY(($GET(APCLPSCT("P"))+$GET(APCLPSCT("S"))),7)
+8 WRITE !!,"Total Number of Visits: ",?45,$JUSTIFY(APCLVCNT,7)
+9 WRITE !!,"PRIMARY PROVIDERS",?35,"# OF VISITS",!
+10 SET APCLX=""
FOR
SET APCLX=$ORDER(^XTMP("APCLCR1",APCLJOB,APCLBTH,"DATA","P",APCLX))
IF APCLX=""!($DATA(APCLQUIT))
QUIT
Begin DoDot:1
+11 SET APCLY=0
FOR
SET APCLY=$ORDER(^XTMP("APCLCR1",APCLJOB,APCLBTH,"DATA","P",APCLX,APCLY))
IF APCLY'=+APCLY!($DATA(APCLQUIT))
QUIT
Begin DoDot:2
+12 IF $Y>(IOSL-2)
DO HEAD
IF $DATA(APCLQUIT)
QUIT
+13 WRITE !?3,APCLX,?35,$JUSTIFY(^XTMP("APCLCR1",APCLJOB,APCLBTH,"DATA","P",APCLX,APCLY),6)
+14 IF APCLLOCT="O"
QUIT
+15 SET APCLZ=0
FOR
SET APCLZ=$ORDER(^XTMP("APCLCR1",APCLJOB,APCLBTH,"DATALOC","P",APCLX,APCLY,APCLZ))
IF APCLZ'=+APCLZ!($DATA(APCLQUIT))
QUIT
Begin DoDot:3
+16 IF $Y>(IOSL-2)
DO HEAD
IF $DATA(APCLQUIT)
QUIT
+17 WRITE !?6,$PIECE(^AUTTLOC(APCLZ,0),U,7),?14,$JUSTIFY(^XTMP("APCLCR1",APCLJOB,APCLBTH,"DATALOC","P",APCLX,APCLY,APCLZ),6)
End DoDot:3
+18 QUIT
End DoDot:2
+19 QUIT
End DoDot:1
+20 WRITE !!,"SECONDARY PROVIDERS",?35,"# OF VISITS",!
+21 SET APCLX=""
FOR
SET APCLX=$ORDER(^XTMP("APCLCR1",APCLJOB,APCLBTH,"DATA","S",APCLX))
IF APCLX=""!($DATA(APCLQUIT))
QUIT
Begin DoDot:1
+22 SET APCLY=0
FOR
SET APCLY=$ORDER(^XTMP("APCLCR1",APCLJOB,APCLBTH,"DATA","S",APCLX,APCLY))
IF APCLY'=+APCLY!($DATA(APCLQUIT))
QUIT
Begin DoDot:2
+23 IF $Y>(IOSL-2)
DO HEAD
IF $DATA(APCLQUIT)
QUIT
+24 WRITE !?3,APCLX,?35,$JUSTIFY(^XTMP("APCLCR1",APCLJOB,APCLBTH,"DATA","S",APCLX,APCLY),6)
+25 IF APCLLOCT="O"
QUIT
+26 SET APCLZ=0
FOR
SET APCLZ=$ORDER(^XTMP("APCLCR1",APCLJOB,APCLBTH,"DATALOC","S",APCLX,APCLY,APCLZ))
IF APCLZ'=+APCLZ!($DATA(APCLQUIT))
QUIT
Begin DoDot:3
+27 IF $Y>(IOSL-2)
DO HEAD
IF $DATA(APCLQUIT)
QUIT
+28 WRITE !?6,$PIECE(^AUTTLOC(APCLZ,0),U,7),?14,$JUSTIFY(^XTMP("APCLCR1",APCLJOB,APCLBTH,"DATALOC","S",APCLX,APCLY,APCLZ),6)
End DoDot:3
+29 QUIT
End DoDot:2
+30 QUIT
End DoDot:1
DONE ;
+1 DO DONE^APCLOSUT
+2 KILL ^XTMP("APCLCR1",APCLJOB,APCLBTH)
+3 QUIT
COVPAGE ;
+1 IF $DATA(IOF)
WRITE @IOF
+2 WRITE !!,$$CJ^XLFSTR("Tally of Selected Primary and Secondary Providers for selected Clinic Visits",80),!
+3 WRITE !,$$CJ^XLFSTR("Visit Dates: "_$$FMTE^XLFDT(APCLBD)_"-"_$$FMTE^XLFDT(APCLED),80),!
+4 IF '$DATA(APCLLOC)
WRITE !!,"Locations: ALL"
+5 IF $DATA(APCLLOC)
WRITE !!,"Locations:"
+6 SET X=0
FOR
SET X=$ORDER(APCLLOC(X))
IF X'=+X
QUIT
IF $Y>(IOSL-2)
WRITE @IOF,!,"Cover page (con't)",!!
WRITE !?10,$PIECE(^DIC(4,X,0),U)
+7 IF '$DATA(APCLCLNT)
WRITE !!,"Clinics: ALL"
+8 IF $DATA(APCLCLNT)
WRITE !!,"Clinics:"
+9 SET X=0
FOR
SET X=$ORDER(APCLCLNT(X))
IF X'=+X
QUIT
IF $Y>(IOSL-2)
WRITE @IOF,!,"Cover page (con't)",!!
WRITE !?10,$PIECE(^DIC(40.7,X,0),U)
+10 IF '$DATA(APCLDISP)
WRITE !!,"Disciplines: ALL"
+11 IF $DATA(APCLDISP)
WRITE !!,"Disciplines:"
+12 SET X=0
FOR
SET X=$ORDER(APCLDISP(X))
IF X'=+X
QUIT
IF $Y>(IOSL-2)
WRITE @IOF,!,"Cover page (con't)",!!
WRITE !?10,$PIECE(^DIC(7,X,0),U)
+13 QUIT
HEAD IF 'APCLPG
GOTO HEAD1
+1 IF $EXTRACT(IOST)="C"
IF IO=IO(0)
WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF Y=0!(Y="^")!($DATA(DTOUT))
SET APCLQUIT=""
QUIT
HEAD1 ;
+1 IF $DATA(IOF)
WRITE @IOF
SET APCLPG=APCLPG+1
+2 WRITE !?58,$$FMTE^XLFDT(DT),?72,"Page ",APCLPG,!
+3 WRITE $$CJ^XLFSTR("TALLY OF SELECTED PRIMARY AND SECONDARY PROVIDERS FOR SELECTED CLINIC VISITS",80),!
+4 WRITE $$CJ^XLFSTR("Visit Dates: "_$$FMTE^XLFDT(APCLBD)_"-"_$$FMTE^XLFDT(APCLED),80),!
+5 IF '$DATA(APCLLOC)
WRITE $$CJ^XLFSTR("FOR: ALL Locations",80),!
+6 IF APCLLOCT="O"
WRITE $$CJ^XLFSTR("FOR: "_$PIECE(^DIC(4,$ORDER(APCLLOC(0)),0),U),80),!
+7 IF APCLLOCT="S"
WRITE $$CJ^XLFSTR("FOR: "_$PIECE(^AUTTSU(APCLSU,0),U)_" Service Unit",80),!
+8 IF APCLLOCT="T"
WRITE $$CJ^XLFSTR("FOR: A taxonomy or selected set of locations",80),!
+9 WRITE $$REPEAT^XLFSTR("-",80),!
+10 QUIT
O ;
+1 WRITE !
SET DIC("A")="Which Facility: "
SET DIC="^AUTTLOC("
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC,DA
IF Y<0
SET APCLQ=1
QUIT
+2 SET APCLLOC(+Y)=""
+3 QUIT
S ;all communities within APCLSU su
+1 SET DIC="^AUTTSU("
SET DIC("B")=$$VAL^XBDIQ1(9999999.06,DUZ(2),.05)
SET DIC(0)="AEMQ"
SET DIC("A")="Which SERVICE UNIT: "
DO ^DIC
KILL DIC
+2 IF Y=-1
SET APCLQ=""
QUIT
+3 SET APCLSU=+Y
+4 WRITE !!,"Gathering up all the facilities..."
+5 SET X=0
FOR
SET X=$ORDER(^AUTTLOC(X))
IF X'=+X
QUIT
IF $PIECE(^AUTTLOC(X,0),U,5)=+Y
SET APCLLOC(X)=""
+6 QUIT
T ;taxonomy - call qman interface
+1 KILL APCLLOC
+2 SET X="ENCOUNTER LOCATION"
SET DIC="^AMQQ(5,"
SET DIC(0)="FM"
SET DIC("S")="I $P(^(0),U,14)"
DO ^DIC
KILL DIC,DA
IF Y=-1
WRITE "OOPS - QMAN NOT CURRENT - QUITTING"
SET APCLQ=1
QUIT
+3 DO PEP^AMQQGTX0(+Y,"APCLLOC(")
+4 IF '$DATA(APCLLOC)
SET APCLQ=1
QUIT
+5 IF $DATA(APCLLOC("*"))
KILL APCLLOC
WRITE !!,$CHAR(7),$CHAR(7),"ALL locations is NOT an option with this report",!
GOTO T
+6 SET X=""
FOR
SET X=$ORDER(APCLLOC(X))
IF X=""
QUIT
SET APCLLOC(X)=""
+7 QUIT
