APCLCP6P ; IHS/CMI/LAB - print activity report ;
;;2.0;IHS PCC SUITE;**2**;MAY 14, 2009
START ;
S APCL80S="-------------------------------------------------------------------------------"
D NOW^%DTC S Y=X D DD^%DT S APCLDT=Y
S Y=APCLBD D DD^%DT S APCLBDD=Y S Y=APCLED D DD^%DT S APCLEDD=Y
S (APCLPG,APCLVAL)=0
I '$D(^XTMP(APCLNSP,APCLJOB,APCLBT)) D HEAD W !,"No data to report.",! G DONE
K APCLQUIT
F S APCLVAL=$O(^XTMP(APCLNSP,APCLJOB,APCLBT,APCLVAL)) Q:APCLVAL'=+APCLVAL!($D(APCLQUIT)) D LOC
DONE ;
D DONE^APCLOSUT
K ^XTMP(APCLNSP,APCLJOB,APCLBT)
Q
LOC ;
D HEAD,SUBHEAD Q:$D(APCLQUIT)
S ^XTMP(APCLNSP,APCLJOB,APCLBT,"SUBTOTAL",APCLVAL,"TOTAL")=0
S APCLLOC="" F S APCLLOC=$O(^XTMP(APCLNSP,APCLJOB,APCLBT,APCLVAL,APCLLOC)) Q:APCLLOC=""!($D(APCLQUIT)) D P
W !!?10,"TOTAL:"
W ?38,$J($S($D(^XTMP(APCLNSP,APCLJOB,APCLBT,"SUBTOTAL",APCLVAL,"TOTAL")):^("TOTAL"),1:0),7)
Q
P ;
S:$D(^XTMP(APCLNSP,APCLJOB,APCLBT,APCLVAL,APCLLOC,"TOTAL")) ^XTMP(APCLNSP,APCLJOB,APCLBT,"SUBTOTAL",APCLVAL,"TOTAL")=^XTMP(APCLNSP,APCLJOB,APCLBT,"SUBTOTAL",APCLVAL,"TOTAL")+^XTMP(APCLNSP,APCLJOB,APCLBT,APCLVAL,APCLLOC,"TOTAL")
I $Y>(IOSL-5) D HEAD,SUBHEAD Q:$D(APCLQUIT)
W !,$E($P(^DIC(4,APCLLOC,0),U),1,26),?38,$J($S($D(^XTMP(APCLNSP,APCLJOB,APCLBT,APCLVAL,APCLLOC,"TOTAL")):^("TOTAL"),1:0),7)
Q
SUBHEAD ;
Q:$D(APCLQUIT)
I APCLSORV="APCLAP" S APCLVALP=$S($P(^DD(9000010.06,.01,0),U,2)[200:$P(^VA(200,APCLVAL,0),U),1:$P(^DIC(16,APCLVAL,0),U)) S APCLLENG=$L(APCLVALP)
I APCLSORV="APCLSU" S APCLLENG=$L($S(APCLSU:$P(^AUTTSU(APCLSU,0),U),1:"UNKNOWN/MISSING")),APCLVALP=$S(APCLSU:$P(^AUTTSU(APCLSU,0),U),1:"UNKNOWN/MISSING")
W ?(80-(11+APCLLENG)/2),APCLSORT,": ",APCLVALP
W !!?35,"TOTAL NUMBER OF"
W !?35,"INDIVIDUALS SEEN"
W !,APCL80S,!
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 !
W APCLDT,?72,"Page ",APCLPG,!
W ?(80-(36+$L($P(^APCLACTG(APCLACTG,0),U)))/2),"NUMBER OF INDIVIDUALS SEEN BY ",$P(^APCLACTG(APCLACTG,0),U)," STAFF",!
W ?18,"VISIT DATES: ",APCLBDD," TO ",APCLEDD,!
S X="" I '$D(APCLLOC) S X="All Locations"
I $D(APCLLOC) S X="Locations: " S Y=0 F S Y=$O(APCLLOC(Y)) Q:Y'=+Y S X=X_$E($P(^DIC(4,Y,0),U),1,10)_"; "
W $$CTR^APCLCP1P(X),!
S X="" I '$D(APCLCLN) S X="All Clinics"
I $D(APCLCLN) S X="Clinics: " S Y=0 F S Y=$O(APCLCLN(Y)) Q:Y'=+Y S X=X_$E($P(^DIC(40.7,Y,0),U),1,10)_"; "
W $$CTR^APCLCP1P(X),!
Q
APCLCP6P ; IHS/CMI/LAB - print activity report ;
+1 ;;2.0;IHS PCC SUITE;**2**;MAY 14, 2009
START ;
+1 SET APCL80S="-------------------------------------------------------------------------------"
+2 DO NOW^%DTC
SET Y=X
DO DD^%DT
SET APCLDT=Y
+3 SET Y=APCLBD
DO DD^%DT
SET APCLBDD=Y
SET Y=APCLED
DO DD^%DT
SET APCLEDD=Y
+4 SET (APCLPG,APCLVAL)=0
+5 IF '$DATA(^XTMP(APCLNSP,APCLJOB,APCLBT))
DO HEAD
WRITE !,"No data to report.",!
GOTO DONE
+6 KILL APCLQUIT
+7 FOR
SET APCLVAL=$ORDER(^XTMP(APCLNSP,APCLJOB,APCLBT,APCLVAL))
IF APCLVAL'=+APCLVAL!($DATA(APCLQUIT))
QUIT
DO LOC
DONE ;
+1 DO DONE^APCLOSUT
+2 KILL ^XTMP(APCLNSP,APCLJOB,APCLBT)
+3 QUIT
LOC ;
+1 DO HEAD
DO SUBHEAD
IF $DATA(APCLQUIT)
QUIT
+2 SET ^XTMP(APCLNSP,APCLJOB,APCLBT,"SUBTOTAL",APCLVAL,"TOTAL")=0
+3 SET APCLLOC=""
FOR
SET APCLLOC=$ORDER(^XTMP(APCLNSP,APCLJOB,APCLBT,APCLVAL,APCLLOC))
IF APCLLOC=""!($DATA(APCLQUIT))
QUIT
DO P
+4 WRITE !!?10,"TOTAL:"
+5 WRITE ?38,$JUSTIFY($SELECT($DATA(^XTMP(APCLNSP,APCLJOB,APCLBT,"SUBTOTAL",APCLVAL,"TOTAL")):^("TOTAL"),1:0),7)
+6 QUIT
P ;
+1 IF $DATA(^XTMP(APCLNSP,APCLJOB,APCLBT,APCLVAL,APCLLOC,"TOTAL"))
SET ^XTMP(APCLNSP,APCLJOB,APCLBT,"SUBTOTAL",APCLVAL,"TOTAL")=^XTMP(APCLNSP,APCLJOB,APCLBT,"SUBTOTAL",APCLVAL,"TOTAL")+^XTMP(APCLNSP,APCLJOB,APCLBT,APCLVAL,APCLLOC,"TOTAL")
+2 IF $Y>(IOSL-5)
DO HEAD
DO SUBHEAD
IF $DATA(APCLQUIT)
QUIT
+3 WRITE !,$EXTRACT($PIECE(^DIC(4,APCLLOC,0),U),1,26),?38,$JUSTIFY($SELECT($DATA(^XTMP(APCLNSP,APCLJOB,APCLBT,APCLVAL,APCLLOC,"TOTAL")):^("TOTAL"),1:0),7)
+4 QUIT
SUBHEAD ;
+1 IF $DATA(APCLQUIT)
QUIT
+2 IF APCLSORV="APCLAP"
SET APCLVALP=$SELECT($PIECE(^DD(9000010.06,.01,0),U,2)[200:$PIECE(^VA(200,APCLVAL,0),U),1:$PIECE(^DIC(16,APCLVAL,0),U))
SET APCLLENG=$LENGTH(APCLVALP)
+3 IF APCLSORV="APCLSU"
SET APCLLENG=$LENGTH($SELECT(APCLSU:$PIECE(^AUTTSU(APCLSU,0),U),1:"UNKNOWN/MISSING"))
SET APCLVALP=$SELECT(APCLSU:$PIECE(^AUTTSU(APCLSU,0),U),1:"UNKNOWN/MISSING")
+4 WRITE ?(80-(11+APCLLENG)/2),APCLSORT,": ",APCLVALP
+5 WRITE !!?35,"TOTAL NUMBER OF"
+6 WRITE !?35,"INDIVIDUALS SEEN"
+7 WRITE !,APCL80S,!
+8 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 !
+3 WRITE APCLDT,?72,"Page ",APCLPG,!
+4 WRITE ?(80-(36+$LENGTH($PIECE(^APCLACTG(APCLACTG,0),U)))/2),"NUMBER OF INDIVIDUALS SEEN BY ",$PIECE(^APCLACTG(APCLACTG,0),U)," STAFF",!
+5 WRITE ?18,"VISIT DATES: ",APCLBDD," TO ",APCLEDD,!
+6 SET X=""
IF '$DATA(APCLLOC)
SET X="All Locations"
+7 IF $DATA(APCLLOC)
SET X="Locations: "
SET Y=0
FOR
SET Y=$ORDER(APCLLOC(Y))
IF Y'=+Y
QUIT
SET X=X_$EXTRACT($PIECE(^DIC(4,Y,0),U),1,10)_"; "
+8 WRITE $$CTR^APCLCP1P(X),!
+9 SET X=""
IF '$DATA(APCLCLN)
SET X="All Clinics"
+10 IF $DATA(APCLCLN)
SET X="Clinics: "
SET Y=0
FOR
SET Y=$ORDER(APCLCLN(Y))
IF Y'=+Y
QUIT
SET X=X_$EXTRACT($PIECE(^DIC(40.7,Y,0),U),1,10)_"; "
+11 WRITE $$CTR^APCLCP1P(X),!
+12 QUIT
