- 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