| 1 | ORCDFH ;SLC/MKB-Utility functions for FH dialogs ; 08 May 2002  2:12 PM
 | 
|---|
| 2 |  ;;3.0;ORDER ENTRY/RESULTS REPORTING;**7,73,92,141,215**;Dec 17, 1997
 | 
|---|
| 3 |  ;
 | 
|---|
| 4 | EN ; -- entry action
 | 
|---|
| 5 |  S ORCAT=$S($G(ORTYPE)="Z":"",$$INPT^ORCD:"I",1:"O")
 | 
|---|
| 6 |  I ORCAT="O" D  Q:$G(ORQUIT)
 | 
|---|
| 7 |  . I $P($G(^ORD(100.98,+$G(ORDG),0)),U,3)="DO" W $C(7),!!,"This patient is not an inpatient!" H 2 S ORQUIT=1 Q
 | 
|---|
| 8 |  . I '$L($T(EN2^FHWOR8)) W $C(7),!!,"Dietetics v5.5 must be installed to place outpatient diet orders!" H 2 S ORQUIT=1 Q
 | 
|---|
| 9 |  . D EN2^FHWOR8(+$G(ORVP),"",.ORDT) I '$O(ORDT(0)) W $C(7),!!,"There are no existing recurring meals with which to associate this type of",!,"order!" H 2 S ORQUIT=1 Q
 | 
|---|
| 10 |  N X S X=$S($G(OREVENT):$$LOC^OREVNTX(OREVENT),1:$G(ORL))  Q:X<1
 | 
|---|
| 11 |  D EN1^FHWOR8(X,.ORPARAM)
 | 
|---|
| 12 |  S:'$L($G(ORPARAM(3))) ORPARAM(3)="TCD" ;for QO editor
 | 
|---|
| 13 |  Q
 | 
|---|
| 14 |  ;
 | 
|---|
| 15 | CKFUTURE ; -- Ck for future diet orders
 | 
|---|
| 16 |  N DG,ORDT,ORSTRT,ORIFN,ORTX
 | 
|---|
| 17 |  S DG=$O(^ORD(100.98,"B","DO",0)),ORDT=$$NOW^XLFDT
 | 
|---|
| 18 |  F  S ORDT=$O(^OR(100,"AW",ORVP,DG,ORDT)) Q:ORDT'>0  S ORIFN=0 D
 | 
|---|
| 19 |  . F  S ORIFN=$O(^OR(100,"AW",ORVP,DG,ORDT,ORIFN)) Q:ORIFN'>0  I $P($G(^OR(100,+ORIFN,3)),U,3)=8 S ORSTRT(ORDT)=ORIFN ;incl only if still sched
 | 
|---|
| 20 |  Q:'$D(ORSTRT)  W !,"Future Diet Orders: ",! S ORDT=0
 | 
|---|
| 21 |  F  S ORDT=$O(ORSTRT(ORDT)) Q:ORDT'>0  D TEXT^ORQ12(.ORTX,+ORSTRT(ORDT)) W !,$$FMTE^XLFDT(ORDT,2)_"    "_$G(ORTX(1))
 | 
|---|
| 22 |  W !!,"A new order with no expiration date will CANCEL these diets."
 | 
|---|
| 23 |  Q:$$CONT  S ORQUIT=1
 | 
|---|
| 24 |  W !!,"Diet Order for this Patient is UNCHANGED -- No order entered!" H 2
 | 
|---|
| 25 |  Q
 | 
|---|
| 26 |  ;
 | 
|---|
| 27 | CONT() ; -- Ok to continue?
 | 
|---|
| 28 |  N X,Y,DIR
 | 
|---|
| 29 |  S DIR(0)="YA",DIR("A")="Do you wish to CONTINUE? ",DIR("B")="NO"
 | 
|---|
| 30 |  D ^DIR
 | 
|---|
| 31 |  Q +Y
 | 
|---|
| 32 |  ;
 | 
|---|
| 33 | EN2 ; -- Reformat ORPARAM() into ORTIME(<tray>,<meal>,1-3)=ext^ext
 | 
|---|
| 34 |  N X,M,T,I,CNT,OFFSET,TIMES,EARLY,LATE
 | 
|---|
| 35 |  S TIMES=$G(ORPARAM(1)),OFFSET=0 Q:TIMES=""
 | 
|---|
| 36 |  F I="EARLY","LATE" S @I=+$O(^ORD(101.43,"S.E/L T",I_" TRAY",0))
 | 
|---|
| 37 |  F M="B","N","E" F T=EARLY,LATE S CNT=0 D
 | 
|---|
| 38 |  . F I=1:1:3 S X=$P(TIMES,U,I+OFFSET) S:X CNT=CNT+1,ORTIME(T,M,I)=X_U_X,ORTIME(T,M,"B",X)=X,ORTIME(T,M,"C",X)=I
 | 
