AMHRAP2P ; IHS/CMI/LAB - print all visit report ;
;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
PRINT ;
D NOW^%DTC S Y=X D DD^%DT S AMHDT=Y
S Y=AMHBD D DD^%DT S AMHBDD=Y S Y=AMHED D DD^%DT S AMHEDD=Y
D COVPAGE^AMHRPTCP
S (AMHTOT,AMHPG,AMHPTOT,AMHTTOT,AMHNTOT)=0 D HEAD
K AMHQUIT
D SORT
G:$D(AMHQUIT) DONE
I $Y>(IOSL-5) D HEAD G:$D(AMHQUIT) DONE
W !?42,"------",?50,"------",?59,"-------",?70,"------",!
;W ?28,"Totals:",?40,$J(AMHTOT,8),?48,$J(AMHPTOT,8) S X=AMHTTOT,X=$J((X/60),6,1) W ?58,$J(X,8)
W ?28,"Totals:",?40,$J(AMHTOT,8) S X=AMHTTOT,X=$J((X/60),6,1) W ?58,$J(X,8)
W ?68,$J(AMHNTOT,8)
DONE ;
D DONE^AMHLEIN,^AMHEKL
K ^XTMP("AMHRAP2",AMHJOB,AMHBTH)
K AMHBT,AMHET
Q
SORT ;
I $Y>(IOSL-6) D HEAD Q:$D(AMHQUIT)
S AMHSORT="" F S AMHSORT=$O(^XTMP("AMHRAP2",AMHJOB,AMHBTH,"TOTAL",AMHSORT)) Q:AMHSORT=""!($D(AMHQUIT)) D P
Q
P ;
I $Y>(IOSL-5) D HEAD Q:$D(AMHQUIT)
S AMHSRT2=$O(^XTMP("AMHRAP2",AMHJOB,AMHBTH,"TOTAL",AMHSORT,""))
S AMHPRNT=AMHSORT I AMHRPROC="DATE" S Y=AMHPRNT D DD^%DT S AMHPRNT=Y
W !,$E(AMHPRNT,1,23),?26,$E(AMHSRT2,1,12),?40,$J(^XTMP("AMHRAP2",AMHJOB,AMHBTH,"TOTAL",AMHSORT,AMHSRT2),8)
W ?48,$S($D(^XTMP("AMHRAP2",AMHJOB,AMHBTH,"PATIENT",AMHSORT,AMHSRT2)):$J(^XTMP("AMHRAP2",AMHJOB,AMHBTH,"PATIENT",AMHSORT,AMHSRT2),8),1:$J(0,8))
I $D(^XTMP("AMHRAP2",AMHJOB,AMHBTH,"TIME TOTAL",AMHSORT,AMHSRT2)) S X=^(AMHSRT2),X=$J((X/60),1,1) W ?58,$J(X,8)
W ?68,$S($D(^XTMP("AMHRAP2",AMHJOB,AMHBTH,"# SERVED",AMHSORT,AMHSRT2)):$J(^XTMP("AMHRAP2",AMHJOB,AMHBTH,"# SERVED",AMHSORT,AMHSRT2),8),1:$J(0,8))
S AMHTOT=AMHTOT+^XTMP("AMHRAP2",AMHJOB,AMHBTH,"TOTAL",AMHSORT,AMHSRT2)
S AMHPTOT=AMHPTOT+$S($D(^XTMP("AMHRAP2",AMHJOB,AMHBTH,"PATIENT",AMHSORT,AMHSRT2)):^(AMHSRT2),1:0)
S AMHNTOT=AMHNTOT+$S($D(^XTMP("AMHRAP2",AMHJOB,AMHBTH,"# SERVED",AMHSORT,AMHSRT2)):^(AMHSRT2),1:0)
S AMHTTOT=AMHTTOT+$S($D(^XTMP("AMHRAP2",AMHJOB,AMHBTH,"TIME TOTAL",AMHSORT,AMHSRT2)):^(AMHSRT2),1:0)
Q
HEAD I 'AMHPG 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 AMHQUIT="" Q
HEAD1 ;
W:$D(IOF) @IOF S AMHPG=AMHPG+1
W !
W ?58,AMHDT,?72,"Page ",AMHPG,!
W ?17,"RECORD DATES: ",AMHBDD," TO ",AMHEDD,!
S AMHLENG=30+$L(AMHTITL)
W ?((80-AMHLENG)/2),"NUMBER OF ACTIVITY RECORDS BY ",AMHTITL,!
W !,AMHHD1,?26,$E(AMHHD2,1,13),?42,"# RECS",?50,"# PATS",?60,"ACTIVITY",?70,"# SERVED",!,?60,"TIME",!
W !,$TR($J(" ",80)," ","-")
Q
AMHRAP2P ; IHS/CMI/LAB - print all visit report ;
+1 ;;4.0;IHS BEHAVIORAL HEALTH;;MAY 14, 2010
PRINT ;
+1 DO NOW^%DTC
SET Y=X
DO DD^%DT
SET AMHDT=Y
+2 SET Y=AMHBD
DO DD^%DT
SET AMHBDD=Y
SET Y=AMHED
DO DD^%DT
SET AMHEDD=Y
+3 DO COVPAGE^AMHRPTCP
+4 SET (AMHTOT,AMHPG,AMHPTOT,AMHTTOT,AMHNTOT)=0
DO HEAD
+5 KILL AMHQUIT
+6 DO SORT
+7 IF $DATA(AMHQUIT)
GOTO DONE
+8 IF $Y>(IOSL-5)
DO HEAD
IF $DATA(AMHQUIT)
GOTO DONE
+9 WRITE !?42,"------",?50,"------",?59,"-------",?70,"------",!
+10 ;W ?28,"Totals:",?40,$J(AMHTOT,8),?48,$J(AMHPTOT,8) S X=AMHTTOT,X=$J((X/60),6,1) W ?58,$J(X,8)
+11 WRITE ?28,"Totals:",?40,$JUSTIFY(AMHTOT,8)
SET X=AMHTTOT
SET X=$JUSTIFY((X/60),6,1)
WRITE ?58,$JUSTIFY(X,8)
+12 WRITE ?68,$JUSTIFY(AMHNTOT,8)
DONE ;
+1 DO DONE^AMHLEIN
DO ^AMHEKL
+2 KILL ^XTMP("AMHRAP2",AMHJOB,AMHBTH)
+3 KILL AMHBT,AMHET
+4 QUIT
SORT ;
+1 IF $Y>(IOSL-6)
DO HEAD
IF $DATA(AMHQUIT)
QUIT
+2 SET AMHSORT=""
FOR
SET AMHSORT=$ORDER(^XTMP("AMHRAP2",AMHJOB,AMHBTH,"TOTAL",AMHSORT))
IF AMHSORT=""!($DATA(AMHQUIT))
QUIT
DO P
+3 QUIT
P ;
+1 IF $Y>(IOSL-5)
DO HEAD
IF $DATA(AMHQUIT)
QUIT
+2 SET AMHSRT2=$ORDER(^XTMP("AMHRAP2",AMHJOB,AMHBTH,"TOTAL",AMHSORT,""))
+3 SET AMHPRNT=AMHSORT
IF AMHRPROC="DATE"
SET Y=AMHPRNT
DO DD^%DT
SET AMHPRNT=Y
+4 WRITE !,$EXTRACT(AMHPRNT,1,23),?26,$EXTRACT(AMHSRT2,1,12),?40,$JUSTIFY(^XTMP("AMHRAP2",AMHJOB,AMHBTH,"TOTAL",AMHSORT,AMHSRT2),8)
+5 WRITE ?48,$SELECT($DATA(^XTMP("AMHRAP2",AMHJOB,AMHBTH,"PATIENT",AMHSORT,AMHSRT2)):$JUSTIFY(^XTMP("AMHRAP2",AMHJOB,AMHBTH,"PATIENT",AMHSORT,AMHSRT2),8),1:$JUSTIFY(0,8))
+6 IF $DATA(^XTMP("AMHRAP2",AMHJOB,AMHBTH,"TIME TOTAL",AMHSORT,AMHSRT2))
SET X=^(AMHSRT2)
SET X=$JUSTIFY((X/60),1,1)
WRITE ?58,$JUSTIFY(X,8)
+7 WRITE ?68,$SELECT($DATA(^XTMP("AMHRAP2",AMHJOB,AMHBTH,"# SERVED",AMHSORT,AMHSRT2)):$JUSTIFY(^XTMP("AMHRAP2",AMHJOB,AMHBTH,"# SERVED",AMHSORT,AMHSRT2),8),1:$JUSTIFY(0,8))
+8 SET AMHTOT=AMHTOT+^XTMP("AMHRAP2",AMHJOB,AMHBTH,"TOTAL",AMHSORT,AMHSRT2)
+9 SET AMHPTOT=AMHPTOT+$SELECT($DATA(^XTMP("AMHRAP2",AMHJOB,AMHBTH,"PATIENT",AMHSORT,AMHSRT2)):^(AMHSRT2),1:0)
+10 SET AMHNTOT=AMHNTOT+$SELECT($DATA(^XTMP("AMHRAP2",AMHJOB,AMHBTH,"# SERVED",AMHSORT,AMHSRT2)):^(AMHSRT2),1:0)
+11 SET AMHTTOT=AMHTTOT+$SELECT($DATA(^XTMP("AMHRAP2",AMHJOB,AMHBTH,"TIME TOTAL",AMHSORT,AMHSRT2)):^(AMHSRT2),1:0)
+12 QUIT
HEAD IF 'AMHPG
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 AMHQUIT=""
QUIT
HEAD1 ;
+1 IF $DATA(IOF)
WRITE @IOF
SET AMHPG=AMHPG+1
+2 WRITE !
+3 WRITE ?58,AMHDT,?72,"Page ",AMHPG,!
+4 WRITE ?17,"RECORD DATES: ",AMHBDD," TO ",AMHEDD,!
+5 SET AMHLENG=30+$LENGTH(AMHTITL)
+6 WRITE ?((80-AMHLENG)/2),"NUMBER OF ACTIVITY RECORDS BY ",AMHTITL,!
+7 WRITE !,AMHHD1,?26,$EXTRACT(AMHHD2,1,13),?42,"# RECS",?50,"# PATS",?60,"ACTIVITY",?70,"# SERVED",!,?60,"TIME",!
+8 WRITE !,$TRANSLATE($JUSTIFY(" ",80)," ","-")
+9 QUIT