Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ORMBLDFH

ORMBLDFH.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1. HL7DATE(DATE) ; -- FM -> HL7 format
  1.  Q $$FMTHL7^XLFDT(DATE)  ;**97
  1.  ;
  1. PTR(NAME) ; -- Returns ptr value of prompt in Dialog file
  1.  Q $O(^ORD(101.41,"AB",$E(NAME,1,63),0))
  1.  ;
  1. DIET ; -- new Diet order (incl NPO)
  1.  I $P(OR0,U,12)'="I" D OPM Q
  1.  N OI,START,STOP,OR3,TYPE,TEXT,QT,INST,J
  1.  S START=$P($G(^OR(100,IFN,0)),U,8),STOP=$P($G(^(0)),U,9),OR3=$G(^(3))
  1.  S TYPE=$G(ORDIALOG($$PTR("OR GTX DELIVERY"),1))
  1.  S TEXT=$G(ORDIALOG($$PTR("OR GTX FREE TEXT 1"),1))
  1.  S OI=$$PTR("OR GTX ORDERABLE ITEM")
  1.  S QT="^^^"_$$HL7DATE(START)_U_$$HL7DATE(STOP),$P(ORMSG(4),"|",8)=QT
  1.  I $$NPO(OI) S ORMSG(5)="ODS|D||^^^FH-5^NPO^99OTH|"_TEXT Q
  1.  S INST=0,J=4 F  S INST=$O(ORDIALOG(OI,INST)) Q:INST'>0  D
  1.  . S J=J+1,ORMSG(J)="ODS|Z"_TYPE_"||"_$$USID^ORMBLD(ORDIALOG(OI,INST))_"|"_TEXT
  1.  I $P(OR3,U,5) S $P(ORMSG(4),"|",4)=$G(^OR(100,+$P(OR3,U,5),4))_"^FH"
  1.  Q
  1.  ;
  1. NPO(Y) ; -- Returns 1 or 0, if diet ordered is NPO
  1.  N X,I S X=$O(^ORD(101.43,"S.DIET","NPO",0)),I=$O(ORDIALOG(Y,0))
  1.  Q (X=ORDIALOG(Y,I))
  1.  ;
  1. OPM ; -- new Outpatient Meal
  1.  N START,STOP,SCH,DAYS,X,I,QT,OI,MEAL,TEXT,TYPE,DELVRY
  1.  S START=$P($P(OR0,U,8),"."),STOP=$P($P(OR0,U,9),"."),TYPE="D"
  1.  S SCH=$G(ORDIALOG($$PTR("OR GTX SCHEDULE"),1)),DAYS=""
  1.  I '$L(SCH),START=DT,STOP=DT S TYPE="S" ;S=special, D=recurring meal
  1.  I $G(SCH)="ONCE" D  ;reset to day for message
  1.  . S X=$$UP^XLFSTR($$DOW^XLFDT(START))
  1.  . S SCH=$S(X="THURSDAY":"R",X="SUNDAY":"X",1:$E(X))
  1.  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)
  1.  S QT=U_DAYS_"^^"_$$HL7DATE(START)_U_$$HL7DATE(STOP),$P(ORMSG(4),"|",8)=QT
  1.  S OI=$$PTR("OR GTX ORDERABLE ITEM")
  1.  S MEAL=$G(ORDIALOG($$PTR("OR GTX MEAL"),1)),MEAL=$TR(MEAL,"BNE","135")
  1.  S TEXT=$G(ORDIALOG($$PTR("OR GTX FREE TEXT 1"),1))
  1.  I $$NPO(OI) S ORMSG(5)="ODS|"_TYPE_"|"_MEAL_"|^^^FH-5^NPO^99OTH|"_TEXT Q
  1.  S I=$$PTR("OR GTX DELIVERY"),DELVRY=$S($D(ORDIALOG(I,1)):$$EXT^ORCD(I,1),1:"")
  1.  S ORMSG(5)="ODS|"_TYPE_"|"_MEAL_"|"_$$USID^ORMBLD(ORDIALOG(OI,1))_"|"_DELVRY
  1.  Q
  1.  ;
  1. ADDN ; -- new Additional Diet order
  1.  N TEXT D DATES
  1.  S TEXT=$G(ORDIALOG($$PTR("OR GTX FREE TEXT 1"),1))
  1.  S ORMSG(5)="ODS|D||^^^FH-6^ADDITIONAL ORDER^99OTH|"_TEXT
  1.  Q
  1.  ;
  1. DATES ; -- get Start date for order IFN, QT field in msg
  1.  N X,INPT S INPT=$S($P($G(^OR(100,+IFN,0)),U,12)="I":1,1:0)
  1.  S X=$S(INPT:+$E($$NOW^XLFDT,1,12),1:+$G(ORDIALOG($$PTR("OR GTX DATE/TIME"),1)))
  1.  D DATES^ORCSAVE2(+IFN,X) ;Stop date for outpts?
  1.  S $P(ORMSG(4),"|",8)="^^^"_$$HL7DATE(X)
  1.  Q
  1.  ;
  1. TF ; -- new Tubefeeding order
  1.  N OI,STR,QT,TEXT,I,J,TF,X,QUAN,INT,DUR
  1.  S OI=$$PTR("OR GTX ORDERABLE ITEM"),STR=$$PTR("OR GTX STRENGTH FH")
  1.  S QT=$$PTR("OR GTX INSTRUCTIONS") D DATES
  1.  S TEXT=$G(ORDIALOG($$PTR("OR GTX FREE TEXT 1"),1))
  1.  S J=4,I=0 F  S I=$O(ORDIALOG(OI,I)) Q:I'>0  D
  1.  . S TF=$$USID^ORMBLD(ORDIALOG(OI,I)),$P(TF,U,4)=$P(TF,U,4)_"-"_$G(ORDIALOG(STR,I))
  1.  . S J=J+1,ORMSG(J)="ODS|ZE||"_TF_"|"_TEXT
  1.  . S X=$G(ORDIALOG(QT,I)),QUAN=+X_"&"_$E($P(X," ",2))
  1.  . S INT=$P($P(X,"/",2)," "),DUR=$P(X," X ",2)
  1.  . S:DUR DUR=$S(DUR["H":"H",1:"X")_+DUR
  1.  . S J=J+1,ORMSG(J)="ZQT||"_QUAN_U_INT_U_DUR
  1.  Q
  1.  ;
  1. TRAY ; -- new Early/Late Tray order
  1.  N START,STOP,ORL,MEAL,TYPE,OI,X,TIME,SCH,I,DAYS,BAGGED,ORPARAM,ORTIME
  1.  S START=$P($G(^OR(100,IFN,0)),U,8),STOP=$P(^(0),U,9),ORL=$P(^(0),U,10)
  1.  D EN1^FHWOR8(ORL,.ORPARAM),EN2^ORCDFH
  1.  S MEAL=$G(ORDIALOG($$PTR("OR GTX MEAL"),1))
  1.  S OI=$G(ORDIALOG($$PTR("OR GTX ORDERABLE ITEM"),1)),TYPE=$P($P($G(^ORD(101.43,+OI,0)),U)," ")
  1.  S TIME=$G(ORDIALOG($$PTR("OR GTX MEAL TIME"),1)),TIME=+$G(ORTIME(OI,MEAL,"C",TIME))
  1.  S:$G(ORDIALOG($$PTR("OR GTX YES/NO"),1)) BAGGED="bagged"
  1.  S SCH=$G(ORDIALOG($$PTR("OR GTX SCHEDULE"),1)),DAYS="ONCE"
  1.  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)
  1.  S $P(ORMSG(4),"|",8)=U_DAYS_"^^"_$$HL7DATE(START)_U_$$HL7DATE(STOP)
  1.  S ORMSG(5)="ODT|"_$$UP^XLFSTR(TYPE)_"|^^^"_MEAL_$E(TYPE)_TIME_"^^99FHS"_"|"_$G(BAGGED)
  1.  Q
  1.  ;
  1. IP ; -- new Isolation/Precaution order
  1.  N NOW,IP S NOW=+$E($$NOW^XLFDT,1,12) D DATES^ORCSAVE2(+IFN,NOW)
  1.  S $P(ORMSG(4),"|",8)="^^^"_$$HL7DATE(NOW)
  1.  S IP=+$G(ORDIALOG($$PTR("OR GTX ISOLATION TYPE"),1))
  1.  S ORMSG(5)="OBR||||||||||||^^^"_IP_U_$P($G(^FH(119.4,IP,0)),U)_"^99FHI"
  1.  Q
  1.  ;
  1. CANCEL(TIME,DFN,LOC,PROV) ; -- Cancel outpatient meal time(s) where
  1.  ;    TIME(n) = date.time
  1.  N ORMSG,ORNOW,I,J S ORNOW=$$FMTHL7^XLFDT($$NOW^XLFDT)
  1.  S ORMSG(1)=$$MSH^ORMBLD("ORM","FH")
  1.  S ORMSG(2)=$$PID^ORMBLD(+$G(DFN))
  1.  S ORMSG(3)=$$PV1^ORMBLD(+$G(DFN),"O",$G(LOC)),J=3
  1.  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
  1.  D MSG^XQOR("OR EVSEND FH",.ORMSG)
  1.  Q