|---|
| 39 |  . S OFFSET=OFFSET+3 S:CNT ORTIME(T,M)=CNT_"^1"
 | 
|---|
| 40 |  Q
 | 
|---|
| 41 |  ;
 | 
|---|
| 42 | FMTIME(X) ; -- Returns FM format of time
 | 
|---|
| 43 |  N Y,%DT S %DT="TX" D ^%DT
 | 
|---|
| 44 |  Q "."_$P(Y,".",2)
 | 
|---|
| 45 |  ;
 | 
|---|
| 46 | EX ; -- exit action
 | 
|---|
| 47 |  K ORPARAM,ORTIME,ORNPO,ORTRAIL,ORCAT,ORDT
 | 
|---|
| 48 |  Q
 | 
|---|
| 49 |  ;
 | 
|---|
| 50 | DIET(DFN) ; -- Returns patient DFN's current diet order
 | 
|---|
| 51 |  N ADM,X1,FHORD,FHLD,FHOR,X,Y,FHDU,%,A1,D3
 | 
|---|
| 52 |  S ADM=+$G(^DPT(DFN,.105)),Y="" I $G(DFN),ADM D CUR^FHORD7
 | 
|---|
| 53 |  Q Y
 | 
|---|
| 54 |  ;
 | 
|---|
| 55 | VALID() ; -- Returns 1 or 0, if selected diet modification is valid
 | 
|---|
| 56 |  N Y,NUM,I,TOTAL,OI
 | 
|---|
| 57 |  S Y=1,TOTAL=+$G(ORDIALOG(PROMPT,"TOT"))
 | 
|---|
| 58 |  S OI=$P($G(^ORD(101.43,+ORDIALOG(PROMPT,ORI),0)),U)
 | 
|---|
| 59 |  I (OI="REGULAR")!(OI="NPO") D  Q Y
 | 
|---|
| 60 |  . I '$D(ORESET),TOTAL=0 S ORDIALOG(PROMPT,"MAX")=1,MAX=1 Q  ; add first
 | 
|---|
| 61 |  . I $G(ORESET),TOTAL'>1 S ORDIALOG(PROMPT,"MAX")=1,MAX=1 Q  ; edit first
 | 
|---|
| 62 |  . S Y=0 W $C(7),!,OI_" may not be ordered with other diets!"
 | 
|---|
| 63 |  S ORDIALOG(PROMPT,"MAX")=5,MAX=5
 | 
|---|
| 64 |  I $$DUP^ORCD(PROMPT,ORI) W $C(7),"This diet has already been selected!" Q 0
 | 
|---|
| 65 |  S NUM=$P($G(^ORD(101.43,+ORDIALOG(PROMPT,ORI),"FH")),U,2) ; precedence #
 | 
|---|
| 66 |  S I=0 F  S I=$O(ORDIALOG(PROMPT,I)) Q:I'>0  D  Q:Y'>0
 | 
|---|
| 67 |  . Q:I=ORI  Q:$P($G(^ORD(101.43,+ORDIALOG(PROMPT,I),"FH")),U,2)'=NUM  ;ok
 | 
|---|
| 68 |  . S Y=0 W $C(7),!,"This diet is not orderable with those already selected!",!
 | 
|---|
| 69 |  Q Y
 | 
|---|
| 70 |  ;
 | 
|---|
| 71 | CURRENT(DG) ; -- Returns order number of currently active DG order
 | 
|---|
| 72 |  N TYPE,START,ORIFN
 | 
|---|
| 73 |  S TYPE=$O(^ORD(100.98,"B",DG,0)),START=$$NOW^XLFDT
 | 
|---|
| 74 |  F  S START=$O(^OR(100,"AW",ORVP,TYPE,START),-1) Q:START'>0  S ORIFN=$O(^(START,0)) Q:$P($G(^OR(100,ORIFN,3)),U,3)=6  K ORIFN
 | 
|---|
| 75 |  Q $G(ORIFN)
 | 
|---|
| 76 |  ;
 | 
|---|
| 77 | FUTURE(FLD) ; -- Returns 1 or 0, if date from FLD is future
 | 
|---|
| 78 |  N X,Y,Z,%DT
 | 
|---|
| 79 |  S X=$$VAL^ORCD(FLD),%DT="TX" D ^%DT S Z=$S($P(Y,".")>DT:1,1:0)
 | 
|---|
| 80 |  Q Z
 | 
|---|
| 81 |  ;
 | 
|---|
| 82 | SCHEDOK(X) ; -- Validates days of the week
 | 
|---|
| 83 |  N Y,I S X=$$UP^XLFSTR(X),Y=1
 | 
|---|
| 84 |  F I=1:1:$L(X) I "^M^T^W^R^F^S^X^"'[(U_$E(X,I)_U) S Y=0 Q
 | 
