source: FOIAVistA/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWDFH.m

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

initial load of FOIAVistA 6/30/08 version

File size: 7.5 KB
Line 
1ORWDFH ; SLC/KCM/JLI - Diet Order calls for Windows Dialogs ;12/12/00 14:44
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,92,141,187,215**;Dec 17, 1997
3TXT(LST,DFN) ; Return text of current & future diets for a patient
4 S LST(1)="Current Diet: "_$$DIET^ORCDFH(DFN)
5 N FUTLST D FUT(.FUTLST,DFN) I $D(FUTLST)>1 D
6 . S LST(2)="Future Diet Orders:",ILST=2
7 . S I=0 F S I=$O(FUTLST(I)) Q:'I D
8 . . S X=$$FMTE^XLFDT(I,2)_" "_$P(FUTLST(I),U,2)
9 . . S LST(ILST)=$S(ILST=2:"Future Diet Orders: "_X,1:" "_X)
10 . . S ILST=ILST+1
11 Q
12FUT(LST,DFN) ; Return a list of future diet orders
13 N DGRP,NXTDT,ORIFN,ORVP,ORTX
14 S ORVP=DFN_";DPT(",DGRP=$O(^ORD(100.98,"B","DO",0)),NXTDT=$$NOW^XLFDT
15 F S NXTDT=$O(^OR(100,"AW",ORVP,DGRP,NXTDT)) Q:NXTDT'>0 D
16 . S ORIFN=+$O(^OR(100,"AW",ORVP,DGRP,NXTDT,0))
17 . I $P($G(^OR(100,ORIFN,3)),U,3)'=8 Q ; only scheduled diets
18 . D TEXT^ORQ12(.ORTX,ORIFN) S LST(NXTDT)=NXTDT_U_$G(ORTX(1))
19 Q
20PARAM(ORLST,ORVP,ORLOC) ; Return dietetics parameters for a patient at a location
21 ; ORLOC: hospital location ptr to ^SC #44
22 ; ORLST(1)=EB1^EB2^EB3^LB1^LB2^LB3^EN1^EN2^...LE2^LE3
23 ; ORLST(2)=BAB^BAE^NAB^NAE^EAB^EAE^BegB^BegN^BegE^Bagged
24 ; ORLST(3)=type of service^RegIEN^NPOIEN^EarlyIEN^LateIEN^TFIFN
25 ; ORLST(4)=max days in future for outpatient recurring meals
26 ; ORLST(5)=default outpatient diet
27 Q:'+ORVP
28 N X,IEN,CURTM
29 S ORVP=+ORVP_";DPT(",ORLOC=+ORLOC
30 S CURTM=$$NOW^XLFDT
31 I $D(^SC(ORLOC,42)) S ORLOC=$G(^SC(ORLOC,42))_";DIC(42"
32 E S ORLOC=ORLOC_";SC("
33 D EN1^FHWOR8(ORLOC,.ORLST)
34 ;
35 I '$L($G(ORLST(3))) S ORLST(3)="T"
36 S $P(ORLST(3),U,2)=$O(^ORD(101.43,"S.DIET","REGULAR",0))
37 S $P(ORLST(3),U,3)=$O(^ORD(101.43,"S.DIET","NPO",0))
38 S $P(ORLST(3),U,4)=$O(^ORD(101.43,"S.E/L T","EARLY TRAY",0))
39 S $P(ORLST(3),U,5)=$O(^ORD(101.43,"S.E/L T","LATE TRAY",0))
40 N TF S TF=$$CURRENT^ORCDFH("TF") I $L(TF,";")=1 S TF=TF_";1"
41 I TF,'$$FUTURE^ORCDFH("EFFECTIVE DATE/TIME") S $P(ORLST(3),U,6)=TF
42 I $$VERSION^XPDUTL("FH")>5 D
43 . S ORLST(4)=$$MAXDAYS^FHOMAPI(ORLOC)
44 . D DIETLST^FHOMAPI Q:'$G(FHDIET(1))
45 . S IEN=$O(^ORD(101.43,"ID",$P(FHDIET(1),U,1)_";99FHD",0)) Q:+IEN=0
46 . S X=^ORD(101.43,"S.DIET",$P(FHDIET(1),U,2),IEN)
47 . I +$P(X,U,3),$P(X,U,3)<CURTM Q
48 . I $P($G(^ORD(101.43,IEN,"FH")),U)'="D",($P($G(^(0)),U)'="NPO") Q
49 . S ORLST(5)=+$G(IEN)
50 Q
51ATTR(REC,OI) ; Return OI^Text^Type^Precedence^AskExpire for a diet
52 I $G(^ORD(101.43,OI,.1)),^(.1)'>$$NOW^XLFDT S REC="0^"_$P($G(^ORD(101.43,OI,0)),U)_" has been inactivated and may not be ordered anymore." Q
53 S REC=OI_U_$P($G(^ORD(101.43,OI,0)),U)_U_$G(^("FH"))
54 Q
55DIETS(Y,FROM,DIR) ; Return a subset of active diets, including NPO
56 ; Y(n)=IEN^.01 Name^.01 Name -or- IEN^Synonym <.01 Name>^.01 Name
57 N I,IEN,CNT,X,CURTM
58 S I=0,CNT=44,CURTM=$$NOW^XLFDT
59 F Q:I'<CNT S FROM=$O(^ORD(101.43,"S.DIET",FROM),DIR) Q:FROM="" D
60 . S IEN=0 F S IEN=$O(^ORD(101.43,"S.DIET",FROM,IEN)) Q:'IEN D
61 . . S X=^ORD(101.43,"S.DIET",FROM,IEN)
62 . . I +$P(X,U,3),$P(X,U,3)<CURTM Q
63 . . I $P($G(^ORD(101.43,IEN,"FH")),U)'="D",($P($G(^(0)),U)'="NPO") Q
64 . . S I=I+1
65 . . I 'X S Y(I)=IEN_U_$P(X,U,2)_U_$P(X,U,2)
66 . . E S Y(I)=IEN_U_$P(X,U,2)_$C(9)_"<"_$P(X,U,4)_">"_U_$P(X,U,4)
67 Q
68OPDIETS(ORY,FROM,DIR) ;Return a list of up to 5 outpatient diets from file 119.9
69 N X,I,J,IEN,CURTM,SYNCNT,SYNTOT,FHDIET
70 D DIETLST^FHOMAPI
71 S CURTM=$$NOW^XLFDT,I=0,SYNTOT=1
72 F S I=$O(FHDIET(I)) Q:'I D
73 . S IEN=$O(^ORD(101.43,"ID",$P(FHDIET(I),U,1)_";99FHD",0)) Q:+IEN=0
74 . S X=^ORD(101.43,"S.DIET",$P(FHDIET(I),U,2),IEN)
75 . I +$P(X,U,3),$P(X,U,3)<CURTM Q
76 . I $P($G(^ORD(101.43,IEN,"FH")),U)'="D",($P($G(^(0)),U)'="NPO") Q
77 . S X=$P(^ORD(101.43,IEN,0),U,1)
78 . S SYNCNT=$P($G(^ORD(101.43,IEN,2,0)),U,4),J=0
79 . S ORY(X)=IEN_U_X_U_X
80 . I +SYNCNT D Q
81 . . S SYNTOT=SYNTOT+SYNCNT
82 . . F S J=$O(^ORD(101.43,IEN,2,J)) Q:'J D
83 . . . S ORY(^ORD(101.43,IEN,2,J,0))=IEN_U_^ORD(101.43,IEN,2,J,0)_$C(9)_"<"_X_">"_U_X
84 Q
85TFPROD(Y) ; Return a list of active tubefeeding products
86 N I,IEN,NAM,X,CURTM
87 S I=0,NAM="",CURTM=$$NOW^XLFDT
88 F S NAM=$O(^ORD(101.43,"S.TF",NAM)) Q:NAM="" D
89 . S IEN=0 F S IEN=$O(^ORD(101.43,"S.TF",NAM,IEN)) Q:'IEN D
90 . . S X=^ORD(101.43,"S.TF",NAM,IEN)
91 . . I +$P(X,U,3),$P(X,U,3)<CURTM Q
92 . . S I=I+1
93 . . I 'X S Y(I)=IEN_U_$P(X,U,2)_U_$P(X,U,2)
94 . . E S Y(I)=IEN_U_$P(X,U,2)_$C(9)_"<"_$P(X,U,4)_">"_U_$P(X,U,4)
95 Q
96QTY2CC(VAL,PRD,STR,QTY) ; Return cc's given a product, strength, & quantity
97 N X,VQTY,DUR
98 S VQTY=$$VALIDQTY^ORCDFHTF(QTY) I '$L(VQTY)!('PRD)!('STR) S VAL="" Q
99 S PRD=+$P($G(^ORD(101.43,PRD,0)),U,2)
100 S DUR=$P(VQTY," X ",2) I $L(DUR) S DUR=$S(DUR["H":"H",1:"X")_+DUR
101 S X=+VQTY_"&"_$E($P(VQTY," ",2))_U_$P($P(VQTY,"/",2)," ")_U_DUR
102 S VAL=$$QUAN^FHWOR5R(PRD_"-"_STR,X)_U_VQTY
103 Q
104FINDTYP(VAL,DGRP) ; Return type of dietetics order based on display group
105 S VAL=$P($G(^ORD(100.98,DGRP,0)),U,3)
106 S:VAL="D AO" VAL="A" S VAL=$E(VAL)
107 Q
108ISOIEN(VAL) ; Return IEN for the Isolation/Precaution orderable item
109 S VAL=$O(^ORD(101.43,"S.PREC","ISOLATION PROCEDURES",0))
110 Q
111CURISO(VAL,ORVP) ; Return a patient's current isolation
112 S ORVP=ORVP_";DPT(" S VAL=$P($$IP^ORMBLD,U,2)
113 I '$L(VAL) S VAL="<none>"
114 Q
115ISOLIST(LST) ; Return list of active isolations/precautions
116 N I,X,IEN
117 S I=0,X="" F S X=$O(^FH(119.4,"B",X)) Q:X="" S IEN=$O(^(X,0)) D
118 . I '$D(^FH(119.4,IEN,"I")) S I=I+1,LST(I)=IEN_U_X
119 Q
120MILTM(X) ; return military time for am/pm time
121 N TM
122 S TM=$P(X,":",1)_+$P(X,":",2)
123 I X["P",TM<1200 S TM=TM+1200
124 I X["A",TM>1200 S TM=TM-1200
125 Q TM
126 ;
127ASKLATE(REC,DFN,ORIFN) ; Return info for ordering late tray for diet order
128 ; REC=0 or 1^meal^bagged^time^time^time
129 S REC=0 Q:'$G(ORIFN) Q:$E($$VALUE^ORX8(ORIFN,"ORDERABLE",1,"E"),1,3)="NPO"
130 N X,Y,%DT,STRT,DATE,ORPARAM,I,MEAL,MEALTIME
131 S X=$O(^OR(100,ORIFN,4.5,"ID","START",0)),X=$G(^OR(100,ORIFN,4.5,+X,1))
132 Q:X="" S %DT="TX" D ^%DT Q:Y'>0 Q:$P(Y,".")>DT ;invalid or future
133 S DATE=$P(Y,"."),STRT=+$E($P(Y,".",2)_"0000",1,4),MEAL=0
134 D EN^FHWOR8(DFN,.ORPARAM) Q:'$D(ORPARAM(2))
135 F I=1,3,5 I $P(ORPARAM(2),U,I)<STRT,STRT<$P(ORPARAM(2),U,I+1) S MEAL=I Q
136 S MEAL=$S(MEAL=1:4,MEAL=3:10,MEAL=5:16,1:0) Q:'MEAL
137 S MEALTIME=$P(ORPARAM(1),U,MEAL,MEAL+2)
138 S MEAL=$S(MEAL=4:"B",MEAL=10:"N",MEAL=16:"E",1:"")
139 F I=1:1:3 S X=$$MILTM($P(MEAL,U,I)) I X<STRT S $P(MEAL,U,I)=""
140 S REC="1"_U_MEAL_U_$P(ORPARAM(2),U,10)_U_MEALTIME
141 I $P(REC,U,2,4)="^^" S REC=0
142 Q
143ADDLATE(REC,ORVP,ORNP,ORL,MEAL,TIME,BAG) ; Add late tray order
144 N ORIFN,ORNEW,ORDUZ,ORSTS,OREVENT,ORCAT,ORDA,ORTS,ORCHECK,ORLOG
145 N ORDIALOG,ORDG,ORTYPE,DA,FIRST,TRAY
146 S ORVP=ORVP_";DPT(",ORL(2)=ORL_";SC(",ORL=ORL(2)
147 S ORTYPE="D",FIRST=1,ORDUZ=DUZ,ORLOG=+$E($$NOW^XLFDT,1,12)
148 S TRAY=+$O(^ORD(101.43,"S.E/L T","LATE TRAY",0))
149 S ORDIALOG=$O(^ORD(101.41,"AB","FHW2",0))
150 D GETDLG^ORCD(ORDIALOG)
151 S ORDIALOG($$PTR^ORCD("OR GTX MEAL"),1)=MEAL
152 S ORDIALOG($$PTR^ORCD("OR GTX ORDERABLE ITEM"),1)=TRAY
153 S ORDIALOG($$PTR^ORCD("OR GTX START DATE"),1)=DT
154 S ORDIALOG($$PTR^ORCD("OR GTX STOP DATE"),1)=DT
155 S ORDIALOG($$PTR^ORCD("OR GTX MEAL TIME"),1)=TIME
156 S ORDIALOG($$PTR^ORCD("OR GTX YES/NO"),1)=BAG
157 D EN^ORCSAVE
158 S REC="" I ORIFN D GETBYIFN^ORWORR(.REC,ORIFN)
159 Q
160CURMEALS(ORY,ORDFN,ORMEAL) ;Return current list of recurring meals for AO and TF orders
161 N I,Y,X S I=0
162 S ORMEAL=$G(ORMEAL,"")
163 D EN2^FHWOR8(ORDFN,ORMEAL,.ORY)
164 F S I=$O(ORY(I)) Q:'I D
165 . S X=$P(ORY(I),U,2)
166 . S Y=$P(ORY(I),U,1) D DD^%DT S $P(ORY(I),U,2)=Y
167 . S $P(ORY(I),U,3)=$S(X="B":"Breakfast",X="N":"Noon",X="E":"Evening",1:"")
168 Q
169NFSLOC(ORLOC) ;Get NUTRITION LOCATION name for HOSPITAL LOCATION
170 Q $$NFSLOC^FHOMAPI(ORLOC)
171OPLOCOK(ORY,ORLOC) ; OK to order OP Meals from this location
172 I 'ORLOC S ORY=0 Q
173 S ORY=$S($L($$NFSLOC^FHOMAPI(ORLOC))>0:1,1:0)
174 Q
Note: See TracBrowser for help on using the repository browser.