source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORCDFHO.m@ 949

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

initial load of WorldVistAEHR
File size: 5.5 KB
Line 
1ORCDFHO ;SLC/MKB-Utility functions for Outpt FH dialogs ;8/27/03 15:28
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215**;Dec 17, 1997
3 ;
4EN ; -- entry action
5 I $$INPT^ORCD W $C(7),!!,"This patient is not an outpatient!" S ORQUIT=1 H 2 Q
6 I '$L($T(EN2^FHWOR8))!'$L($T(DIETLST^FHOMAPI)) W $C(7),!!,"Dietetics v5.5 must be installed to place outpatient diet orders!" S ORQUIT=1 H 2 Q
7 N X S X=$S($G(OREVENT):$$LOC^OREVNTX(OREVENT),1:$G(ORL)) Q:X<1
8 D EN1^FHWOR8(X,.ORPARAM) S ORCAT="O"
9 I $G(ORPARAM(3))'["B" S ORPARAM(3)=$G(ORPARAM(3))_"B" ;bagged meal
10 I $G(OREWRITE) D ;remove addl diets
11 . N I,P1,P2 S P1=$$PTR("ADDL DIETS"),P2=$$PTR("MEAL DATE")
12 . S I=0 F S I=$O(ORDIALOG(P1,I)) Q:I<1 K ORDIALOG(P1,I),ORDIALOG(P2,I)
13 Q
14 ;
15EX ; -- exit action
16 K ORPARAM,ORNPO,ORTRAIL,ORDAY,ORDT,ORCAT
17 Q
18 ;
19PTR(X) ; -- Returns ptr value of prompt OR GTX X in Dialog file
20 Q +$O(^ORD(101.41,"AB",$E("OR GTX "_X,1,63),0))
21 ;
22OPDIETS ; -- Get list of diets ok for outpatients
23 Q:$G(ORDIALOG(PROMPT,"LIST")) N FHDIET,I,X,Y,CNT
24 D DIETLST^FHOMAPI S CNT=0
25 S I=0 F S I=$O(FHDIET(I)) Q:I<1 D
26 . S Y=FHDIET(I),X=+Y,Y=$P(Y,U,2)
27 . S X=+$O(^ORD(101.43,"ID",X_";99FHD",0))
28 . I X S CNT=CNT+1,ORDIALOG(PROMPT,"LIST",CNT)=X_U_Y,ORDIALOG(PROMPT,"LIST","B",Y)=X
29 S:CNT ORDIALOG(PROMPT,"LIST")=CNT_"^1"
30 Q
31 ;
32ONETIME() ; -- Condition for SCHEDULE
33 N X,Y
34 S Y=$$FTDCOMP^ORCD("END DATE","START DATE",">")
35 S X=$G(ORDIALOG(PROMPT,INST))
36 S:'Y ORDIALOG(PROMPT,INST)="ONCE" I Y,X="ONCE" K ORDIALOG(PROMPT,INST)
37 Q 'Y
38 ;
39TIMES ; -- get existing outpatient meal times
40 Q:$G(ORDIALOG(PROMPT,"LIST")) D EN2^FHWOR8(+$G(ORVP),"",.ORDT)
41 N I,CNT,X,Y,M S (I,CNT)=0 F S I=$O(ORDT(I)) Q:I<1 D
42 . S X=ORDT(I),Y=$$FMTE^XLFDT(+X),M=$P(X,U,2)
43 . S Y=Y_" "_$S(M="B":"Breakfast",M="N":"Noon",M="E":"Evening",1:"")
44 . S X=$TR(X,"^",";"),CNT=CNT+1
45 . S ORDIALOG(PROMPT,"LIST",I)=X_U_Y,ORDIALOG(PROMPT,"LIST","B",Y)=X
46 S:CNT ORDIALOG(PROMPT,"LIST")=CNT_"^1"
47 Q
48 ;
49ENDT ; -- setup START
50 ;S $P(ORDIALOG(PROMPT,0),":",3)="ETX" ;allow time
51 D TIMES I FIRST,$G(ORDIALOG(PROMPT,"LIST")) D LIST^ORCD
52 Q
53 ;
54EXDT(X) ; -- populate E/L T values from START
55 Q:X'[";" N DATE,MEAL
56 S DATE=+X,MEAL=$P(X,";",2)
57 S ORDIALOG(PROMPT,INST)=DATE,ORDIALOG($$PTR("STOP DATE"),1)=DATE
58 S ORDIALOG($$PTR("MEAL"),1)=MEAL
59 Q
60 ;
61MEALTIME(IFN) ; -- gets meal time for order IFN [from STARTDT^ORCSAVE2]
62 N ORPARAM,ORLOC,X,Y S IFN=+$G(IFN)
63 S ORLOC=$S($G(ORL):ORL,1:$P($G(^OR(100,IFN,0)),U,10))
64 D EN1^FHWOR8(ORLOC,.ORPARAM) S X=$$VALUE^ORCSAVE2(IFN,"MEAL")
65 S:'$D(ORPARAM(2)) ORPARAM(2)="^^^^^^6:00A^12:00P^6:00P"
66 S Y=$S(X="B":$P(ORPARAM(2),U,7),X="N":$P(ORPARAM(2),U,8),X="E":$P(ORPARAM(2),U,9),1:"")
67 Q Y
68 ;
69CKMEAL(Y,DAY,MEAL,LOC) ; -- Returns Y if valid mealtime or not
70 ; Y = 0^msg if invalid
71 ; 1 if valid
72 ; 2 if valid, but latetray will be needed
73 ; RPC = ORCDFHO CKMEAL
74 ;
75 N TIMES,NOW,BEGIN,LATE S Y=1 Q:$G(ORTYPE)="Z"
76 S DAY=$$FMDATE($G(DAY)) I DAY<0 S Y="0^Invalid date." Q
77 Q:DAY>DT I DAY<DT S Y="0^Cannot order for past days." Q
78 I "^B^N^E^"'[(U_$G(MEAL)_U) S Y="0^Invalid meal." Q
79 S TIMES=$G(ORPARAM(2)),NOW="."_$P($$NOW^XLFDT,".",2)
80 I TIMES="" D Q:Y<1 ;get meal times for location
81 . I '$G(LOC) S Y="0^Missing or invalid location." Q
82 . N ORPARAM D EN1^FHWOR8(LOC,.ORPARAM)
83 . S TIMES=$G(ORPARAM(2))
84 I TIMES="" S Y="0^No meal times defined for this location." Q
85 S BEGIN=$P(TIMES,U,$S(MEAL="B":7,MEAL="N":8,1:9)) Q:NOW<$$FMTIME(BEGIN)
86 S LATE="."_$P(TIMES,U,$S(MEAL="B":2,MEAL="N":4,1:6)) ;late alarm end
87 I NOW>LATE S Y="0^This meal can no longer be ordered today." Q
88 S LATE="."_$P(TIMES,U,$S(MEAL="B":1,MEAL="N":3,1:5)) ;late alarm start
89 S:NOW>LATE Y=2 ;within alarm window for late tray, else ok
90 Q
91 ;
92FMDATE(X) ; -- Ensure X is in FM date format, return day only
93 N Y,%DT S %DT="TX" D ^%DT
94 Q $P(Y,".")
95 ;
96FMTIME(X) ; -- Returns FM format of time
97 N Y,%DT S %DT="TX" D ^%DT
98 Q "."_$P(Y,".",2)
99 ;
100LATETRAY ; -- Check if latetray is needed, if so place order [from VALID^ORCSIGN]
101 ; Expects ORIFN, ORL, ORVP
102 ; Returns ORES(orifn;1)="" of new latetray order
103 Q:'$G(ORIFN) Q:$E($$VALUE^ORX8(ORIFN,"ORDERABLE",1,"E"),1,3)="NPO"
104 N X,Y,%DT,ORDATE,ORNP
105 S X=$O(^OR(100,ORIFN,4.5,"ID","START",0)),X=$G(^OR(100,ORIFN,4.5,+X,1))
106 Q:X="" S %DT="TX" D ^%DT Q:Y'>0 Q:$P(Y,".")>DT ;invalid or future
107 S ORDATE=$P(Y,"."),ORNP=$P(^OR(100,ORIFN,0),U,4)
108LTRAY ; -- enter here w/ORDATE,ORNP,ORL [reinstated diet after dc'ing NPO]
109 N ORPARAM,ORMEAL,ORTRAY,ORTIME,ORSTRT,Y,I
110 D EN1^FHWOR8(ORL,.ORPARAM) Q:'$D(ORPARAM(2))
111 S I=$O(^OR(100,ORIFN,4.5,"ID","MEAL",0)),ORMEAL=$G(^OR(100,ORIFN,4.5,+I,1))
112 D CKMEAL(.Y,ORDATE,ORMEAL) Q:Y'=2 ;no late tray needed
113 S ORTRAY=+$O(^ORD(101.43,"S.E/L T","LATE TRAY",0))
114 S ORSTRT=+$E($P($$NOW^XLFDT,".",2)_"0000",1,4) D EN2^ORCDFH
115 F I=1:1:3 S Z=$G(ORTIME(ORTRAY,ORMEAL,I)) I Z S Z=$$FMTIME($P(Z,U)),Z=+$E($P(Z,".",2)_"0000",1,4) I Z>ORSTRT S OK=1 Q
116 Q:'$G(OK) Q:'$$ORDTRAY^ORCDFH(ORMEAL) ;Else, cont w/late tray order
117LT1 N ORIFN,ORDIALOG,ORDG,ORTYPE,ORCHECK,ORQUIT,ORDUZ,ORLOG,ORCAT,SEQ,DA,FIRST
118 S ORDIALOG=$O(^ORD(101.41,"AB","FHW2",0)) Q:'ORDIALOG
119 S ORTYPE="D",FIRST=1,ORDUZ=DUZ,ORLOG=+$E($$NOW^XLFDT,1,12),ORCAT="O"
120 D GETDLG^ORCD(ORDIALOG) S ORDIALOG($$PTR^ORCD("OR GTX MEAL"),1)=ORMEAL
121 S ORDIALOG($$PTR^ORCD("OR GTX ORDERABLE ITEM"),1)=ORTRAY
122 S ORDIALOG($$PTR^ORCD("OR GTX START DATE"),1)=ORDATE,ORDIALOG($$PTR^ORCD("OR GTX STOP DATE"),1)=ORDATE
123 F SEQ=6,7 S DA=$O(^ORD(101.41,+ORDIALOG,10,"B",SEQ,0)) Q:'DA D EN^ORCDLG1(DA) Q:$G(ORQUIT) ; prompt for meal time, bagged meal
124 I $G(ORQUIT) W $C(7),!!,"No late tray ordered!",! H 2 Q
125 D EN^ORCSAVE Q:'$G(ORIFN) S ORES(ORIFN_";1")=""
126 W !?10,"... order placed.",!
127 Q
Note: See TracBrowser for help on using the repository browser.