APCLCZPP ; IHS/CMI/LAB - print all visit report ;
;;2.0;IHS PCC SUITE;;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 (APCLTOT,APCLPG,APCLVLOC)=0 D HEAD
K APCLQUIT
F S APCLVLOC=$O(^XTMP("APCLCZP",APCLJOB,APCLBTH,"LOCTOT",APCLVLOC)) Q:APCLVLOC=""!($D(APCLQUIT)) D SORT
G:$D(APCLQUIT) DONE
I $Y>(IOSL-5) D HEAD G:$D(APCLQUIT) DONE
W !?60,"--------",!
W ?52,"Total:",?60,$J(APCLTOT,8),!
DONE ;
D DONE^APCLOSUT
K ^XTMP("APCLCZP",APCLJOB,APCLBTH)
Q
SORT ;
I $Y>(IOSL-6) D HEAD Q:$D(APCLQUIT)
W !,$P(^DIC(4,APCLVLOC,0),U) W:APCLPROC'="LOS" !
S APCLSORT="" F S APCLSORT=$O(^XTMP("APCLCZP",APCLJOB,APCLBTH,"LOCTOT",APCLVLOC,APCLSORT)) Q:APCLSORT=""!($D(APCLQUIT)) D P
Q:$D(APCLQUIT)
Q:APCLPROC="LOS"
W !?60,"--------",!
W ?40,"Location Subtotal:",?60,$J(^XTMP("APCLCZP",APCLJOB,APCLBTH,"SUBTOTAL",APCLVLOC),8),!
Q
P ;
S APCLCLNT=0
S:'$D(^XTMP("APCLCZP",APCLJOB,APCLBTH,"SUBTOTAL",APCLVLOC)) ^XTMP("APCLCZP",APCLJOB,APCLBTH,"SUBTOTAL",APCLVLOC)=0
I $Y>(IOSL-5) D HEAD Q:$D(APCLQUIT)
S APCLSRT2=$O(^XTMP("APCLCZP",APCLJOB,APCLBTH,"LOCTOT",APCLVLOC,APCLSORT,""))
S APCLPRNT=APCLSORT I APCLPROC="DATE" S Y=APCLPRNT D DD^%DT S APCLPRNT=Y
W:APCLPROC'="LOS" !?5,$E(APCLPRNT,1,25)," (",APCLSRT2,")"
S APCLCZP="" F S APCLCZP=$O(^XTMP("APCLCZP",APCLJOB,APCLBTH,"LOCTOT",APCLVLOC,APCLSORT,APCLSRT2,APCLCZP)) Q:APCLCZP="" D
.W !?35,APCLCZP,?60,$J(^XTMP("APCLCZP",APCLJOB,APCLBTH,"LOCTOT",APCLVLOC,APCLSORT,APCLSRT2,APCLCZP),8)
.S APCLCLNT=APCLCLNT+^XTMP("APCLCZP",APCLJOB,APCLBTH,"LOCTOT",APCLVLOC,APCLSORT,APCLSRT2,APCLCZP)
.S APCLTOT=APCLTOT+^XTMP("APCLCZP",APCLJOB,APCLBTH,"LOCTOT",APCLVLOC,APCLSORT,APCLSRT2,APCLCZP)
.S ^XTMP("APCLCZP",APCLJOB,APCLBTH,"SUBTOTAL",APCLVLOC)=^XTMP("APCLCZP",APCLJOB,APCLBTH,"SUBTOTAL",APCLVLOC)+^XTMP("APCLCZP",APCLJOB,APCLBTH,"LOCTOT",APCLVLOC,APCLSORT,APCLSRT2,APCLCZP)
W !!?40,"Clinic Total:",?60,$J(APCLCLNT,8)
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 ?58,APCLDT,?72,"Page ",APCLPG,!
S APCLLENG=31+$L(APCLTITL)
W ?((80-APCLLENG)/2),"NUMBER OF AMBULATORY VISITS BY ",APCLTITL,!
S APCLLOCT=$S(APCLLOC="":"ALL",1:$P(^DIC(4,APCLLOC,0),U))
S APCLLENG=21+$L(APCLLOCT)
W ?((80-APCLLENG)/2),"LOCATION OF VISITS: ",APCLLOCT,!
W ?18,"VISIT DATES: ",APCLBDD," TO ",APCLEDD,!
W !,"LOCATION OF VISIT"
W !?5,APCLHD1," (CODE)",?35,"ZIP CODE",?60,"# VISITS",!
W APCL80S,!
Q
APCLCZPP ; IHS/CMI/LAB - print all visit report ;
+1 ;;2.0;IHS PCC SUITE;;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 (APCLTOT,APCLPG,APCLVLOC)=0
DO HEAD
+5 KILL APCLQUIT
+6 FOR
SET APCLVLOC=$ORDER(^XTMP("APCLCZP",APCLJOB,APCLBTH,"LOCTOT",APCLVLOC))
IF APCLVLOC=""!($DATA(APCLQUIT))
QUIT
DO SORT
+7 IF $DATA(APCLQUIT)
GOTO DONE
+8 IF $Y>(IOSL-5)
DO HEAD
IF $DATA(APCLQUIT)
GOTO DONE
+9 WRITE !?60,"--------",!
+10 WRITE ?52,"Total:",?60,$JUSTIFY(APCLTOT,8),!
DONE ;
+1 DO DONE^APCLOSUT
+2 KILL ^XTMP("APCLCZP",APCLJOB,APCLBTH)
+3 QUIT
SORT ;
+1 IF $Y>(IOSL-6)
DO HEAD
IF $DATA(APCLQUIT)
QUIT
+2 WRITE !,$PIECE(^DIC(4,APCLVLOC,0),U)
IF APCLPROC'="LOS"
WRITE !
+3 SET APCLSORT=""
FOR
SET APCLSORT=$ORDER(^XTMP("APCLCZP",APCLJOB,APCLBTH,"LOCTOT",APCLVLOC,APCLSORT))
IF APCLSORT=""!($DATA(APCLQUIT))
QUIT
DO P
+4 IF $DATA(APCLQUIT)
QUIT
+5 IF APCLPROC="LOS"
QUIT
+6 WRITE !?60,"--------",!
+7 WRITE ?40,"Location Subtotal:",?60,$JUSTIFY(^XTMP("APCLCZP",APCLJOB,APCLBTH,"SUBTOTAL",APCLVLOC),8),!
+8 QUIT
P ;
+1 SET APCLCLNT=0
+2 IF '$DATA(^XTMP("APCLCZP",APCLJOB,APCLBTH,"SUBTOTAL",APCLVLOC))
SET ^XTMP("APCLCZP",APCLJOB,APCLBTH,"SUBTOTAL",APCLVLOC)=0
+3 IF $Y>(IOSL-5)
DO HEAD
IF $DATA(APCLQUIT)
QUIT
+4 SET APCLSRT2=$ORDER(^XTMP("APCLCZP",APCLJOB,APCLBTH,"LOCTOT",APCLVLOC,APCLSORT,""))
+5 SET APCLPRNT=APCLSORT
IF APCLPROC="DATE"
SET Y=APCLPRNT
DO DD^%DT
SET APCLPRNT=Y
+6 IF APCLPROC'="LOS"
WRITE !?5,$EXTRACT(APCLPRNT,1,25)," (",APCLSRT2,")"
+7 SET APCLCZP=""
FOR
SET APCLCZP=$ORDER(^XTMP("APCLCZP",APCLJOB,APCLBTH,"LOCTOT",APCLVLOC,APCLSORT,APCLSRT2,APCLCZP))
IF APCLCZP=""
QUIT
Begin DoDot:1
+8 WRITE !?35,APCLCZP,?60,$JUSTIFY(^XTMP("APCLCZP",APCLJOB,APCLBTH,"LOCTOT",APCLVLOC,APCLSORT,APCLSRT2,APCLCZP),8)
+9 SET APCLCLNT=APCLCLNT+^XTMP("APCLCZP",APCLJOB,APCLBTH,"LOCTOT",APCLVLOC,APCLSORT,APCLSRT2,APCLCZP)
+10 SET APCLTOT=APCLTOT+^XTMP("APCLCZP",APCLJOB,APCLBTH,"LOCTOT",APCLVLOC,APCLSORT,APCLSRT2,APCLCZP)
+11 SET ^XTMP("APCLCZP",APCLJOB,APCLBTH,"SUBTOTAL",APCLVLOC)=^XTMP("APCLCZP",APCLJOB,APCLBTH,"SUBTOTAL",APCLVLOC)+^XTMP("APCLCZP",APCLJOB,APCLBTH,"LOCTOT",APCLVLOC,APCLSORT,APCLSRT2,APCLCZP)
End DoDot:1
+12 WRITE !!?40,"Clinic Total:",?60,$JUSTIFY(APCLCLNT,8)
+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 !
+3 WRITE ?58,APCLDT,?72,"Page ",APCLPG,!
+4 SET APCLLENG=31+$LENGTH(APCLTITL)
+5 WRITE ?((80-APCLLENG)/2),"NUMBER OF AMBULATORY VISITS BY ",APCLTITL,!
+6 SET APCLLOCT=$SELECT(APCLLOC="":"ALL",1:$PIECE(^DIC(4,APCLLOC,0),U))
+7 SET APCLLENG=21+$LENGTH(APCLLOCT)
+8 WRITE ?((80-APCLLENG)/2),"LOCATION OF VISITS: ",APCLLOCT,!
+9 WRITE ?18,"VISIT DATES: ",APCLBDD," TO ",APCLEDD,!
+10 WRITE !,"LOCATION OF VISIT"
+11 WRITE !?5,APCLHD1," (CODE)",?35,"ZIP CODE",?60,"# VISITS",!
+12 WRITE APCL80S,!
+13 QUIT