|---|
| 85 |  Q Y
 | 
|---|
| 86 |  ;
 | 
|---|
| 87 | MEALS ; -- Sets meal times into ORDIALOG(PROMPT,"LIST")
 | 
|---|
| 88 |  K ORDIALOG(PROMPT,"LIST") Q:'$L($G(ORMEAL))  Q:'$G(ORTRAY)
 | 
|---|
| 89 |  M ORDIALOG(PROMPT,"LIST")=ORTIME(ORTRAY,ORMEAL)
 | 
|---|
| 90 |  Q
 | 
|---|
| 91 |  ;
 | 
|---|
| 92 | NOTIMES(MEAL,TIME) ; -- If no tray times defined, write msg and reask
 | 
|---|
| 93 |  N I,Y,PAST S Y=0 G:'$L($G(MEAL)) NTQ G:'$G(TIME) NTQ
 | 
|---|
| 94 |  I '$D(ORTIME(TIME,MEAL)) K DONE W $C(7),!,"There are no "_$P($G(^ORD(101.43,TIME,0)),U)_" times defined for the "_$S(MEAL="B":"breakfast ",MEAL="N":"noon ",MEAL="E":"evening ",1:"")_"meal at this location!",! S Y=1 G NTQ
 | 
|---|
| 95 |  G:$G(ORDATE)'=DT NTQ S PAST=1,NOW="."_$P($$NOW^XLFDT,".",2)
 | 
|---|
| 96 |  F I=1:1:3 S X=$G(ORTIME(TIME,MEAL,I)) I X,$$FMTIME($P(X,U))>NOW S PAST=0 Q
 | 
|---|
| 97 |  I PAST K DONE W $C(7),!,"All "_$P($G(^ORD(101.43,TIME,0)),U)_" times have passed for the "_$S(MEAL="B":"breakfast ",MEAL="N":"noon ",MEAL="E":"evening ",1:"")_"meal at this location!",! S Y=1
 | 
|---|
| 98 | NTQ Q Y
 | 
|---|
| 99 |  ;
 | 
|---|
| 100 | CKTIME ; -- Validate meal time
 | 
|---|
| 101 |  Q:$G(ORDATE)'=DT  N NOW,X S NOW="."_$P($$NOW^XLFDT,".",2)
 | 
|---|
| 102 |  S X=ORDIALOG(PROMPT,ORI),X=$$FMTIME(X)
 | 
|---|
| 103 |  I X'>NOW W $C(7),!,"This time has already passed!",! K DONE Q
 | 
|---|
| 104 |  Q
 | 
|---|
| 105 |  ;
 | 
|---|
| 106 | DELIVERY ; -- Set available delivery/service types by location
 | 
|---|
| 107 |  I $G(ORNPO) K ORDIALOG(PROMPT,INST) Q
 | 
|---|
| 108 |  Q:$D(ORDIALOG(PROMPT,"LIST"))
 | 
|---|
| 109 |  N X,Y,Z,I S X=$G(ORPARAM(3))
 | 
|---|
| 110 |  S Z="" F I=1:1:$L(X) S Y=$E(X,I) S Z=Z_Y_":"_$S(Y="T":"TRAY",Y="C":"CAFETERIA",Y="D":"DINING ROOM",Y="B":"BAGGED",1:"")_";"
 | 
|---|
| 111 |  S:$L(Z) $P(ORDIALOG(PROMPT,0),U,2)=Z
 | 
|---|
| 112 |  S ORDIALOG(PROMPT,"LIST")=$L(X)
 | 
|---|
| 113 |  Q
 | 
|---|
| 114 |  ;
 | 
|---|
| 115 | CANCEL(ORIFN) ; -- Return 1 or 0, if future trays should be cancelled
 | 
|---|
| 116 |  N DA,Y S DA=$O(^OR(100,+ORIFN,4.5,"ID","CANCEL",0)),Y=0
 | 
|---|
| 117 |  S:DA Y=+$G(^OR(100,+ORIFN,4.5,+DA,1))
 | 
|---|
| 118 |  Q Y
 | 
|---|
| 119 |  ;
 | 
|---|
| 120 | RESUME(ORDER) ; -- Returns 1 or 0, if tray service should be resumed
 | 
|---|
| 121 |  N I,X S I=$O(^OR(100,+ORDER,4.5,"ID","RESUME",0)),X=0
 | 
|---|
| 122 |  I I S X=+$G(^OR(100,+ORDER,4.5,+I,1))
 | 
|---|
| 123 |  Q X
 | 
|---|
| 124 |  ;
 | 
|---|
| 125 | LATETRAY ; -- Order a late tray with diet ORIFN? [from VALID^ORCSIGN]
 | 
