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

BCHRP3P.m

Go to the documentation of this file. 
  1. BCHRP3P ; IHS/CMI/LAB - print all visit report ; 
  1.  ;;2.0;IHS RPMS CHR SYSTEM;;OCT 23, 2012;Build 27
  1.  ;IHS/CMI/LAB - tmp to xtmp
  1. START ;
  1.  D NOW^%DTC S Y=X D DD^%DT S BCHDT=Y
  1.  S Y=BCHBD D DD^%DT S BCHBDD=Y S Y=BCHED D DD^%DT S BCHEDD=Y
  1.  S (BCHATOT,BCHACTOT,BCHSTOT,BCHFTOT,BCHPTOT,BCHPG)=0
  1.  D @("HEAD"_(2-($E(IOST,1,2)="C-")))
  1.  K BCHQUIT
  1. PROG ;
  1.  S BCHPROG="" F  S BCHPROG=$O(^XTMP("BCHRP3",BCHJOB,BCHBTH,"RECORDS",BCHPROG)) Q:BCHPROG=""!($D(BCHQUIT))  D
  1.  .S (BCHATOT("R"),BCHATOT("AT"))=0
  1.  .I $Y>(IOSL-4) D HEAD Q:$D(BCHQUIT)
  1.  .W !,"PROGRAM:  ",BCHPROG
  1.  .D LOC
  1.  .Q:$D(BCHQUIT)
  1.  .I $Y>(IOSL-5) D HEAD Q:$D(BCHQUIT)
  1.  .W !?59,"=======",?67,"=======",!
  1.  .W "PROGRAM TOTAL:",?59,$J(BCHATOT("R"),7),?67,$J((BCHATOT("AT")/60),7,1),!
  1. DONE ;
  1.  D DONE^BCHUTIL1
  1.  K ^XTMP("BCHRP3",BCHJOB,BCHBTH)
  1.  Q
  1. LOC ;
  1.  S BCHLOC="" F  S BCHLOC=$O(^XTMP("BCHRP3",BCHJOB,BCHBTH,"RECORDS",BCHPROG,BCHLOC)) Q:BCHLOC=""!($D(BCHQUIT))  D
  1.  .S (BCHLTOT("R"),BCHLTOT("AT"))=0
  1.  .I $Y>(IOSL-4) D HEAD Q:$D(BCHQUIT)
  1.  .W !?4,"ACTIVITY LOCATION:  ",BCHLOC
  1.  .D PROV
  1.  .Q:$D(BCHQUIT)
  1.  .I $Y>(IOSL-5) D HEAD Q:$D(BCHQUIT)
  1.  .W !?59,"=======",?67,"=======",!
  1.  .W ?4,"ACTIVITY LOCATION TOTAL:",?59,$J(BCHLTOT("R"),7),?67,$J((BCHLTOT("AT")/60),7,1),!
  1.  Q
  1. PROV ;
  1.  S BCHPROV="" F  S BCHPROV=$O(^XTMP("BCHRP3",BCHJOB,BCHBTH,"RECORDS",BCHPROG,BCHLOC,BCHPROV)) Q:BCHPROV=""!($D(BCHQUIT))  D
  1.  .S (BCHPTOT("R"),BCHPTOT("AT"))=0
  1.  .I $Y>(IOSL-4) D HEAD Q:$D(BCHQUIT)
  1.  .W !?11,"CHR:  ",BCHPROV
  1.  .D ACT
  1.  .Q:$D(BCHQUIT)
  1.  .I $Y>(IOSL-5) D HEAD Q:$D(BCHQUIT)
  1.  .W !?59,"=======",?67,"=======",!
  1.  .W ?11,"PROVIDER TOTAL:",?59,$J(BCHPTOT("R"),7),?67,$J((BCHPTOT("AT")/60),7,1),!
  1.  Q
  1. ACT ;
  1.  S BCHACT="" F  S BCHACT=$O(^XTMP("BCHRP3",BCHJOB,BCHBTH,"RECORDS",BCHPROG,BCHLOC,BCHPROV,BCHACT)) Q:BCHACT=""!($D(BCHQUIT))  D
  1.  .S (BCHACTOT("R"),BCHACTOT("AT"))=0
  1.  .I $Y>(IOSL-4) D HEAD Q:$D(BCHQUIT)
  1.  .W !?17,"ACTIVITY:  ",$E(BCHACT,1,28)
  1.  .D PROB
  1.  .Q:$D(BCHQUIT)
  1.  .I $Y>(IOSL-5) D HEAD Q:$D(BCHQUIT)
  1.  .W !?59,"=======",?67,"=======",!
  1.  .W ?17,"ACTIVITY TOTAL:",?59,$J(BCHACTOT("R"),7),?67,$J((BCHACTOT("AT")/60),7,1),!
  1.  Q
  1. PROB ;
  1.  S BCHPROB="" F  S BCHPROB=$O(^XTMP("BCHRP3",BCHJOB,BCHBTH,"RECORDS",BCHPROG,BCHLOC,BCHPROV,BCHACT,BCHPROB)) Q:BCHPROB=""!($D(BCHQUIT))  D
  1.  .I $Y>(IOSL-4) D HEAD Q:$D(BCHQUIT)
  1.  .S BCHREC=$P(^XTMP("BCHRP3",BCHJOB,BCHBT,"RECORDS",BCHPROG,BCHLOC,BCHPROV,BCHACT,BCHPROB),U),BCHAT=$P(^(BCHPROB),U,2),BCHPAT=$P(^(BCHPROB),U,3)
  1.  .W !?22,"PROBLEM:",?32,$E(BCHPROB,1,30),?59,$J(BCHREC,7),?67,$J((BCHAT/60),7,1)
  1.  .S BCHATOT("R")=BCHATOT("R")+BCHREC,BCHLTOT("R")=BCHLTOT("R")+BCHREC,BCHPTOT("R")=BCHPTOT("R")+BCHREC,BCHACTOT("R")=BCHACTOT("R")+BCHREC
  1.  .S BCHATOT("AT")=BCHATOT("AT")+BCHAT,BCHLTOT("AT")=BCHLTOT("AT")+BCHAT,BCHPTOT("AT")=BCHPTOT("AT")+BCHAT,BCHACTOT("AT")=BCHACTOT("AT")+BCHAT
  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 !?13,"********** CONFIDENTIAL PATIENT INFORMATION **********"
  1.  W !,$P(^VA(200,DUZ,0),U,2),?33,BCHDT,?70,"Page ",BCHPG,!
  1.  W $$CTR^BCHRLU($$LOC^BCHRLU),!
  1.  W ?24,"ACTIVITY REPORT BY HEALTH PROBLEM",!
  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 !?52,"# Activities",?66,"ACT TIME (hrs)",!
  1.  W !,$TR($J(" ",80)," ","-")
  1.  Q