BCHRC8P ; IHS/CMI/LAB - print all visit report ;
;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
;IHS/CMI/LAB - tmp to xtmp
START ;
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
I '$D(^XTMP("BCHRC8",BCHJOB,BCHBTH)) S BCHNONE="",BCHPG=0 D HEAD W !!,"NO DATA TO REPORT",!! G DONE
K BCHQUIT S BCHPG=0
;
PROG ; process for each program, monthly numbers
S BCHPROG=0 F S BCHPROG=$O(^XTMP("BCHRC8",BCHJOB,BCHBT,BCHPROG)) Q:BCHPROG'=+BCHPROG!($D(BCHQUIT)) D Q:$D(BCHQUIT)
. D @("HEAD"_(2-($E(IOST,1,2)="C-")))
. Q:$D(BCHQUIT)
.S M="" F S M=$O(^XTMP("BCHRC8",BCHJOB,BCHBT,BCHPROG,"MONTHS",M)) Q:M'=+M!($D(BCHQUIT)) D Q:$D(BCHQUIT)
.. I $Y>(IOSL-4) D EOP Q:$D(BCHQUIT)
..; I $Y>(IOSL-4) D HEAD Q:$D(BCHQUIT)
.. S R=$O(^XTMP("BCHRC8",BCHJOB,BCHBT,BCHPROG,"MONTHS",M,""))
.. W !?3,R F I=1:1:3 S V=$P(^XTMP("BCHRC8",BCHJOB,BCHBT,BCHPROG,"MONTHS",M,R),U,I),V=V/60 W ?(I*20),$J($FN(V,",",0),10)
.. Q
. Q:$D(BCHQUIT)
. D:$O(^XTMP("BCHRC8",BCHJOB,BCHBT,BCHPROG))'="" EOP
. Q
DONE ;
D DONE^BCHUTIL1
K ^XTMP("BCHRC8",BCHJOB,BCHBTH),BCHJOB,BCHBTH
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 ; if terminal
W:$D(IOF) @IOF
HEAD2 ; if printer
S BCHPG=BCHPG+1
W !,$P(^VA(200,DUZ,0),U,2),?58,BCHDT,?72,"Page ",BCHPG,!
W $$CTR^BCHRLU($$LOC^BCHRLU),!
W !?20,"********** CHR REPORT NO. ",BCHRN," **********"
W !!?17,"HOURS (SERVICE+TRAVEL) BY MONTH AND ",BCHCH
I BCHRPT="PR" S BCHPROGN=$S(BCHPRG:$P(^BCHTPROG(BCHPRG,0),U)_" ("_$P(^(0),U,5)_")",1:"ALL"),X=$L(BCHPROGN)+10
I BCHRPT="PR" W !?((80-X)/2),"PROGRAM: ",BCHPROGN
D @BCHRPT
S X=$L("PATIENTS: "_BCHREGN)
W !?((80-X)/2),"PATIENTS: ",BCHREGN
W !?17,"REPORT DATES: ",BCHBDD," TO ",BCHEDD,!
W !,"MONTH/YEAR",?20,"TOTAL HOURS",?40,"SERVICE HOURS",?60,"TRAVEL HOURS"
W !,$TR($J(" ",80)," ","-")
Q
PG ;
Q:$D(BCHNONE)
S BCHPROGN=$P(^BCHTPROG(BCHPROG,0),U)_" ("_$P(^(0),U,5)_")",X=$L(BCHPROGN)+10
W !!?((80-X)/2),"PROGRAM: ",BCHPROGN
Q
PR ;
Q:$D(BCHNONE)
S BCHNAME=$P(^VA(200,BCHPROG,0),U),X=$L(BCHNAME)+11 W !!?((80-X)/2),"PROVIDER: ",$P(^VA(200,BCHPROG,0),U)
Q
;
EOP ; pause OR form feed between pages of report for terminal/printer
I $E(IOST,1,2)="P-"!($D(IO("S"))) W @IOF Q
W ! S DIR(0)="EO" D ^DIR K DIR S:$D(DUOUT) (DIRUT,BCHQUIT)=1
Q
BCHRC8P ; 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
START ;
+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 IF '$DATA(^XTMP("BCHRC8",BCHJOB,BCHBTH))
SET BCHNONE=""
SET BCHPG=0
DO HEAD
WRITE !!,"NO DATA TO REPORT",!!
GOTO DONE
+4 KILL BCHQUIT
SET BCHPG=0
+5 ;
PROG ; process for each program, monthly numbers
+1 SET BCHPROG=0
FOR
SET BCHPROG=$ORDER(^XTMP("BCHRC8",BCHJOB,BCHBT,BCHPROG))
IF BCHPROG'=+BCHPROG!($DATA(BCHQUIT))
QUIT
Begin DoDot:1
+2 DO @("HEAD"_(2-($EXTRACT(IOST,1,2)="C-")))
+3 IF $DATA(BCHQUIT)
QUIT
+4 SET M=""
FOR
SET M=$ORDER(^XTMP("BCHRC8",BCHJOB,BCHBT,BCHPROG,"MONTHS",M))
IF M'=+M!($DATA(BCHQUIT))
QUIT
Begin DoDot:2
+5 IF $Y>(IOSL-4)
DO EOP
IF $DATA(BCHQUIT)
QUIT
+6 ; I $Y>(IOSL-4) D HEAD Q:$D(BCHQUIT)
+7 SET R=$ORDER(^XTMP("BCHRC8",BCHJOB,BCHBT,BCHPROG,"MONTHS",M,""))
+8 WRITE !?3,R
FOR I=1:1:3
SET V=$PIECE(^XTMP("BCHRC8",BCHJOB,BCHBT,BCHPROG,"MONTHS",M,R),U,I)
SET V=V/60
WRITE ?(I*20),$JUSTIFY($FNUMBER(V,",",0),10)
+9 QUIT
End DoDot:2
IF $DATA(BCHQUIT)
QUIT
+10 IF $DATA(BCHQUIT)
QUIT
+11 IF $ORDER(^XTMP("BCHRC8",BCHJOB,BCHBT,BCHPROG))'=""
DO EOP
+12 QUIT
End DoDot:1
IF $DATA(BCHQUIT)
QUIT
DONE ;
+1 DO DONE^BCHUTIL1
+2 KILL ^XTMP("BCHRC8",BCHJOB,BCHBTH),BCHJOB,BCHBTH
+3 QUIT
HEAD ;I 'BCHPG G 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 ; if terminal
+1 IF $DATA(IOF)
WRITE @IOF
HEAD2 ; if printer
+1 SET BCHPG=BCHPG+1
+2 WRITE !,$PIECE(^VA(200,DUZ,0),U,2),?58,BCHDT,?72,"Page ",BCHPG,!
+3 WRITE $$CTR^BCHRLU($$LOC^BCHRLU),!
+4 WRITE !?20,"********** CHR REPORT NO. ",BCHRN," **********"
+5 WRITE !!?17,"HOURS (SERVICE+TRAVEL) BY MONTH AND ",BCHCH
+6 IF BCHRPT="PR"
SET BCHPROGN=$SELECT(BCHPRG:$PIECE(^BCHTPROG(BCHPRG,0),U)_" ("_$PIECE(^(0),U,5)_")",1:"ALL")
SET X=$LENGTH(BCHPROGN)+10
+7 IF BCHRPT="PR"
WRITE !?((80-X)/2),"PROGRAM: ",BCHPROGN
+8 DO @BCHRPT
+9 SET X=$LENGTH("PATIENTS: "_BCHREGN)
+10 WRITE !?((80-X)/2),"PATIENTS: ",BCHREGN
+11 WRITE !?17,"REPORT DATES: ",BCHBDD," TO ",BCHEDD,!
+12 WRITE !,"MONTH/YEAR",?20,"TOTAL HOURS",?40,"SERVICE HOURS",?60,"TRAVEL HOURS"
+13 WRITE !,$TRANSLATE($JUSTIFY(" ",80)," ","-")
+14 QUIT
PG ;
+1 IF $DATA(BCHNONE)
QUIT
+2 SET BCHPROGN=$PIECE(^BCHTPROG(BCHPROG,0),U)_" ("_$PIECE(^(0),U,5)_")"
SET X=$LENGTH(BCHPROGN)+10
+3 WRITE !!?((80-X)/2),"PROGRAM: ",BCHPROGN
+4 QUIT
PR ;
+1 IF $DATA(BCHNONE)
QUIT
+2 SET BCHNAME=$PIECE(^VA(200,BCHPROG,0),U)
SET X=$LENGTH(BCHNAME)+11
WRITE !!?((80-X)/2),"PROVIDER: ",$PIECE(^VA(200,BCHPROG,0),U)
+3 QUIT
+4 ;
EOP ; pause OR form feed between pages of report for terminal/printer
+1 IF $EXTRACT(IOST,1,2)="P-"!($DATA(IO("S")))
WRITE @IOF
QUIT
+2 WRITE !
SET DIR(0)="EO"
DO ^DIR
KILL DIR
IF $DATA(DUOUT)
SET (DIRUT,BCHQUIT)=1
+3 QUIT