|---|
| 126 |  Q:'$G(ORIFN)  Q:$E($$VALUE^ORX8(ORIFN,"ORDERABLE",1,"E"),1,3)="NPO"
 | 
|---|
| 127 |  N X,Y,%DT,ORSTRT,ORDATE,ORNP
 | 
|---|
| 128 |  S X=$O(^OR(100,ORIFN,4.5,"ID","START",0)),X=$G(^OR(100,ORIFN,4.5,+X,1))
 | 
|---|
| 129 |  Q:X=""  S %DT="TX" D ^%DT Q:Y'>0  Q:$P(Y,".")>DT  ;invalid or future
 | 
|---|
| 130 |  S ORDATE=$P(Y,"."),ORSTRT=+$E($P(Y,".",2)_"0000",1,4)
 | 
|---|
| 131 |  S ORNP=$P(^OR(100,ORIFN,0),U,4)
 | 
|---|
| 132 | LTRAY ; -- enter here w/ORDATE,ORSTRT,ORNP [reinstated diet after dc'ing NPO]
 | 
|---|
| 133 |  N ORPARAM,ORTIME,I,ORMEAL,ORTRAY
 | 
|---|
| 134 |  D EN^FHWOR8(+ORVP,.ORPARAM),EN2 Q:'$D(ORPARAM(2))
 | 
|---|
| 135 |  F I=1,3,5 I $P(ORPARAM(2),U,I)<ORSTRT,ORSTRT<$P(ORPARAM(2),U,I+1)  S ORMEAL=I Q
 | 
|---|
| 136 |  Q:'$G(ORMEAL)  S ORMEAL=$S(ORMEAL=1:"B",ORMEAL=3:"N",ORMEAL=5:"E",1:U)
 | 
|---|
| 137 |  Q:ORMEAL="^"  S ORTRAY=+$O(^ORD(101.43,"S.E/L T","LATE TRAY",0))
 | 
|---|
| 138 |  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
 | 
|---|
| 139 |  Q:'$G(OK)  Q:'$$ORDTRAY(ORMEAL)  ;Else, continue w/order for late tray
 | 
|---|
| 140 | LT1 N ORIFN,ORDIALOG,ORDG,ORTYPE,ORCHECK,ORQUIT,ORDUZ,ORLOG,SEQ,DA,FIRST
 | 
|---|
| 141 |  S ORDIALOG=$O(^ORD(101.41,"AB","FHW2",0)) Q:'ORDIALOG
 | 
|---|
| 142 |  S ORTYPE="D",FIRST=1,ORDUZ=DUZ,ORLOG=+$E($$NOW^XLFDT,1,12)
 | 
|---|
| 143 |  D GETDLG^ORCD(ORDIALOG) S ORDIALOG($$PTR^ORCD("OR GTX MEAL"),1)=ORMEAL
 | 
|---|
| 144 |  S ORDIALOG($$PTR^ORCD("OR GTX ORDERABLE ITEM"),1)=ORTRAY
 | 
|---|
| 145 |  S ORDIALOG($$PTR^ORCD("OR GTX START DATE"),1)=ORDATE,ORDIALOG($$PTR^ORCD("OR GTX STOP DATE"),1)=ORDATE
 | 
|---|
| 146 |  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
 | 
|---|
| 147 |  I $G(ORQUIT) W $C(7),!!,"No late tray ordered!",! H 2 Q
 | 
|---|
| 148 |  D EN^ORCSAVE Q:'$G(ORIFN)  S ORES(ORIFN_";1")=""
 | 
|---|
| 149 |  W !?10,"... order placed.",!
 | 
|---|
| 150 |  Q
 | 
|---|
| 151 |  ;
 | 
|---|
| 152 | ORDTRAY(M) ; -- Want to order tray for meal M?
 | 
|---|
| 153 |  N X,Y,DIR
 | 
|---|
| 154 |  S DIR(0)="YA",DIR("A",1)="You have missed the "_$S(M="B":"breakfast",M="N":"noon",M="E":"evening",1:"")_" cut-off.",DIR("A")="Do you wish to order a late tray? ",DIR("B")="YES"
 | 
|---|
| 155 |  D ^DIR
 | 
|---|
| 156 |  Q +Y
 | 
|---|
| 157 |  ;
 | 
|---|
| 158 | ASKSTOP() ; -- Ck OI's for parameter
 | 
|---|
| 159 |  N I,OI,Y S OI=+$$PTR^ORCD("OR GTX ORDERABLE ITEM"),Y=0
 | 
|---|
| 160 |  S I=0 F  S I=$O(ORDIALOG(OI,I)) Q:I'>0  I $P($G(^ORD(101.43,+ORDIALOG(OI,I),"FH")),U,3)="Y" S Y=1 Q
 | 
|---|
| 161 |  Q Y
 | 
|---|