ORMFH1 ;SLC/MKB - Process OP Meal ORM msgs ;5/5/05 13:18
;;3.0;ORDER ENTRY/RESULTS REPORTING;**215**;Dec 17, 1997
;
XX ; -- Change order (diet mod or location only)
N ODS,ORDIALOG,ORDG,ORIT,ORDA,ORX,STS,ORP,ORI,ORTRAIL,ORSIG,X
I $G(ORCAT)="I" S ORERR="Only outpatient meals can be changed" Q
I '$D(^VA(200,+ORDUZ,0)) S ORERR="Missing or invalid entering person" Q
;I '$G(ORL) S ORERR="Missing or invalid patient location" Q
S ODS=$O(@ORMSG@(+ORC)) I 'ODS S ORERR="Incomplete message" Q
S ODS=ODS_U_@ORMSG@(ODS),ORIFN=+ORIFN S:'$L(ORNATR) ORNATR="S"
S X=$P(ODS,"|",4) D ;get OI
. I X?1"^^^FH-5".E S X=+$O(^ORD(101.43,"S.DIET","NPO",0)) Q
. I X?1"^^^FH-X".E S X=+$O(^ORD(101.43,"S.DIET","NO MEAL",0)) Q
. S X=$$ORDITEM^ORM(X)
I 'X S ORERR="Missing or invalid diet modification" Q
S ORSTRT=+ORSTRT I ORSTRT<1 S ORERR="Missing or invalid meal date" Q
; - Setup dialog and current responses:
S ORDIALOG=+$O(^ORD(101.41,"AB","FHW OP MEAL",0)),ORTRAIL="Meal"
D GETDLG1^ORCD(ORDIALOG),GETORDER^ORCD(ORIFN)
S ORP=$$PTR("MEAL DATE"),ORI=$$PTR("ADDL DIETS")
S ORIT=$G(ORDIALOG($$PTR("ORDERABLE ITEM"),1)) ;orig diet
I '$G(ORDIALOG(ORI,ORSTRT)) Q:X=ORIT ;no diet change
E Q:X=$G(ORDIALOG(ORI,ORSTRT)) I X=ORIT K ORDIALOG(ORI,ORSTRT),ORDIALOG(ORP,ORSTRT) G XX1 ;back to orig diet
S ORDIALOG(ORI,ORSTRT)=X,ORDIALOG(ORP,ORSTRT)=ORSTRT
XX1 ; - Create action to track change
S ORDA=$$ACTION^ORCSAVE("XX",ORIFN,ORNP,OREASON,ORLOG,ORDUZ)
I ORDA'>0 S ORERR="Cannot create new order action" Q
; - Update sts of order to active, last action to dc/edit:
K ORX S ORX=+$P($G(^OR(100,ORIFN,3)),U,7)
S:$P($G(^OR(100,ORIFN,8,ORX,0)),U,15)="" $P(^(0),U,15)=12
S $P(^OR(100,ORIFN,3),U,7)=ORDA,STS=$P(^(3),U,3)
D STATUS^ORCSAVE2(ORIFN,6):STS'=6,SETALL^ORDD100(ORIFN):STS=6
D RELEASE^ORCSAVE2(ORIFN,ORDA,ORLOG,ORDUZ,ORNATR)
; - If unsigned edit, leave XX unsigned & mark ORX as Sig Not Req'd:
S ORSIG=$S($P($G(^OR(100,ORIFN,8,ORX,0)),U,4)'=2:1,1:0)
D SIGSTS^ORCSAVE2(ORIFN,ORDA):ORSIG,SIGN^ORCSAVE2(ORIFN,,,5,ORX):'ORSIG
; - Update responses, get/save new order text:
K ^OR(100,ORIFN,4.5) D RESPONSE^ORCSAVE,ORDTEXT^ORCSAVE1(ORIFN_";"_ORDA)
S $P(^OR(100,ORIFN,8,ORDA,0),U,14)=ORDA
XXQ I $G(ORL) K ORP S ORP(1)=+ORIFN_";"_ORDA_"^1" D PRINTS^ORWD1(.ORP,+ORL)
Q
;
OPM ; -- parse Outpatient Meal dialog
N X,TYPE,NPO
S TYPE=$P(ODS,"|",2),X=$S(TYPE="S":"SPECIAL",1:"OP")
S ORDIALOG=+$O(^ORD(101.41,"AB","FHW "_X_" MEAL",0)),ORTRAIL="Meal"
D GETDLG1^ORCD(ORDIALOG) S X=$P(ODS,"|",4)
I X?1"^^^FH-5".E S X=+$O(^ORD(101.43,"S.DIET","NPO",0)),NPO=1
E S X=$$ORDITEM^ORM(X)
I 'X S ORERR="Missing or invalid diet modification" Q
S ORDIALOG($$PTR("ORDERABLE ITEM"),1)=X I TYPE="D" D
. N DAYS,SCH,I 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 X=$P(ODS,"|",3) S:X ORDIALOG($$PTR("MEAL"),1)=$TR(X,"135","BNE")
S ORDIALOG($$PTR("START DATE"),1)=ORSTRT
S:ORSTOP ORDIALOG($$PTR("STOP DATE"),1)=ORSTOP
S X=$P(ODS,"|",5) I $G(NPO) S:$L(X) ORDIALOG($$PTR("FREE TEXT 1"),1)=X
E S ORDIALOG($$PTR("DELIVERY"),1)=$E(X)
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[HORMFH1 3344 printed Sep 23, 2025@20:08:16 Page 2
ORMFH1 ;SLC/MKB - Process OP Meal ORM msgs ;5/5/05 13:18
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215**;Dec 17, 1997
+2 ;
XX ; -- Change order (diet mod or location only)
+1 NEW ODS,ORDIALOG,ORDG,ORIT,ORDA,ORX,STS,ORP,ORI,ORTRAIL,ORSIG,X
+2 IF $GET(ORCAT)="I"
SET ORERR="Only outpatient meals can be changed"
QUIT
+3 IF '$DATA(^VA(200,+ORDUZ,0))
SET ORERR="Missing or invalid entering person"
QUIT
+4 ;I '$G(ORL) S ORERR="Missing or invalid patient location" Q
+5 SET ODS=$ORDER(@ORMSG@(+ORC))
IF 'ODS
SET ORERR="Incomplete message"
QUIT
+6 SET ODS=ODS_U_@ORMSG@(ODS)
SET ORIFN=+ORIFN
if '$LENGTH(ORNATR)
SET ORNATR="S"
+7 ;get OI
SET X=$PIECE(ODS,"|",4)
Begin DoDot:1
+8 IF X?1"^^^FH-5".E
SET X=+$ORDER(^ORD(101.43,"S.DIET","NPO",0))
QUIT
+9 IF X?1"^^^FH-X".E
SET X=+$ORDER(^ORD(101.43,"S.DIET","NO MEAL",0))
QUIT
+10 SET X=$$ORDITEM^ORM(X)
End DoDot:1
+11 IF 'X
SET ORERR="Missing or invalid diet modification"
QUIT
+12 SET ORSTRT=+ORSTRT
IF ORSTRT<1
SET ORERR="Missing or invalid meal date"
QUIT
+13 ; - Setup dialog and current responses:
+14 SET ORDIALOG=+$ORDER(^ORD(101.41,"AB","FHW OP MEAL",0))
SET ORTRAIL="Meal"
+15 DO GETDLG1^ORCD(ORDIALOG)
DO GETORDER^ORCD(ORIFN)
+16 SET ORP=$$PTR("MEAL DATE")
SET ORI=$$PTR("ADDL DIETS")
+17 ;orig diet
SET ORIT=$GET(ORDIALOG($$PTR("ORDERABLE ITEM"),1))
+18 ;no diet change
IF '$GET(ORDIALOG(ORI,ORSTRT))
if X=ORIT
QUIT
+19 ;back to orig diet
IF '$TEST
if X=$GET(ORDIALOG(ORI,ORSTRT))
QUIT
IF X=ORIT
KILL ORDIALOG(ORI,ORSTRT),ORDIALOG(ORP,ORSTRT)
GOTO XX1
+20 SET ORDIALOG(ORI,ORSTRT)=X
SET ORDIALOG(ORP,ORSTRT)=ORSTRT
XX1 ; - Create action to track change
+1 SET ORDA=$$ACTION^ORCSAVE("XX",ORIFN,ORNP,OREASON,ORLOG,ORDUZ)
+2 IF ORDA'>0
SET ORERR="Cannot create new order action"
QUIT
+3 ; - Update sts of order to active, last action to dc/edit:
+4 KILL ORX
SET ORX=+$PIECE($GET(^OR(100,ORIFN,3)),U,7)
+5 if $PIECE($GET(^OR(100,ORIFN,8,ORX,0)),U,15)=""
SET $PIECE(^(0),U,15)=12
+6 SET $PIECE(^OR(100,ORIFN,3),U,7)=ORDA
SET STS=$PIECE(^(3),U,3)
+7 if STS'=6
DO STATUS^ORCSAVE2(ORIFN,6)
if STS=6
DO SETALL^ORDD100(ORIFN)
+8 DO RELEASE^ORCSAVE2(ORIFN,ORDA,ORLOG,ORDUZ,ORNATR)
+9 ; - If unsigned edit, leave XX unsigned & mark ORX as Sig Not Req'd:
+10 SET ORSIG=$SELECT($PIECE($GET(^OR(100,ORIFN,8,ORX,0)),U,4)'=2:1,1:0)
+11 if ORSIG
DO SIGSTS^ORCSAVE2(ORIFN,ORDA)
if 'ORSIG
DO SIGN^ORCSAVE2(ORIFN,,,5,ORX)
+12 ; - Update responses, get/save new order text:
+13 KILL ^OR(100,ORIFN,4.5)
DO RESPONSE^ORCSAVE
DO ORDTEXT^ORCSAVE1(ORIFN_";"_ORDA)
+14 SET $PIECE(^OR(100,ORIFN,8,ORDA,0),U,14)=ORDA
XXQ IF $GET(ORL)
KILL ORP
SET ORP(1)=+ORIFN_";"_ORDA_"^1"
DO PRINTS^ORWD1(.ORP,+ORL)
+1 QUIT
+2 ;
OPM ; -- parse Outpatient Meal dialog
+1 NEW X,TYPE,NPO
+2 SET TYPE=$PIECE(ODS,"|",2)
SET X=$SELECT(TYPE="S":"SPECIAL",1:"OP")
+3 SET ORDIALOG=+$ORDER(^ORD(101.41,"AB","FHW "_X_" MEAL",0))
SET ORTRAIL="Meal"
+4 DO GETDLG1^ORCD(ORDIALOG)
SET X=$PIECE(ODS,"|",4)
+5 IF X?1"^^^FH-5".E
SET X=+$ORDER(^ORD(101.43,"S.DIET","NPO",0))
SET NPO=1
+6 IF '$TEST
SET X=$$ORDITEM^ORM(X)
+7 IF 'X
SET ORERR="Missing or invalid diet modification"
QUIT
+8 SET ORDIALOG($$PTR("ORDERABLE ITEM"),1)=X
IF TYPE="D"
Begin DoDot:1
+9 NEW DAYS,SCH,I
SET DAYS=""
SET SCH=$PIECE(ORQT,U,2)
+10 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)
+11 if $LENGTH(DAYS)
SET ORDIALOG($$PTR("SCHEDULE"),1)=DAYS
End DoDot:1
+12 SET X=$PIECE(ODS,"|",3)
if X
SET ORDIALOG($$PTR("MEAL"),1)=$TRANSLATE(X,"135","BNE")
+13 SET ORDIALOG($$PTR("START DATE"),1)=ORSTRT
+14 if ORSTOP
SET ORDIALOG($$PTR("STOP DATE"),1)=ORSTOP
+15 SET X=$PIECE(ODS,"|",5)
IF $GET(NPO)
if $LENGTH(X)
SET ORDIALOG($$PTR("FREE TEXT 1"),1)=X
+16 IF '$TEST
SET ORDIALOG($$PTR("DELIVERY"),1)=$EXTRACT(X)
+17 QUIT
+18 ;
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))
