BCHRU1P ; 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("BCHRU1",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=(BCHPATS("ST")/60)
S BCHTOTA=BCHPATS
S BCHTOTC=BCHPATS("F")
S BCHTOTT=BCHPATS("M")
I $Y>(IOSL-3) D HEAD G:$D(BCHQUIT) DONE
W !?4,"TOTAL",?28,$J($FN(BCHTOTA,",",0),6),?35,"100%",?41,$J($FN(BCHTOTC,",",0),5),?47,"100%",?54,$J($FN(BCHTOTT,",",0),5),?60,"100%",?67,$J($FN(BCHTOTS,",",0),5),?73,"100%",!
S BCHHA="*Z" F S BCHHA=$O(^XTMP("BCHRU1",BCHJOB,BCHBTH,"DATA",BCHHA)) Q:BCHHA=""!($D(BCHQUIT)) D
.S BCHCS=($P(^XTMP("BCHRU1",BCHJOB,BCHBTH,"DATA",BCHHA),U,4)/60),BCHCA=$P(^(BCHHA),U),BCHCC=$P(^(BCHHA),U,2),BCHCT=$P(^(BCHHA),U,3)
.I $Y>(IOSL-4) D HEAD Q:$D(BCHQUIT)
.W !
.I BCHSUB W !
.W ?0,$E($P(BCHHA,"|",2),1,25)," ",$E($P(BCHHA,"|"),1,22)
.W ?29,$J(BCHCA,5),?35,$S(BCHTOTA:$J(((BCHCA/BCHTOTA)*100),3,0),1:$J("0",3,0)),"%"
.W ?41,$J(BCHCC,5),?47,$S(BCHTOTC:$J(((BCHCC/BCHTOTC)*100),3,0),1:$J("0",3,0)),"%"
.W ?54,$J(BCHCT,5),?60,$S(BCHTOTT:$J(((BCHCT/BCHTOTT)*100),3,0),1:$J("0",3,0)),"%"
.W ?67,$J(BCHCS,5,0) W ?73,$S(BCHTOTS:$J(((BCHCS/BCHTOTS)*100),3,0),1:$J("0",3,0)),"%"
.Q:'BCHSUB
.W !
.S BCHSUB1="" F S BCHSUB1=$O(^XTMP("BCHRU1",BCHJOB,BCHBTH,"DATA",BCHHA,BCHSUB1)) Q:BCHSUB1=""!($D(BCHQUIT)) D
..S BCHCS=($P(^XTMP("BCHRU1",BCHJOB,BCHBTH,"DATA",BCHHA,BCHSUB1),U,4)/60),BCHCA=$P(^(BCHSUB1),U),BCHCC=$P(^(BCHSUB1),U,2),BCHCT=$P(^(BCHSUB1),U,3)
..I $Y>(IOSL-4) D HEAD Q:$D(BCHQUIT)
..W !?2,$P(BCHSUB1,"|",2)," ",$E($P(BCHSUB1,"|"),1,22)
..W ?29,$J(BCHCA,5) W ?35,$S(BCHTOTA:$J(((BCHCA/BCHTOTA)*100),3,0),1:$J("0",3,0)),"%"
..W ?41,$J(BCHCC,5),?47,$S(BCHTOTC:$J(((BCHCC/BCHTOTC)*100),3,0),1:$J("0",3,0)),"%"
..W ?54,$J(BCHCT,5),?60,$S(BCHTOTT:$J(((BCHCT/BCHTOTT)*100),3,0),1:$J("0",3,0)),"%"
..W ?67,$J(BCHCS,5,0),?73,$S(BCHTOTS:$J(((BCHCS/BCHTOTS)*100),3,0),1:$J("0",3,0)),"%"
..Q
DONE ;
D DONE^BCHUTIL1
K ^XTMP("BCHRU1",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),!
S X="********** UNDUPLICATED PATIENT REPORT NO. "_BCHRPT_" **********" W !,$$CTR^BCHRLU(X,80)
S X="Unduplicated Patient Count by "_BCHCH W !,$$CTR^BCHRLU(X,80)
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 !!?3,BCHCH,?31,"# PATIENTS",?44,"# FEMALES",?56,"# MALES",?69,"SERVICE"
W !?69,"HOURS"
W !,$TR($J(" ",80)," ","-")
Q
BCHRU1P ; 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("BCHRU1",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=(BCHPATS("ST")/60)
+4 SET BCHTOTA=BCHPATS
+5 SET BCHTOTC=BCHPATS("F")
+6 SET BCHTOTT=BCHPATS("M")
+7 IF $Y>(IOSL-3)
DO HEAD
IF $DATA(BCHQUIT)
GOTO DONE
+8 WRITE !?4,"TOTAL",?28,$JUSTIFY($FNUMBER(BCHTOTA,",",0),6),?35,"100%",?41,$JUSTIFY($FNUMBER(BCHTOTC,",",0),5),?47,"100%",?54,$JUSTIFY($FNUMBER(BCHTOTT,",",0),5),?60,"100%",?67,$JUSTIFY($FNUMBER(BCHTOTS,",",0),5),?73,"100%",!
+9 SET BCHHA="*Z"
FOR
SET BCHHA=$ORDER(^XTMP("BCHRU1",BCHJOB,BCHBTH,"DATA",BCHHA))
IF BCHHA=""!($DATA(BCHQUIT))
QUIT
Begin DoDot:1
+10 SET BCHCS=($PIECE(^XTMP("BCHRU1",BCHJOB,BCHBTH,"DATA",BCHHA),U,4)/60)
SET BCHCA=$PIECE(^(BCHHA),U)
SET BCHCC=$PIECE(^(BCHHA),U,2)
SET BCHCT=$PIECE(^(BCHHA),U,3)
+11 IF $Y>(IOSL-4)
DO HEAD
IF $DATA(BCHQUIT)
QUIT
+12 WRITE !
+13 IF BCHSUB
WRITE !
+14 WRITE ?0,$EXTRACT($PIECE(BCHHA,"|",2),1,25)," ",$EXTRACT($PIECE(BCHHA,"|"),1,22)
+15 WRITE ?29,$JUSTIFY(BCHCA,5),?35,$SELECT(BCHTOTA:$JUSTIFY(((BCHCA/BCHTOTA)*100),3,0),1:$JUSTIFY("0",3,0)),"%"
+16 WRITE ?41,$JUSTIFY(BCHCC,5),?47,$SELECT(BCHTOTC:$JUSTIFY(((BCHCC/BCHTOTC)*100),3,0),1:$JUSTIFY("0",3,0)),"%"
+17 WRITE ?54,$JUSTIFY(BCHCT,5),?60,$SELECT(BCHTOTT:$JUSTIFY(((BCHCT/BCHTOTT)*100),3,0),1:$JUSTIFY("0",3,0)),"%"
+18 WRITE ?67,$JUSTIFY(BCHCS,5,0)
WRITE ?73,$SELECT(BCHTOTS:$JUSTIFY(((BCHCS/BCHTOTS)*100),3,0),1:$JUSTIFY("0",3,0)),"%"
+19 IF 'BCHSUB
QUIT
+20 WRITE !
+21 SET BCHSUB1=""
FOR
SET BCHSUB1=$ORDER(^XTMP("BCHRU1",BCHJOB,BCHBTH,"DATA",BCHHA,BCHSUB1))
IF BCHSUB1=""!($DATA(BCHQUIT))
QUIT
Begin DoDot:2
+22 SET BCHCS=($PIECE(^XTMP("BCHRU1",BCHJOB,BCHBTH,"DATA",BCHHA,BCHSUB1),U,4)/60)
SET BCHCA=$PIECE(^(BCHSUB1),U)
SET BCHCC=$PIECE(^(BCHSUB1),U,2)
SET BCHCT=$PIECE(^(BCHSUB1),U,3)
+23 IF $Y>(IOSL-4)
DO HEAD
IF $DATA(BCHQUIT)
QUIT
+24 WRITE !?2,$PIECE(BCHSUB1,"|",2)," ",$EXTRACT($PIECE(BCHSUB1,"|"),1,22)
+25 WRITE ?29,$JUSTIFY(BCHCA,5)
WRITE ?35,$SELECT(BCHTOTA:$JUSTIFY(((BCHCA/BCHTOTA)*100),3,0),1:$JUSTIFY("0",3,0)),"%"
+26 WRITE ?41,$JUSTIFY(BCHCC,5),?47,$SELECT(BCHTOTC:$JUSTIFY(((BCHCC/BCHTOTC)*100),3,0),1:$JUSTIFY("0",3,0)),"%"
+27 WRITE ?54,$JUSTIFY(BCHCT,5),?60,$SELECT(BCHTOTT:$JUSTIFY(((BCHCT/BCHTOTT)*100),3,0),1:$JUSTIFY("0",3,0)),"%"
+28 WRITE ?67,$JUSTIFY(BCHCS,5,0),?73,$SELECT(BCHTOTS:$JUSTIFY(((BCHCS/BCHTOTS)*100),3,0),1:$JUSTIFY("0",3,0)),"%"
+29 QUIT
End DoDot:2
End DoDot:1
DONE ;
+1 DO DONE^BCHUTIL1
+2 KILL ^XTMP("BCHRU1",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 SET X="********** UNDUPLICATED PATIENT REPORT NO. "_BCHRPT_" **********"
WRITE !,$$CTR^BCHRLU(X,80)
+5 SET X="Unduplicated Patient Count by "_BCHCH
WRITE !,$$CTR^BCHRLU(X,80)
+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 !!?3,BCHCH,?31,"# PATIENTS",?44,"# FEMALES",?56,"# MALES",?69,"SERVICE"
+14 WRITE !?69,"HOURS"
+15 WRITE !,$TRANSLATE($JUSTIFY(" ",80)," ","-")
+16 QUIT
