BCHRC2P ; 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("BCHRC2",BCHJOB,BCHBTH)) W !!,"NO DATA TO REPORT",!! G DONE
K BCHQUIT S BCHPG=0
REF ;
D @("HEAD"_(2-($E(IOST,1,2)="C-")))
;set total numbers and print
I $Y>(IOSL-3) D HEAD G:$D(BCHQUIT) DONE
W !?4,"TOTAL",?26,$J($FN(^XTMP("BCHRC2",BCHJOB,BCHBT,"TOTAL","FROM"),","),5),?32,"100%"
W ?46,"TOTAL",?69,$J($FN(^XTMP("BCHRC2",BCHJOB,BCHBT,"TOTAL","TO"),","),5),?75,"100%"
S BCHFT=^XTMP("BCHRC2",BCHJOB,BCHBT,"TOTAL","FROM"),BCHTT=^XTMP("BCHRC2",BCHJOB,BCHBT,"TOTAL","TO")
S BCHREF=0 F S BCHREF=$O(^XTMP("BCHRC2",BCHJOB,BCHBTH,BCHREF)) Q:BCHREF'=+BCHREF!($D(BCHQUIT)) D
.S BCHF=^XTMP("BCHRC2",BCHJOB,BCHBTH,BCHREF,"FROM")
.S BCHT=^XTMP("BCHRC2",BCHJOB,BCHBTH,BCHREF,"TO")
.I $Y>(IOSL-4) D HEAD Q:$D(BCHQUIT)
.W !,$P(^BCHTREF(BCHREF,0),U,3)," ",$E($P(^(0),U),1,20),?26,$J(BCHF,5),?32,$S(BCHFT:$J(((BCHF/BCHFT)*100),3,0),1:$J("0",3,0)),"%"
.W ?44,$P(^BCHTREF(BCHREF,0),U,3)," ",$E($P(^(0),U),1,20),?69,$J(BCHT,5),?75,$S(BCHTT:$J(((BCHT/BCHTT)*100),3,0),1:$J("0",3,0)),"%"
.Q
DONE ;
D DONE^BCHUTIL1
K ^XTMP("BCHRC2",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 ; 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),?58,BCHDT,?72,"Page ",BCHPG,!
W $$CTR^BCHRLU($$LOC^BCHRLU),!
W !?20,"********** CHR REPORT NO. 4 **********"
W !!?26,"NUMBER OF REFERRALS FROM/TO"
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 !,"REFERRALS TO CHR FROM",?25,"# REFERRALS",?44,"REFERRALS BY CHR TO",?69,"# REFERRALS"
W !,$TR($J(" ",80)," ","-")
Q
BCHRC2P ; 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("BCHRC2",BCHJOB,BCHBTH))
WRITE !!,"NO DATA TO REPORT",!!
GOTO DONE
+4 KILL BCHQUIT
SET BCHPG=0
REF ;
+1 DO @("HEAD"_(2-($EXTRACT(IOST,1,2)="C-")))
+2 ;set total numbers and print
+3 IF $Y>(IOSL-3)
DO HEAD
IF $DATA(BCHQUIT)
GOTO DONE
+4 WRITE !?4,"TOTAL",?26,$JUSTIFY($FNUMBER(^XTMP("BCHRC2",BCHJOB,BCHBT,"TOTAL","FROM"),","),5),?32,"100%"
+5 WRITE ?46,"TOTAL",?69,$JUSTIFY($FNUMBER(^XTMP("BCHRC2",BCHJOB,BCHBT,"TOTAL","TO"),","),5),?75,"100%"
+6 SET BCHFT=^XTMP("BCHRC2",BCHJOB,BCHBT,"TOTAL","FROM")
SET BCHTT=^XTMP("BCHRC2",BCHJOB,BCHBT,"TOTAL","TO")
+7 SET BCHREF=0
FOR
SET BCHREF=$ORDER(^XTMP("BCHRC2",BCHJOB,BCHBTH,BCHREF))
IF BCHREF'=+BCHREF!($DATA(BCHQUIT))
QUIT
Begin DoDot:1
+8 SET BCHF=^XTMP("BCHRC2",BCHJOB,BCHBTH,BCHREF,"FROM")
+9 SET BCHT=^XTMP("BCHRC2",BCHJOB,BCHBTH,BCHREF,"TO")
+10 IF $Y>(IOSL-4)
DO HEAD
IF $DATA(BCHQUIT)
QUIT
+11 WRITE !,$PIECE(^BCHTREF(BCHREF,0),U,3)," ",$EXTRACT($PIECE(^(0),U),1,20),?26,$JUSTIFY(BCHF,5),?32,$SELECT(BCHFT:$JUSTIFY(((BCHF/BCHFT)*100),3,0),1:$JUSTIFY("0",3,0)),"%"
+12 WRITE ?44,$PIECE(^BCHTREF(BCHREF,0),U,3)," ",$EXTRACT($PIECE(^(0),U),1,20),?69,$JUSTIFY(BCHT,5),?75,$SELECT(BCHTT:$JUSTIFY(((BCHT/BCHTT)*100),3,0),1:$JUSTIFY("0",3,0)),"%"
+13 QUIT
End DoDot:1
DONE ;
+1 DO DONE^BCHUTIL1
+2 KILL ^XTMP("BCHRC2",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 ; if terminal
+1 IF $DATA(IOF)
WRITE @IOF
+2 ;
HEAD2 ; if printer
+1 SET BCHPG=BCHPG+1
+2 ;W !?13,"********** CONFIDENTIAL PATIENT INFORMATION **********"
+3 WRITE !,$PIECE(^VA(200,DUZ,0),U,2),?58,BCHDT,?72,"Page ",BCHPG,!
+4 WRITE $$CTR^BCHRLU($$LOC^BCHRLU),!
+5 WRITE !?20,"********** CHR REPORT NO. 4 **********"
+6 WRITE !!?26,"NUMBER OF REFERRALS FROM/TO"
+7 SET BCHPROGN=$SELECT(BCHPRG:$PIECE(^BCHTPROG(BCHPRG,0),U)_" ("_$PIECE(^(0),U,5)_")",1:"ALL")
SET X=$LENGTH(BCHPROGN)+10
+8 WRITE !!?((80-X)/2),"PROGRAM: ",BCHPROGN
+9 SET BCHPROVN=$SELECT(BCHPROVT="O":$PIECE(^VA(200,BCHCHR1,0),U),1:"ALL")
SET X=$LENGTH(BCHPROGN)+10
+10 WRITE !?((80-X)/2),"PROVIDER: ",BCHPROVN
+11 SET X=$LENGTH("PATIENTS: "_BCHREGN)
+12 WRITE !?((80-X)/2),"PATIENTS: ",BCHREGN
+13 WRITE !?17,"REPORT DATES: ",BCHBDD," TO ",BCHEDD,!
+14 WRITE !,"REFERRALS TO CHR FROM",?25,"# REFERRALS",?44,"REFERRALS BY CHR TO",?69,"# REFERRALS"
+15 WRITE !,$TRANSLATE($JUSTIFY(" ",80)," ","-")
+16 QUIT
