source: FOIAVistA/trunk/r/DIETETICS-FH/FHMNREP.m@ 1582

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

initial load of FOIAVistA 6/30/08 version

File size: 3.0 KB
Line 
1FHMNREP ;Hines OIFO/RTK - Dietetics Monitor Report ;10/18/01 11:49
2 ;;5.5;DIETETICS;;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 ^FHMMNREP Q
7 S (FHTADM,FHTMON)=0
8 W ! S %DT="AEPT",%DT("A")="Enter beginning date: " D ^%DT Q:Y<0
9 S FHSDT=Y,%DT(0)=FHSDT,%DT("A")="Enter ending date: " D ^%DT K %DT(0)
10 S FHEDT=Y I Y<0 D END Q
11 D SORTCR S FHSORT=Y I Y="^" D END Q
12 I FHSORT="C" D FHCL Q:'$D(FHCLIEN) S FHNXIEN=CLNAM
13 I FHSORT="W" D FHWA Q:'$D(FHWRIEN) S FHNXIEN=WRDNAM
14 D DEV,END Q
15 ;
16FHCL ;
17 K DIR S DIR(0)="Y",DIR("A")="Select ALL Clinicians",DIR("B")="Y" D ^DIR
18 I Y=1 S (FHCLIEN,CLNAM)="ALL"
19 I Y=0 K DIC S DIC="^VA(200,",DIC(0)="AEQM",DIC("A")="Select CLINICIAN: " D ^DIC S FHCLIEN=$P(Y,U,1),CLNAM=$P($G(^VA(200,FHCLIEN,0)),U,1)
20 I (Y=-1)!($D(DUOUT))!($D(DTOUT)) D END Q
21 Q
22FHWA ;
23 K DIR S DIR(0)="Y",DIR("A")="Select ALL Wards",DIR("B")="Y" D ^DIR
24 I Y=1 S (FHWRIEN,WRDNAM)="ALL"
25 I Y=0 K DIC S DIC="^FH(119.6,",DIC(0)="AEQM" D ^DIC S FHWRIEN=$P(Y,U,1),WRDNAM=$P($G(^FH(119.6,FHWRIEN,0)),U,1)
26 I (Y=-1)!($D(DUOUT))!($D(DTOUT)) D END Q
27 Q
28EN ;
29 ;FHDATA SUBSCRIPTS(CLINIC OR WARD NAME,DGPM DATE,DGPM ENTRY)
30 ;FHDATA ARRAY="PatName^SSN^Monitors?^DischargeDt^DFN^Status"
31 ;
32 K FHDATA,FHMON
33 S I=FHSDT F S I=$O(^DGPM("ATT1",I)) Q:'I!(I>FHEDT) D
34 .S J=0 F S J=$O(^DGPM("ATT1",I,J)) Q:'J D
35 ..S FHTADM=FHTADM+1
36 ..S DFN=$P($G(^DGPM(J,0)),U,3)
37 ..S FHZ115="P"_DFN D CHECK^FHOMDPA I FHDFN="" Q
38 ..I '$D(^FHPT(FHDFN,"A",J,"MO","B")) Q
39 ..S II=$P(I,".")
40 ..S WRD=$P($G(^FHPT(FHDFN,"A",J,0)),U,8),CLN=""
41 ..I WRD'="" S CLN=$P($G(^FH(119.6,WRD,0)),"^",2)
42 ..;S CLN=$P($G(^DGPM(J,0)),U,19),WRD=$P($G(^DGPM(J,0)),U,6)
43 ..S INDX=$S(FHSORT="C":CLN,1:WRD) I INDX="" Q
44 ..S INDX=$S(FHSORT="C":$P($G(^VA(200,CLN,0)),U,1),1:$P($G(^FH(119.6,WRD,0)),U,1))
45 ..S $P(FHDATA(INDX,II,J),U,1)=$E($P(^DPT(DFN,0),U,1),1,23)
46 ..S $P(FHDATA(INDX,II,J),U,5)=DFN
47 ..S $P(FHDATA(INDX,II,J),U,2)=$E($P(^DPT(DFN,0),U,9),6,9)
48 ..I $D(^FHPT(FHDFN,"A",J,"MO","B")) S $P(FHDATA(INDX,II,J),U,3)="Yes",FHTMON=FHTMON+1,MCNT=0 D
49 ...F FHMN=0:0 S FHMN=$O(^FHPT(FHDFN,"A",J,"MO",FHMN)) Q:FHMN'>0 S MCNT=MCNT+1,FHMON(DFN,J,MCNT)=$P($G(^FHPT(FHDFN,"A",J,"MO",FHMN,0)),"^",1)
50 ..S Y=$P($P($G(^FHPT(FHDFN,"A",J,0)),U,14),".",1) I Y X ^DD("DD") S $P(FHDATA(INDX,II,J),U,4)=Y
51 ..I $D(^FHPT(FHDFN,"S",0)) S NS=$O(^FHPT(FHDFN,"S",0)),STAT=$P($G(^FHPT(FHDFN,"S",NS,0)),U,2) S $P(FHDATA(INDX,II,J),U,6)=$P($G(^FH(115.4,STAT,0)),U,1)
52 ..Q
53 .Q
54 D PRINT^FHMNPRT
55 Q
56DEV ;get device and set up queue
57 W ! K %ZIS,IOP S %ZIS="Q" D ^%ZIS Q:POP
58 I '$D(IO("Q")) U IO D EN,^%ZISC,END Q
59 S ZTRTN="EN^FHMNREP",ZTSAVE("FHSDT")="",ZTSAVE("FHEDT")=""
60 S ZTSAVE("FHNDT")="",ZTSAVE("FHPER")="",ZTSAVE("FHSORT")=""
61 S ZTSAVE("FHNXIEN")="",ZTSAVE("FHTADM")="",ZTSAVE("FHTMON")=""
62 S ZTDESC="Dietetics Monitor Report" D ^%ZTLOAD
63 D ^%ZISC K %ZIS,IOP
64 D END Q
65SORTCR ;
66 K DIR S DIR(0)="SB^C:CLINICIAN;W:WARD",DIR("A")="Sort by Clinician/Ward"
67 D ^DIR
68 Q
69END ;kill and quit
70 K CLN,CLNAM,FHDFN,DFN,I,II,INDX,J,SSN,MCNT
71 K FHCLIEN,FHEDT,FHMN,FHNDT,FHNXIEN,FHTADM,FHTMON
72 K FHPER,FHSDT,FHSORT,FHWRIEN,WRD,WRDNAM,X,Y,Z
73 Q
Note: See TracBrowser for help on using the repository browser.