BCHRC1P ; 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
K BCHQUIT S BCHPG=0
S Y=BCHBD D DD^%DT S BCHBDD=Y S Y=BCHED D DD^%DT S BCHEDD=Y
I '$D(^XTMP("BCHRC1",BCHJOB,BCHBTH,"DATA")) D HEAD W !!,"NO DATA TO REPORT",!! G DONE
HA ;
D @("HEAD"_(2-($E(IOST,1,2)="C-")))
;set total numbers and print
S BCHTOTS=($P(^XTMP("BCHRC1",BCHJOB,BCHBTH,"DATA","*TOTAL*"),U,2)/60),BCHTOTA=$P(^("*TOTAL*"),U),BCHTOTC=$P(^("*TOTAL*"),U,4),BCHTOTT=($P(^("*TOTAL*"),U,3)/60)
I $Y>(IOSL-3) D HEAD G:$D(BCHQUIT) DONE
W !?4,"TOTAL",?28,$J($FN(BCHTOTS,",",0),6),?35,"100%",?41,$J($FN(BCHTOTT,",",0),5),?47,"100%",?54,$J($FN(BCHTOTC,",",0),5),?60,"100%",?67,$J($FN(BCHTOTA,",",0),5),?73,"100%",!
S BCHHA="*Z" F S BCHHA=$O(^XTMP("BCHRC1",BCHJOB,BCHBTH,"DATA",BCHHA)) Q:BCHHA=""!($D(BCHQUIT)) D
.S BCHCS=($P(^XTMP("BCHRC1",BCHJOB,BCHBTH,"DATA",BCHHA),U,2)/60),BCHCA=$P(^(BCHHA),U),BCHCC=$P(^(BCHHA),U,4),BCHCT=($P(^(BCHHA),U,3)/60)
.I $Y>(IOSL-4) D HEAD Q:$D(BCHQUIT)
.W !
.I BCHSUB W !
.W $P(BCHHA,"|",2)," ",$E($P(BCHHA,"|"),1,22)
.W ?29,$J(BCHCS,5,0) W ?35,$S(BCHTOTS:$J(((BCHCS/BCHTOTS)*100),3,0),1:$J("0",3,0)),"%"
.W ?41,$J(BCHCT,5,0),?47,$S(BCHTOTT:$J(((BCHCT/BCHTOTT)*100),3,0),1:$J("0",3,0)),"%"
.W ?54,$J(BCHCC,5),?60,$S(BCHTOTC:$J(((BCHCC/BCHTOTC)*100),3,0),1:$J("0",3,0)),"%"
.W ?67,$J(BCHCA,5),?73,$S(BCHTOTA:$J(((BCHCA/BCHTOTA)*100),3,0),1:$J("0",3,0)),"%"
.Q:'BCHSUB
.W !
.S BCHSUB1="" F S BCHSUB1=$O(^XTMP("BCHRC1",BCHJOB,BCHBTH,"DATA",BCHHA,BCHSUB1)) Q:BCHSUB1=""!($D(BCHQUIT)) D
..S BCHCS=($P(^XTMP("BCHRC1",BCHJOB,BCHBTH,"DATA",BCHHA,BCHSUB1),U,2)/60),BCHCA=$P(^(BCHSUB1),U),BCHCC=$P(^(BCHSUB1),U,4),BCHCT=($P(^(BCHSUB1),U,3)/60)
..I $Y>(IOSL-4) D HEAD Q:$D(BCHQUIT)
..W !?2,$P(BCHSUB1,"|",2)," ",$E($P(BCHSUB1,"|"),1,22)
..W ?29,$J(BCHCS,5,0) W ?35,$S(BCHTOTS:$J(((BCHCS/BCHTOTS)*100),3,0),1:$J("0",3,0)),"%"
..W ?41,$J(BCHCT,5,0),?47,$S(BCHTOTT:$J(((BCHCT/BCHTOTT)*100),3,0),1:$J("0",3,0)),"%"
..W ?54,$J(BCHCC,5),?60,$S(BCHTOTC:$J(((BCHCC/BCHTOTC)*100),3,0),1:$J("0",3,0)),"%"
..W ?67,$J(BCHCA,5),?73,$S(BCHTOTA:$J(((BCHCA/BCHTOTA)*100),3,0),1:$J("0",3,0)),"%"
..Q
DONE ;
D DONE^BCHUTIL1
K ^XTMP("BCHRC1",BCHJOB,BCHBTH),BCHJOB,BCHBTH
Q
HEAD ;
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
HEAD2 ;
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. ",BCHRPT," **********"
W !?((80-($L(BCHCH)+47))/2),"TIME SPENT, ",$S(BCHRPT=3:"# SERVED",1:"SERVICE ACTIVITIES"),", AND SERVICES by ",BCHCH
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 BCHPROVN=$S(BCHPROVT="O":$P(^VA(200,BCHCHR1,0),U),1:"ALL"),X=$L(BCHPROGN)+10
W !?((80-X)/2),"PROVIDER: ",BCHPROVN
S X=$L("PATIENTS: "_BCHREGN)
W !?((80-X)/2),"PATIENTS: ",BCHREGN
W !?17,"REPORT DATES: ",BCHBDD," TO ",BCHEDD,!
W !,"* SERVICES is equal to # of Lines of Assessment"
W !!?3,BCHCH,?31,"SERVICE",?44,"TRAVEL",?56,$S(BCHRPT=3:"NUMBER",1:"SERVICE"),?69,"SERVICES*"
W !?31,"HOURS",?44,"HOURS",?56,$S(BCHRPT=3:"SERVED",1:"ACTIVITIES")
W !,$TR($J(" ",80)," ","-")
Q
BCHRC1P ; 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 KILL BCHQUIT
SET BCHPG=0
+3 SET Y=BCHBD
DO DD^%DT
SET BCHBDD=Y
SET Y=BCHED
DO DD^%DT
SET BCHEDD=Y
+4 IF '$DATA(^XTMP("BCHRC1",BCHJOB,BCHBTH,"DATA"))
DO HEAD
WRITE !!,"NO DATA TO REPORT",!!
GOTO DONE
HA ;
+1 DO @("HEAD"_(2-($EXTRACT(IOST,1,2)="C-")))
+2 ;set total numbers and print
+3 SET BCHTOTS=($PIECE(^XTMP("BCHRC1",BCHJOB,BCHBTH,"DATA","*TOTAL*"),U,2)/60)
SET BCHTOTA=$PIECE(^("*TOTAL*"),U)
SET BCHTOTC=$PIECE(^("*TOTAL*"),U,4)
SET BCHTOTT=($PIECE(^("*TOTAL*"),U,3)/60)
+4 IF $Y>(IOSL-3)
DO HEAD
IF $DATA(BCHQUIT)
GOTO DONE
+5 WRITE !?4,"TOTAL",?28,$JUSTIFY($FNUMBER(BCHTOTS,",",0),6),?35,"100%",?41,$JUSTIFY($FNUMBER(BCHTOTT,",",0),5),?47,"100%",?54,$JUSTIFY($FNUMBER(BCHTOTC,",",0),5),?60,"100%",?67,$JUSTIFY($FNUMBER(BCHTOTA,",",0),5),?73,"100%",!
+6 SET BCHHA="*Z"
FOR
SET BCHHA=$ORDER(^XTMP("BCHRC1",BCHJOB,BCHBTH,"DATA",BCHHA))
IF BCHHA=""!($DATA(BCHQUIT))
QUIT
Begin DoDot:1
+7 SET BCHCS=($PIECE(^XTMP("BCHRC1",BCHJOB,BCHBTH,"DATA",BCHHA),U,2)/60)
SET BCHCA=$PIECE(^(BCHHA),U)
SET BCHCC=$PIECE(^(BCHHA),U,4)
SET BCHCT=($PIECE(^(BCHHA),U,3)/60)
+8 IF $Y>(IOSL-4)
DO HEAD
IF $DATA(BCHQUIT)
QUIT
+9 WRITE !
+10 IF BCHSUB
WRITE !
+11 WRITE $PIECE(BCHHA,"|",2)," ",$EXTRACT($PIECE(BCHHA,"|"),1,22)
+12 WRITE ?29,$JUSTIFY(BCHCS,5,0)
WRITE ?35,$SELECT(BCHTOTS:$JUSTIFY(((BCHCS/BCHTOTS)*100),3,0),1:$JUSTIFY("0",3,0)),"%"
+13 WRITE ?41,$JUSTIFY(BCHCT,5,0),?47,$SELECT(BCHTOTT:$JUSTIFY(((BCHCT/BCHTOTT)*100),3,0),1:$JUSTIFY("0",3,0)),"%"
+14 WRITE ?54,$JUSTIFY(BCHCC,5),?60,$SELECT(BCHTOTC:$JUSTIFY(((BCHCC/BCHTOTC)*100),3,0),1:$JUSTIFY("0",3,0)),"%"
+15 WRITE ?67,$JUSTIFY(BCHCA,5),?73,$SELECT(BCHTOTA:$JUSTIFY(((BCHCA/BCHTOTA)*100),3,0),1:$JUSTIFY("0",3,0)),"%"
+16 IF 'BCHSUB
QUIT
+17 WRITE !
+18 SET BCHSUB1=""
FOR
SET BCHSUB1=$ORDER(^XTMP("BCHRC1",BCHJOB,BCHBTH,"DATA",BCHHA,BCHSUB1))
IF BCHSUB1=""!($DATA(BCHQUIT))
QUIT
Begin DoDot:2
+19 SET BCHCS=($PIECE(^XTMP("BCHRC1",BCHJOB,BCHBTH,"DATA",BCHHA,BCHSUB1),U,2)/60)
SET BCHCA=$PIECE(^(BCHSUB1),U)
SET BCHCC=$PIECE(^(BCHSUB1),U,4)
SET BCHCT=($PIECE(^(BCHSUB1),U,3)/60)
+20 IF $Y>(IOSL-4)
DO HEAD
IF $DATA(BCHQUIT)
QUIT
+21 WRITE !?2,$PIECE(BCHSUB1,"|",2)," ",$EXTRACT($PIECE(BCHSUB1,"|"),1,22)
+22 WRITE ?29,$JUSTIFY(BCHCS,5,0)
WRITE ?35,$SELECT(BCHTOTS:$JUSTIFY(((BCHCS/BCHTOTS)*100),3,0),1:$JUSTIFY("0",3,0)),"%"
+23 WRITE ?41,$JUSTIFY(BCHCT,5,0),?47,$SELECT(BCHTOTT:$JUSTIFY(((BCHCT/BCHTOTT)*100),3,0),1:$JUSTIFY("0",3,0)),"%"
+24 WRITE ?54,$JUSTIFY(BCHCC,5),?60,$SELECT(BCHTOTC:$JUSTIFY(((BCHCC/BCHTOTC)*100),3,0),1:$JUSTIFY("0",3,0)),"%"
+25 WRITE ?67,$JUSTIFY(BCHCA,5),?73,$SELECT(BCHTOTA:$JUSTIFY(((BCHCA/BCHTOTA)*100),3,0),1:$JUSTIFY("0",3,0)),"%"
+26 QUIT
End DoDot:2
End DoDot:1
DONE ;
+1 DO DONE^BCHUTIL1
+2 KILL ^XTMP("BCHRC1",BCHJOB,BCHBTH),BCHJOB,BCHBTH
+3 QUIT
HEAD ;
+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
HEAD2 ;
+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. ",BCHRPT," **********"
+5 WRITE !?((80-($LENGTH(BCHCH)+47))/2),"TIME SPENT, ",$SELECT(BCHRPT=3:"# SERVED",1:"SERVICE ACTIVITIES"),", AND SERVICES by ",BCHCH
+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 BCHPROVN=$SELECT(BCHPROVT="O":$PIECE(^VA(200,BCHCHR1,0),U),1:"ALL")
SET X=$LENGTH(BCHPROGN)+10
+9 WRITE !?((80-X)/2),"PROVIDER: ",BCHPROVN
+10 SET X=$LENGTH("PATIENTS: "_BCHREGN)
+11 WRITE !?((80-X)/2),"PATIENTS: ",BCHREGN
+12 WRITE !?17,"REPORT DATES: ",BCHBDD," TO ",BCHEDD,!
+13 WRITE !,"* SERVICES is equal to # of Lines of Assessment"
+14 WRITE !!?3,BCHCH,?31,"SERVICE",?44,"TRAVEL",?56,$SELECT(BCHRPT=3:"NUMBER",1:"SERVICE"),?69,"SERVICES*"
+15 WRITE !?31,"HOURS",?44,"HOURS",?56,$SELECT(BCHRPT=3:"SERVED",1:"ACTIVITIES")
+16 WRITE !,$TRANSLATE($JUSTIFY(" ",80)," ","-")
+17 QUIT
