ORMFH1.m

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 ---ORMFH1   3344     printed  Mar 13, 2025@21:36:53                                                                                                                                                                                                      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))