BCHRC6P ; IHS/CMI/LAB - print dx by age ;
;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
;IHS/CMI/LAB - tmp to xtmp
START ;
S Y=BCHBD D DD^%DT S BCHBDD=Y S Y=BCHED D DD^%DT S BCHEDD=Y
S Y=DT D DD^%DT S BCHDT=Y
S BCHPG=0
K BCHQUIT
I '$D(^XTMP("BCHRC6",BCHJOB,BCHBT)) W !!,"NO DATA TO REPORT" G DONE
;
D @("HEAD"_(2-($E(IOST,1,2)="C-")))
;
I $Y>(IOSL-4) D HEAD G:$D(BCHQUIT) DONE
W !,"TOTAL"
F I=1:1:10 S V="V"_I S @V=$P(^XTMP("BCHRC6",BCHJOB,BCHBT,"TOTAL"),U,I)
S V1=V1/60 W ?19,$J($FN(V1,",",0),7)
S V2=V2/60 W ?26,$J($FN(V2,",",0),7)
S V3=V3/60 W ?34,$J($FN(V3,",",0),7)
S V4=V4/60 W ?42,$J($FN(V4,",",0),7)
W ?50,$J($FN(V5,",",0),7)
W ?58,$J($FN(V6,",",0),7)
W ?62,$J($FN(V7,",",0),7)
;S V8=$S(V7:V10/V7,1:0) W ?109,$J($FN(V8,",",1),10)
W ?73,$J($FN(V9,",",0),7)
PROV ;print each provider
S BCHX="" F S BCHX=$O(^XTMP("BCHRC6",BCHJOB,BCHBT,"PROVIDER",BCHX)) Q:BCHX=""!($D(BCHQUIT)) D
.I $Y>(IOSL-4) D HEAD G:$D(BCHQUIT) DONE
.W !,$E(BCHX,1,13)
.F I=1:1:10 S V="V"_I S @V=$P(^XTMP("BCHRC6",BCHJOB,BCHBT,"PROVIDER",BCHX),U,I)
.S V1=V1/60 W ?19,$J($FN(V1,",",0),7)
.S V2=V2/60 W ?26,$J($FN(V2,",",0),7)
.S V3=V3/60 W ?34,$J($FN(V3,",",0),7)
.S V4=V4/60 W ?42,$J($FN(V4,",",0),7)
.W ?50,$J($FN(V5,",",0),7)
.W ?58,$J($FN(V6,",",0),7)
.W ?62,$J($FN(V7,",",0),7)
.;S V8=$S(V7:V10/V7,1:0) W ?109,$J($FN(V8,",",1),10)
.W ?73,$J($FN(V9,",",0),7)
DONE D DONE^BCHUTIL1
K ^XTMP("BCHRC6",BCHJOB,BCHBT),BCHJOB,BCHBT
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 !,$P(^VA(200,DUZ,0),U,2),?56,"DATE GENERATED: ",BCHDT,?124,"Page ",BCHPG,!
W $$CTR^BCHRLU($$LOC^BCHRLU),!
S X="********** CHR REPORT NO. 6 **********" W !,$$CTR^BCHRLU(X,80)
S X="PROVIDER DATA" 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 X=$L("PATIENTS: "_BCHREGN)
W !?((80-X)/2),"PATIENTS: ",BCHREGN
S X="REPORT DATES: "_BCHBDD_" TO "_BCHEDD W !,$$CTR^BCHRLU(X,80)
W !!?20,"SERVICE",?28,"TRAVEL",?36,"LEAVE",?44,"TOTAL",?52,"0 NUM",?60,"1 NUM",?68,">1 NUM",?75,"TOT #"
W !,"PROVIDER",?20,"HOURS",?28,"HOURS",?36,"HOURS",?44,"HOURS",?52,"SERV",?60,"SERV",?68,"SERV",?74,"SERVED"
W !,$TR($J(" ",80)," ","-")
Q
BCHRC6P ; IHS/CMI/LAB - print dx by age ;
+1 ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
+2 ;IHS/CMI/LAB - tmp to xtmp
START ;
+1 SET Y=BCHBD
DO DD^%DT
SET BCHBDD=Y
SET Y=BCHED
DO DD^%DT
SET BCHEDD=Y
+2 SET Y=DT
DO DD^%DT
SET BCHDT=Y
+3 SET BCHPG=0
+4 KILL BCHQUIT
+5 IF '$DATA(^XTMP("BCHRC6",BCHJOB,BCHBT))
WRITE !!,"NO DATA TO REPORT"
GOTO DONE
+6 ;
+7 DO @("HEAD"_(2-($EXTRACT(IOST,1,2)="C-")))
+8 ;
+9 IF $Y>(IOSL-4)
DO HEAD
IF $DATA(BCHQUIT)
GOTO DONE
+10 WRITE !,"TOTAL"
+11 FOR I=1:1:10
SET V="V"_I
SET @V=$PIECE(^XTMP("BCHRC6",BCHJOB,BCHBT,"TOTAL"),U,I)
+12 SET V1=V1/60
WRITE ?19,$JUSTIFY($FNUMBER(V1,",",0),7)
+13 SET V2=V2/60
WRITE ?26,$JUSTIFY($FNUMBER(V2,",",0),7)
+14 SET V3=V3/60
WRITE ?34,$JUSTIFY($FNUMBER(V3,",",0),7)
+15 SET V4=V4/60
WRITE ?42,$JUSTIFY($FNUMBER(V4,",",0),7)
+16 WRITE ?50,$JUSTIFY($FNUMBER(V5,",",0),7)
+17 WRITE ?58,$JUSTIFY($FNUMBER(V6,",",0),7)
+18 WRITE ?62,$JUSTIFY($FNUMBER(V7,",",0),7)
+19 ;S V8=$S(V7:V10/V7,1:0) W ?109,$J($FN(V8,",",1),10)
+20 WRITE ?73,$JUSTIFY($FNUMBER(V9,",",0),7)
PROV ;print each provider
+1 SET BCHX=""
FOR
SET BCHX=$ORDER(^XTMP("BCHRC6",BCHJOB,BCHBT,"PROVIDER",BCHX))
IF BCHX=""!($DATA(BCHQUIT))
QUIT
Begin DoDot:1
+2 IF $Y>(IOSL-4)
DO HEAD
IF $DATA(BCHQUIT)
GOTO DONE
+3 WRITE !,$EXTRACT(BCHX,1,13)
+4 FOR I=1:1:10
SET V="V"_I
SET @V=$PIECE(^XTMP("BCHRC6",BCHJOB,BCHBT,"PROVIDER",BCHX),U,I)
+5 SET V1=V1/60
WRITE ?19,$JUSTIFY($FNUMBER(V1,",",0),7)
+6 SET V2=V2/60
WRITE ?26,$JUSTIFY($FNUMBER(V2,",",0),7)
+7 SET V3=V3/60
WRITE ?34,$JUSTIFY($FNUMBER(V3,",",0),7)
+8 SET V4=V4/60
WRITE ?42,$JUSTIFY($FNUMBER(V4,",",0),7)
+9 WRITE ?50,$JUSTIFY($FNUMBER(V5,",",0),7)
+10 WRITE ?58,$JUSTIFY($FNUMBER(V6,",",0),7)
+11 WRITE ?62,$JUSTIFY($FNUMBER(V7,",",0),7)
+12 ;S V8=$S(V7:V10/V7,1:0) W ?109,$J($FN(V8,",",1),10)
+13 WRITE ?73,$JUSTIFY($FNUMBER(V9,",",0),7)
End DoDot:1
DONE DO DONE^BCHUTIL1
+1 KILL ^XTMP("BCHRC6",BCHJOB,BCHBT),BCHJOB,BCHBT
+2 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
HEAD2 ; if printer
+1 SET BCHPG=BCHPG+1
+2 WRITE !,$PIECE(^VA(200,DUZ,0),U,2),?56,"DATE GENERATED: ",BCHDT,?124,"Page ",BCHPG,!
+3 WRITE $$CTR^BCHRLU($$LOC^BCHRLU),!
+4 SET X="********** CHR REPORT NO. 6 **********"
WRITE !,$$CTR^BCHRLU(X,80)
+5 SET X="PROVIDER DATA"
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 X=$LENGTH("PATIENTS: "_BCHREGN)
+9 WRITE !?((80-X)/2),"PATIENTS: ",BCHREGN
+10 SET X="REPORT DATES: "_BCHBDD_" TO "_BCHEDD
WRITE !,$$CTR^BCHRLU(X,80)
+11 WRITE !!?20,"SERVICE",?28,"TRAVEL",?36,"LEAVE",?44,"TOTAL",?52,"0 NUM",?60,"1 NUM",?68,">1 NUM",?75,"TOT #"
+12 WRITE !,"PROVIDER",?20,"HOURS",?28,"HOURS",?36,"HOURS",?44,"HOURS",?52,"SERV",?60,"SERV",?68,"SERV",?74,"SERVED"
+13 WRITE !,$TRANSLATE($JUSTIFY(" ",80)," ","-")
+14 QUIT
