source: WorldVistAEHR/trunk/r/DIETETICS-FH/FHMMNREP.m@ 1375

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

initial load of WorldVistAEHR
File size: 4.1 KB
Line 
1FHMMNREP ;Hines OIFO/RTK,AAC - Multidiv Monitor Report ;10/10/03 11:49
2 ;;5.5;DIETETICS;;Jan 28, 2005
3 ;
4COM ;Get Communication Offices
5 S (ZCO,CO,COXX,CONAME,CONAM,WARD,FHCOMM)="",(ZCOMM,CONUMX,ALLCOMM)=0
6 ;S ZZOUT=$G(^FH(119.73,0)),ZOUT=$P(ZZOUT,"^",4)
7 S ZZCOUNT=0 F ZZCOUNT=0:0 S ZZCOUNT=$O(^FH(119.73,ZZCOUNT)) Q:ZZCOUNT'>0 S ZOUT=ZZCOUNT
8 R !!,"Print report for all Communications Offices Y or N: ",ZCO:DTIME W ! S ZCO=$TR(ZCO,"y","Y")
9 Q:ZCO="^"
10 I ZCO'="Y" D N2 I (Y=-1)&(CO="") Q
11 ;
12DATE ;sets date
13 S (FHTADM,FHTMON)=0
14 W ! S %DT="AEPT",%DT("A")="Enter beginning date: " D ^%DT Q:Y<0
15 S FHSDT=Y,%DT(0)=FHSDT,%DT("A")="Enter ending date: " D ^%DT K %DT(0)
16 S FHEDT=Y I Y<0 D END Q
17 D SORTCR S FHSORT=Y I Y="^" D END Q
18 I FHSORT="C" D FHCL Q:'$D(FHCLIEN) S FHNXIEN=CLNAM
19 I FHSORT="W" D FHWA Q:'$D(FHWRIEN) S FHNXIEN=WRDNAM
20 D DEV,END Q
21 ;
22FHCL ;
23 K DIR S DIR(0)="Y",DIR("A")="Select ALL Clinicians",DIR("B")="Y" D ^DIR
24 I Y=1 S (FHCLIEN,CLNAM)="ALL"
25 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)
26 I (Y=-1)!($D(DUOUT))!($D(DTOUT)) D END Q
27 Q
28FHWA ;
29 K DIR S DIR(0)="Y",DIR("A")="Select ALL Wards",DIR("B")="Y" D ^DIR
30 I Y=1 S (FHWRIEN,WRDNAM)="ALL"
31 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)
32 I (Y=-1)!($D(DUOUT))!($D(DTOUT)) D END Q
33 Q
34EN ;
35 ;^TMP($J,"FHDATA") SUBSCRIPTS (CLINIC OR WARD NAME,DGPM DATE,DGPM ENTRY)
36 ;^TMP($J,"FHDATA") PIECES="PatName^SSN^Monitors?^DischargeDt^DFN^Status"
37 ;
38 K ^TMP($J,"FHDATA"),FHMON
39 S I=FHSDT F S I=$O(^DGPM("ATT1",I)) Q:'I!(I>FHEDT) D
40 .S J=0 F S J=$O(^DGPM("ATT1",I,J)) Q:'J D
41 ..S ZCOMM=ZCOMM+1
42 ..S DFN=$P($G(^DGPM(J,0)),U,3)
43 ..S FHZ115="P"_DFN D CHECK^FHOMDPA I FHDFN="" Q
44 ..I '$D(^FHPT(FHDFN,"A",J,"MO","B")) Q
45 ..S II=$P(I,".")
46 ..S FHWARD=$P($G(^DGPM(J,0)),U,6)
47 ..Q:'$D(^FH(119.6,"AW",FHWARD))
48 ..S WRD=$O(^FH(119.6,"AW",FHWARD,""))
49 ..S FHCOMM=$P($G(^FH(119.6,WRD,0)),"^",8),CLN=$P($G(^FH(119.6,WRD,0)),"^",2)
50 ..Q:FHCOMM="" Q:$D(^FH(119.73,FHCOMM,"I"))
51 ..S FHTADM=FHTADM+1
52 ..S ALLCOMM=ALLCOMM+1
53 ..;S CLN=$P($G(^DGPM(J,0)),U,19),WRD=$P($G(^DGPM(J,0)),U,6)
54 ..S INDX=$S(FHSORT="C":CLN,1:WRD) I INDX="" Q
55 ..S INDX=$S(FHSORT="C":$P($G(^VA(200,CLN,0)),U,1),1:$P($G(^FH(119.6,WRD,0)),U,1))
56 ..S $P(^TMP($J,"FHDATA",FHCOMM,INDX,II,J),U,1)=FHCOMM
57 ..S $P(^TMP($J,"FHDATA",FHCOMM,INDX,II,J),U,2)=$E($P($G(^DPT(DFN,0)),U,1),1,23)
58 ..S $P(^TMP($J,"FHDATA",FHCOMM,INDX,II,J),U,5)=DFN
59 ..S $P(^TMP($J,"FHDATA",FHCOMM,INDX,II,J),U,3)=$E($P($G(^DPT(DFN,0)),U,9),6,9)
60 ..I $D(^FHPT(FHDFN,"A",J,"MO","B")) S $P(^TMP($J,"FHDATA",FHCOMM,INDX,II,J),U,7)="Yes",FHTMON=FHTMON+1,MCNT=0 D
61 ...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)
62 ..S Y=$P($P($G(^FHPT(FHDFN,"A",J,0)),U,14),".",1) I Y X ^DD("DD") S $P(^TMP($J,"FHDATA",FHCOMM,INDX,II,J),U,4)=Y
63 ..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(^TMP($J,"FHDATA",FHCOMM,INDX,II,J),U,6)=$P($G(^FH(115.4,STAT,0)),U,1)
64 ..Q
65 .Q
66 D ^FHMMNPRT
67 Q
68 ;
69THEND ;Q
70 ;
71DEV ;get device and set up queue
72 W ! K %ZIS,IOP S %ZIS="Q" D ^%ZIS Q:POP
73 I '$D(IO("Q")) U IO D EN,^%ZISC,END Q
74 S ZTRTN="EN^FHMMNREP",ZTSAVE("FHSDT")="",ZTSAVE("FHEDT")="",ZTSAVE("ZCOMM")=""
75 S ZTSAVE("FHNDT")="",ZTSAVE("FHPER")="",ZTSAVE("FHSORT")=""
76 S ZTSAVE("FHNXIEN")="",ZTSAVE("FHTADM")="",ZTSAVE("FHTMON")=""
77 S ZTSAVE("ALLCOMM")="",ZTSAVE("ZCO")="",ZTSAVE("COXX")="",ZTSAVE("ZOUT")=""
78 S ZTSAVE("CONUMX")="",ZTSAVE("CO")="",ZTSAVE("CONAME")=""
79 S ZTDESC="Dietetics Monitor Report" D ^%ZTLOAD
80 D ^%ZISC K %ZIS,IOP
81 D END Q
82 ;
83N2 ;Find Communication Office
84 S DIC=119.73,DIC(0)="AEQ",DIC("A")="Select Communication Offices: "
85 D ^DIC I Y=-1&(CO="") Q
86 I Y=-1 Q
87 S CON=$P(Y,"^",1),CO=CON_"^"_CO,CONAM=$P(Y,"^",2),CONAME=CONAM_"^"_CONAME S CONUMX=$L(CO,"^") G N2
88 I Y=-1 K DIC Q
89 Q
90 ;
91SORTCR ;
92 K DIR S DIR(0)="SB^C:CLINICIAN;W:WARD",DIR("A")="Sort by Clinician/Ward"
93 D ^DIR
94 Q
95END ;kill and quit
96 K CLN,CLNAM,FHDFN,DFN,I,II,INDX,J,SSN,MCNT
97 K FHCLIEN,FHEDT,FHMN,FHNDT,FHNXIEN,FHTADM,FHTMON
98 K FHPER,FHSDT,FHSORT,FHWRIEN,WRD,WRDNAM,X,Y,Z
99 Q
Note: See TracBrowser for help on using the repository browser.