BCHRC9P ; IHS/CMI/LAB - = print all visit report ;
;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
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("BCHRC9",BCHJOB,BCHBTH)) W !!,"NO DATA TO REPORT",!! G DONE
TOTAL ;
D @("HEAD"_(2-($E(IOST,1,2)="C-")))
;
I $Y>(IOSL-4) D HEAD G:$D(BCHQUIT) DONE
W !,"TOTAL" S J=25 F I=1,2 S X=$P(^XTMP("BCHRC9",BCHJOB,BCHBT,"TOTAL"),U,I) W ?J,$J($FN(X,",",0),10) S J=J+11
F I=3:1:5 S X=$P(^XTMP("BCHRC9",BCHJOB,BCHBT,"TOTAL"),U,I),X=X/60 W ?J,$J($FN(X,",",0),10) S J=J+11
W !
PROV ;
S BCHPROV="" F S BCHPROV=$O(^XTMP("BCHRC9",BCHJOB,BCHBT,"PROV",BCHPROV)) Q:BCHPROV=""!($D(BCHQUIT)) D
.I $Y>(IOSL-4) D HEAD Q:$D(BCHQUIT)
.W !,BCHPROV S J=25 F I=1,2 S X=$P(^XTMP("BCHRC9",BCHJOB,BCHBT,"PROV",BCHPROV),U,I) W ?J,$J($FN(X,",",0),10) S J=J+11
.F I=3:1:5 S X=$P(^XTMP("BCHRC9",BCHJOB,BCHBT,"PROV",BCHPROV),U,I),X=X/60 W ?J,$J($FN(X,",",0),10) S J=J+11
.Q
.Q
DONE ;
D DONE^BCHUTIL1
K ^XTMP("BCHRC9",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 !,$P(^VA(200,DUZ,0),U,2),?58,BCHDT,?72,"Page ",BCHPG,!
W $$CTR^BCHRLU($$LOC^BCHRLU),!
W !?20,"********** CHR REPORT NO. 9 **********"
W !!?28,"DATA SUMMARY BY PROVIDER"
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
W !?17,"REPORT DATES: ",BCHBDD," TO ",BCHEDD,!
W !,"**Note: S&T HRS stands for Service and Travel Hours"
W !," ADM Service is defined as service codes AM, LT and OT"
W !!?25,"TOT NUM OF",?36," NUMBER",?47," S&T HRS",?58," S&T HRS",?69," S&T HRS"
W !,"PROVIDER",?25,"SERVICES",?36," SERVED",?47," ALL SRVS",?58," NON-ADM",?69," ADM SRV"
W !,$TR($J(" ",80)," ","-")
Q
BCHRC9P ; IHS/CMI/LAB - = print all visit report ;
+1 ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
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("BCHRC9",BCHJOB,BCHBTH))
WRITE !!,"NO DATA TO REPORT",!!
GOTO DONE
TOTAL ;
+1 DO @("HEAD"_(2-($EXTRACT(IOST,1,2)="C-")))
+2 ;
+3 IF $Y>(IOSL-4)
DO HEAD
IF $DATA(BCHQUIT)
GOTO DONE
+4 WRITE !,"TOTAL"
SET J=25
FOR I=1,2
SET X=$PIECE(^XTMP("BCHRC9",BCHJOB,BCHBT,"TOTAL"),U,I)
WRITE ?J,$JUSTIFY($FNUMBER(X,",",0),10)
SET J=J+11
+5 FOR I=3:1:5
SET X=$PIECE(^XTMP("BCHRC9",BCHJOB,BCHBT,"TOTAL"),U,I)
SET X=X/60
WRITE ?J,$JUSTIFY($FNUMBER(X,",",0),10)
SET J=J+11
+6 WRITE !
PROV ;
+1 SET BCHPROV=""
FOR
SET BCHPROV=$ORDER(^XTMP("BCHRC9",BCHJOB,BCHBT,"PROV",BCHPROV))
IF BCHPROV=""!($DATA(BCHQUIT))
QUIT
Begin DoDot:1
+2 IF $Y>(IOSL-4)
DO HEAD
IF $DATA(BCHQUIT)
QUIT
+3 WRITE !,BCHPROV
SET J=25
FOR I=1,2
SET X=$PIECE(^XTMP("BCHRC9",BCHJOB,BCHBT,"PROV",BCHPROV),U,I)
WRITE ?J,$JUSTIFY($FNUMBER(X,",",0),10)
SET J=J+11
+4 FOR I=3:1:5
SET X=$PIECE(^XTMP("BCHRC9",BCHJOB,BCHBT,"PROV",BCHPROV),U,I)
SET X=X/60
WRITE ?J,$JUSTIFY($FNUMBER(X,",",0),10)
SET J=J+11
+5 QUIT
+6 QUIT
End DoDot:1
DONE ;
+1 DO DONE^BCHUTIL1
+2 KILL ^XTMP("BCHRC9",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
HEAD2 ; if printer
+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. 9 **********"
+5 WRITE !!?28,"DATA SUMMARY BY PROVIDER"
+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 WRITE !?17,"REPORT DATES: ",BCHBDD," TO ",BCHEDD,!
+11 WRITE !,"**Note: S&T HRS stands for Service and Travel Hours"
+12 WRITE !," ADM Service is defined as service codes AM, LT and OT"
+13 WRITE !!?25,"TOT NUM OF",?36," NUMBER",?47," S&T HRS",?58," S&T HRS",?69," S&T HRS"
+14 WRITE !,"PROVIDER",?25,"SERVICES",?36," SERVED",?47," ALL SRVS",?58," NON-ADM",?69," ADM SRV"
+15 WRITE !,$TRANSLATE($JUSTIFY(" ",80)," ","-")
+16 QUIT
