source: FOIAVistA/trunk/r/DIETETICS-FH/FHMMNPRT.m@ 1801

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

initial load of FOIAVistA 6/30/08 version

File size: 5.6 KB
Line 
1FHMMNPRT ;Hines OIFO/RTK,AAC - Mult Monitor Report Print ;02/08/06 10:29
2 ;;5.5;DIETETICS;**4**;Jan 28, 2005;Build 32
3 ;
4 S (COUNT,COMM,CTCOMM,MON,ALLMON,ALLMON1,M1,M2,M3,M4,M5)=0
5 S PG=0,(EX,XX)="" D NOW^%DTC S Y=X D DD^%DT S FHNDT=Y
6 K FHMNTT
7 ;
8PRINT ;
9 S (MM1,MM2,MM3,MM4,MM5)=0
10 D MNAME
11 Q:XX="*"
12 I FHNXIEN'="ALL" I '$D(^TMP($J,"FHDATA",COMM,FHNXIEN)) D MESSAGE Q
13 I FHNXIEN'="ALL" S ZZ=FHNXIEN D DISP,D1END Q
14 I FHNXIEN="ALL" S ZZ="" F S ZZ=$O(^TMP($J,"FHDATA",COMM,ZZ)) Q:ZZ=""!(EX=U) D
15 .D PG
16 .D DISP
17 .S ALLMON=ALLMON+MON
18 .S ALLMON1=ALLMON1+MON
19 .S M1=M1+MON1,M2=M2+MON2,M3=M3+MON3,M4=M4+MON4,M5=M5+MON5
20 .S MM1=MM1+MON1,MM2=MM2+MON2,MM3=MM3+MON3,MM4=MM4+MON4,MM5=MM5+MON5
21 .Q
22 I FHNXIEN'="ALL"!(EX=U) G END Q
23 I ALLMON=0 W !!?5,"NO PATIENTS WITH MONITORS IN GIVEN DATE RANGE" D END Q
24 ;
25 W !!,"** TOTAL COMMUNICATIONS OFFICE - Admissions.....: ",NAME I $Y>(IOSL-4) D PG I EX=U Q
26 ;
27 W !!?16,"Totals for ALL ",$S(FHSORT="C":"Clinicians.......: ",1:"Wards............: "),$J(ALLMON1,3) I $Y>(IOSL-4) D PG I EX=U Q
28 ;I ZCO'="Y",ALLMON1=0 G PRINT
29 I ALLMON>0 W !?16,"Monitor: Albumin < 2.8..........: ",$J(MM1,3)," ",$J(((MM1/ALLMON)*100),1,2),"%" I $Y>(IOSL-4) D PG I EX=U Q
30 I ALLMON>0 W !?16,"Monitor: BMI < 18.5...............: ",$J(MM2,3)," ",$J(((MM2/ALLMON)*100),1,2),"%" I $Y>(IOSL-4) D PG I EX=U Q
31 I ALLMON>0 W !?16,"Monitor: NPO+Clr Liq > 3 days...: ",$J(MM3,3)," ",$J(((MM3/ALLMON)*100),1,2),"%" I $Y>(IOSL-4) D PG I EX=U Q
32 I ALLMON>0 W !?16,"Monitor: On Hyperals............: ",$J(MM4,3)," ",$J(((MM4/ALLMON)*100),1,2),"%" I $Y>(IOSL-4) D PG I EX=U Q
33 I ALLMON>0 W !?16,"Monitor: On Tubefeeding.........: ",$J(MM5,3)," ",$J(((MM5/ALLMON)*100),1,2),"%" I $Y>(IOSL-4) D PG I EX=U Q
34 ;
35 ;
36 S (MM1,MM2,MM3,MM4,MM5,ALLMON1)=0
37 G PRINT Q
38 Q
39 ;
40THEND ;
41 S NAME="ALL COMMUNICATION OFFICES " D PG I EX=U Q
42 W !!,"*** TOTAL PATIENTS WITH MONITORS ALL COMMUNICATION OFFICES....: ",CTCOMM
43 ;
44 W !!?16,"Totals for ALL ",$S(FHSORT="C":"Clinicians.......: ",1:"Wards............: "),$J(ALLMON,3)
45 I ALLMON>0 W !?16,"Monitor: Albumin < 2.8..........: ",$J(M1,3)," ",$J(((M1/ALLMON)*100),1,2),"%" I $Y>(IOSL-4) D PG I EX=U Q
46 I ALLMON>0 W !?16,"Monitor: BMI < 18.5...............: ",$J(M2,3)," ",$J(((M2/ALLMON)*100),1,2),"%" I $Y>(IOSL-4) D PG I EX=U Q
47 I ALLMON>0 W !?16,"Monitor: NPO+Clr Liq > 3 days...: ",$J(M3,3)," ",$J(((M3/ALLMON)*100),1,2),"%" I $Y>(IOSL-4) D PG I EX=U Q
48 I ALLMON>0 W !?16,"Monitor: On Hyperals............: ",$J(M4,3)," ",$J(((M4/ALLMON)*100),1,2),"%" I $Y>(IOSL-4) D PG I EX=U Q
49 I ALLMON>0 W !?16,"Monitor: On Tubefeeding.........: ",$J(M5,3)," ",$J(((M5/ALLMON)*100),1,2),"%" I $Y>(IOSL-4) D PG I EX=U Q
50 ;
51 ;W !!!,"TOTAL ADMISSIONS....:",?23,FHTADM
52 ;W !,"TOTAL MONITORS......:",?23,ALLMON
53 ;I FHTADM>0 W !,"PERCENTAGE..........:",?23,$J(((ALLMON/FHTADM)*100),1,2),"%"
54 D LINE
55 S XX="*"
56 Q
57 ;I $Y>(IOSL-4)
58 ;
59D1END W ! K DIR Q:EX'=U S DIR(0)="E" D ^DIR ;I IOST?1"C".E,EX'=U
60 D END Q
61 Q
62DISP ;
63 S (TOT,MON,MON1,MON2,MON3,MON4,MON5)=0
64 F YY=0:0 S YY=$O(^TMP($J,"FHDATA",COMM,ZZ,YY)) Q:YY'>0 D
65DISP2 .F HH=0:0 S HH=$O(^TMP($J,"FHDATA",COMM,ZZ,YY,HH)) Q:HH'>0!(EX=U) D
66 ..I $Y>(IOSL-4) I EX=U Q W ! D HDR
67 ..S CTCOMM=CTCOMM+1
68 ..S DFN=$P(^TMP($J,"FHDATA",COMM,ZZ,YY,HH),U,5)
69 ..S Y=YY X ^DD("DD") W !,Y
70 ..W ?13,$P(^TMP($J,"FHDATA",COMM,ZZ,YY,HH),U,2)
71 ..W ?39,$P(^TMP($J,"FHDATA",COMM,ZZ,YY,HH),U,3)
72 ..W ?47,$P(^TMP($J,"FHDATA",COMM,ZZ,YY,HH),U,6)
73 ..I $P(^TMP($J,"FHDATA",COMM,ZZ,YY,HH),U,7)="Yes" D
74 ...F NUM=0:0 S NUM=$O(FHMON(DFN,HH,NUM)) Q:NUM'>0!(EX=U) D
75 ....I NUM'=1 W !
76 ....S MON=MON+1,MONTYP=$P($P(FHMON(DFN,HH,NUM),U,1),": ",2)
77 ....S PC=$S(MONTYP["Albumin":1,MONTYP["BMI":2,MONTYP["NPO+Clr":3,MONTYP["Hyper":4,1:5)
78 ....I $G(FHMNTT(COMM,ZZ))="" S FHMNTT(COMM,ZZ)=""
79 ....S $P(FHMNTT(COMM,ZZ),U,PC)=$P(FHMNTT(COMM,ZZ),U,PC)+1
80 ....W ?56,MONTYP I $Y>(IOSL-4) D PG I EX=U Q
81 ....Q
82 ...Q
83 ..S TOT=TOT+1
84 ..Q
85 .Q
86 I MON=0!(EX=U) Q
87 I FHSORT="C" W !!,"* CLINICIAN: ",ZZ
88 I FHSORT="W" W !!,"* WARD: ",ZZ
89 W !?16,"Total Number of Monitors........: ",$J(MON,3) I $Y>(IOSL-4) D PG I EX=U Q
90 S PCE=$P(FHMNTT(COMM,ZZ),U,1) I PCE>0 W !?16,"Monitor: Albumin < 2.8..........: ",$J(PCE,3)," ",$J(((PCE/MON)*100),1,2),"%" S MON1=PCE I $Y>(IOSL-4) D PG I EX=U Q
91 S PCE=$P(FHMNTT(COMM,ZZ),U,2) I PCE>0 W !?16,"Monitor: BMI < 18.5...............: ",$J(PCE,3)," ",$J(((PCE/MON)*100),1,2),"%" S MON2=PCE I $Y>(IOSL-4) D PG I EX=U Q
92 S PCE=$P(FHMNTT(COMM,ZZ),U,3) I PCE>0 W !?16,"Monitor: NPO+Clr Liq > 3 days...: ",$J(PCE,3)," ",$J(((PCE/MON)*100),1,2),"%" S MON3=PCE I $Y>(IOSL-4) D PG I EX=U Q
93 S PCE=$P(FHMNTT(COMM,ZZ),U,4) I PCE>0 W !?16,"Monitor: On Hyperals............: ",$J(PCE,3)," ",$J(((PCE/MON)*100),1,2),"%" S MON4=PCE I $Y>(IOSL-4) D PG I EX=U Q
94 S PCE=$P(FHMNTT(COMM,ZZ),U,5) I PCE>0 W !?16,"Monitor: On Tubefeeding.........: ",$J(PCE,3)," ",$J(((PCE/MON)*100),1,2),"%" S MON5=PCE
95 W !
96 Q
97 ;
98MESSAGE ;
99 W !!?5,"NO PATIENTS WITH MONITORS IN GIVEN DATE RANGE"
100 W !?10,"FOR THIS ",$S(FHSORT="C":"CLINICIAN",1:"WARD"),": ",FHNXIEN
101 Q
102END K FHMNTT,HH,M1,M2,M3,M4,M5,MON,MON1,MON2,MON3,MON4,MON5,MONTYP
103 K NUM,PC,PCE,PG,PER,TOT,YY
104 QUIT
105 Q
106 ;
107PG ;
108 I IOST?1"C".E W ! K DIR S DIR(0)="E" D ^DIR I 'Y S EX=U Q
109 D HDR Q
110 Q
111HDR ;Header
112 W:$Y @IOF W !,FHNDT,?60,"Page: " S PG=PG+1 W PG,!
113 W !,?25,"Nutrition Monitor Statistic Report"
114 W !,NAME,!
115 W "Admission",?13,"Patient",?39,"SSN",?45,"Status",?56,"Monitor(s)"
116LINE W ! F Z=1:1:79 W "="
117 Q
118MNAME ;
119 I ZCO'="Y" S CONUMX=CONUMX-1 G:CONUMX<1 THEND S COXX=$P(CO,"^",CONUMX),NAME=$P(CONAME,"^",CONUMX) S COMM=COXX Q
120 I ZCO="Y" S COUNT=COUNT+1 G:COUNT>ZOUT THEND S NAME=$G(^FH(119.73,COUNT,0)),NAME=$P(NAME,"^") S COMM=COUNT
121 I $D(^FH(119.73,COUNT,"I"))!'$D(^FH(119.73,COUNT,0)) G MNAME
122 Q
123QUIT ;
124 W !
125 Q
Note: See TracBrowser for help on using the repository browser.