source: FOIAVistA/tag/r/DIETETICS-FH/FHMNBRPT.m@ 1683

Last change on this file since 1683 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 1.9 KB
Line 
1FHMNBRPT ;Hines OIFO/JT,RTK - Dietetics Monitor Brief ;07/26/01 11:49
2 ;;5.5;DIETETICS;**2**;Jan 28, 2005
3 ;
4DATE ;sets date
5 ; Check for multidivisional site
6 I $P($G(^FH(119.9,1,0)),U,20)'="N" D ^FHMMBRPT Q
7 W ! S %DT="AEPT",%DT("A")="Enter beginning date: " D ^%DT Q:Y<0
8 S FHSDT=Y,%DT(0)=FHSDT,%DT("A")="Enter ending date: " D ^%DT K %DT(0)
9 I Y<0 D END Q
10 S FHEDT=Y D DEV
11 D END Q
12 ;
13EN ;get admission/monitor information
14 S PG=0,EX="" D NOW^%DTC S Y=X D DD^%DT S FHNDT=Y D HDR
15 S ADMTOT=0,MONTOT=0
16 S I=FHSDT F S I=$O(^DGPM("ATT1",I)) Q:'I!(I>FHEDT) D
17 .S J=0 F S J=$O(^DGPM("ATT1",I,J)) Q:'J!(EX=U) D
18 ..S DFN=$P(^DGPM(J,0),U,3) I $Y>(IOSL-4) D PG I EX=U Q
19 ..S FHZ115="P"_DFN D CHECK^FHOMDPA I FHDFN="" Q
20 ..S Y=$P(I,".") X ^DD("DD") W !,Y,?13,$E($P(^DPT(DFN,0),U,1),1,23)
21 ..W ?39,$E($P(^DPT(DFN,0),U,9),6,9) S ADMTOT=ADMTOT+1
22 ..I $D(^FHPT(FHDFN,"A",J,"MO","B")) W ?48,"Yes" S MONTOT=MONTOT+1
23 ..S Y=$P($P($G(^FHPT(FHDFN,"A",J,0)),U,14),".",1) I Y X ^DD("DD") W ?56,Y
24 ..Q
25 .Q
26 I EX=U D END Q
27 W !!,"TOTAL ADMISSIONS: ",?22,ADMTOT
28 W !,"TOTAL WITH MONITORS:",?22,MONTOT
29 W !,"Percentage of Admissions with Monitors: "
30 I ADMTOT=0!(MONTOT=0) W "0.0%" D END Q
31 S FHPER=(MONTOT/ADMTOT)*100
32 I $L($P(FHPER,".",2))>2 S FHPER=$P(FHPER,".",1)_"."_$E($P(FHPER,".",2),1,2)
33 W FHPER,"%"
34 I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR
35 D END Q
36DEV ;get device and set up queue
37 W ! K %ZIS,IOP S %ZIS="Q" D ^%ZIS Q:POP
38 I '$D(IO("Q")) U IO D EN,^%ZISC,END Q
39 S ZTRTN="EN^FHMNBRPT",ZTSAVE("FHSDT")="",ZTSAVE("FHEDT")=""
40 S ZTSAVE=("FHNDT"),ZTSAVE=("FHPER")
41 S ZTDESC="Dietetics Monitor Report" D ^%ZTLOAD
42 D ^%ZISC K %ZIS,IOP
43 D END Q
44END ;kill and quit
45 K I,J,FHDFN,DFN,SSN,ADMTOT,MONTOT,FHPER,FHSDT,FHEDT,FHNDT,X,Y,PG
46 Q
47PG ;
48 I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR I 'Y S EX=U Q
49 D HDR Q
50HDR ;Header
51 W:$Y @IOF W !,FHNDT,?60,"Page: " S PG=PG+1 W PG,!!
52 W "Admission",?13,"Patient",?39,"SSN",?45,"Monitor?",?56,"Discharge"
53 W ! F Z=1:1:79 W "="
54 Q
Note: See TracBrowser for help on using the repository browser.