Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BCHRC9P

BCHRC9P.m

Go to the documentation of this file.
  1. BCHRC9P ; IHS/CMI/LAB - = print all visit report ;
  1. ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
  1. START ;
  1. D NOW^%DTC S Y=X D DD^%DT S BCHDT=Y
  1. K BCHQUIT S BCHPG=0
  1. S Y=BCHBD D DD^%DT S BCHBDD=Y S Y=BCHED D DD^%DT S BCHEDD=Y
  1. I '$D(^XTMP("BCHRC9",BCHJOB,BCHBTH)) W !!,"NO DATA TO REPORT",!! G DONE
  1. TOTAL ;
  1. D @("HEAD"_(2-($E(IOST,1,2)="C-")))
  1. ;
  1. I $Y>(IOSL-4) D HEAD G:$D(BCHQUIT) DONE
  1. 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
  1. 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
  1. W !
  1. PROV ;
  1. S BCHPROV="" F S BCHPROV=$O(^XTMP("BCHRC9",BCHJOB,BCHBT,"PROV",BCHPROV)) Q:BCHPROV=""!($D(BCHQUIT)) D
  1. .I $Y>(IOSL-4) D HEAD Q:$D(BCHQUIT)
  1. .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
  1. .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
  1. .Q
  1. .Q
  1. DONE ;
  1. D DONE^BCHUTIL1
  1. K ^XTMP("BCHRC9",BCHJOB,BCHBTH),BCHJOB,BCHBTH
  1. Q
  1. 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
  1. HEAD1 ; if terminal
  1. W:$D(IOF) @IOF
  1. HEAD2 ; if printer
  1. S BCHPG=BCHPG+1
  1. W !,$P(^VA(200,DUZ,0),U,2),?58,BCHDT,?72,"Page ",BCHPG,!
  1. W $$CTR^BCHRLU($$LOC^BCHRLU),!
  1. W !?20,"********** CHR REPORT NO. 9 **********"
  1. W !!?28,"DATA SUMMARY BY PROVIDER"
  1. S BCHPROGN=$S(BCHPRG:$P(^BCHTPROG(BCHPRG,0),U)_" ("_$P(^(0),U,5)_")",1:"ALL"),X=$L(BCHPROGN)+10
  1. W !?((80-X)/2),"PROGRAM: ",BCHPROGN
  1. S X=$L("PATIENTS: "_BCHREGN)
  1. W !?((80-X)/2),"PATIENTS: ",BCHREGN
  1. W !?17,"REPORT DATES: ",BCHBDD," TO ",BCHEDD,!
  1. W !,"**Note: S&T HRS stands for Service and Travel Hours"
  1. W !," ADM Service is defined as service codes AM, LT and OT"
  1. W !!?25,"TOT NUM OF",?36," NUMBER",?47," S&T HRS",?58," S&T HRS",?69," S&T HRS"
  1. W !,"PROVIDER",?25,"SERVICES",?36," SERVED",?47," ALL SRVS",?58," NON-ADM",?69," ADM SRV"
  1. W !,$TR($J(" ",80)," ","-")
  1. Q