ORMFH ;SLC/MKB - Process Dietetics ORM msgs ;5/5/05 13:18
;;3.0;ORDER ENTRY/RESULTS REPORTING;**3,73,92,215,243**;Dec 17, 1997;Build 242
;
EN ; -- entry point for FH messages
I '$L($T(@ORDCNTRL)) Q ;S ORERR="Invalid order control code" Q
I ORDCNTRL'="SN",ORDCNTRL'="ZP",'ORIFN!('$D(^OR(100,+ORIFN,0))) S ORERR="Invalid OE/RR order number" Q
S ORLOG=+$E($$NOW^XLFDT,1,12) S:'$G(ORDUZ) ORDUZ=DUZ S:'$G(ORNP) ORNP=ORDUZ
S:$G(DGPMT) ORNATR="A",OREASON=$S(DGPMT=1:"Admission",DGPMT=3:"Discharge",1:"Transfer"),ORDUZ=""
D @ORDCNTRL
Q
;
ZP ; -- Purged
Q:'ORIFN Q:'$D(^OR(100,+ORIFN,0))
K ^OR(100,+ORIFN,4) I "^6^8^"[(U_$P($G(^(3)),U,3)_U) D STATUS^ORCSAVE2(+ORIFN,14) ; Remove pkg reference, sts=lapsed if still active
Q
;
ZR ; -- Purged as requested [ack]
D DELETE^ORCSAVE2(+ORIFN)
Q
;
ZU ; -- Unable to purge [ack]
S $P(^OR(100,+ORIFN,3),U)=$$NOW^XLFDT ; update Last Activity
Q
;
OK ; -- Order accepted, FH order # assigned [ack]
N ORSTS S ^OR(100,+ORIFN,4)=PKGIFN ; FH identifier
I "DN"'[$E(PKGIFN) S ORSTS=6 ;not Diet or NPO
E S ORSTS=$S($P($G(^OR(100,+ORIFN,0)),U,8)>ORLOG:8,1:6)
D STATUS^ORCSAVE2(+ORIFN,ORSTS)
Q
;
XX ; -- Edited backdoor order (OP recurring meals only)
D XX^ORMFH1 Q
;
SN ; -- New backdoor order: return NA msg w/ORIFN
N ODS,ODT,OBR,ORDIALOG,X,I,OI,SEG,ORNEW,ORPARAM,ORTIME,ORSTS,ORDG,ORP,ORTRAIL
;I '$D(^VA(200,+ORNP,0)) S ORERR="Missing or invalid ordering provider"Q
; Don't require provider until Nature of Order is added
I '$G(DGPMT),'$D(^VA(200,+ORDUZ,0)) S ORERR="Missing or invalid entering person" Q
I 'ORSTRT S ORERR="Missing effective date/time" Q
;I '$G(ORL) S ORERR="Missing or invalid patient location" Q
D EN1^FHWOR8(ORL,.ORPARAM)
S ODS=$O(@ORMSG@(+ORC)) I 'ODS S ORERR="Incomplete message" Q
S ODS=ODS_U_@ORMSG@(ODS),ORSTS=6 I '$L(ORNATR),ORCAT="I" S ORNATR="S"
I $E($P(ODS,U,2),1,3)="OBR" S OBR=ODS D IP G SN1
I $E($P(ODS,U,2),1,3)="ODT" S ODT=ODS D TRAY G SN1
I $E($P(ODS,U,2),1,3)'="ODS" S ORERR="Missing or invalid ODS segment" Q
I $P(ODS,"|",2)="ZE" D TF G SN1
I $P(ODS,"|",4)?1"^^^FH-6".E D ADDL G SN1
I ORCAT'="I" D OPM^ORMFH1 G SN1
I $P(ODS,"|",4)?1"^^^FH-5".E D NPO G SN1
DIET ; Diet order
S ORDIALOG=$O(^ORD(101.41,"AB","FHW1",0)),ORTRAIL="Diet"
D GETDLG1^ORCD(ORDIALOG) S:ORSTRT>ORLOG ORSTS=8
S ORDIALOG($$PTR("START DATE/TIME"),1)=ORSTRT
S:ORSTOP ORDIALOG($$PTR("STOP DATE/TIME"),1)=ORSTOP
S X=$P(ODS,"|",2),ORDIALOG($$PTR("DELIVERY"),1)=$S($L(X)=1:X,1:$E(X,2))
; Comments ??
S X=$$ORDITEM^ORM($P(ODS,"|",4))
I 'X S ORERR="Missing or invalid diet modification" Q
S I=1,OI=$$PTR("ORDERABLE ITEM"),ORDIALOG(OI,I)=X
I $O(@ORMSG@(+ODS)) F S ODS=$O(@ORMSG@(+ODS)) Q:ODS'>0 S SEG=$E(@ORMSG@(+ODS),1,3) Q:SEG="ORC" Q:SEG="MSH" I SEG="ODS" D Q:$D(ORERR)
. S X=$$ORDITEM^ORM($P(@ORMSG@(+ODS),"|",4))
. I 'X S ORERR="Missing or invalid diet modification" Q
. S I=I+1,ORDIALOG(OI,I)=X
SN1 ; continue ... save order, post message
Q:$D(ORERR)
D EN^ORCSAVE I '$G(ORIFN) S ORERR="Cannot create new order" Q
D RELEASE^ORCSAVE2(ORIFN,1,ORLOG,ORDUZ,ORNATR),SIGSTS^ORCSAVE2(ORIFN,1)
D:'$P($G(^OR(100,ORIFN,0)),U,8) DATES^ORCSAVE2(ORIFN,ORSTRT,ORSTOP)
D STATUS^ORCSAVE2(ORIFN,ORSTS)
I $G(ORL) S ORP(1)=ORIFN_";1^1" D PRINTS^ORWD1(.ORP,+ORL) ; chart copy
S ^OR(100,ORIFN,4)=PKGIFN
Q
;
TRAY ; Early/Late tray
I 'ORSTOP S ORERR="Missing stop date" Q
S ORDIALOG=$O(^ORD(101.41,"AB","FHW2",0)) D GETDLG1^ORCD(ORDIALOG),EN2^ORCDFH
S ORDIALOG($$PTR("START DATE"),1)=ORSTRT
S ORDIALOG($$PTR("STOP DATE"),1)=ORSTOP
N DAYS,SCH S DAYS="",SCH=$P(ORQT,U,2)
I $L(SCH),SCH'="ONCE" F I=1:1:$L(SCH,"~") S X=+$P($P(SCH,"~",I),"J",2),DAYS=DAYS_$E("MTWRFSX",X)
S:$L(DAYS) ORDIALOG($$PTR("SCHEDULE"),1)=DAYS
S OI=+$O(^ORD(101.43,"S.E/L T",$P(ODT,"|",2)_" TRAY",0)),ORDIALOG($$PTR("ORDERABLE ITEM"),1)=OI
S X=$P($P(ODT,"|",3),U,4),ORDIALOG($$PTR("MEAL"),1)=$E(X)
S ORDIALOG($$PTR("MEAL TIME"),1)=$P($G(ORTIME(OI,$E(X),+$E(X,3))),U,2)
S:$L($P(ODT,"|",4)) ORDIALOG($$PTR("YES/NO"),1)=1
Q
;
IP ; Isolation/Precautions
N IP S IP=+$P($P(OBR,"|",13),U,4)
I IP'>0 S ORERR="Missing or invalid isolation type" Q
S ORDIALOG=$O(^ORD(101.41,"AB","FHW3",0)) D GETDLG1^ORCD(ORDIALOG)
S ORDIALOG($$PTR("ISOLATION TYPE"),1)=IP
S ORDIALOG($$PTR("ORDERABLE ITEM"),1)=$O(^ORD(101.43,"S.PREC","ISOLATION PROCEDURES",0))
Q
;
TF ; Tubefeeding
N OI,STR,INSTR,CMMT,I,X,X4,XI,ZQT,QT,QTY,DUR
S ORDIALOG=$O(^ORD(101.41,"AB","FHW8",0)) D GETDLG1^ORCD(ORDIALOG)
S OI=$$PTR("ORDERABLE ITEM"),STR=$$PTR("STRENGTH FH")
S INSTR=$$PTR("INSTRUCTIONS"),CMMT=$$PTR("FREE TEXT 1")
; Comments ??
S I=0 F D S ODS=$O(@ORMSG@(+ODS)) Q:ODS'>0 Q:$E(@ORMSG@(ODS),1,3)="ORC" S ODS=ODS_U_@ORMSG@(ODS)
. Q:$E($P(ODS,U,2),1,3)'="ODS" ; not ODS segment
. S X=$P(ODS,"|",4),X4=$P(X,U,4) ; OI
. S:X4["-" $P(X,U,4)=+X4,X4=+$P(X4,"-",2) ; strength
. S XI=$$ORDITEM^ORM(X) I 'XI S ORERR="Missing or invalid tubefeeding product" Q
. S ZQT=$O(@ORMSG@(+ODS)) I 'ZQT S ORERR="Missing QT information" Q
. S QT=$P(@ORMSG@(ZQT),"|",3),DUR=$P(QT,U,3)
. S QTY=+QT_" "_$$UNITS($P($P(QT,U),"&",2))_"/"_$P(QT,U,2)
. S:$L(DUR) QTY=QTY_" X "_+$E(DUR,2,99)_$S($E(DUR)="H":"HR",1:"")
. S I=I+1,ORDIALOG(OI,I)=XI,ORDIALOG(STR,I)=X4,ORDIALOG(INSTR,I)=QTY
. S:$L($P(ODS,"|",5)) ORDIALOG(CMMT,I)=$P(ODS,"|",5)
I ORCAT="O",ORQT["~" D DATES
Q
;
UNITS(X) ; -- Returns name of unit X
N Y S X=$E(X)
S Y=$S(X="K":"KCAL",X="C":"CC",X="M":"ML",X="O":"OZ",X="U":"UNITS",X="T":"TBSP",X="G":"GM",1:"")
Q Y
;
NPO ; NPO <uses FHW1 dialog - FHW4 now a quick order>
S ORDIALOG=$O(^ORD(101.41,"AB","FHW1",0)) D GETDLG1^ORCD(ORDIALOG)
S ORDIALOG($$PTR("ORDERABLE ITEM"),1)=$O(^ORD(101.43,"S.DIET","NPO",0))
S ORDIALOG($$PTR("START DATE/TIME"),1)=ORSTRT S:ORSTRT>ORLOG ORSTS=8
S:ORSTOP ORDIALOG($$PTR("STOP DATE/TIME"),1)=ORSTOP
S:$L($P(ODS,"|",5)) ORDIALOG($$PTR("FREE TEXT 1"),1)=$P(ODS,"|",5)
Q
;
ADDL ; Additional order
S ORDIALOG=$O(^ORD(101.41,"AB","FHW7",0)) D GETDLG1^ORCD(ORDIALOG)
S ORDIALOG($$PTR("FREE TEXT 1"),1)=$P(ODS,"|",5)
I ORCAT="O",ORQT["~" D DATES
Q
;
DATES ; -- pull dates out of ORQT
N P,I,X S P=$$PTR("DATE/TIME")
F I=1:1:$L(ORQT,"~") S X=$P(ORQT,"~",I),ORDIALOG(P,I)=$$HL7TFM^XLFDT($P(X,U,4))
S ORSTRT=$G(ORDIALOG(P,1)),ORSTOP=$G(ORDIALOG(P,I))
Q
;
SC ; -- Status Change
SR ; -- Status Update [ack]
N ORSTS,OROLD S OROLD=$P($G(^OR(100,+ORIFN,3)),U,3)
D DATES^ORCSAVE2(+ORIFN,ORSTRT,ORSTOP)
S ORSTS=$S(ORDSTS="DC":1,ORDSTS="IP":6,ORDSTS="ZE":7,ORDSTS="SC":8,1:"")
D:ORSTS STATUS^ORCSAVE2(+ORIFN,ORSTS)
I ORDSTS="DC",'$D(^OR(100,+ORIFN,6)) D ;set 6-node
. I ORNATR'="A","DN"[$E(PKGIFN) S ORNATR="C" S:'$L(OREASON) OREASON="Replaced with new diet order" S:ORDUZ<1 ORDUZ=""
. S ^OR(100,+ORIFN,6)=$S($L(ORNATR):+$O(^ORD(100.02,"C",ORNATR,0)),1:"")_U_ORDUZ_U_ORLOG_U_U_OREASON
I OROLD=1,ORSTS=6 D ; reactivate
. N X S $P(^OR(100,+ORIFN,3),U,7)=1,X=$P(^(0),U,9) K ^(6)
. I 'ORSTOP,X S $P(^OR(100,+ORIFN,0),U,9)="" K ^OR(100,"AE",X,+ORIFN)
. D SETALL^ORDD100(+ORIFN)
Q
;
OC ; -- Cancelled <E/L Trays only> / [ack]
G:ORTYPE="ORR" UA ;rejected new order
I $P($G(^OR(100,+ORIFN,3)),U,3)=6,$P(^(0),U,8)<ORLOG G OD
S ^OR(100,+ORIFN,6)=$S($L(ORNATR):+$O(^ORD(100.02,"C",ORNATR,0)),1:"")_U_ORDUZ_U_ORLOG_U_U_OREASON
D UPDATE(13,"DC")
Q
;
CR ; -- Cancelled as requested [ack]
D STATUS^ORCSAVE2(+ORIFN,13)
Q
;
OD ; -- Discontinued <Tubefeedings only>
S ^OR(100,+ORIFN,6)=$S($L(ORNATR):+$O(^ORD(100.02,"C",ORNATR,0)),1:"")_U_ORDUZ_U_ORLOG_U_U_OREASON
D UPDATE(1,"DC")
Q
;
DR ; -- Discontinued as requested [ack]
D STATUS^ORCSAVE2(+ORIFN,1)
Q
;
UA ; -- Unable to Accept [ack]
S:'$L(ORNATR) ORNATR="X" ;Rejected
S ^OR(100,+ORIFN,6)=+$O(^ORD(100.02,"C",ORNATR,0))_U_U_ORLOG_U_U_OREASON
D STATUS^ORCSAVE2(+ORIFN,13)
UC ; -- Unable to Cancel [ack]
UD ; -- Unable to Discontinue [ack]
N DA S DA=$P(ORIFN,";",2) I DA D
. S:$G(OREJECT) $P(^OR(100,+ORIFN,8,DA,0),U,15)=13 ; request rejected
. S:$L(OREASON) ^OR(100,+ORIFN,8,DA,1)=OREASON
Q
;
UPDATE(ORSTS,ORACT) ; -- continue processing
N ORX,DA,ORP D DATES^ORCSAVE2(+ORIFN,ORSTRT,ORSTOP)
D:$G(ORSTS) STATUS^ORCSAVE2(+ORIFN,ORSTS)
S ORX=$$CREATE^ORX1(ORNATR) D:ORX
. S DA=$$ACTION^ORCSAVE(ORACT,+ORIFN,ORNP,OREASON,ORLOG,ORDUZ)
. I DA'>0 S ORERR="Cannot create new order action" Q
. D RELEASE^ORCSAVE2(+ORIFN,DA,ORLOG,ORDUZ,ORNATR)
. D SIGSTS^ORCSAVE2(+ORIFN,DA)
. I $G(ORL) S ORP(1)=+ORIFN_";"_DA_"^1" D PRINTS^ORWD1(.ORP,+ORL)
. S $P(^OR(100,+ORIFN,3),U,7)=DA
I ORACT="DC",'$$ACTV^ORX1(ORNATR) S $P(^OR(100,+ORIFN,3),U,7)=0
D:ORACT="DC" CANCEL^ORCSEND(+ORIFN)
Q
;
PTR(NAME) ; -- Returns ien of prompt NAME in Order Dialog file #101.41
Q $O(^ORD(101.41,"AB",$E("OR GTX "_NAME,1,63),0))
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORMFH 8841 printed Sep 23, 2025@20:08:15 Page 2
ORMFH ;SLC/MKB - Process Dietetics ORM msgs ;5/5/05 13:18
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**3,73,92,215,243**;Dec 17, 1997;Build 242
+2 ;
EN ; -- entry point for FH messages
+1 ;S ORERR="Invalid order control code" Q
IF '$LENGTH($TEXT(@ORDCNTRL))
QUIT
+2 IF ORDCNTRL'="SN"
IF ORDCNTRL'="ZP"
IF 'ORIFN!('$DATA(^OR(100,+ORIFN,0)))
SET ORERR="Invalid OE/RR order number"
QUIT
+3 SET ORLOG=+$EXTRACT($$NOW^XLFDT,1,12)
if '$GET(ORDUZ)
SET ORDUZ=DUZ
if '$GET(ORNP)
SET ORNP=ORDUZ
+4 if $GET(DGPMT)
SET ORNATR="A"
SET OREASON=$SELECT(DGPMT=1:"Admission",DGPMT=3:"Discharge",1:"Transfer")
SET ORDUZ=""
+5 DO @ORDCNTRL
+6 QUIT
+7 ;
ZP ; -- Purged
+1 if 'ORIFN
QUIT
if '$DATA(^OR(100,+ORIFN,0))
QUIT
+2 ; Remove pkg reference, sts=lapsed if still active
KILL ^OR(100,+ORIFN,4)
IF "^6^8^"[(U_$PIECE($GET(^(3)),U,3)_U)
DO STATUS^ORCSAVE2(+ORIFN,14)
+3 QUIT
+4 ;
ZR ; -- Purged as requested [ack]
+1 DO DELETE^ORCSAVE2(+ORIFN)
+2 QUIT
+3 ;
ZU ; -- Unable to purge [ack]
+1 ; update Last Activity
SET $PIECE(^OR(100,+ORIFN,3),U)=$$NOW^XLFDT
+2 QUIT
+3 ;
OK ; -- Order accepted, FH order # assigned [ack]
+1 ; FH identifier
NEW ORSTS
SET ^OR(100,+ORIFN,4)=PKGIFN
+2 ;not Diet or NPO
IF "DN"'[$EXTRACT(PKGIFN)
SET ORSTS=6
+3 IF '$TEST
SET ORSTS=$SELECT($PIECE($GET(^OR(100,+ORIFN,0)),U,8)>ORLOG:8,1:6)
+4 DO STATUS^ORCSAVE2(+ORIFN,ORSTS)
+5 QUIT
+6 ;
XX ; -- Edited backdoor order (OP recurring meals only)
+1 DO XX^ORMFH1
QUIT
+2 ;
SN ; -- New backdoor order: return NA msg w/ORIFN
+1 NEW ODS,ODT,OBR,ORDIALOG,X,I,OI,SEG,ORNEW,ORPARAM,ORTIME,ORSTS,ORDG,ORP,ORTRAIL
+2 ;I '$D(^VA(200,+ORNP,0)) S ORERR="Missing or invalid ordering provider"Q
+3 ; Don't require provider until Nature of Order is added
+4 IF '$GET(DGPMT)
IF '$DATA(^VA(200,+ORDUZ,0))
SET ORERR="Missing or invalid entering person"
QUIT
+5 IF 'ORSTRT
SET ORERR="Missing effective date/time"
QUIT
+6 ;I '$G(ORL) S ORERR="Missing or invalid patient location" Q
+7 DO EN1^FHWOR8(ORL,.ORPARAM)
+8 SET ODS=$ORDER(@ORMSG@(+ORC))
IF 'ODS
SET ORERR="Incomplete message"
QUIT
+9 SET ODS=ODS_U_@ORMSG@(ODS)
SET ORSTS=6
IF '$LENGTH(ORNATR)
IF ORCAT="I"
SET ORNATR="S"
+10 IF $EXTRACT($PIECE(ODS,U,2),1,3)="OBR"
SET OBR=ODS
DO IP
GOTO SN1
+11 IF $EXTRACT($PIECE(ODS,U,2),1,3)="ODT"
SET ODT=ODS
DO TRAY
GOTO SN1
+12 IF $EXTRACT($PIECE(ODS,U,2),1,3)'="ODS"
SET ORERR="Missing or invalid ODS segment"
QUIT
+13 IF $PIECE(ODS,"|",2)="ZE"
DO TF
GOTO SN1
+14 IF $PIECE(ODS,"|",4)?1"^^^FH-6".E
DO ADDL
GOTO SN1
+15 IF ORCAT'="I"
DO OPM^ORMFH1
GOTO SN1
+16 IF $PIECE(ODS,"|",4)?1"^^^FH-5".E
DO NPO
GOTO SN1
DIET ; Diet order
+1 SET ORDIALOG=$ORDER(^ORD(101.41,"AB","FHW1",0))
SET ORTRAIL="Diet"
+2 DO GETDLG1^ORCD(ORDIALOG)
if ORSTRT>ORLOG
SET ORSTS=8
+3 SET ORDIALOG($$PTR("START DATE/TIME"),1)=ORSTRT
+4 if ORSTOP
SET ORDIALOG($$PTR("STOP DATE/TIME"),1)=ORSTOP
+5 SET X=$PIECE(ODS,"|",2)
SET ORDIALOG($$PTR("DELIVERY"),1)=$SELECT($LENGTH(X)=1:X,1:$EXTRACT(X,2))
+6 ; Comments ??
+7 SET X=$$ORDITEM^ORM($PIECE(ODS,"|",4))
+8 IF 'X
SET ORERR="Missing or invalid diet modification"
QUIT
+9 SET I=1
SET OI=$$PTR("ORDERABLE ITEM")
SET ORDIALOG(OI,I)=X
+10 IF $ORDER(@ORMSG@(+ODS))
FOR
SET ODS=$ORDER(@ORMSG@(+ODS))
if ODS'>0
QUIT
SET SEG=$EXTRACT(@ORMSG@(+ODS),1,3)
if SEG="ORC"
QUIT
if SEG="MSH"
QUIT
IF SEG="ODS"
Begin DoDot:1
+11 SET X=$$ORDITEM^ORM($PIECE(@ORMSG@(+ODS),"|",4))
+12 IF 'X
SET ORERR="Missing or invalid diet modification"
QUIT
+13 SET I=I+1
SET ORDIALOG(OI,I)=X
End DoDot:1
if $DATA(ORERR)
QUIT
SN1 ; continue ... save order, post message
+1 if $DATA(ORERR)
QUIT
+2 DO EN^ORCSAVE
IF '$GET(ORIFN)
SET ORERR="Cannot create new order"
QUIT
+3 DO RELEASE^ORCSAVE2(ORIFN,1,ORLOG,ORDUZ,ORNATR)
DO SIGSTS^ORCSAVE2(ORIFN,1)
+4 if '$PIECE($GET(^OR(100,ORIFN,0)),U,8)
DO DATES^ORCSAVE2(ORIFN,ORSTRT,ORSTOP)
+5 DO STATUS^ORCSAVE2(ORIFN,ORSTS)
+6 ; chart copy
IF $GET(ORL)
SET ORP(1)=ORIFN_";1^1"
DO PRINTS^ORWD1(.ORP,+ORL)
+7 SET ^OR(100,ORIFN,4)=PKGIFN
+8 QUIT
+9 ;
TRAY ; Early/Late tray
+1 IF 'ORSTOP
SET ORERR="Missing stop date"
QUIT
+2 SET ORDIALOG=$ORDER(^ORD(101.41,"AB","FHW2",0))
DO GETDLG1^ORCD(ORDIALOG)
DO EN2^ORCDFH
+3 SET ORDIALOG($$PTR("START DATE"),1)=ORSTRT
+4 SET ORDIALOG($$PTR("STOP DATE"),1)=ORSTOP
+5 NEW DAYS,SCH
SET DAYS=""
SET SCH=$PIECE(ORQT,U,2)
+6 IF $LENGTH(SCH)
IF SCH'="ONCE"
FOR I=1:1:$LENGTH(SCH,"~")
SET X=+$PIECE($PIECE(SCH,"~",I),"J",2)
SET DAYS=DAYS_$EXTRACT("MTWRFSX",X)
+7 if $LENGTH(DAYS)
SET ORDIALOG($$PTR("SCHEDULE"),1)=DAYS
+8 SET OI=+$ORDER(^ORD(101.43,"S.E/L T",$PIECE(ODT,"|",2)_" TRAY",0))
SET ORDIALOG($$PTR("ORDERABLE ITEM"),1)=OI
+9 SET X=$PIECE($PIECE(ODT,"|",3),U,4)
SET ORDIALOG($$PTR("MEAL"),1)=$EXTRACT(X)
+10 SET ORDIALOG($$PTR("MEAL TIME"),1)=$PIECE($GET(ORTIME(OI,$EXTRACT(X),+$EXTRACT(X,3))),U,2)
+11 if $LENGTH($PIECE(ODT,"|",4))
SET ORDIALOG($$PTR("YES/NO"),1)=1
+12 QUIT
+13 ;
IP ; Isolation/Precautions
+1 NEW IP
SET IP=+$PIECE($PIECE(OBR,"|",13),U,4)
+2 IF IP'>0
SET ORERR="Missing or invalid isolation type"
QUIT
+3 SET ORDIALOG=$ORDER(^ORD(101.41,"AB","FHW3",0))
DO GETDLG1^ORCD(ORDIALOG)
+4 SET ORDIALOG($$PTR("ISOLATION TYPE"),1)=IP
+5 SET ORDIALOG($$PTR("ORDERABLE ITEM"),1)=$ORDER(^ORD(101.43,"S.PREC","ISOLATION PROCEDURES",0))
+6 QUIT
+7 ;
TF ; Tubefeeding
+1 NEW OI,STR,INSTR,CMMT,I,X,X4,XI,ZQT,QT,QTY,DUR
+2 SET ORDIALOG=$ORDER(^ORD(101.41,"AB","FHW8",0))
DO GETDLG1^ORCD(ORDIALOG)
+3 SET OI=$$PTR("ORDERABLE ITEM")
SET STR=$$PTR("STRENGTH FH")
+4 SET INSTR=$$PTR("INSTRUCTIONS")
SET CMMT=$$PTR("FREE TEXT 1")
+5 ; Comments ??
+6 SET I=0
FOR
Begin DoDot:1
+7 ; not ODS segment
if $EXTRACT($PIECE(ODS,U,2),1,3)'="ODS"
QUIT
+8 ; OI
SET X=$PIECE(ODS,"|",4)
SET X4=$PIECE(X,U,4)
+9 ; strength
if X4["-"
SET $PIECE(X,U,4)=+X4
SET X4=+$PIECE(X4,"-",2)
+10 SET XI=$$ORDITEM^ORM(X)
IF 'XI
SET ORERR="Missing or invalid tubefeeding product"
QUIT
+11 SET ZQT=$ORDER(@ORMSG@(+ODS))
IF 'ZQT
SET ORERR="Missing QT information"
QUIT
+12 SET QT=$PIECE(@ORMSG@(ZQT),"|",3)
SET DUR=$PIECE(QT,U,3)
+13 SET QTY=+QT_" "_$$UNITS($PIECE($PIECE(QT,U),"&",2))_"/"_$PIECE(QT,U,2)
+14 if $LENGTH(DUR)
SET QTY=QTY_" X "_+$EXTRACT(DUR,2,99)_$SELECT($EXTRACT(DUR)="H":"HR",1:"")
+15 SET I=I+1
SET ORDIALOG(OI,I)=XI
SET ORDIALOG(STR,I)=X4
SET ORDIALOG(INSTR,I)=QTY
+16 if $LENGTH($PIECE(ODS,"|",5))
SET ORDIALOG(CMMT,I)=$PIECE(ODS,"|",5)
End DoDot:1
SET ODS=$ORDER(@ORMSG@(+ODS))
if ODS'>0
QUIT
if $EXTRACT(@ORMSG@(ODS),1,3)="ORC"
QUIT
SET ODS=ODS_U_@ORMSG@(ODS)
+17 IF ORCAT="O"
IF ORQT["~"
DO DATES
+18 QUIT
+19 ;
UNITS(X) ; -- Returns name of unit X
+1 NEW Y
SET X=$EXTRACT(X)
+2 SET Y=$SELECT(X="K":"KCAL",X="C":"CC",X="M":"ML",X="O":"OZ",X="U":"UNITS",X="T":"TBSP",X="G":"GM",1:"")
+3 QUIT Y
+4 ;
NPO ; NPO <uses FHW1 dialog - FHW4 now a quick order>
+1 SET ORDIALOG=$ORDER(^ORD(101.41,"AB","FHW1",0))
DO GETDLG1^ORCD(ORDIALOG)
+2 SET ORDIALOG($$PTR("ORDERABLE ITEM"),1)=$ORDER(^ORD(101.43,"S.DIET","NPO",0))
+3 SET ORDIALOG($$PTR("START DATE/TIME"),1)=ORSTRT
if ORSTRT>ORLOG
SET ORSTS=8
+4 if ORSTOP
SET ORDIALOG($$PTR("STOP DATE/TIME"),1)=ORSTOP
+5 if $LENGTH($PIECE(ODS,"|",5))
SET ORDIALOG($$PTR("FREE TEXT 1"),1)=$PIECE(ODS,"|",5)
+6 QUIT
+7 ;
ADDL ; Additional order
+1 SET ORDIALOG=$ORDER(^ORD(101.41,"AB","FHW7",0))
DO GETDLG1^ORCD(ORDIALOG)
+2 SET ORDIALOG($$PTR("FREE TEXT 1"),1)=$PIECE(ODS,"|",5)
+3 IF ORCAT="O"
IF ORQT["~"
DO DATES
+4 QUIT
+5 ;
DATES ; -- pull dates out of ORQT
+1 NEW P,I,X
SET P=$$PTR("DATE/TIME")
+2 FOR I=1:1:$LENGTH(ORQT,"~")
SET X=$PIECE(ORQT,"~",I)
SET ORDIALOG(P,I)=$$HL7TFM^XLFDT($PIECE(X,U,4))
+3 SET ORSTRT=$GET(ORDIALOG(P,1))
SET ORSTOP=$GET(ORDIALOG(P,I))
+4 QUIT
+5 ;
SC ; -- Status Change
SR ; -- Status Update [ack]
+1 NEW ORSTS,OROLD
SET OROLD=$PIECE($GET(^OR(100,+ORIFN,3)),U,3)
+2 DO DATES^ORCSAVE2(+ORIFN,ORSTRT,ORSTOP)
+3 SET ORSTS=$SELECT(ORDSTS="DC":1,ORDSTS="IP":6,ORDSTS="ZE":7,ORDSTS="SC":8,1:"")
+4 if ORSTS
DO STATUS^ORCSAVE2(+ORIFN,ORSTS)
+5 ;set 6-node
IF ORDSTS="DC"
IF '$DATA(^OR(100,+ORIFN,6))
Begin DoDot:1
+6 IF ORNATR'="A"
IF "DN"[$EXTRACT(PKGIFN)
SET ORNATR="C"
if '$LENGTH(OREASON)
SET OREASON="Replaced with new diet order"
if ORDUZ<1
SET ORDUZ=""
+7 SET ^OR(100,+ORIFN,6)=$SELECT($LENGTH(ORNATR):+$ORDER(^ORD(100.02,"C",ORNATR,0)),1:"")_U_ORDUZ_U_ORLOG_U_U_OREASON
End DoDot:1
+8 ; reactivate
IF OROLD=1
IF ORSTS=6
Begin DoDot:1
+9 NEW X
SET $PIECE(^OR(100,+ORIFN,3),U,7)=1
SET X=$PIECE(^(0),U,9)
KILL ^(6)
+10 IF 'ORSTOP
IF X
SET $PIECE(^OR(100,+ORIFN,0),U,9)=""
KILL ^OR(100,"AE",X,+ORIFN)
+11 DO SETALL^ORDD100(+ORIFN)
End DoDot:1
+12 QUIT
+13 ;
OC ; -- Cancelled <E/L Trays only> / [ack]
+1 ;rejected new order
if ORTYPE="ORR"
GOTO UA
+2 IF $PIECE($GET(^OR(100,+ORIFN,3)),U,3)=6
IF $PIECE(^(0),U,8)<ORLOG
GOTO OD
+3 SET ^OR(100,+ORIFN,6)=$SELECT($LENGTH(ORNATR):+$ORDER(^ORD(100.02,"C",ORNATR,0)),1:"")_U_ORDUZ_U_ORLOG_U_U_OREASON
+4 DO UPDATE(13,"DC")
+5 QUIT
+6 ;
CR ; -- Cancelled as requested [ack]
+1 DO STATUS^ORCSAVE2(+ORIFN,13)
+2 QUIT
+3 ;
OD ; -- Discontinued <Tubefeedings only>
+1 SET ^OR(100,+ORIFN,6)=$SELECT($LENGTH(ORNATR):+$ORDER(^ORD(100.02,"C",ORNATR,0)),1:"")_U_ORDUZ_U_ORLOG_U_U_OREASON
+2 DO UPDATE(1,"DC")
+3 QUIT
+4 ;
DR ; -- Discontinued as requested [ack]
+1 DO STATUS^ORCSAVE2(+ORIFN,1)
+2 QUIT
+3 ;
UA ; -- Unable to Accept [ack]
+1 ;Rejected
if '$LENGTH(ORNATR)
SET ORNATR="X"
+2 SET ^OR(100,+ORIFN,6)=+$ORDER(^ORD(100.02,"C",ORNATR,0))_U_U_ORLOG_U_U_OREASON
+3 DO STATUS^ORCSAVE2(+ORIFN,13)
UC ; -- Unable to Cancel [ack]
UD ; -- Unable to Discontinue [ack]
+1 NEW DA
SET DA=$PIECE(ORIFN,";",2)
IF DA
Begin DoDot:1
+2 ; request rejected
if $GET(OREJECT)
SET $PIECE(^OR(100,+ORIFN,8,DA,0),U,15)=13
+3 if $LENGTH(OREASON)
SET ^OR(100,+ORIFN,8,DA,1)=OREASON
End DoDot:1
+4 QUIT
+5 ;
UPDATE(ORSTS,ORACT) ; -- continue processing
+1 NEW ORX,DA,ORP
DO DATES^ORCSAVE2(+ORIFN,ORSTRT,ORSTOP)
+2 if $GET(ORSTS)
DO STATUS^ORCSAVE2(+ORIFN,ORSTS)
+3 SET ORX=$$CREATE^ORX1(ORNATR)
if ORX
Begin DoDot:1
+4 SET DA=$$ACTION^ORCSAVE(ORACT,+ORIFN,ORNP,OREASON,ORLOG,ORDUZ)
+5 IF DA'>0
SET ORERR="Cannot create new order action"
QUIT
+6 DO RELEASE^ORCSAVE2(+ORIFN,DA,ORLOG,ORDUZ,ORNATR)
+7 DO SIGSTS^ORCSAVE2(+ORIFN,DA)
+8 IF $GET(ORL)
SET ORP(1)=+ORIFN_";"_DA_"^1"
DO PRINTS^ORWD1(.ORP,+ORL)
+9 SET $PIECE(^OR(100,+ORIFN,3),U,7)=DA
End DoDot:1
+10 IF ORACT="DC"
IF '$$ACTV^ORX1(ORNATR)
SET $PIECE(^OR(100,+ORIFN,3),U,7)=0
+11 if ORACT="DC"
DO CANCEL^ORCSEND(+ORIFN)
+12 QUIT
+13 ;
PTR(NAME) ; -- Returns ien of prompt NAME in Order Dialog file #101.41
+1 QUIT $ORDER(^ORD(101.41,"AB",$EXTRACT("OR GTX "_NAME,1,63),0))
