- 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
