source: WorldVistAEHR/trunk/r/DIETETICS-FH/FHCTF5.m@ 623

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

initial load of WorldVistAEHR

File size: 5.2 KB
Line 
1FHCTF5 ; HIOFO/REL/FAI - Check Inpatients for Monitors ;08/29/06 14:43
2 ;;5.5;Dietetics;**4,8**;Jan 28, 2005;Build 28
3 ;3/14/07 - patch 8 adds the nutrition assessment alert.
4 D NOW^%DTC S NOW=% D CLR
5 S FHEDT=$P(NOW,".")
6 F WRD=0:0 S WRD=$O(^FH(119.6,WRD)) Q:WRD<1 S FHDUZ=$P($G(^(WRD,0)),"^",2) F FHDFN=0:0 S FHDFN=$O(^FHPT("AW",WRD,FHDFN)) Q:FHDFN'>0 S ADM=$G(^FHPT("AW",WRD,FHDFN)) D PAT
7 D P5
8 K %,A1,A2,ADM,BMI,CLR,DA,DD,DFN,DIC,DTE,FHDUZ,FHOR,FHORD,FHTF
9 K GMRVSTR,HT,L,LST,MONIFN,MONTX,N,NOW,PX,STOP,TF,WRD,WT,X,X0,Y
10 K I,FHTMO,FHTFLG,FHEDT,FHTICK,FHTDFN,FHTDT1,FHWTDT,FHHTDT,WARD,FHGMDT
11 K A,A0,AGE,BID,DEAD,FDA,FHAGE,FHBID,FHCLIN,FHDFN,FHI,FHI115,FHJ,FHJDAT,FHDFN
12 K FHPTNM,FHPCZN,FHSEX,FHSSN,FHHDAT,FILE,HTM,IEN,IEN200,NAM,PID,SEX
13 Q
14PAT ;; Check a patient
15 D PATNAME^FHOMUTL I DFN="" Q
16 S Y=^DPT(DFN,0),NAM=$P(Y,"^",1),SEX=$P(Y,"^",2),DOB=$P(Y,"^",3)
17 S AGE="" I DOB'="" S AGE=$E(NOW,1,3)-$E(DOB,1,3)-($E(NOW,4,7)<$E(DOB,4,7))
18 S DEAD=$P($G(^DPT(DFN,.35)),"^",1) Q:DEAD'=""
19 D ALRT^FHASM2A ;creates alert for nutrition assessment(follow-up dt & food/drug interaction.
20 ;
21P0 ; Calculate BMI
22 S GMRVSTR="WT" D EN6^GMRVUTL S WT=$P(X,"^",8),FHWTDT=$P(X,"^",1)
23 S GMRVSTR="HT" D EN6^GMRVUTL S HT=$P(X,"^",8),FHHTDT=$P(X,"^",1)
24 S FHGMDT=$S(FHWTDT>FHHTDT:FHWTDT,FHHTDT>FHWTDT:FHHTDT,1:FHWTDT)
25 S BMI="" I WT,HT S A2=HT*.0254,BMI=+$J(WT/2.2/(A2*A2),0,1)
26 I $G(BMI)=""!($G(BMI)'<18.5) G P1
27 S MONTX="Monitor: BMI < 18.5",DTE=NOW
28 S N=$O(^FHPT(FHDFN,"A",ADM,"MO","B",MONTX,""),-1) I 'N,(FHGMDT>(FHEDT-7)) D FIL G P1
29 I 'N G P1
30 ; Check if been 30 days
31 S LST=$P($G(^FHPT(FHDFN,"A",ADM,"MO",N,0)),"^",2)
32 S X=$$FMDIFF^XLFDT(DTE,LST) I (X>30) D FIL
33P1 ; Check for current Tubefeeding
34 S TF=$P($G(^FHPT(FHDFN,"A",ADM,0)),"^",4) I 'TF G P2
35 S MONTX="Monitor: On Tubefeeding",DTE=NOW
36 S N=$O(^FHPT(FHDFN,"A",ADM,"MO","B",MONTX,""),-1) I 'N D FIL G P2
37 ; Check if been 7 days
38 S LST=$P($G(^FHPT(FHDFN,"A",ADM,"MO",N,0)),"^",2)
39 S X=$$FMDIFF^XLFDT(DTE,LST) I X>7 D FIL
40P2 ; Check for Hyperals
41 S MONTX="",DTE=NOW
42 D PSS435^PSS55(DFN,,"FHIV") F DA=0:0 S DA=$O(^TMP($J,"FHIV",DA)) Q:DA<1 D
43 .S (X0,HTM)=$P($G(^TMP($J,"FHIV",DA,.02)),"^",2) I X0>NOW Q
44 .S MONTX="Monitor: On Hyperals" D FIL Q
45 ;
46P3 ; Check for Serum Albumin
47 S MONTX="",PX=6 D LAB^FHASM4 I $D(^TMP($J,"LRTST")) D
48 .F L=0:0 S L=$O(^TMP($J,"LRTST",L)) Q:L<1 S Y=$TR($P(^(L),"^",6)," ","") I Y'?1A.E,Y<2.8 S MONTX="Monitor: Albumin < 2.8",DTE=$P(^(L),"^",7)
49 I MONTX="" G P4
50 S N=$O(^FHPT(FHDFN,"A",ADM,"MO","B",MONTX,""),-1)
51 ;process new Albumin if old test date is within 7 days.
52 I 'N S X=$$FMDIFF^XLFDT(NOW,DTE) I X<8 D FIL G P4
53 I 'N G P4
54 ; Check if same test
55 S LST=$P($G(^FHPT(FHDFN,"A",ADM,"MO",N,0)),"^",2) I DTE>LST D FIL
56 ;
57P4 ; Check for NPO+Clr Liq > 3 days
58 S A1=NOW,DTE=NOW
59 F D Q:'A1
60 .S A1=$O(^FHPT(FHDFN,"A",ADM,"AC",A1),-1) Q:'A1
61 .S FHORD=$P($G(^FHPT(FHDFN,"A",ADM,"AC",A1,0)),"^",2) I 'FHORD S A1="" Q
62 .S FHOR=$G(^FHPT(FHDFN,"A",ADM,"DI",FHORD,0))
63 .I $P(FHOR,"^",7)="N" S DTE=A1 Q
64 .I $P(FHOR,"^",2)=CLR S DTE=A1 Q
65 .S A1="" Q
66 I DTE'<NOW Q
67 S X=$$FMDIFF^XLFDT(NOW,DTE) Q:X<3
68 S MONTX="Monitor: NPO+Clr Liq > 3 days",DTE=NOW
69 S N=$O(^FHPT(FHDFN,"A",ADM,"MO","B",MONTX,""),-1) I 'N D FIL Q
70 ; Check if been 3 days
71 S LST=$P($G(^FHPT(FHDFN,"A",ADM,"MO",N,0)),"^",2)
72 S X=$$FMDIFF^XLFDT(NOW,LST) I X>3 D FIL
73 Q
74P5 ;clear personalized tickler and quit
75 F FHI=0:0 S FHI=$O(^FH(119,FHI)) Q:FHI'>0 F FHJ=0:0 S FHJ=$O(^FH(119,FHI,"I",FHJ)) Q:FHJ'>0 D
76 .S FHJDAT=$G(^FH(119,FHI,"I",FHJ,0))
77 .Q:$P(FHJDAT,U,2)'="X"
78 .I $P(FHJDAT,U,1)<NOW K ^FH(119,FHI,"I",FHJ)
79 Q
80CLR ; Find Clear Liquid
81 S CLR=$O(^FH(111,"B","CLEAR LIQUID",0)) Q:CLR
82 S CLR=$O(^FH(111,"C","CLEAR LIQUID",0)) Q:CLR
83 S CLR=$O(^FH(111,"C","CLR LIQ",0)) Q:CLR
84 S CLR=$O(^FH(111,"C","CL",0)) Q:CLR
85 Q
86FIL ; File Monitor
87 S FHCLIN=""
88 K XQA S:FHDUZ FHCLIN=$P($G(^VA(200,FHDUZ,0)),U,1)
89 D PATNAME^FHOMUTL
90 I (MONTX["BMI"),($P($G(^FH(119.6,WRD,1)),"^",5)'="Y") G TFIL
91 I (MONTX["Tubefeed"),($P($G(^FH(119.6,WRD,1)),"^",6)'="Y") G TFIL
92 I (MONTX["Hyperals"),($P($G(^FH(119.6,WRD,1)),"^",7)'="Y") G TFIL
93 I (MONTX["Albumin"),($P($G(^FH(119.6,WRD,1)),"^",8)'="Y") G TFIL
94 I (MONTX["NPO+Clr"),($P($G(^FH(119.6,WRD,1)),"^",9)'="Y") G TFIL
95 K XQA,XQAMSG,XQAOPT,XQAROU
96 S XQAID="FH,"_$J_","_$H
97 S XQAMSG=$E(FHPTNM,1,9)_" ("_$E(FHPTNM,1,1)_$P(FHSSN,"-",3)_"): "
98 S XQAOPT="FHCTF2",XQAMSG=XQAMSG_" "_MONTX_" "_$E(DTE,4,5)_"/"_$E(DTE,6,7)_"/"_$E(DTE,2,3)_" Clinician: "_$G(FHCLIN)
99 F A=0:0 S A=$O(^FH(119.6,WRD,2,A)) Q:A'>0 S TK=$P($G(^FH(119.6,WRD,2,A,0)),U,1),XQA(TK)=""
100 I '$D(XQA(FHDUZ)) S XQA(FHDUZ)=""
101 D SETUP^XQALERT
102 ;
103TFIL ;
104 Q:$G(MONTX)=""
105 S FHTFLG=0
106 F I=0:0 S I=$O(^FH(119,FHDUZ,"I",I)) Q:I'>0 D
107 .S FHTDT1=$P(I,".",1)
108 .S FHTICK=^FH(119,FHDUZ,"I",I,0),FHTMO=$P(FHTICK,"^",3),FHTDFN=$P(FHTICK,"^",4)
109 .I (FHTMO=MONTX),(FHTDFN=DFN),(FHTDT1=FHEDT) S FHTFLG=1
110 Q:FHTFLG ;only one monitor for the same day, same clinician and same pt.
111 L +^FHPT(FHDFN,"A",ADM,"MO",0)
112 I '$D(^FHPT(FHDFN,"A",ADM,"MO",0)) S ^FHPT(FHDFN,"A",ADM,"MO",0)="^115.11^^"
113 L -^FHPT(FHDFN,"A",ADM,"MO",0)
114 K DIC,DD,DO,DINUM S DIC="^FHPT(FHDFN,""A"",ADM,""MO"",",DIC(0)="L",DA(1)=ADM,DA(2)=FHDFN,DLAYGO=115,X=MONTX D FILE^DICN K DIC,DLAYGO
115 Q:Y<1 S MONIFN=+Y
116 S $P(^FHPT(FHDFN,"A",ADM,"MO",MONIFN,0),"^",2)=DTE,^FHPT(FHDFN,"A",ADM,"MO","AC",DTE,MONIFN)=""
117CRT ;create tickler
118 S FHTF=DTE_"^M^"_MONTX_"^"_DFN_"^"_ADM_"^"_MONIFN
119 D:FHDUZ FILE^FHCTF2
120 Q
Note: See TracBrowser for help on using the repository browser.