- ORCDFH ;SLC/MKB-Utility functions for FH dialogs ; 08 May 2002 2:12 PM
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**7,73,92,141,215**;Dec 17, 1997
- ;
- EN ; -- entry action
- S ORCAT=$S($G(ORTYPE)="Z":"",$$INPT^ORCD:"I",1:"O")
- I ORCAT="O" D Q:$G(ORQUIT)
- . 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
- . 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
- . 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
- N X S X=$S($G(OREVENT):$$LOC^OREVNTX(OREVENT),1:$G(ORL)) Q:X<1
- D EN1^FHWOR8(X,.ORPARAM)
- S:'$L($G(ORPARAM(3))) ORPARAM(3)="TCD" ;for QO editor
- Q
- ;
- CKFUTURE ; -- Ck for future diet orders
- N DG,ORDT,ORSTRT,ORIFN,ORTX
- S DG=$O(^ORD(100.98,"B","DO",0)),ORDT=$$NOW^XLFDT
- F S ORDT=$O(^OR(100,"AW",ORVP,DG,ORDT)) Q:ORDT'>0 S ORIFN=0 D
- . 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
- Q:'$D(ORSTRT) W !,"Future Diet Orders: ",! S ORDT=0
- F S ORDT=$O(ORSTRT(ORDT)) Q:ORDT'>0 D TEXT^ORQ12(.ORTX,+ORSTRT(ORDT)) W !,$$FMTE^XLFDT(ORDT,2)_" "_$G(ORTX(1))
- W !!,"A new order with no expiration date will CANCEL these diets."
- Q:$$CONT S ORQUIT=1
- W !!,"Diet Order for this Patient is UNCHANGED -- No order entered!" H 2
- Q
- ;
- CONT() ; -- Ok to continue?
- N X,Y,DIR
- S DIR(0)="YA",DIR("A")="Do you wish to CONTINUE? ",DIR("B")="NO"
- D ^DIR
- Q +Y
- ;
- EN2 ; -- Reformat ORPARAM() into ORTIME(<tray>,<meal>,1-3)=ext^ext
- N X,M,T,I,CNT,OFFSET,TIMES,EARLY,LATE
- S TIMES=$G(ORPARAM(1)),OFFSET=0 Q:TIMES=""
- F I="EARLY","LATE" S @I=+$O(^ORD(101.43,"S.E/L T",I_" TRAY",0))
- F M="B","N","E" F T=EARLY,LATE S CNT=0 D
- . 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
- . S OFFSET=OFFSET+3 S:CNT ORTIME(T,M)=CNT_"^1"
- Q
- ;
- FMTIME(X) ; -- Returns FM format of time
- N Y,%DT S %DT="TX" D ^%DT
- Q "."_$P(Y,".",2)
- ;
- EX ; -- exit action
- K ORPARAM,ORTIME,ORNPO,ORTRAIL,ORCAT,ORDT
- Q
- ;
- DIET(DFN) ; -- Returns patient DFN's current diet order
- N ADM,X1,FHORD,FHLD,FHOR,X,Y,FHDU,%,A1,D3
- S ADM=+$G(^DPT(DFN,.105)),Y="" I $G(DFN),ADM D CUR^FHORD7
- Q Y
- ;
- VALID() ; -- Returns 1 or 0, if selected diet modification is valid
- N Y,NUM,I,TOTAL,OI
- S Y=1,TOTAL=+$G(ORDIALOG(PROMPT,"TOT"))
- S OI=$P($G(^ORD(101.43,+ORDIALOG(PROMPT,ORI),0)),U)
- I (OI="REGULAR")!(OI="NPO") D Q Y
- . I '$D(ORESET),TOTAL=0 S ORDIALOG(PROMPT,"MAX")=1,MAX=1 Q ; add first
- . I $G(ORESET),TOTAL'>1 S ORDIALOG(PROMPT,"MAX")=1,MAX=1 Q ; edit first
- . S Y=0 W $C(7),!,OI_" may not be ordered with other diets!"
- S ORDIALOG(PROMPT,"MAX")=5,MAX=5
- I $$DUP^ORCD(PROMPT,ORI) W $C(7),"This diet has already been selected!" Q 0
- S NUM=$P($G(^ORD(101.43,+ORDIALOG(PROMPT,ORI),"FH")),U,2) ; precedence #
- S I=0 F S I=$O(ORDIALOG(PROMPT,I)) Q:I'>0 D Q:Y'>0
- . Q:I=ORI Q:$P($G(^ORD(101.43,+ORDIALOG(PROMPT,I),"FH")),U,2)'=NUM ;ok
- . S Y=0 W $C(7),!,"This diet is not orderable with those already selected!",!
- Q Y
- ;
- CURRENT(DG) ; -- Returns order number of currently active DG order
- N TYPE,START,ORIFN
- S TYPE=$O(^ORD(100.98,"B",DG,0)),START=$$NOW^XLFDT
- 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
- Q $G(ORIFN)
- ;
- FUTURE(FLD) ; -- Returns 1 or 0, if date from FLD is future
- N X,Y,Z,%DT
- S X=$$VAL^ORCD(FLD),%DT="TX" D ^%DT S Z=$S($P(Y,".")>DT:1,1:0)
- Q Z
- ;
- SCHEDOK(X) ; -- Validates days of the week
- N Y,I S X=$$UP^XLFSTR(X),Y=1
- F I=1:1:$L(X) I "^M^T^W^R^F^S^X^"'[(U_$E(X,I)_U) S Y=0 Q
- Q Y
- ;
- MEALS ; -- Sets meal times into ORDIALOG(PROMPT,"LIST")
- K ORDIALOG(PROMPT,"LIST") Q:'$L($G(ORMEAL)) Q:'$G(ORTRAY)
- M ORDIALOG(PROMPT,"LIST")=ORTIME(ORTRAY,ORMEAL)
- Q
- ;
- NOTIMES(MEAL,TIME) ; -- If no tray times defined, write msg and reask
- N I,Y,PAST S Y=0 G:'$L($G(MEAL)) NTQ G:'$G(TIME) NTQ
- 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
- G:$G(ORDATE)'=DT NTQ S PAST=1,NOW="."_$P($$NOW^XLFDT,".",2)
- F I=1:1:3 S X=$G(ORTIME(TIME,MEAL,I)) I X,$$FMTIME($P(X,U))>NOW S PAST=0 Q
- 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
- NTQ Q Y
- ;
- CKTIME ; -- Validate meal time
- Q:$G(ORDATE)'=DT N NOW,X S NOW="."_$P($$NOW^XLFDT,".",2)
- S X=ORDIALOG(PROMPT,ORI),X=$$FMTIME(X)
- I X'>NOW W $C(7),!,"This time has already passed!",! K DONE Q
- Q
- ;
- DELIVERY ; -- Set available delivery/service types by location
- I $G(ORNPO) K ORDIALOG(PROMPT,INST) Q
- Q:$D(ORDIALOG(PROMPT,"LIST"))
- N X,Y,Z,I S X=$G(ORPARAM(3))
- 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:"")_";"
- S:$L(Z) $P(ORDIALOG(PROMPT,0),U,2)=Z
- S ORDIALOG(PROMPT,"LIST")=$L(X)
- Q
- ;
- CANCEL(ORIFN) ; -- Return 1 or 0, if future trays should be cancelled
- N DA,Y S DA=$O(^OR(100,+ORIFN,4.5,"ID","CANCEL",0)),Y=0
- S:DA Y=+$G(^OR(100,+ORIFN,4.5,+DA,1))
- Q Y
- ;
- RESUME(ORDER) ; -- Returns 1 or 0, if tray service should be resumed
- N I,X S I=$O(^OR(100,+ORDER,4.5,"ID","RESUME",0)),X=0
- I I S X=+$G(^OR(100,+ORDER,4.5,+I,1))
- Q X
- ;
- LATETRAY ; -- Order a late tray with diet ORIFN? [from VALID^ORCSIGN]
- Q:'$G(ORIFN) Q:$E($$VALUE^ORX8(ORIFN,"ORDERABLE",1,"E"),1,3)="NPO"
- N X,Y,%DT,ORSTRT,ORDATE,ORNP
- S X=$O(^OR(100,ORIFN,4.5,"ID","START",0)),X=$G(^OR(100,ORIFN,4.5,+X,1))
- Q:X="" S %DT="TX" D ^%DT Q:Y'>0 Q:$P(Y,".")>DT ;invalid or future
- S ORDATE=$P(Y,"."),ORSTRT=+$E($P(Y,".",2)_"0000",1,4)
- S ORNP=$P(^OR(100,ORIFN,0),U,4)
- LTRAY ; -- enter here w/ORDATE,ORSTRT,ORNP [reinstated diet after dc'ing NPO]
- N ORPARAM,ORTIME,I,ORMEAL,ORTRAY
- D EN^FHWOR8(+ORVP,.ORPARAM),EN2 Q:'$D(ORPARAM(2))
- F I=1,3,5 I $P(ORPARAM(2),U,I)<ORSTRT,ORSTRT<$P(ORPARAM(2),U,I+1) S ORMEAL=I Q
- Q:'$G(ORMEAL) S ORMEAL=$S(ORMEAL=1:"B",ORMEAL=3:"N",ORMEAL=5:"E",1:U)
- Q:ORMEAL="^" S ORTRAY=+$O(^ORD(101.43,"S.E/L T","LATE TRAY",0))
- 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
- Q:'$G(OK) Q:'$$ORDTRAY(ORMEAL) ;Else, continue w/order for late tray
- LT1 N ORIFN,ORDIALOG,ORDG,ORTYPE,ORCHECK,ORQUIT,ORDUZ,ORLOG,SEQ,DA,FIRST
- S ORDIALOG=$O(^ORD(101.41,"AB","FHW2",0)) Q:'ORDIALOG
- S ORTYPE="D",FIRST=1,ORDUZ=DUZ,ORLOG=+$E($$NOW^XLFDT,1,12)
- D GETDLG^ORCD(ORDIALOG) S ORDIALOG($$PTR^ORCD("OR GTX MEAL"),1)=ORMEAL
- S ORDIALOG($$PTR^ORCD("OR GTX ORDERABLE ITEM"),1)=ORTRAY
- S ORDIALOG($$PTR^ORCD("OR GTX START DATE"),1)=ORDATE,ORDIALOG($$PTR^ORCD("OR GTX STOP DATE"),1)=ORDATE
- 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
- I $G(ORQUIT) W $C(7),!!,"No late tray ordered!",! H 2 Q
- D EN^ORCSAVE Q:'$G(ORIFN) S ORES(ORIFN_";1")=""
- W !?10,"... order placed.",!
- Q
- ;
- ORDTRAY(M) ; -- Want to order tray for meal M?
- N X,Y,DIR
- 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"
- D ^DIR
- Q +Y
- ;
- ASKSTOP() ; -- Ck OI's for parameter
- N I,OI,Y S OI=+$$PTR^ORCD("OR GTX ORDERABLE ITEM"),Y=0
- 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
- Q Y
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORCDFH 7781 printed Jan 18, 2025@03:29:06 Page 2
- ORCDFH ;SLC/MKB-Utility functions for FH dialogs ; 08 May 2002 2:12 PM
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**7,73,92,141,215**;Dec 17, 1997
- +2 ;
- EN ; -- entry action
- +1 SET ORCAT=$SELECT($GET(ORTYPE)="Z":"",$$INPT^ORCD:"I",1:"O")
- +2 IF ORCAT="O"
- Begin DoDot:1
- +3 IF $PIECE($GET(^ORD(100.98,+$GET(ORDG),0)),U,3)="DO"
- WRITE $CHAR(7),!!,"This patient is not an inpatient!"
- HANG 2
- SET ORQUIT=1
- QUIT
- +4 IF '$LENGTH($TEXT(EN2^FHWOR8))
- WRITE $CHAR(7),!!,"Dietetics v5.5 must be installed to place outpatient diet orders!"
- HANG 2
- SET ORQUIT=1
- QUIT
- +5 DO EN2^FHWOR8(+$GET(ORVP),"",.ORDT)
- IF '$ORDER(ORDT(0))
- WRITE $CHAR(7),!!,"There are no existing recurring meals with which to associate this type of",!,"order!"
- HANG 2
- SET ORQUIT=1
- QUIT
- End DoDot:1
- if $GET(ORQUIT)
- QUIT
- +6 NEW X
- SET X=$SELECT($GET(OREVENT):$$LOC^OREVNTX(OREVENT),1:$GET(ORL))
- if X<1
- QUIT
- +7 DO EN1^FHWOR8(X,.ORPARAM)
- +8 ;for QO editor
- if '$LENGTH($GET(ORPARAM(3)))
- SET ORPARAM(3)="TCD"
- +9 QUIT
- +10 ;
- CKFUTURE ; -- Ck for future diet orders
- +1 NEW DG,ORDT,ORSTRT,ORIFN,ORTX
- +2 SET DG=$ORDER(^ORD(100.98,"B","DO",0))
- SET ORDT=$$NOW^XLFDT
- +3 FOR
- SET ORDT=$ORDER(^OR(100,"AW",ORVP,DG,ORDT))
- if ORDT'>0
- QUIT
- SET ORIFN=0
- Begin DoDot:1
- +4 ;incl only if still sched
- FOR
- SET ORIFN=$ORDER(^OR(100,"AW",ORVP,DG,ORDT,ORIFN))
- if ORIFN'>0
- QUIT
- IF $PIECE($GET(^OR(100,+ORIFN,3)),U,3)=8
- SET ORSTRT(ORDT)=ORIFN
- End DoDot:1
- +5 if '$DATA(ORSTRT)
- QUIT
- WRITE !,"Future Diet Orders: ",!
- SET ORDT=0
- +6 FOR
- SET ORDT=$ORDER(ORSTRT(ORDT))
- if ORDT'>0
- QUIT
- DO TEXT^ORQ12(.ORTX,+ORSTRT(ORDT))
- WRITE !,$$FMTE^XLFDT(ORDT,2)_" "_$GET(ORTX(1))
- +7 WRITE !!,"A new order with no expiration date will CANCEL these diets."
- +8 if $$CONT
- QUIT
- SET ORQUIT=1
- +9 WRITE !!,"Diet Order for this Patient is UNCHANGED -- No order entered!"
- HANG 2
- +10 QUIT
- +11 ;
- CONT() ; -- Ok to continue?
- +1 NEW X,Y,DIR
- +2 SET DIR(0)="YA"
- SET DIR("A")="Do you wish to CONTINUE? "
- SET DIR("B")="NO"
- +3 DO ^DIR
- +4 QUIT +Y
- +5 ;
- EN2 ; -- Reformat ORPARAM() into ORTIME(<tray>,<meal>,1-3)=ext^ext
- +1 NEW X,M,T,I,CNT,OFFSET,TIMES,EARLY,LATE
- +2 SET TIMES=$GET(ORPARAM(1))
- SET OFFSET=0
- if TIMES=""
- QUIT
- +3 FOR I="EARLY","LATE"
- SET @I=+$ORDER(^ORD(101.43,"S.E/L T",I_" TRAY",0))
- +4 FOR M="B","N","E"
- FOR T=EARLY,LATE
- SET CNT=0
- Begin DoDot:1
- +5 FOR I=1:1:3
- SET X=$PIECE(TIMES,U,I+OFFSET)
- if X
- SET CNT=CNT+1
- SET ORTIME(T,M,I)=X_U_X
- SET ORTIME(T,M,"B",X)=X
- SET ORTIME(T,M,"C",X)=I
- +6 SET OFFSET=OFFSET+3
- if CNT
- SET ORTIME(T,M)=CNT_"^1"
- End DoDot:1
- +7 QUIT
- +8 ;
- FMTIME(X) ; -- Returns FM format of time
- +1 NEW Y,%DT
- SET %DT="TX"
- DO ^%DT
- +2 QUIT "."_$PIECE(Y,".",2)
- +3 ;
- EX ; -- exit action
- +1 KILL ORPARAM,ORTIME,ORNPO,ORTRAIL,ORCAT,ORDT
- +2 QUIT
- +3 ;
- DIET(DFN) ; -- Returns patient DFN's current diet order
- +1 NEW ADM,X1,FHORD,FHLD,FHOR,X,Y,FHDU,%,A1,D3
- +2 SET ADM=+$GET(^DPT(DFN,.105))
- SET Y=""
- IF $GET(DFN)
- IF ADM
- DO CUR^FHORD7
- +3 QUIT Y
- +4 ;
- VALID() ; -- Returns 1 or 0, if selected diet modification is valid
- +1 NEW Y,NUM,I,TOTAL,OI
- +2 SET Y=1
- SET TOTAL=+$GET(ORDIALOG(PROMPT,"TOT"))
- +3 SET OI=$PIECE($GET(^ORD(101.43,+ORDIALOG(PROMPT,ORI),0)),U)
- +4 IF (OI="REGULAR")!(OI="NPO")
- Begin DoDot:1
- +5 ; add first
- IF '$DATA(ORESET)
- IF TOTAL=0
- SET ORDIALOG(PROMPT,"MAX")=1
- SET MAX=1
- QUIT
- +6 ; edit first
- IF $GET(ORESET)
- IF TOTAL'>1
- SET ORDIALOG(PROMPT,"MAX")=1
- SET MAX=1
- QUIT
- +7 SET Y=0
- WRITE $CHAR(7),!,OI_" may not be ordered with other diets!"
- End DoDot:1
- QUIT Y
- +8 SET ORDIALOG(PROMPT,"MAX")=5
- SET MAX=5
- +9 IF $$DUP^ORCD(PROMPT,ORI)
- WRITE $CHAR(7),"This diet has already been selected!"
- QUIT 0
- +10 ; precedence #
- SET NUM=$PIECE($GET(^ORD(101.43,+ORDIALOG(PROMPT,ORI),"FH")),U,2)
- +11 SET I=0
- FOR
- SET I=$ORDER(ORDIALOG(PROMPT,I))
- if I'>0
- QUIT
- Begin DoDot:1
- +12 ;ok
- if I=ORI
- QUIT
- if $PIECE($GET(^ORD(101.43,+ORDIALOG(PROMPT,I),"FH")),U,2)'=NUM
- QUIT
- +13 SET Y=0
- WRITE $CHAR(7),!,"This diet is not orderable with those already selected!",!
- End DoDot:1
- if Y'>0
- QUIT
- +14 QUIT Y
- +15 ;
- CURRENT(DG) ; -- Returns order number of currently active DG order
- +1 NEW TYPE,START,ORIFN
- +2 SET TYPE=$ORDER(^ORD(100.98,"B",DG,0))
- SET START=$$NOW^XLFDT
- +3 FOR
- SET START=$ORDER(^OR(100,"AW",ORVP,TYPE,START),-1)
- if START'>0
- QUIT
- SET ORIFN=$ORDER(^(START,0))
- if $PIECE($GET(^OR(100,ORIFN,3)),U,3)=6
- QUIT
- KILL ORIFN
- +4 QUIT $GET(ORIFN)
- +5 ;
- FUTURE(FLD) ; -- Returns 1 or 0, if date from FLD is future
- +1 NEW X,Y,Z,%DT
- +2 SET X=$$VAL^ORCD(FLD)
- SET %DT="TX"
- DO ^%DT
- SET Z=$SELECT($PIECE(Y,".")>DT:1,1:0)
- +3 QUIT Z
- +4 ;
- SCHEDOK(X) ; -- Validates days of the week
- +1 NEW Y,I
- SET X=$$UP^XLFSTR(X)
- SET Y=1
- +2 FOR I=1:1:$LENGTH(X)
- IF "^M^T^W^R^F^S^X^"'[(U_$EXTRACT(X,I)_U)
- SET Y=0
- QUIT
- +3 QUIT Y
- +4 ;
- MEALS ; -- Sets meal times into ORDIALOG(PROMPT,"LIST")
- +1 KILL ORDIALOG(PROMPT,"LIST")
- if '$LENGTH($GET(ORMEAL))
- QUIT
- if '$GET(ORTRAY)
- QUIT
- +2 MERGE ORDIALOG(PROMPT,"LIST")=ORTIME(ORTRAY,ORMEAL)
- +3 QUIT
- +4 ;
- NOTIMES(MEAL,TIME) ; -- If no tray times defined, write msg and reask
- +1 NEW I,Y,PAST
- SET Y=0
- if '$LENGTH($GET(MEAL))
- GOTO NTQ
- if '$GET(TIME)
- GOTO NTQ
- +2 IF '$DATA(ORTIME(TIME,MEAL))
- KILL DONE
- WRITE $CHAR(7),!,"There are no "_$PIECE($GET(^ORD(101.43,TIME,0)),U)_" times defined for the "_$SELECT(MEAL="B":"breakfast ",MEAL="N":"noon ",MEAL="E":"evening ",1:"")_"meal at this location!",!
- SET Y=1
- GOTO NTQ
- +3 if $GET(ORDATE)'=DT
- GOTO NTQ
- SET PAST=1
- SET NOW="."_$PIECE($$NOW^XLFDT,".",2)
- +4 FOR I=1:1:3
- SET X=$GET(ORTIME(TIME,MEAL,I))
- IF X
- IF $$FMTIME($PIECE(X,U))>NOW
- SET PAST=0
- QUIT
- +5 IF PAST
- KILL DONE
- WRITE $CHAR(7),!,"All "_$PIECE($GET(^ORD(101.43,TIME,0)),U)_" times have passed for the "_$SELECT(MEAL="B":"breakfast ",MEAL="N":"noon ",MEAL="E":"evening ",1:"")_"meal at this location!",!
- SET Y=1
- NTQ QUIT Y
- +1 ;
- CKTIME ; -- Validate meal time
- +1 if $GET(ORDATE)'=DT
- QUIT
- NEW NOW,X
- SET NOW="."_$PIECE($$NOW^XLFDT,".",2)
- +2 SET X=ORDIALOG(PROMPT,ORI)
- SET X=$$FMTIME(X)
- +3 IF X'>NOW
- WRITE $CHAR(7),!,"This time has already passed!",!
- KILL DONE
- QUIT
- +4 QUIT
- +5 ;
- DELIVERY ; -- Set available delivery/service types by location
- +1 IF $GET(ORNPO)
- KILL ORDIALOG(PROMPT,INST)
- QUIT
- +2 if $DATA(ORDIALOG(PROMPT,"LIST"))
- QUIT
- +3 NEW X,Y,Z,I
- SET X=$GET(ORPARAM(3))
- +4 SET Z=""
- FOR I=1:1:$LENGTH(X)
- SET Y=$EXTRACT(X,I)
- SET Z=Z_Y_":"_$SELECT(Y="T":"TRAY",Y="C":"CAFETERIA",Y="D":"DINING ROOM",Y="B":"BAGGED",1:"")_";"
- +5 if $LENGTH(Z)
- SET $PIECE(ORDIALOG(PROMPT,0),U,2)=Z
- +6 SET ORDIALOG(PROMPT,"LIST")=$LENGTH(X)
- +7 QUIT
- +8 ;
- CANCEL(ORIFN) ; -- Return 1 or 0, if future trays should be cancelled
- +1 NEW DA,Y
- SET DA=$ORDER(^OR(100,+ORIFN,4.5,"ID","CANCEL",0))
- SET Y=0
- +2 if DA
- SET Y=+$GET(^OR(100,+ORIFN,4.5,+DA,1))
- +3 QUIT Y
- +4 ;
- RESUME(ORDER) ; -- Returns 1 or 0, if tray service should be resumed
- +1 NEW I,X
- SET I=$ORDER(^OR(100,+ORDER,4.5,"ID","RESUME",0))
- SET X=0
- +2 IF I
- SET X=+$GET(^OR(100,+ORDER,4.5,+I,1))
- +3 QUIT X
- +4 ;
- LATETRAY ; -- Order a late tray with diet ORIFN? [from VALID^ORCSIGN]
- +1 if '$GET(ORIFN)
- QUIT
- if $EXTRACT($$VALUE^ORX8(ORIFN,"ORDERABLE",1,"E"),1,3)="NPO"
- QUIT
- +2 NEW X,Y,%DT,ORSTRT,ORDATE,ORNP
- +3 SET X=$ORDER(^OR(100,ORIFN,4.5,"ID","START",0))
- SET X=$GET(^OR(100,ORIFN,4.5,+X,1))
- +4 ;invalid or future
- if X=""
- QUIT
- SET %DT="TX"
- DO ^%DT
- if Y'>0
- QUIT
- if $PIECE(Y,".")>DT
- QUIT
- +5 SET ORDATE=$PIECE(Y,".")
- SET ORSTRT=+$EXTRACT($PIECE(Y,".",2)_"0000",1,4)
- +6 SET ORNP=$PIECE(^OR(100,ORIFN,0),U,4)
- LTRAY ; -- enter here w/ORDATE,ORSTRT,ORNP [reinstated diet after dc'ing NPO]
- +1 NEW ORPARAM,ORTIME,I,ORMEAL,ORTRAY
- +2 DO EN^FHWOR8(+ORVP,.ORPARAM)
- DO EN2
- if '$DATA(ORPARAM(2))
- QUIT
- +3 FOR I=1,3,5
- IF $PIECE(ORPARAM(2),U,I)<ORSTRT
- IF ORSTRT<$PIECE(ORPARAM(2),U,I+1)
- SET ORMEAL=I
- QUIT
- +4 if '$GET(ORMEAL)
- QUIT
- SET ORMEAL=$SELECT(ORMEAL=1:"B",ORMEAL=3:"N",ORMEAL=5:"E",1:U)
- +5 if ORMEAL="^"
- QUIT
- SET ORTRAY=+$ORDER(^ORD(101.43,"S.E/L T","LATE TRAY",0))
- +6 FOR I=1:1:3
- SET Z=$GET(ORTIME(ORTRAY,ORMEAL,I))
- IF Z
- SET Z=$$FMTIME($PIECE(Z,U))
- SET Z=+$EXTRACT($PIECE(Z,".",2)_"0000",1,4)
- IF Z>ORSTRT
- SET OK=1
- QUIT
- +7 ;Else, continue w/order for late tray
- if '$GET(OK)
- QUIT
- if '$$ORDTRAY(ORMEAL)
- QUIT
- LT1 NEW ORIFN,ORDIALOG,ORDG,ORTYPE,ORCHECK,ORQUIT,ORDUZ,ORLOG,SEQ,DA,FIRST
- +1 SET ORDIALOG=$ORDER(^ORD(101.41,"AB","FHW2",0))
- if 'ORDIALOG
- QUIT
- +2 SET ORTYPE="D"
- SET FIRST=1
- SET ORDUZ=DUZ
- SET ORLOG=+$EXTRACT($$NOW^XLFDT,1,12)
- +3 DO GETDLG^ORCD(ORDIALOG)
- SET ORDIALOG($$PTR^ORCD("OR GTX MEAL"),1)=ORMEAL
- +4 SET ORDIALOG($$PTR^ORCD("OR GTX ORDERABLE ITEM"),1)=ORTRAY
- +5 SET ORDIALOG($$PTR^ORCD("OR GTX START DATE"),1)=ORDATE
- SET ORDIALOG($$PTR^ORCD("OR GTX STOP DATE"),1)=ORDATE
- +6 ; prompt for meal time, bagged meal
- FOR SEQ=6,7
- SET DA=$ORDER(^ORD(101.41,+ORDIALOG,10,"B",SEQ,0))
- if 'DA
- QUIT
- DO EN^ORCDLG1(DA)
- if $GET(ORQUIT)
- QUIT
- +7 IF $GET(ORQUIT)
- WRITE $CHAR(7),!!,"No late tray ordered!",!
- HANG 2
- QUIT
- +8 DO EN^ORCSAVE
- if '$GET(ORIFN)
- QUIT
- SET ORES(ORIFN_";1")=""
- +9 WRITE !?10,"... order placed.",!
- +10 QUIT
- +11 ;
- ORDTRAY(M) ; -- Want to order tray for meal M?
- +1 NEW X,Y,DIR
- +2 SET DIR(0)="YA"
- SET DIR("A",1)="You have missed the "_$SELECT(M="B":"breakfast",M="N":"noon",M="E":"evening",1:"")_" cut-off."
- SET DIR("A")="Do you wish to order a late tray? "
- SET DIR("B")="YES"
- +3 DO ^DIR
- +4 QUIT +Y
- +5 ;
- ASKSTOP() ; -- Ck OI's for parameter
- +1 NEW I,OI,Y
- SET OI=+$$PTR^ORCD("OR GTX ORDERABLE ITEM")
- SET Y=0
- +2 SET I=0
- FOR
- SET I=$ORDER(ORDIALOG(OI,I))
- if I'>0
- QUIT
- IF $PIECE($GET(^ORD(101.43,+ORDIALOG(OI,I),"FH")),U,3)="Y"
- SET Y=1
- QUIT
- +3 QUIT Y