BCHRP3P ; 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
S (BCHATOT,BCHACTOT,BCHSTOT,BCHFTOT,BCHPTOT,BCHPG)=0
D @("HEAD"_(2-($E(IOST,1,2)="C-")))
K BCHQUIT
PROG ;
S BCHPROG="" F S BCHPROG=$O(^XTMP("BCHRP3",BCHJOB,BCHBTH,"RECORDS",BCHPROG)) Q:BCHPROG=""!($D(BCHQUIT)) D
.S (BCHATOT("R"),BCHATOT("AT"))=0
.I $Y>(IOSL-4) D HEAD Q:$D(BCHQUIT)
.W !,"PROGRAM: ",BCHPROG
.D LOC
.Q:$D(BCHQUIT)
.I $Y>(IOSL-5) D HEAD Q:$D(BCHQUIT)
.W !?59,"=======",?67,"=======",!
.W "PROGRAM TOTAL:",?59,$J(BCHATOT("R"),7),?67,$J((BCHATOT("AT")/60),7,1),!
DONE ;
D DONE^BCHUTIL1
K ^XTMP("BCHRP3",BCHJOB,BCHBTH)
Q
LOC ;
S BCHLOC="" F S BCHLOC=$O(^XTMP("BCHRP3",BCHJOB,BCHBTH,"RECORDS",BCHPROG,BCHLOC)) Q:BCHLOC=""!($D(BCHQUIT)) D
.S (BCHLTOT("R"),BCHLTOT("AT"))=0
.I $Y>(IOSL-4) D HEAD Q:$D(BCHQUIT)
.W !?4,"ACTIVITY LOCATION: ",BCHLOC
.D PROV
.Q:$D(BCHQUIT)
.I $Y>(IOSL-5) D HEAD Q:$D(BCHQUIT)
.W !?59,"=======",?67,"=======",!
.W ?4,"ACTIVITY LOCATION TOTAL:",?59,$J(BCHLTOT("R"),7),?67,$J((BCHLTOT("AT")/60),7,1),!
Q
PROV ;
S BCHPROV="" F S BCHPROV=$O(^XTMP("BCHRP3",BCHJOB,BCHBTH,"RECORDS",BCHPROG,BCHLOC,BCHPROV)) Q:BCHPROV=""!($D(BCHQUIT)) D
.S (BCHPTOT("R"),BCHPTOT("AT"))=0
.I $Y>(IOSL-4) D HEAD Q:$D(BCHQUIT)
.W !?11,"CHR: ",BCHPROV
.D ACT
.Q:$D(BCHQUIT)
.I $Y>(IOSL-5) D HEAD Q:$D(BCHQUIT)
.W !?59,"=======",?67,"=======",!
.W ?11,"PROVIDER TOTAL:",?59,$J(BCHPTOT("R"),7),?67,$J((BCHPTOT("AT")/60),7,1),!
Q
ACT ;
S BCHACT="" F S BCHACT=$O(^XTMP("BCHRP3",BCHJOB,BCHBTH,"RECORDS",BCHPROG,BCHLOC,BCHPROV,BCHACT)) Q:BCHACT=""!($D(BCHQUIT)) D
.S (BCHACTOT("R"),BCHACTOT("AT"))=0
.I $Y>(IOSL-4) D HEAD Q:$D(BCHQUIT)
.W !?17,"ACTIVITY: ",$E(BCHACT,1,28)
.D PROB
.Q:$D(BCHQUIT)
.I $Y>(IOSL-5) D HEAD Q:$D(BCHQUIT)
.W !?59,"=======",?67,"=======",!
.W ?17,"ACTIVITY TOTAL:",?59,$J(BCHACTOT("R"),7),?67,$J((BCHACTOT("AT")/60),7,1),!
Q
PROB ;
S BCHPROB="" F S BCHPROB=$O(^XTMP("BCHRP3",BCHJOB,BCHBTH,"RECORDS",BCHPROG,BCHLOC,BCHPROV,BCHACT,BCHPROB)) Q:BCHPROB=""!($D(BCHQUIT)) D
.I $Y>(IOSL-4) D HEAD Q:$D(BCHQUIT)
.S BCHREC=$P(^XTMP("BCHRP3",BCHJOB,BCHBT,"RECORDS",BCHPROG,BCHLOC,BCHPROV,BCHACT,BCHPROB),U),BCHAT=$P(^(BCHPROB),U,2),BCHPAT=$P(^(BCHPROB),U,3)
.W !?22,"PROBLEM:",?32,$E(BCHPROB,1,30),?59,$J(BCHREC,7),?67,$J((BCHAT/60),7,1)
.S BCHATOT("R")=BCHATOT("R")+BCHREC,BCHLTOT("R")=BCHLTOT("R")+BCHREC,BCHPTOT("R")=BCHPTOT("R")+BCHREC,BCHACTOT("R")=BCHACTOT("R")+BCHREC
.S BCHATOT("AT")=BCHATOT("AT")+BCHAT,BCHLTOT("AT")=BCHLTOT("AT")+BCHAT,BCHPTOT("AT")=BCHPTOT("AT")+BCHAT,BCHACTOT("AT")=BCHACTOT("AT")+BCHAT
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 !?13,"********** CONFIDENTIAL PATIENT INFORMATION **********"
W !,$P(^VA(200,DUZ,0),U,2),?33,BCHDT,?70,"Page ",BCHPG,!
W $$CTR^BCHRLU($$LOC^BCHRLU),!
W ?24,"ACTIVITY REPORT BY HEALTH PROBLEM",!
S BCHPROGN=$S(BCHPRG:$P(^BCHTPROG(BCHPRG,0),U)_" ("_$P(^(0),U,5)_")",1:"ALL"),X=$L(BCHPROGN)+10
W ?((80-X)/2),"PROGRAM: ",BCHPROGN,!
S X=$L("PATIENTS: "_BCHREGN)
W ?((80-X)/2),"PATIENTS: ",BCHREGN
W !?17,"REPORT DATES: ",BCHBDD," TO ",BCHEDD,!
W !?52,"# Activities",?66,"ACT TIME (hrs)",!
W !,$TR($J(" ",80)," ","-")
Q
BCHRP3P ; 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 SET (BCHATOT,BCHACTOT,BCHSTOT,BCHFTOT,BCHPTOT,BCHPG)=0
+4 DO @("HEAD"_(2-($EXTRACT(IOST,1,2)="C-")))
+5 KILL BCHQUIT
PROG ;
+1 SET BCHPROG=""
FOR
SET BCHPROG=$ORDER(^XTMP("BCHRP3",BCHJOB,BCHBTH,"RECORDS",BCHPROG))
IF BCHPROG=""!($DATA(BCHQUIT))
QUIT
Begin DoDot:1
+2 SET (BCHATOT("R"),BCHATOT("AT"))=0
+3 IF $Y>(IOSL-4)
DO HEAD
IF $DATA(BCHQUIT)
QUIT
+4 WRITE !,"PROGRAM: ",BCHPROG
+5 DO LOC
+6 IF $DATA(BCHQUIT)
QUIT
+7 IF $Y>(IOSL-5)
DO HEAD
IF $DATA(BCHQUIT)
QUIT
+8 WRITE !?59,"=======",?67,"=======",!
+9 WRITE "PROGRAM TOTAL:",?59,$JUSTIFY(BCHATOT("R"),7),?67,$JUSTIFY((BCHATOT("AT")/60),7,1),!
End DoDot:1
DONE ;
+1 DO DONE^BCHUTIL1
+2 KILL ^XTMP("BCHRP3",BCHJOB,BCHBTH)
+3 QUIT
LOC ;
+1 SET BCHLOC=""
FOR
SET BCHLOC=$ORDER(^XTMP("BCHRP3",BCHJOB,BCHBTH,"RECORDS",BCHPROG,BCHLOC))
IF BCHLOC=""!($DATA(BCHQUIT))
QUIT
Begin DoDot:1
+2 SET (BCHLTOT("R"),BCHLTOT("AT"))=0
+3 IF $Y>(IOSL-4)
DO HEAD
IF $DATA(BCHQUIT)
QUIT
+4 WRITE !?4,"ACTIVITY LOCATION: ",BCHLOC
+5 DO PROV
+6 IF $DATA(BCHQUIT)
QUIT
+7 IF $Y>(IOSL-5)
DO HEAD
IF $DATA(BCHQUIT)
QUIT
+8 WRITE !?59,"=======",?67,"=======",!
+9 WRITE ?4,"ACTIVITY LOCATION TOTAL:",?59,$JUSTIFY(BCHLTOT("R"),7),?67,$JUSTIFY((BCHLTOT("AT")/60),7,1),!
End DoDot:1
+10 QUIT
PROV ;
+1 SET BCHPROV=""
FOR
SET BCHPROV=$ORDER(^XTMP("BCHRP3",BCHJOB,BCHBTH,"RECORDS",BCHPROG,BCHLOC,BCHPROV))
IF BCHPROV=""!($DATA(BCHQUIT))
QUIT
Begin DoDot:1
+2 SET (BCHPTOT("R"),BCHPTOT("AT"))=0
+3 IF $Y>(IOSL-4)
DO HEAD
IF $DATA(BCHQUIT)
QUIT
+4 WRITE !?11,"CHR: ",BCHPROV
+5 DO ACT
+6 IF $DATA(BCHQUIT)
QUIT
+7 IF $Y>(IOSL-5)
DO HEAD
IF $DATA(BCHQUIT)
QUIT
+8 WRITE !?59,"=======",?67,"=======",!
+9 WRITE ?11,"PROVIDER TOTAL:",?59,$JUSTIFY(BCHPTOT("R"),7),?67,$JUSTIFY((BCHPTOT("AT")/60),7,1),!
End DoDot:1
+10 QUIT
ACT ;
+1 SET BCHACT=""
FOR
SET BCHACT=$ORDER(^XTMP("BCHRP3",BCHJOB,BCHBTH,"RECORDS",BCHPROG,BCHLOC,BCHPROV,BCHACT))
IF BCHACT=""!($DATA(BCHQUIT))
QUIT
Begin DoDot:1
+2 SET (BCHACTOT("R"),BCHACTOT("AT"))=0
+3 IF $Y>(IOSL-4)
DO HEAD
IF $DATA(BCHQUIT)
QUIT
+4 WRITE !?17,"ACTIVITY: ",$EXTRACT(BCHACT,1,28)
+5 DO PROB
+6 IF $DATA(BCHQUIT)
QUIT
+7 IF $Y>(IOSL-5)
DO HEAD
IF $DATA(BCHQUIT)
QUIT
+8 WRITE !?59,"=======",?67,"=======",!
+9 WRITE ?17,"ACTIVITY TOTAL:",?59,$JUSTIFY(BCHACTOT("R"),7),?67,$JUSTIFY((BCHACTOT("AT")/60),7,1),!
End DoDot:1
+10 QUIT
PROB ;
+1 SET BCHPROB=""
FOR
SET BCHPROB=$ORDER(^XTMP("BCHRP3",BCHJOB,BCHBTH,"RECORDS",BCHPROG,BCHLOC,BCHPROV,BCHACT,BCHPROB))
IF BCHPROB=""!($DATA(BCHQUIT))
QUIT
Begin DoDot:1
+2 IF $Y>(IOSL-4)
DO HEAD
IF $DATA(BCHQUIT)
QUIT
+3 SET BCHREC=$PIECE(^XTMP("BCHRP3",BCHJOB,BCHBT,"RECORDS",BCHPROG,BCHLOC,BCHPROV,BCHACT,BCHPROB),U)
SET BCHAT=$PIECE(^(BCHPROB),U,2)
SET BCHPAT=$PIECE(^(BCHPROB),U,3)
+4 WRITE !?22,"PROBLEM:",?32,$EXTRACT(BCHPROB,1,30),?59,$JUSTIFY(BCHREC,7),?67,$JUSTIFY((BCHAT/60),7,1)
+5 SET BCHATOT("R")=BCHATOT("R")+BCHREC
SET BCHLTOT("R")=BCHLTOT("R")+BCHREC
SET BCHPTOT("R")=BCHPTOT("R")+BCHREC
SET BCHACTOT("R")=BCHACTOT("R")+BCHREC
+6 SET BCHATOT("AT")=BCHATOT("AT")+BCHAT
SET BCHLTOT("AT")=BCHLTOT("AT")+BCHAT
SET BCHPTOT("AT")=BCHPTOT("AT")+BCHAT
SET BCHACTOT("AT")=BCHACTOT("AT")+BCHAT
End DoDot:1
+7 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 !?13,"********** CONFIDENTIAL PATIENT INFORMATION **********"
+3 WRITE !,$PIECE(^VA(200,DUZ,0),U,2),?33,BCHDT,?70,"Page ",BCHPG,!
+4 WRITE $$CTR^BCHRLU($$LOC^BCHRLU),!
+5 WRITE ?24,"ACTIVITY REPORT BY HEALTH PROBLEM",!
+6 SET BCHPROGN=$SELECT(BCHPRG:$PIECE(^BCHTPROG(BCHPRG,0),U)_" ("_$PIECE(^(0),U,5)_")",1:"ALL")
SET X=$LENGTH(BCHPROGN)+10
+7 WRITE ?((80-X)/2),"PROGRAM: ",BCHPROGN,!
+8 SET X=$LENGTH("PATIENTS: "_BCHREGN)
+9 WRITE ?((80-X)/2),"PATIENTS: ",BCHREGN
+10 WRITE !?17,"REPORT DATES: ",BCHBDD," TO ",BCHEDD,!
+11 WRITE !?52,"# Activities",?66,"ACT TIME (hrs)",!
+12 WRITE !,$TRANSLATE($JUSTIFY(" ",80)," ","-")
+13 QUIT
