BCHRAP2P ; IHS/CMI/LAB - print all visit report ;
;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
;IHS/CMI/LAB - tmp to xtmp
;
;Print routine.
;
PRINT ;
D NOW^%DTC S Y=X D DD^%DT S BCHDT=Y
S Y=BCHBD D DD^%DT S BCHBDD=Y S Y=BCHED D DD^%DT S BCHEDD=Y
D COVPAGE^BCHRPTCP
S (BCHTOT,BCHPG,BCHPTOT,BCHTTOT)=0 D HEAD
K BCHQUIT
D SORT
G:$D(BCHQUIT) DONE
I $Y>(IOSL-5) D HEAD G:$D(BCHQUIT) DONE
W !?47,"--------",?56,"--------",?68,"--------",!
W ?32,"Totals:",?45,$J(BCHTOT,8),?54,$J(BCHPTOT,8) S X=BCHTTOT,X=$J((X/60),6,1) W ?66,$J(X,8)
DONE ;
D DONE^BCHUTIL1
K ^XTMP("BCHRAP2",BCHJOB,BCHBTH)
K BCHBT,BCHET
Q
SORT ;
I $Y>(IOSL-6) D HEAD Q:$D(BCHQUIT)
S BCHSORT="" F S BCHSORT=$O(^XTMP("BCHRAP2",BCHJOB,BCHBTH,"TOTAL",BCHSORT)) Q:BCHSORT=""!($D(BCHQUIT)) D P
Q
P ;
I $Y>(IOSL-5) D HEAD Q:$D(BCHQUIT)
S BCHSRT2=$O(^XTMP("BCHRAP2",BCHJOB,BCHBTH,"TOTAL",BCHSORT,""))
S BCHPRNT=BCHSORT I BCHRPROC="DATE" S Y=BCHPRNT D DD^%DT S BCHPRNT=Y
W !,$E(BCHPRNT,1,25) W ?28,$E(BCHSRT2,1,15),?45,$J(^XTMP("BCHRAP2",BCHJOB,BCHBTH,"TOTAL",BCHSORT,BCHSRT2),8)
W ?54,$S($D(^XTMP("BCHRAP2",BCHJOB,BCHBTH,"PATIENT",BCHSORT,BCHSRT2)):$J(^XTMP("BCHRAP2",BCHJOB,BCHBTH,"PATIENT",BCHSORT,BCHSRT2),8),1:$J(0,8))
I $D(^XTMP("BCHRAP2",BCHJOB,BCHBTH,"TIME TOTAL",BCHSORT,BCHSRT2)) S X=^(BCHSRT2),X=$J((X/60),1,1) W ?66,$J(X,8)
S BCHTOT=BCHTOT+^XTMP("BCHRAP2",BCHJOB,BCHBTH,"TOTAL",BCHSORT,BCHSRT2)
S BCHPTOT=BCHPTOT+$S($D(^XTMP("BCHRAP2",BCHJOB,BCHBTH,"PATIENT",BCHSORT,BCHSRT2)):^(BCHSRT2),1:0)
S BCHTTOT=BCHTTOT+$S($D(^XTMP("BCHRAP2",BCHJOB,BCHBTH,"TIME TOTAL",BCHSORT,BCHSRT2)):^(BCHSRT2),1:0)
Q
HEAD I 'BCHPG 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 BCHQUIT="" Q
HEAD1 ;
W:$D(IOF) @IOF S BCHPG=BCHPG+1
W !
W ?58,BCHDT,?72,"Page ",BCHPG,!
W $$CTR^BCHRLU($$LOC^BCHRLU),!
W ?17,"RECORD DATES: ",BCHBDD," TO ",BCHEDD,!
S BCHLENG=30+$L(BCHTITL)
W ?((80-BCHLENG)/2),"NUMBER OF ACTIVITY RECORDS BY ",BCHTITL,!
W !,BCHHD1,?28,$E(BCHHD2,1,13),?47,"# PCC",?56,"# SERVED",?65,"ACTIVITY TIME",!,?47,"FORMS",?67,"(hrs)",!
W !,$TR($J(" ",80)," ","-")
Q
BCHRAP2P ; IHS/CMI/LAB - print all visit report ;
+1 ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
+2 ;IHS/CMI/LAB - tmp to xtmp
+3 ;
+4 ;Print routine.
+5 ;
PRINT ;
+1 DO NOW^%DTC
SET Y=X
DO DD^%DT
SET BCHDT=Y
+2 SET Y=BCHBD
DO DD^%DT
SET BCHBDD=Y
SET Y=BCHED
DO DD^%DT
SET BCHEDD=Y
+3 DO COVPAGE^BCHRPTCP
+4 SET (BCHTOT,BCHPG,BCHPTOT,BCHTTOT)=0
DO HEAD
+5 KILL BCHQUIT
+6 DO SORT
+7 IF $DATA(BCHQUIT)
GOTO DONE
+8 IF $Y>(IOSL-5)
DO HEAD
IF $DATA(BCHQUIT)
GOTO DONE
+9 WRITE !?47,"--------",?56,"--------",?68,"--------",!
+10 WRITE ?32,"Totals:",?45,$JUSTIFY(BCHTOT,8),?54,$JUSTIFY(BCHPTOT,8)
SET X=BCHTTOT
SET X=$JUSTIFY((X/60),6,1)
WRITE ?66,$JUSTIFY(X,8)
DONE ;
+1 DO DONE^BCHUTIL1
+2 KILL ^XTMP("BCHRAP2",BCHJOB,BCHBTH)
+3 KILL BCHBT,BCHET
+4 QUIT
SORT ;
+1 IF $Y>(IOSL-6)
DO HEAD
IF $DATA(BCHQUIT)
QUIT
+2 SET BCHSORT=""
FOR
SET BCHSORT=$ORDER(^XTMP("BCHRAP2",BCHJOB,BCHBTH,"TOTAL",BCHSORT))
IF BCHSORT=""!($DATA(BCHQUIT))
QUIT
DO P
+3 QUIT
P ;
+1 IF $Y>(IOSL-5)
DO HEAD
IF $DATA(BCHQUIT)
QUIT
+2 SET BCHSRT2=$ORDER(^XTMP("BCHRAP2",BCHJOB,BCHBTH,"TOTAL",BCHSORT,""))
+3 SET BCHPRNT=BCHSORT
IF BCHRPROC="DATE"
SET Y=BCHPRNT
DO DD^%DT
SET BCHPRNT=Y
+4 WRITE !,$EXTRACT(BCHPRNT,1,25)
WRITE ?28,$EXTRACT(BCHSRT2,1,15),?45,$JUSTIFY(^XTMP("BCHRAP2",BCHJOB,BCHBTH,"TOTAL",BCHSORT,BCHSRT2),8)
+5 WRITE ?54,$SELECT($DATA(^XTMP("BCHRAP2",BCHJOB,BCHBTH,"PATIENT",BCHSORT,BCHSRT2)):$JUSTIFY(^XTMP("BCHRAP2",BCHJOB,BCHBTH,"PATIENT",BCHSORT,BCHSRT2),8),1:$JUSTIFY(0,8))
+6 IF $DATA(^XTMP("BCHRAP2",BCHJOB,BCHBTH,"TIME TOTAL",BCHSORT,BCHSRT2))
SET X=^(BCHSRT2)
SET X=$JUSTIFY((X/60),1,1)
WRITE ?66,$JUSTIFY(X,8)
+7 SET BCHTOT=BCHTOT+^XTMP("BCHRAP2",BCHJOB,BCHBTH,"TOTAL",BCHSORT,BCHSRT2)
+8 SET BCHPTOT=BCHPTOT+$SELECT($DATA(^XTMP("BCHRAP2",BCHJOB,BCHBTH,"PATIENT",BCHSORT,BCHSRT2)):^(BCHSRT2),1:0)
+9 SET BCHTTOT=BCHTTOT+$SELECT($DATA(^XTMP("BCHRAP2",BCHJOB,BCHBTH,"TIME TOTAL",BCHSORT,BCHSRT2)):^(BCHSRT2),1:0)
+10 QUIT
HEAD IF 'BCHPG
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 BCHQUIT=""
QUIT
HEAD1 ;
+1 IF $DATA(IOF)
WRITE @IOF
SET BCHPG=BCHPG+1
+2 WRITE !
+3 WRITE ?58,BCHDT,?72,"Page ",BCHPG,!
+4 WRITE $$CTR^BCHRLU($$LOC^BCHRLU),!
+5 WRITE ?17,"RECORD DATES: ",BCHBDD," TO ",BCHEDD,!
+6 SET BCHLENG=30+$LENGTH(BCHTITL)
+7 WRITE ?((80-BCHLENG)/2),"NUMBER OF ACTIVITY RECORDS BY ",BCHTITL,!
+8 WRITE !,BCHHD1,?28,$EXTRACT(BCHHD2,1,13),?47,"# PCC",?56,"# SERVED",?65,"ACTIVITY TIME",!,?47,"FORMS",?67,"(hrs)",!
+9 WRITE !,$TRANSLATE($JUSTIFY(" ",80)," ","-")
+10 QUIT
