ORMBLDFH ; SLC/MKB - Build outgoing Dietetics ORM msgs ;11/17/00 11:06
;;3.0;ORDER ENTRY/RESULTS REPORTING;**73,97,215**;Dec 17, 1997
;
HL7DATE(DATE) ; -- FM -> HL7 format
Q $$FMTHL7^XLFDT(DATE) ;**97
;
PTR(NAME) ; -- Returns ptr value of prompt in Dialog file
Q $O(^ORD(101.41,"AB",$E(NAME,1,63),0))
;
DIET ; -- new Diet order (incl NPO)
I $P(OR0,U,12)'="I" D OPM Q
N OI,START,STOP,OR3,TYPE,TEXT,QT,INST,J
S START=$P($G(^OR(100,IFN,0)),U,8),STOP=$P($G(^(0)),U,9),OR3=$G(^(3))
S TYPE=$G(ORDIALOG($$PTR("OR GTX DELIVERY"),1))
S TEXT=$G(ORDIALOG($$PTR("OR GTX FREE TEXT 1"),1))
S OI=$$PTR("OR GTX ORDERABLE ITEM")
S QT="^^^"_$$HL7DATE(START)_U_$$HL7DATE(STOP),$P(ORMSG(4),"|",8)=QT
I $$NPO(OI) S ORMSG(5)="ODS|D||^^^FH-5^NPO^99OTH|"_TEXT Q
S INST=0,J=4 F S INST=$O(ORDIALOG(OI,INST)) Q:INST'>0 D
. S J=J+1,ORMSG(J)="ODS|Z"_TYPE_"||"_$$USID^ORMBLD(ORDIALOG(OI,INST))_"|"_TEXT
I $P(OR3,U,5) S $P(ORMSG(4),"|",4)=$G(^OR(100,+$P(OR3,U,5),4))_"^FH"
Q
;
NPO(Y) ; -- Returns 1 or 0, if diet ordered is NPO
N X,I S X=$O(^ORD(101.43,"S.DIET","NPO",0)),I=$O(ORDIALOG(Y,0))
Q (X=ORDIALOG(Y,I))
;
OPM ; -- new Outpatient Meal
N START,STOP,SCH,DAYS,X,I,QT,OI,MEAL,TEXT,TYPE,DELVRY
S START=$P($P(OR0,U,8),"."),STOP=$P($P(OR0,U,9),"."),TYPE="D"
S SCH=$G(ORDIALOG($$PTR("OR GTX SCHEDULE"),1)),DAYS=""
I '$L(SCH),START=DT,STOP=DT S TYPE="S" ;S=special, D=recurring meal
I $G(SCH)="ONCE" D ;reset to day for message
. S X=$$UP^XLFSTR($$DOW^XLFDT(START))
. S SCH=$S(X="THURSDAY":"R",X="SUNDAY":"X",1:$E(X))
I $L(SCH) F I=1:1:$L(SCH) S X=$E(SCH,I),DAYS=DAYS_$S($L(DAYS):"~",1:"")_"QJ"_($F("MTWRFSX",X)-1)
S QT=U_DAYS_"^^"_$$HL7DATE(START)_U_$$HL7DATE(STOP),$P(ORMSG(4),"|",8)=QT
S OI=$$PTR("OR GTX ORDERABLE ITEM")
S MEAL=$G(ORDIALOG($$PTR("OR GTX MEAL"),1)),MEAL=$TR(MEAL,"BNE","135")
S TEXT=$G(ORDIALOG($$PTR("OR GTX FREE TEXT 1"),1))
I $$NPO(OI) S ORMSG(5)="ODS|"_TYPE_"|"_MEAL_"|^^^FH-5^NPO^99OTH|"_TEXT Q
S I=$$PTR("OR GTX DELIVERY"),DELVRY=$S($D(ORDIALOG(I,1)):$$EXT^ORCD(I,1),1:"")
S ORMSG(5)="ODS|"_TYPE_"|"_MEAL_"|"_$$USID^ORMBLD(ORDIALOG(OI,1))_"|"_DELVRY
Q
;
ADDN ; -- new Additional Diet order
N TEXT D DATES
S TEXT=$G(ORDIALOG($$PTR("OR GTX FREE TEXT 1"),1))
S ORMSG(5)="ODS|D||^^^FH-6^ADDITIONAL ORDER^99OTH|"_TEXT
Q
;
DATES ; -- get Start date for order IFN, QT field in msg
N X,INPT S INPT=$S($P($G(^OR(100,+IFN,0)),U,12)="I":1,1:0)
S X=$S(INPT:+$E($$NOW^XLFDT,1,12),1:+$G(ORDIALOG($$PTR("OR GTX DATE/TIME"),1)))
D DATES^ORCSAVE2(+IFN,X) ;Stop date for outpts?
S $P(ORMSG(4),"|",8)="^^^"_$$HL7DATE(X)
Q
;
TF ; -- new Tubefeeding order
N OI,STR,QT,TEXT,I,J,TF,X,QUAN,INT,DUR
S OI=$$PTR("OR GTX ORDERABLE ITEM"),STR=$$PTR("OR GTX STRENGTH FH")
S QT=$$PTR("OR GTX INSTRUCTIONS") D DATES
S TEXT=$G(ORDIALOG($$PTR("OR GTX FREE TEXT 1"),1))
S J=4,I=0 F S I=$O(ORDIALOG(OI,I)) Q:I'>0 D
. S TF=$$USID^ORMBLD(ORDIALOG(OI,I)),$P(TF,U,4)=$P(TF,U,4)_"-"_$G(ORDIALOG(STR,I))
. S J=J+1,ORMSG(J)="ODS|ZE||"_TF_"|"_TEXT
. S X=$G(ORDIALOG(QT,I)),QUAN=+X_"&"_$E($P(X," ",2))
. S INT=$P($P(X,"/",2)," "),DUR=$P(X," X ",2)
. S:DUR DUR=$S(DUR["H":"H",1:"X")_+DUR
. S J=J+1,ORMSG(J)="ZQT||"_QUAN_U_INT_U_DUR
Q
;
TRAY ; -- new Early/Late Tray order
N START,STOP,ORL,MEAL,TYPE,OI,X,TIME,SCH,I,DAYS,BAGGED,ORPARAM,ORTIME
S START=$P($G(^OR(100,IFN,0)),U,8),STOP=$P(^(0),U,9),ORL=$P(^(0),U,10)
D EN1^FHWOR8(ORL,.ORPARAM),EN2^ORCDFH
S MEAL=$G(ORDIALOG($$PTR("OR GTX MEAL"),1))
S OI=$G(ORDIALOG($$PTR("OR GTX ORDERABLE ITEM"),1)),TYPE=$P($P($G(^ORD(101.43,+OI,0)),U)," ")
S TIME=$G(ORDIALOG($$PTR("OR GTX MEAL TIME"),1)),TIME=+$G(ORTIME(OI,MEAL,"C",TIME))
S:$G(ORDIALOG($$PTR("OR GTX YES/NO"),1)) BAGGED="bagged"
S SCH=$G(ORDIALOG($$PTR("OR GTX SCHEDULE"),1)),DAYS="ONCE"
I $L(SCH) S DAYS="" F I=1:1:$L(SCH) S X=$E(SCH,I),DAYS=DAYS_$S($L(DAYS):"~",1:"")_"QJ"_($F("MTWRFSX",X)-1)
S $P(ORMSG(4),"|",8)=U_DAYS_"^^"_$$HL7DATE(START)_U_$$HL7DATE(STOP)
S ORMSG(5)="ODT|"_$$UP^XLFSTR(TYPE)_"|^^^"_MEAL_$E(TYPE)_TIME_"^^99FHS"_"|"_$G(BAGGED)
Q
;
IP ; -- new Isolation/Precaution order
N NOW,IP S NOW=+$E($$NOW^XLFDT,1,12) D DATES^ORCSAVE2(+IFN,NOW)
S $P(ORMSG(4),"|",8)="^^^"_$$HL7DATE(NOW)
S IP=+$G(ORDIALOG($$PTR("OR GTX ISOLATION TYPE"),1))
S ORMSG(5)="OBR||||||||||||^^^"_IP_U_$P($G(^FH(119.4,IP,0)),U)_"^99FHI"
Q
;
CANCEL(TIME,DFN,LOC,PROV) ; -- Cancel outpatient meal time(s) where
; TIME(n) = date.time
N ORMSG,ORNOW,I,J S ORNOW=$$FMTHL7^XLFDT($$NOW^XLFDT)
S ORMSG(1)=$$MSH^ORMBLD("ORM","FH")
S ORMSG(2)=$$PID^ORMBLD(+$G(DFN))
S ORMSG(3)=$$PV1^ORMBLD(+$G(DFN),"O",$G(LOC)),J=3
S I=0 F S I=$O(TIME(I)) Q:I<1 S X=TIME(I),J=J+1,ORMSG(J)="ORC|CA||"_X_"^FH||||||"_ORNOW_"|"_$G(DUZ)_"||"_$G(PROV)_"|||"_ORNOW
D MSG^XQOR("OR EVSEND FH",.ORMSG)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORMBLDFH 4807 printed Nov 22, 2024@17:41:42 Page 2
ORMBLDFH ; SLC/MKB - Build outgoing Dietetics ORM msgs ;11/17/00 11:06
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**73,97,215**;Dec 17, 1997
+2 ;
HL7DATE(DATE) ; -- FM -> HL7 format
+1 ;**97
QUIT $$FMTHL7^XLFDT(DATE)
+2 ;
PTR(NAME) ; -- Returns ptr value of prompt in Dialog file
+1 QUIT $ORDER(^ORD(101.41,"AB",$EXTRACT(NAME,1,63),0))
+2 ;
DIET ; -- new Diet order (incl NPO)
+1 IF $PIECE(OR0,U,12)'="I"
DO OPM
QUIT
+2 NEW OI,START,STOP,OR3,TYPE,TEXT,QT,INST,J
+3 SET START=$PIECE($GET(^OR(100,IFN,0)),U,8)
SET STOP=$PIECE($GET(^(0)),U,9)
SET OR3=$GET(^(3))
+4 SET TYPE=$GET(ORDIALOG($$PTR("OR GTX DELIVERY"),1))
+5 SET TEXT=$GET(ORDIALOG($$PTR("OR GTX FREE TEXT 1"),1))
+6 SET OI=$$PTR("OR GTX ORDERABLE ITEM")
+7 SET QT="^^^"_$$HL7DATE(START)_U_$$HL7DATE(STOP)
SET $PIECE(ORMSG(4),"|",8)=QT
+8 IF $$NPO(OI)
SET ORMSG(5)="ODS|D||^^^FH-5^NPO^99OTH|"_TEXT
QUIT
+9 SET INST=0
SET J=4
FOR
SET INST=$ORDER(ORDIALOG(OI,INST))
if INST'>0
QUIT
Begin DoDot:1
+10 SET J=J+1
SET ORMSG(J)="ODS|Z"_TYPE_"||"_$$USID^ORMBLD(ORDIALOG(OI,INST))_"|"_TEXT
End DoDot:1
+11 IF $PIECE(OR3,U,5)
SET $PIECE(ORMSG(4),"|",4)=$GET(^OR(100,+$PIECE(OR3,U,5),4))_"^FH"
+12 QUIT
+13 ;
NPO(Y) ; -- Returns 1 or 0, if diet ordered is NPO
+1 NEW X,I
SET X=$ORDER(^ORD(101.43,"S.DIET","NPO",0))
SET I=$ORDER(ORDIALOG(Y,0))
+2 QUIT (X=ORDIALOG(Y,I))
+3 ;
OPM ; -- new Outpatient Meal
+1 NEW START,STOP,SCH,DAYS,X,I,QT,OI,MEAL,TEXT,TYPE,DELVRY
+2 SET START=$PIECE($PIECE(OR0,U,8),".")
SET STOP=$PIECE($PIECE(OR0,U,9),".")
SET TYPE="D"
+3 SET SCH=$GET(ORDIALOG($$PTR("OR GTX SCHEDULE"),1))
SET DAYS=""
+4 ;S=special, D=recurring meal
IF '$LENGTH(SCH)
IF START=DT
IF STOP=DT
SET TYPE="S"
+5 ;reset to day for message
IF $GET(SCH)="ONCE"
Begin DoDot:1
+6 SET X=$$UP^XLFSTR($$DOW^XLFDT(START))
+7 SET SCH=$SELECT(X="THURSDAY":"R",X="SUNDAY":"X",1:$EXTRACT(X))
End DoDot:1
+8 IF $LENGTH(SCH)
FOR I=1:1:$LENGTH(SCH)
SET X=$EXTRACT(SCH,I)
SET DAYS=DAYS_$SELECT($LENGTH(DAYS):"~",1:"")_"QJ"_($FIND("MTWRFSX",X)-1)
+9 SET QT=U_DAYS_"^^"_$$HL7DATE(START)_U_$$HL7DATE(STOP)
SET $PIECE(ORMSG(4),"|",8)=QT
+10 SET OI=$$PTR("OR GTX ORDERABLE ITEM")
+11 SET MEAL=$GET(ORDIALOG($$PTR("OR GTX MEAL"),1))
SET MEAL=$TRANSLATE(MEAL,"BNE","135")
+12 SET TEXT=$GET(ORDIALOG($$PTR("OR GTX FREE TEXT 1"),1))
+13 IF $$NPO(OI)
SET ORMSG(5)="ODS|"_TYPE_"|"_MEAL_"|^^^FH-5^NPO^99OTH|"_TEXT
QUIT
+14 SET I=$$PTR("OR GTX DELIVERY")
SET DELVRY=$SELECT($DATA(ORDIALOG(I,1)):$$EXT^ORCD(I,1),1:"")
+15 SET ORMSG(5)="ODS|"_TYPE_"|"_MEAL_"|"_$$USID^ORMBLD(ORDIALOG(OI,1))_"|"_DELVRY
+16 QUIT
+17 ;
ADDN ; -- new Additional Diet order
+1 NEW TEXT
DO DATES
+2 SET TEXT=$GET(ORDIALOG($$PTR("OR GTX FREE TEXT 1"),1))
+3 SET ORMSG(5)="ODS|D||^^^FH-6^ADDITIONAL ORDER^99OTH|"_TEXT
+4 QUIT
+5 ;
DATES ; -- get Start date for order IFN, QT field in msg
+1 NEW X,INPT
SET INPT=$SELECT($PIECE($GET(^OR(100,+IFN,0)),U,12)="I":1,1:0)
+2 SET X=$SELECT(INPT:+$EXTRACT($$NOW^XLFDT,1,12),1:+$GET(ORDIALOG($$PTR("OR GTX DATE/TIME"),1)))
+3 ;Stop date for outpts?
DO DATES^ORCSAVE2(+IFN,X)
+4 SET $PIECE(ORMSG(4),"|",8)="^^^"_$$HL7DATE(X)
+5 QUIT
+6 ;
TF ; -- new Tubefeeding order
+1 NEW OI,STR,QT,TEXT,I,J,TF,X,QUAN,INT,DUR
+2 SET OI=$$PTR("OR GTX ORDERABLE ITEM")
SET STR=$$PTR("OR GTX STRENGTH FH")
+3 SET QT=$$PTR("OR GTX INSTRUCTIONS")
DO DATES
+4 SET TEXT=$GET(ORDIALOG($$PTR("OR GTX FREE TEXT 1"),1))
+5 SET J=4
SET I=0
FOR
SET I=$ORDER(ORDIALOG(OI,I))
if I'>0
QUIT
Begin DoDot:1
+6 SET TF=$$USID^ORMBLD(ORDIALOG(OI,I))
SET $PIECE(TF,U,4)=$PIECE(TF,U,4)_"-"_$GET(ORDIALOG(STR,I))
+7 SET J=J+1
SET ORMSG(J)="ODS|ZE||"_TF_"|"_TEXT
+8 SET X=$GET(ORDIALOG(QT,I))
SET QUAN=+X_"&"_$EXTRACT($PIECE(X," ",2))
+9 SET INT=$PIECE($PIECE(X,"/",2)," ")
SET DUR=$PIECE(X," X ",2)
+10 if DUR
SET DUR=$SELECT(DUR["H":"H",1:"X")_+DUR
+11 SET J=J+1
SET ORMSG(J)="ZQT||"_QUAN_U_INT_U_DUR
End DoDot:1
+12 QUIT
+13 ;
TRAY ; -- new Early/Late Tray order
+1 NEW START,STOP,ORL,MEAL,TYPE,OI,X,TIME,SCH,I,DAYS,BAGGED,ORPARAM,ORTIME
+2 SET START=$PIECE($GET(^OR(100,IFN,0)),U,8)
SET STOP=$PIECE(^(0),U,9)
SET ORL=$PIECE(^(0),U,10)
+3 DO EN1^FHWOR8(ORL,.ORPARAM)
DO EN2^ORCDFH
+4 SET MEAL=$GET(ORDIALOG($$PTR("OR GTX MEAL"),1))
+5 SET OI=$GET(ORDIALOG($$PTR("OR GTX ORDERABLE ITEM"),1))
SET TYPE=$PIECE($PIECE($GET(^ORD(101.43,+OI,0)),U)," ")
+6 SET TIME=$GET(ORDIALOG($$PTR("OR GTX MEAL TIME"),1))
SET TIME=+$GET(ORTIME(OI,MEAL,"C",TIME))
+7 if $GET(ORDIALOG($$PTR("OR GTX YES/NO"),1))
SET BAGGED="bagged"
+8 SET SCH=$GET(ORDIALOG($$PTR("OR GTX SCHEDULE"),1))
SET DAYS="ONCE"
+9 IF $LENGTH(SCH)
SET DAYS=""
FOR I=1:1:$LENGTH(SCH)
SET X=$EXTRACT(SCH,I)
SET DAYS=DAYS_$SELECT($LENGTH(DAYS):"~",1:"")_"QJ"_($FIND("MTWRFSX",X)-1)
+10 SET $PIECE(ORMSG(4),"|",8)=U_DAYS_"^^"_$$HL7DATE(START)_U_$$HL7DATE(STOP)
+11 SET ORMSG(5)="ODT|"_$$UP^XLFSTR(TYPE)_"|^^^"_MEAL_$EXTRACT(TYPE)_TIME_"^^99FHS"_"|"_$GET(BAGGED)
+12 QUIT
+13 ;
IP ; -- new Isolation/Precaution order
+1 NEW NOW,IP
SET NOW=+$EXTRACT($$NOW^XLFDT,1,12)
DO DATES^ORCSAVE2(+IFN,NOW)
+2 SET $PIECE(ORMSG(4),"|",8)="^^^"_$$HL7DATE(NOW)
+3 SET IP=+$GET(ORDIALOG($$PTR("OR GTX ISOLATION TYPE"),1))
+4 SET ORMSG(5)="OBR||||||||||||^^^"_IP_U_$PIECE($GET(^FH(119.4,IP,0)),U)_"^99FHI"
+5 QUIT
+6 ;
CANCEL(TIME,DFN,LOC,PROV) ; -- Cancel outpatient meal time(s) where
+1 ; TIME(n) = date.time
+2 NEW ORMSG,ORNOW,I,J
SET ORNOW=$$FMTHL7^XLFDT($$NOW^XLFDT)
+3 SET ORMSG(1)=$$MSH^ORMBLD("ORM","FH")
+4 SET ORMSG(2)=$$PID^ORMBLD(+$GET(DFN))
+5 SET ORMSG(3)=$$PV1^ORMBLD(+$GET(DFN),"O",$GET(LOC))
SET J=3
+6 SET I=0
FOR
SET I=$ORDER(TIME(I))
if I<1
QUIT
SET X=TIME(I)
SET J=J+1
SET ORMSG(J)="ORC|CA||"_X_"^FH||||||"_ORNOW_"|"_$GET(DUZ)_"||"_$GET(PROV)_"|||"_ORNOW
+7 DO MSG^XQOR("OR EVSEND FH",.ORMSG)
+8 QUIT
