source: WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORMFH1.m@ 771

Last change on this file since 771 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.2 KB
RevLine 
[613]1ORMFH1 ;SLC/MKB - Process OP Meal ORM msgs ;5/5/05 13:18
2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**215**;Dec 17, 1997
3 ;
4XX ; -- Change order (diet mod or location only)
5 N ODS,ORDIALOG,ORDG,ORIT,ORDA,ORX,STS,ORP,ORI,ORTRAIL,ORSIG,X
6 I $G(ORCAT)="I" S ORERR="Only outpatient meals can be changed" Q
7 I '$D(^VA(200,+ORDUZ,0)) S ORERR="Missing or invalid entering person" Q
8 ;I '$G(ORL) S ORERR="Missing or invalid patient location" Q
9 S ODS=$O(@ORMSG@(+ORC)) I 'ODS S ORERR="Incomplete message" Q
10 S ODS=ODS_U_@ORMSG@(ODS),ORIFN=+ORIFN S:'$L(ORNATR) ORNATR="S"
11 S X=$P(ODS,"|",4) D ;get OI
12 . I X?1"^^^FH-5".E S X=+$O(^ORD(101.43,"S.DIET","NPO",0)) Q
13 . I X?1"^^^FH-X".E S X=+$O(^ORD(101.43,"S.DIET","NO MEAL",0)) Q
14 . S X=$$ORDITEM^ORM(X)
15 I 'X S ORERR="Missing or invalid diet modification" Q
16 S ORSTRT=+ORSTRT I ORSTRT<1 S ORERR="Missing or invalid meal date" Q
17 ; - Setup dialog and current responses:
18 S ORDIALOG=+$O(^ORD(101.41,"AB","FHW OP MEAL",0)),ORTRAIL="Meal"
19 D GETDLG1^ORCD(ORDIALOG),GETORDER^ORCD(ORIFN)
20 S ORP=$$PTR("MEAL DATE"),ORI=$$PTR("ADDL DIETS")
21 S ORIT=$G(ORDIALOG($$PTR("ORDERABLE ITEM"),1)) ;orig diet
22 I '$G(ORDIALOG(ORI,ORSTRT)) Q:X=ORIT ;no diet change
23 E Q:X=$G(ORDIALOG(ORI,ORSTRT)) I X=ORIT K ORDIALOG(ORI,ORSTRT),ORDIALOG(ORP,ORSTRT) G XX1 ;back to orig diet
24 S ORDIALOG(ORI,ORSTRT)=X,ORDIALOG(ORP,ORSTRT)=ORSTRT
25XX1 ; - Create action to track change
26 S ORDA=$$ACTION^ORCSAVE("XX",ORIFN,ORNP,OREASON,ORLOG,ORDUZ)
27 I ORDA'>0 S ORERR="Cannot create new order action" Q
28 ; - Update sts of order to active, last action to dc/edit:
29 K ORX S ORX=+$P($G(^OR(100,ORIFN,3)),U,7)
30 S:$P($G(^OR(100,ORIFN,8,ORX,0)),U,15)="" $P(^(0),U,15)=12
31 S $P(^OR(100,ORIFN,3),U,7)=ORDA,STS=$P(^(3),U,3)
32 D STATUS^ORCSAVE2(ORIFN,6):STS'=6,SETALL^ORDD100(ORIFN):STS=6
33 D RELEASE^ORCSAVE2(ORIFN,ORDA,ORLOG,ORDUZ,ORNATR)
34 ; - If unsigned edit, leave XX unsigned & mark ORX as Sig Not Req'd:
35 S ORSIG=$S($P($G(^OR(100,ORIFN,8,ORX,0)),U,4)'=2:1,1:0)
36 D SIGSTS^ORCSAVE2(ORIFN,ORDA):ORSIG,SIGN^ORCSAVE2(ORIFN,,,5,ORX):'ORSIG
37 ; - Update responses, get/save new order text:
38 K ^OR(100,ORIFN,4.5) D RESPONSE^ORCSAVE,ORDTEXT^ORCSAVE1(ORIFN_";"_ORDA)
39 S $P(^OR(100,ORIFN,8,ORDA,0),U,14)=ORDA
40XXQ I $G(ORL) K ORP S ORP(1)=+ORIFN_";"_ORDA_"^1" D PRINTS^ORWD1(.ORP,+ORL)
41 Q
42 ;
43OPM ; -- parse Outpatient Meal dialog
44 N X,TYPE,NPO
45 S TYPE=$P(ODS,"|",2),X=$S(TYPE="S":"SPECIAL",1:"OP")
46 S ORDIALOG=+$O(^ORD(101.41,"AB","FHW "_X_" MEAL",0)),ORTRAIL="Meal"
47 D GETDLG1^ORCD(ORDIALOG) S X=$P(ODS,"|",4)
48 I X?1"^^^FH-5".E S X=+$O(^ORD(101.43,"S.DIET","NPO",0)),NPO=1
49 E S X=$$ORDITEM^ORM(X)
50 I 'X S ORERR="Missing or invalid diet modification" Q
51 S ORDIALOG($$PTR("ORDERABLE ITEM"),1)=X I TYPE="D" D
52 . N DAYS,SCH,I S DAYS="",SCH=$P(ORQT,U,2)
53 . I $L(SCH),SCH'="ONCE" F I=1:1:$L(SCH,"~") S X=+$P($P(SCH,"~",I),"J",2),DAYS=DAYS_$E("MTWRFSX",X)
54 . S:$L(DAYS) ORDIALOG($$PTR("SCHEDULE"),1)=DAYS
55 S X=$P(ODS,"|",3) S:X ORDIALOG($$PTR("MEAL"),1)=$TR(X,"135","BNE")
56 S ORDIALOG($$PTR("START DATE"),1)=ORSTRT
57 S:ORSTOP ORDIALOG($$PTR("STOP DATE"),1)=ORSTOP
58 S X=$P(ODS,"|",5) I $G(NPO) S:$L(X) ORDIALOG($$PTR("FREE TEXT 1"),1)=X
59 E S ORDIALOG($$PTR("DELIVERY"),1)=$E(X)
60 Q
61 ;
62PTR(NAME) ; -- Returns ien of prompt NAME in Order Dialog file #101.41
63 Q +$O(^ORD(101.41,"AB",$E("OR GTX "_NAME,1,63),0))
Note: See TracBrowser for help on using the repository browser.