source: FOIAVistA/trunk/r/DIETETICS-FH/FHOMUTL.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 6.9 KB
Line 
1FHOMUTL ;Hines OIFO/RTK OUTPATIENT MEALS UTILITIES ;2/04/03 15:15
2 ;;5.5;DIETETICS;**1,2,5**;Jan 28, 2005;Build 53
3 ;
4DIV ;ask for Communication office if Multi-division.
5 N FHSCNT,FH
6 K FHSITE,FHSITENM
7 S FHSCNT=0 F FH=0:0 S FH=$O(^FH(119.73,FH)) Q:FH'>0 S FHSCNT=FHSCNT+1,FHSITE=FH,FHSITENM=$P($G(^FH(119.73,FH,0)),U,1)
8 I (FHSCNT=1),($P($G(^FH(119.9,1,0)),U,20)'="Y") Q
9D2 I FHSCNT>1 K FHSITE,FHSITENM,X R !!,"Select COMMUNICATION OFFICE (or ALL): ALL// ",X:DTIME S:X="" X="ALL" Q:'$T!("^"[X) D TR^FH I X="ALL" S FHSITE=0
10 I X'="ALL" K DIC S DIC="^FH(119.73,",DIC(0)="EMQ" D ^DIC G:Y<1 D2 S FHSITE=+Y,FHSITENM=$P(Y,U,2)
11 Q
12 ;
13STDATE ;Prompt for start date (if FHPSDT="N" do not allow past dates)
14 S STDT="" D NOW^%DTC S Y=X D DD^%DT S FHDTDF=Y
15 K DIR S DIR("A")="Select Start Date: ",DIR("B")=FHDTDF
16 S DIR(0)="DAO" I $G(FHPSDT)="N" S DIR(0)="DAO^FHDTDF"
17 D ^DIR Q:$D(DIRUT) S STDT=Y S Y=STDT D DD^%DT W " ",Y
18 Q
19ENDATE ;Prompt for end date
20 S ENDT="" D NOW^%DTC S Y=X D DD^%DT S FHDTDF=Y K DIR
21 S DIR("A")="Select End Date: ",DIR("B")=FHDTDF,DIR(0)="DAO^"_STDT D ^DIR
22 Q:$D(DIRUT) S ENDT=Y S Y=ENDT D DD^%DT W " ",Y
23 Q
24OUTLOC ;Prompt for outpatient location - screen for ONLY Outpatient Locations
25 S FHLOC="",FHOUT="O"
26 K DIC S DIC="^FH(119.6,",DIC(0)="AEQZ"
27 S DIC("A")="Select Outpatient Ordering Location: "
28 S DIC("S")="I $P(^(0),U,3)=FHOUT" D ^DIC
29 Q:$D(DUOUT) I Y=-1 Q
30 S FHLOC=+Y,FHCOMM=$P($G(^FH(119.6,FHLOC,0)),U,8)
31 I '$O(^FH(119.6,FHLOC,"L",0)) S FHLOC="",FHCOMM="" W !!,"The selected location does not have an Associated Hospital Location. To set",!,"the Associated Hospital Location use option ENTER/EDIT NUTRITION LOCATIONS."
32 Q
33 ;
34RMBED ;Prompt for outpatient room-bed - must be set up for Outpatient Location
35 S (FHRMBD,FHRMBSL)=""
36 I $G(FHLOC)="" W !!,"No OUTPATIENT LOCATION selected" Q
37 I '$D(^FH(119.6,FHLOC,"R")) Q
38 F FHRMBI=0:0 S FHRMBI=$O(^FH(119.6,FHLOC,"R",FHRMBI)) Q:FHRMBI'>0 D
39 .S FHRMBPT=$P($G(^FH(119.6,FHLOC,"R",FHRMBI,0)),U),FHRMBSL(FHRMBPT)=1
40 K DIC S DIC="^DG(405.4,",DIC(0)="AEQZ"
41 S DIC("A")="Select Outpatient Room-Bed: "
42 S DIC("S")="I $D(FHRMBSL(+Y))" D ^DIC
43 Q:$D(DUOUT) I Y=-1 Q
44 S FHRMBD=+Y
45 Q
46GTFHDFN ;Get FHDFN, given DFN
47 K DIR S DIR(0)="NAO",DIR("B")="ENTER DFN" D ^DIR Q:$D(DIRUT) S ZZDFN=Y
48 S FHZ115="P"_ZZDFN,FHDFN=$O(^FHPT("B",FHZ115,""))
49 I '$D(^DPT(ZZDFN)) W !!,"DFN '",ZZDFN,"' NOT FOUND IN FILE 2",! Q
50 I FHDFN="" W !!,"NO CORRESPONDING FHDFN"
51 W !!," NAME: ",$P($G(^DPT(ZZDFN,0)),U,1)
52 W !?2,"DFN: ",ZZDFN,!,"FHDFN: ",FHDFN,!
53 Q
54GETOPT ;Select outpatient for recurring meals
55 S FHFIND=1 D ^FHOMDPA I FHDFN="" S FHFIND=0 Q
56 I '$D(^FHPT(FHDFN,0)) S FHFIND=0 Q ;W !!,"UNKNOWN SELECTION !"
57 I $O(^FHPT(FHDFN,"OP",0))="" W !!,"NO RECURRING MEALS FOR THIS PERSON" S FHFIND=0 Q
58 W ! D STDATE I STDT="" S FHFIND=0 Q
59 Q
60PATNAME ;Get name and demographics of patient/new person
61 ;input variable: FHDFN
62 S (FHDOB,FHBID,FHSEX,DFN)="" D GETZN
63 I FILE="P" S FHPTNM=$P($G(^DPT(IEN,0)),U,1)
64 I FILE="N" S FHPTNM=$P($G(^VA(200,IEN,0)),U,1)
65 ;Get SSN,Age,DOB,Sex of patient/new person
66 I FILE="P" D
67 .S DFN=IEN
68 .D PID^FHDPA S FHSSN=PID
69 .S FHSEX=$P($G(^DPT(DFN,0)),U,2),FHDOB=$P($G(^DPT(DFN,0)),U,3)
70 .S FHBID=BID
71 I FILE="N" D
72 .S IEN200=IEN,FHSSN=$P($G(^VA(200,IEN,1)),U,9)
73 .S FHBID=$E(FHSSN,6,$L(FHSSN))
74 .S FHSEX=$P($G(^VA(200,IEN,1)),U,2),FHDOB=$P($G(^VA(200,IEN,1)),U,3)
75 S FHAGE="" D NOW^%DTC
76 I FHDOB'="" S FHAGE=$E(%,1,3)-$E(FHDOB,1,3)-($E(%,4,7)<$E(FHDOB,4,7))
77 Q
78GETZN ;Get first piece of zero node in 115
79 S FHPCZN=$P($G(^FHPT(FHDFN,0)),U,1),FILE=$E(FHPCZN,1)
80 S IEN=$E(FHPCZN,2,99)
81 Q
82DIETVER ;Verify that diet selected is from the allowable diets in 119.9
83 D DIETLST I $D(FHDIETS(FHDIET)) Q
84 S FHDIET="" W *7," ==> NOT ALLOWED",! D DIETMSG Q
85DIETHLP ;Display allowable diets from 119.9
86 D DIETLST,DIETMSG Q
87DIETLST ;Build list
88 K FHDIETS,SPD S FHSPDTS="",SPD=$P($G(^FH(119.9,1,0)),U,2,6)_"^"_$P($G(^FH(119.9,1,1)),U,1,10)
89 S FHDEF=$P($G(^FH(119.9,1,0)),U,2)
90 F A=1:1:15 S AB=$P(SPD,U,A) D
91 .I AB="" Q
92 .S FHDIETS(AB)=AB
93 .S FHSPDTS=FHSPDTS_$P($G(^FH(111,AB,0)),U,1)_"^"
94 Q
95DIETMSG ;Display message
96 W !?3,"You must select from the diets set up in the Site Parameters:"
97 S AB="" F S AB=$O(FHDIETS(AB)) Q:AB'>0 W !?3,$P($G(^FH(111,AB,0)),U)
98 W ! Q
99 Q
100EXMSG ;Display message stating meal NOT ordered
101 D TYPE
102 W !!?3,FHMSGML," NOT ordered!",! H 2
103 Q
104OKMSG ;Display message stating meal ordered successfully
105 D TYPE
106 D PATNAME W !!?3,FHMSGML," ordered for ",FHPTNM,"...",! H 2
107 Q
108TYPE ;
109 S FHMSGML=$S(FHMSG1="G":"Guest meal",FHMSG1="S":"Special meal",FHMSG1="R":"Recurring meal",FHMSG1="E":"Early/Late tray",FHMSG1="T":"Tubefeeding",1:"Additional order")
110 Q
111UPXMSG ;
112 W !!?3,"Recurring meal NOT updated! ",! H 2
113 Q
114UPDMSG ;
115 D PATNAME W !!?3,"Recurring meal updated for ",FHPTNM,"...",! H 2
116 Q
117SMSTAT ;Status of last special meal request
118 S FHSMNUM=$O(^FHPT(FHDFN,"SM","B",""),-1) I FHSMNUM="" S FHSTAT="" Q
119 I $E(FHSMNUM,1,7)'=DT S FHSTAT="" Q
120 S FHSTAT=$P($G(^FHPT(FHDFN,"SM",FHSMNUM,0)),U,2)
121 Q
122RANGE ;Check for validity of range of numbers entered
123 S FHCLST="",FLG="",X=FHNUM D TR^FH S FHNUM=X
124 I FHNUM="A"!(FHNUM?1"A"1.2"L") S FHNUM="1-"_NUM
125 F K=1:1 S K1=$P(FHNUM,",",K) Q:K1=""!(FLG="QUIT") D
126 .S K2=$S(K1["-":$P(K1,"-",2),1:+K1),K1=+K1 D CK I FLG="QUIT" Q
127 .F K3=K1:1:K2 S FHCLST=FHCLST_K3_","
128 Q
129CK I K1<1!(K1>NUM)!(K1'?1N.N) D C1 Q
130 I K2<1!(K2>NUM)!(K2'?1N.N) D C1 Q
131 Q:K2'<K1
132C1 W !," Enter numbers or range or ALL (E.G., 1,3,4 or 3-5 or 1,3-5)" S FLG="QUIT",FHCLST="" Q
133 Q
134MSHOM ;Code MSG for outpatient orders
135 D SITE^FH
136 S MSG(1)="MSH|^~\&|DIETETICS|"_SITE(1)_"|||||ORM"
137 S MSG(2)="PID|||"_DFN_"||"_$P($G(^DPT(DFN,0)),"^",1)
138 S FHOLOC=$O(^FH(119.6,FHLOC,"L",0)) I FHOLOC="" Q ;RESULTS IN NO BKDOOR
139 S FHOLOC=$G(^FH(119.6,FHLOC,"L",FHOLOC,0))
140 S FHOLOCNM=$P($G(^SC(FHOLOC,0)),U,1)
141 S MSG(3)="PV1||O|"_FHOLOC_"^"_FHOLOCNM_"||||||||||||||||"
142 Q
143MSHCA ;Code Cancel/Discontinue for outpatient orders
144 D NOW^%DTC S FHNOW=% K MSG S ACT="OC" D SITE^FH
145 I $G(FHCATXT)="" S FHCATXT="Dietetics Canceled order."
146 S MSG(1)="MSH|^~\&|DIETETICS|"_SITE(1)_"|||||ORM"
147 S MSG(2)="PID|||"_DFN_"||"_$P($G(^DPT(DFN,0)),"^",1)
148 S DATE=$$FMTHL7^XLFDT(FHNOW)
149 S MSG(3)="ORC|"_ACT_"|"_FHORN_"^OR|"_FILL_"^FH|||||||||"_DUZ_"|||"_DATE_"|"_FHCATXT
150 Q
151MSHSS ;Code MSG for outpatient send status messages
152 D SITE^FH
153 S MSG(1)="MSH|^~\&|DIETETICS|"_SITE(1)_"|||||ORR"
154 S MSG(2)="PID|||"_DFN_"||"_$P($G(^DPT(DFN,0)),"^",1)
155 S MSG(3)="ORC|SR|"_FHORN_"^OR|"_FILL_"||"_FHSTTS
156 Q
157CONVC ;Convert Amount/Unit in file 118.2, from "C" to "ML".
158 F FHII=0:0 S FHII=$O(^FH(118.2,FHII)) Q:FHII'>0 D
159 .S FHAU=$P(^FH(118.2,FHII,0),U,3)
160 .I FHAU["C" S FHAF=$P(FHAU,"C",1),FHAS=$P(FHAU,"C",2) D
161 ..S $P(^FH(118.2,FHII,0),U,3)=FHAF_"ML"_FHAS
162 Q
163MONUM ;Prompt for number of monitors to display
164 W ! K DIR S FHNUM="",DIR("?")="Select ALL to view all monitors, or select a specific number. For example, enter 20 to display the 20 most recent monitors."
165 S DIR(0)="F",DIR("A")="How many monitors would you like to display?"
166 S DIR("B")="ALL" D ^DIR
167 I $D(DIRUT) S FHNUM="" Q
168 S FHNUM=Y I FHNUM'="A",FHNUM'="ALL",FHNUM'?1.5N D MONUM Q
169 I FHNUM="A"!(FHNUM="ALL") S FHNUM=99999
170 Q
Note: See TracBrowser for help on using the repository browser.