- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORWDFH.m
r613 r623 1 ORWDFH 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**10,92,141,187,215,243**;Dec 17, 1997;Build 242 3 TXT(LST,DFN) 4 5 6 7 8 9 10 11 12 FUT(LST,DFN) 13 14 15 16 17 18 19 20 PARAM(ORLST,ORVP,ORLOC) 21 22 23 24 25 26 27 28 29 30 31 I +$G(^SC(ORLOC,42)) S ORLOC=$G(^SC(ORLOC,42))_";DIC(42"32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 ATTR(REC,OI) 52 53 54 55 DIETS(Y,FROM,DIR) 56 57 58 59 60 61 62 63 64 65 66 67 68 OPDIETS(ORY,FROM,DIR) 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 TFPROD(Y) 86 87 88 89 90 91 92 93 94 95 96 QTY2CC(VAL,PRD,STR,QTY) 97 98 99 100 101 102 103 104 FINDTYP(VAL,DGRP) 105 106 107 108 ISOIEN(VAL) 109 110 111 CURISO(VAL,ORVP) 112 113 114 115 ISOLIST(LST) 116 117 118 119 120 MILTM(X) 121 122 123 124 125 126 127 ASKLATE(REC,DFN,ORIFN) 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 ADDLATE(REC,ORVP,ORNP,ORL,MEAL,TIME,BAG) 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 CURMEALS(ORY,ORDFN,ORMEAL) 161 162 163 164 165 166 167 168 169 NFSLOC(ORLOC) 170 171 OPLOCOK(ORY,ORLOC) 172 173 174 1 ORWDFH ; 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 3 TXT(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 12 FUT(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 20 PARAM(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 51 ATTR(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 55 DIETS(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 68 OPDIETS(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 85 TFPROD(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 96 QTY2CC(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 104 FINDTYP(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 108 ISOIEN(VAL) ; Return IEN for the Isolation/Precaution orderable item 109 S VAL=$O(^ORD(101.43,"S.PREC","ISOLATION PROCEDURES",0)) 110 Q 111 CURISO(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 115 ISOLIST(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 120 MILTM(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 ; 127 ASKLATE(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 143 ADDLATE(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 160 CURMEALS(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 169 NFSLOC(ORLOC) ;Get NUTRITION LOCATION name for HOSPITAL LOCATION 170 Q $$NFSLOC^FHOMAPI(ORLOC) 171 OPLOCOK(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 TracChangeset
for help on using the changeset viewer.
