APCLAP2P ; IHS/CMI/LAB - print all visit report ;
;;2.0;IHS PCC SUITE;**7,20**;MAY 14, 2009;Build 25
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("APCLAP2",APCLJOB,APCLBTH,"LOCTOT",APCLVLOC)) Q:APCLVLOC=""!($D(APCLQUIT)) D SORT
I APCLTOTL,APCLPROC'="LOS" D
.S APCLGTOT=0
.S APCLLTT="ALL LOCATIONS COMBINED"
.I $Y>(IOSL-6) D HEAD Q:$D(APCLQUIT)
.W !,APCLLTT W:APCLPROC'="LOS" !
.S APCLSORT="" F S APCLSORT=$O(^XTMP("APCLAP2",APCLJOB,APCLBTH,"ALLLOC",APCLSORT)) Q:APCLSORT=""!($D(APCLQUIT)) D
..S APCLSRT2="" F S APCLSRT2=$O(^XTMP("APCLAP2",APCLJOB,APCLBTH,"ALLLOC",APCLSORT,APCLSRT2)) Q:APCLSRT2=""!($D(APCLQUIT)) D
...I $Y>(IOSL-5) D HEAD Q:$D(APCLQUIT)
...S APCLPRNT=APCLSORT I APCLPROC="DATE" S Y=APCLPRNT D DD^%DT S APCLPRNT=Y
...W:APCLPROC'="LOS" !?5,$E(APCLPRNT,1,25) W ?35,$E(APCLSRT2,1,20),?60,$J(^XTMP("APCLAP2",APCLJOB,APCLBTH,"ALLLOC",APCLSORT,APCLSRT2),8)
...S APCLGTOT=APCLGTOT+^XTMP("APCLAP2",APCLJOB,APCLBTH,"ALLLOC",APCLSORT,APCLSRT2)
.Q:APCLPROC="LOS"
.;W !?60,"--------",!
.;W ?50,"TOTAL:",?60,$J(APCLGTOT,8),!
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("APCLAP2",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("APCLAP2",APCLJOB,APCLBTH,"LOCTOT",APCLVLOC,APCLSORT)) Q:APCLSORT=""!($D(APCLQUIT)) D P
Q:APCLPROC="LOS"
W !?60,"--------",!
W ?50,"Subtotal:",?60,$J(^XTMP("APCLAP2",APCLJOB,APCLBTH,"SUBTOTAL",APCLVLOC),8),!
Q
P ;
S APCLSRT2="" F S APCLSRT2=$O(^XTMP("APCLAP2",APCLJOB,APCLBTH,"LOCTOT",APCLVLOC,APCLSORT,APCLSRT2)) Q:APCLSRT2=""!($D(APCLQUIT)) D
.S:'$D(^XTMP("APCLAP2",APCLJOB,APCLBTH,"SUBTOTAL",APCLVLOC)) ^XTMP("APCLAP2",APCLJOB,APCLBTH,"SUBTOTAL",APCLVLOC)=0
.I $Y>(IOSL-5) D HEAD Q:$D(APCLQUIT)
.;S APCLSRT2=$O(^XTMP("APCLAP2",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) W ?35,$E(APCLSRT2,1,20),?60,$J(^XTMP("APCLAP2",APCLJOB,APCLBTH,"LOCTOT",APCLVLOC,APCLSORT,APCLSRT2),8)
.S APCLTOT=APCLTOT+^XTMP("APCLAP2",APCLJOB,APCLBTH,"LOCTOT",APCLVLOC,APCLSORT,APCLSRT2)
.S ^XTMP("APCLAP2",APCLJOB,APCLBTH,"SUBTOTAL",APCLVLOC)=^XTMP("APCLAP2",APCLJOB,APCLBTH,"SUBTOTAL",APCLVLOC)+^XTMP("APCLAP2",APCLJOB,APCLBTH,"LOCTOT",APCLVLOC,APCLSORT,APCLSRT2)
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=0:"ALL",1:"SELECTED")
S APCLLENG=21+$L(APCLLOCT)
W ?((80-APCLLENG)/2),"LOCATION OF VISITS: ",APCLLOCT,!
S X="Chart Reviews are "_$S('APCLCRYN:"not ",1:"")_"included." W $$CTR(X,80),!
W ?18,"VISIT DATES: ",APCLBDD," TO ",APCLEDD,!
W !,"LOCATION OF VISIT"
W !?5,APCLHD1,?35,APCLHD2,?60,"# VISITS",!
W APCL80S,!
Q
;
CTR(X,Y) ;EP - Center X in a field Y wide.
Q $J("",$S($D(Y):Y,1:IOM)-$L(X)\2)_X
;----------
APCLAP2P ; IHS/CMI/LAB - print all visit report ;
+1 ;;2.0;IHS PCC SUITE;**7,20**;MAY 14, 2009;Build 25
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("APCLAP2",APCLJOB,APCLBTH,"LOCTOT",APCLVLOC))
IF APCLVLOC=""!($DATA(APCLQUIT))
QUIT
DO SORT
+7 IF APCLTOTL
IF APCLPROC'="LOS"
Begin DoDot:1
+8 SET APCLGTOT=0
+9 SET APCLLTT="ALL LOCATIONS COMBINED"
+10 IF $Y>(IOSL-6)
DO HEAD
IF $DATA(APCLQUIT)
QUIT
+11 WRITE !,APCLLTT
IF APCLPROC'="LOS"
WRITE !
+12 SET APCLSORT=""
FOR
SET APCLSORT=$ORDER(^XTMP("APCLAP2",APCLJOB,APCLBTH,"ALLLOC",APCLSORT))
IF APCLSORT=""!($DATA(APCLQUIT))
QUIT
Begin DoDot:2
+13 SET APCLSRT2=""
FOR
SET APCLSRT2=$ORDER(^XTMP("APCLAP2",APCLJOB,APCLBTH,"ALLLOC",APCLSORT,APCLSRT2))
IF APCLSRT2=""!($DATA(APCLQUIT))
QUIT
Begin DoDot:3
+14 IF $Y>(IOSL-5)
DO HEAD
IF $DATA(APCLQUIT)
QUIT
+15 SET APCLPRNT=APCLSORT
IF APCLPROC="DATE"
SET Y=APCLPRNT
DO DD^%DT
SET APCLPRNT=Y
+16 IF APCLPROC'="LOS"
WRITE !?5,$EXTRACT(APCLPRNT,1,25)
WRITE ?35,$EXTRACT(APCLSRT2,1,20),?60,$JUSTIFY(^XTMP("APCLAP2",APCLJOB,APCLBTH,"ALLLOC",APCLSORT,APCLSRT2),8)
+17 SET APCLGTOT=APCLGTOT+^XTMP("APCLAP2",APCLJOB,APCLBTH,"ALLLOC",APCLSORT,APCLSRT2)
End DoDot:3
End DoDot:2
+18 IF APCLPROC="LOS"
QUIT
+19 ;W !?60,"--------",!
+20 ;W ?50,"TOTAL:",?60,$J(APCLGTOT,8),!
End DoDot:1
+21 IF $DATA(APCLQUIT)
GOTO DONE
+22 IF $Y>(IOSL-5)
DO HEAD
IF $DATA(APCLQUIT)
GOTO DONE
+23 WRITE !?60,"--------",!
+24 WRITE ?52,"Total:",?60,$JUSTIFY(APCLTOT,8),!
DONE ;
+1 DO DONE^APCLOSUT
+2 KILL ^XTMP("APCLAP2",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("APCLAP2",APCLJOB,APCLBTH,"LOCTOT",APCLVLOC,APCLSORT))
IF APCLSORT=""!($DATA(APCLQUIT))
QUIT
DO P
+4 IF APCLPROC="LOS"
QUIT
+5 WRITE !?60,"--------",!
+6 WRITE ?50,"Subtotal:",?60,$JUSTIFY(^XTMP("APCLAP2",APCLJOB,APCLBTH,"SUBTOTAL",APCLVLOC),8),!
+7 QUIT
P ;
+1 SET APCLSRT2=""
FOR
SET APCLSRT2=$ORDER(^XTMP("APCLAP2",APCLJOB,APCLBTH,"LOCTOT",APCLVLOC,APCLSORT,APCLSRT2))
IF APCLSRT2=""!($DATA(APCLQUIT))
QUIT
Begin DoDot:1
+2 IF '$DATA(^XTMP("APCLAP2",APCLJOB,APCLBTH,"SUBTOTAL",APCLVLOC))
SET ^XTMP("APCLAP2",APCLJOB,APCLBTH,"SUBTOTAL",APCLVLOC)=0
+3 IF $Y>(IOSL-5)
DO HEAD
IF $DATA(APCLQUIT)
QUIT
+4 ;S APCLSRT2=$O(^XTMP("APCLAP2",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)
WRITE ?35,$EXTRACT(APCLSRT2,1,20),?60,$JUSTIFY(^XTMP("APCLAP2",APCLJOB,APCLBTH,"LOCTOT",APCLVLOC,APCLSORT,APCLSRT2),8)
+7 SET APCLTOT=APCLTOT+^XTMP("APCLAP2",APCLJOB,APCLBTH,"LOCTOT",APCLVLOC,APCLSORT,APCLSRT2)
+8 SET ^XTMP("APCLAP2",APCLJOB,APCLBTH,"SUBTOTAL",APCLVLOC)=^XTMP("APCLAP2",APCLJOB,APCLBTH,"SUBTOTAL",APCLVLOC)+^XTMP("APCLAP2",APCLJOB,APCLBTH,"LOCTOT",APCLVLOC,APCLSORT,APCLSRT2)
End DoDot:1
+9 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=0:"ALL",1:"SELECTED")
+7 SET APCLLENG=21+$LENGTH(APCLLOCT)
+8 WRITE ?((80-APCLLENG)/2),"LOCATION OF VISITS: ",APCLLOCT,!
+9 SET X="Chart Reviews are "_$SELECT('APCLCRYN:"not ",1:"")_"included."
WRITE $$CTR(X,80),!
+10 WRITE ?18,"VISIT DATES: ",APCLBDD," TO ",APCLEDD,!
+11 WRITE !,"LOCATION OF VISIT"
+12 WRITE !?5,APCLHD1,?35,APCLHD2,?60,"# VISITS",!
+13 WRITE APCL80S,!
+14 QUIT
+15 ;
CTR(X,Y) ;EP - Center X in a field Y wide.
+1 QUIT $JUSTIFY("",$SELECT($DATA(Y):Y,1:IOM)-$LENGTH(X)\2)_X
+2 ;----------
