- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/ORDER_ENTRY_RESULTS_REPORTING-OR-OCX--ORRC--ORRJ/ORMFH.m
r613 r623 1 ORMFH 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**3,73,92,215,243**;Dec 17, 1997;Build 242 3 4 EN 5 6 7 8 9 10 11 12 ZP 13 14 15 16 17 ZR 18 19 20 21 ZU 22 23 24 25 OK 26 27 28 29 30 31 32 XX 33 34 35 SN 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 DIET 53 54 55 56 57 58 59 60 61 62 63 64 65 66 SN1 67 68 69 70 71 72 73 74 75 76 TRAY 77 78 79 80 81 82 83 84 85 86 87 88 89 90 IP 91 92 93 94 95 96 97 98 TF 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 UNITS(X) 119 120 121 122 123 NPO 124 125 126 127 128 129 130 131 ADDL 132 133 134 135 136 137 DATES 138 139 140 141 142 143 SC 144 SR 145 146 147 148 149 150 151 152 153 154 155 156 157 158 OC 159 160 161 162 163 164 165 CR 166 167 168 169 OD 170 171 172 173 174 DR 175 176 177 178 UA 179 180 181 182 UC 183 UD 184 185 186 187 188 189 UPDATE(ORSTS,ORACT) 190 191 192 193 194 195 196 197 198 199 IORACT="DC",'$$ACTV^ORX1(ORNATR) S $P(^OR(100,+ORIFN,3),U,7)=0200 201 202 203 PTR(NAME) 204 1 ORMFH ;SLC/MKB - Process Dietetics ORM msgs ;5/5/05 13:18 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**3,73,92,215**;Dec 17, 1997 3 ; 4 EN ; -- entry point for FH messages 5 I '$L($T(@ORDCNTRL)) Q ;S ORERR="Invalid order control code" Q 6 I ORDCNTRL'="SN",ORDCNTRL'="ZP",'ORIFN!('$D(^OR(100,+ORIFN,0))) S ORERR="Invalid OE/RR order number" Q 7 S ORLOG=+$E($$NOW^XLFDT,1,12) S:'$G(ORDUZ) ORDUZ=DUZ S:'$G(ORNP) ORNP=ORDUZ 8 S:$G(DGPMT) ORNATR="A",OREASON=$S(DGPMT=1:"Admission",DGPMT=3:"Discharge",1:"Transfer"),ORDUZ="" 9 D @ORDCNTRL 10 Q 11 ; 12 ZP ; -- Purged 13 Q:'ORIFN Q:'$D(^OR(100,+ORIFN,0)) 14 K ^OR(100,+ORIFN,4) I "^6^8^"[(U_$P($G(^(3)),U,3)_U) D STATUS^ORCSAVE2(+ORIFN,14) ; Remove pkg reference, sts=lapsed if still active 15 Q 16 ; 17 ZR ; -- Purged as requested [ack] 18 D DELETE^ORCSAVE2(+ORIFN) 19 Q 20 ; 21 ZU ; -- Unable to purge [ack] 22 S $P(^OR(100,+ORIFN,3),U)=$$NOW^XLFDT ; update Last Activity 23 Q 24 ; 25 OK ; -- Order accepted, FH order # assigned [ack] 26 N ORSTS S ^OR(100,+ORIFN,4)=PKGIFN ; FH identifier 27 I "DN"'[$E(PKGIFN) S ORSTS=6 ;not Diet or NPO 28 E S ORSTS=$S($P($G(^OR(100,+ORIFN,0)),U,8)>ORLOG:8,1:6) 29 D STATUS^ORCSAVE2(+ORIFN,ORSTS) 30 Q 31 ; 32 XX ; -- Edited backdoor order (OP recurring meals only) 33 D XX^ORMFH1 Q 34 ; 35 SN ; -- New backdoor order: return NA msg w/ORIFN 36 N ODS,ODT,OBR,ORDIALOG,X,I,OI,SEG,ORNEW,ORPARAM,ORTIME,ORSTS,ORDG,ORP,ORTRAIL 37 ;I '$D(^VA(200,+ORNP,0)) S ORERR="Missing or invalid ordering provider"Q 38 ; Don't require provider until Nature of Order is added 39 I '$G(DGPMT),'$D(^VA(200,+ORDUZ,0)) S ORERR="Missing or invalid entering person" Q 40 I 'ORSTRT S ORERR="Missing effective date/time" Q 41 ;I '$G(ORL) S ORERR="Missing or invalid patient location" Q 42 D EN1^FHWOR8(ORL,.ORPARAM) 43 S ODS=$O(@ORMSG@(+ORC)) I 'ODS S ORERR="Incomplete message" Q 44 S ODS=ODS_U_@ORMSG@(ODS),ORSTS=6 I '$L(ORNATR),ORCAT="I" S ORNATR="S" 45 I $E($P(ODS,U,2),1,3)="OBR" S OBR=ODS D IP G SN1 46 I $E($P(ODS,U,2),1,3)="ODT" S ODT=ODS D TRAY G SN1 47 I $E($P(ODS,U,2),1,3)'="ODS" S ORERR="Missing or invalid ODS segment" Q 48 I $P(ODS,"|",2)="ZE" D TF G SN1 49 I $P(ODS,"|",4)?1"^^^FH-6".E D ADDL G SN1 50 I ORCAT'="I" D OPM^ORMFH1 G SN1 51 I $P(ODS,"|",4)?1"^^^FH-5".E D NPO G SN1 52 DIET ; Diet order 53 S ORDIALOG=$O(^ORD(101.41,"AB","FHW1",0)),ORTRAIL="Diet" 54 D GETDLG1^ORCD(ORDIALOG) S:ORSTRT>ORLOG ORSTS=8 55 S ORDIALOG($$PTR("START DATE/TIME"),1)=ORSTRT 56 S:ORSTOP ORDIALOG($$PTR("STOP DATE/TIME"),1)=ORSTOP 57 S X=$P(ODS,"|",2),ORDIALOG($$PTR("DELIVERY"),1)=$S($L(X)=1:X,1:$E(X,2)) 58 ; Comments ?? 59 S X=$$ORDITEM^ORM($P(ODS,"|",4)) 60 I 'X S ORERR="Missing or invalid diet modification" Q 61 S I=1,OI=$$PTR("ORDERABLE ITEM"),ORDIALOG(OI,I)=X 62 I $O(@ORMSG@(+ODS)) F S ODS=$O(@ORMSG@(+ODS)) Q:ODS'>0 S SEG=$E(@ORMSG@(+ODS),1,3) Q:SEG="ORC" Q:SEG="MSH" I SEG="ODS" D Q:$D(ORERR) 63 . S X=$$ORDITEM^ORM($P(@ORMSG@(+ODS),"|",4)) 64 . I 'X S ORERR="Missing or invalid diet modification" Q 65 . S I=I+1,ORDIALOG(OI,I)=X 66 SN1 ; continue ... save order, post message 67 Q:$D(ORERR) 68 D EN^ORCSAVE I '$G(ORIFN) S ORERR="Cannot create new order" Q 69 D RELEASE^ORCSAVE2(ORIFN,1,ORLOG,ORDUZ,ORNATR),SIGSTS^ORCSAVE2(ORIFN,1) 70 D:'$P($G(^OR(100,ORIFN,0)),U,8) DATES^ORCSAVE2(ORIFN,ORSTRT,ORSTOP) 71 D STATUS^ORCSAVE2(ORIFN,ORSTS) 72 I $G(ORL) S ORP(1)=ORIFN_";1^1" D PRINTS^ORWD1(.ORP,+ORL) ; chart copy 73 S ^OR(100,ORIFN,4)=PKGIFN 74 Q 75 ; 76 TRAY ; Early/Late tray 77 I 'ORSTOP S ORERR="Missing stop date" Q 78 S ORDIALOG=$O(^ORD(101.41,"AB","FHW2",0)) D GETDLG1^ORCD(ORDIALOG),EN2^ORCDFH 79 S ORDIALOG($$PTR("START DATE"),1)=ORSTRT 80 S ORDIALOG($$PTR("STOP DATE"),1)=ORSTOP 81 N DAYS,SCH S DAYS="",SCH=$P(ORQT,U,2) 82 I $L(SCH),SCH'="ONCE" F I=1:1:$L(SCH,"~") S X=+$P($P(SCH,"~",I),"J",2),DAYS=DAYS_$E("MTWRFSX",X) 83 S:$L(DAYS) ORDIALOG($$PTR("SCHEDULE"),1)=DAYS 84 S OI=+$O(^ORD(101.43,"S.E/L T",$P(ODT,"|",2)_" TRAY",0)),ORDIALOG($$PTR("ORDERABLE ITEM"),1)=OI 85 S X=$P($P(ODT,"|",3),U,4),ORDIALOG($$PTR("MEAL"),1)=$E(X) 86 S ORDIALOG($$PTR("MEAL TIME"),1)=$P($G(ORTIME(OI,$E(X),+$E(X,3))),U,2) 87 S:$L($P(ODT,"|",4)) ORDIALOG($$PTR("YES/NO"),1)=1 88 Q 89 ; 90 IP ; Isolation/Precautions 91 N IP S IP=+$P($P(OBR,"|",13),U,4) 92 I IP'>0 S ORERR="Missing or invalid isolation type" Q 93 S ORDIALOG=$O(^ORD(101.41,"AB","FHW3",0)) D GETDLG1^ORCD(ORDIALOG) 94 S ORDIALOG($$PTR("ISOLATION TYPE"),1)=IP 95 S ORDIALOG($$PTR("ORDERABLE ITEM"),1)=$O(^ORD(101.43,"S.PREC","ISOLATION PROCEDURES",0)) 96 Q 97 ; 98 TF ; Tubefeeding 99 N OI,STR,INSTR,CMMT,I,X,X4,XI,ZQT,QT,QTY,DUR 100 S ORDIALOG=$O(^ORD(101.41,"AB","FHW8",0)) D GETDLG1^ORCD(ORDIALOG) 101 S OI=$$PTR("ORDERABLE ITEM"),STR=$$PTR("STRENGTH FH") 102 S INSTR=$$PTR("INSTRUCTIONS"),CMMT=$$PTR("FREE TEXT 1") 103 ; Comments ?? 104 S I=0 F D S ODS=$O(@ORMSG@(+ODS)) Q:ODS'>0 Q:$E(@ORMSG@(ODS),1,3)="ORC" S ODS=ODS_U_@ORMSG@(ODS) 105 . Q:$E($P(ODS,U,2),1,3)'="ODS" ; not ODS segment 106 . S X=$P(ODS,"|",4),X4=$P(X,U,4) ; OI 107 . S:X4["-" $P(X,U,4)=+X4,X4=+$P(X4,"-",2) ; strength 108 . S XI=$$ORDITEM^ORM(X) I 'XI S ORERR="Missing or invalid tubefeeding product" Q 109 . S ZQT=$O(@ORMSG@(+ODS)) I 'ZQT S ORERR="Missing QT information" Q 110 . S QT=$P(@ORMSG@(ZQT),"|",3),DUR=$P(QT,U,3) 111 . S QTY=+QT_" "_$$UNITS($P($P(QT,U),"&",2))_"/"_$P(QT,U,2) 112 . S:$L(DUR) QTY=QTY_" X "_+$E(DUR,2,99)_$S($E(DUR)="H":"HR",1:"") 113 . S I=I+1,ORDIALOG(OI,I)=XI,ORDIALOG(STR,I)=X4,ORDIALOG(INSTR,I)=QTY 114 . S:$L($P(ODS,"|",5)) ORDIALOG(CMMT,I)=$P(ODS,"|",5) 115 I ORCAT="O",ORQT["~" D DATES 116 Q 117 ; 118 UNITS(X) ; -- Returns name of unit X 119 N Y S X=$E(X) 120 S Y=$S(X="K":"KCAL",X="C":"CC",X="M":"ML",X="O":"OZ",X="U":"UNITS",X="T":"TBSP",X="G":"GM",1:"") 121 Q Y 122 ; 123 NPO ; NPO <uses FHW1 dialog - FHW4 now a quick order> 124 S ORDIALOG=$O(^ORD(101.41,"AB","FHW1",0)) D GETDLG1^ORCD(ORDIALOG) 125 S ORDIALOG($$PTR("ORDERABLE ITEM"),1)=$O(^ORD(101.43,"S.DIET","NPO",0)) 126 S ORDIALOG($$PTR("START DATE/TIME"),1)=ORSTRT S:ORSTRT>ORLOG ORSTS=8 127 S:ORSTOP ORDIALOG($$PTR("STOP DATE/TIME"),1)=ORSTOP 128 S:$L($P(ODS,"|",5)) ORDIALOG($$PTR("FREE TEXT 1"),1)=$P(ODS,"|",5) 129 Q 130 ; 131 ADDL ; Additional order 132 S ORDIALOG=$O(^ORD(101.41,"AB","FHW7",0)) D GETDLG1^ORCD(ORDIALOG) 133 S ORDIALOG($$PTR("FREE TEXT 1"),1)=$P(ODS,"|",5) 134 I ORCAT="O",ORQT["~" D DATES 135 Q 136 ; 137 DATES ; -- pull dates out of ORQT 138 N P,I,X S P=$$PTR("DATE/TIME") 139 F I=1:1:$L(ORQT,"~") S X=$P(ORQT,"~",I),ORDIALOG(P,I)=$$HL7TFM^XLFDT($P(X,U,4)) 140 S ORSTRT=$G(ORDIALOG(P,1)),ORSTOP=$G(ORDIALOG(P,I)) 141 Q 142 ; 143 SC ; -- Status Change 144 SR ; -- Status Update [ack] 145 N ORSTS,OROLD S OROLD=$P($G(^OR(100,+ORIFN,3)),U,3) 146 D DATES^ORCSAVE2(+ORIFN,ORSTRT,ORSTOP) 147 S ORSTS=$S(ORDSTS="DC":1,ORDSTS="IP":6,ORDSTS="ZE":7,ORDSTS="SC":8,1:"") 148 D:ORSTS STATUS^ORCSAVE2(+ORIFN,ORSTS) 149 I ORDSTS="DC",'$D(^OR(100,+ORIFN,6)) D ;set 6-node 150 . I ORNATR'="A","DN"[$E(PKGIFN) S ORNATR="C" S:'$L(OREASON) OREASON="Replaced with new diet order" S:ORDUZ<1 ORDUZ="" 151 . S ^OR(100,+ORIFN,6)=$S($L(ORNATR):+$O(^ORD(100.02,"C",ORNATR,0)),1:"")_U_ORDUZ_U_ORLOG_U_U_OREASON 152 I OROLD=1,ORSTS=6 D ; reactivate 153 . N X S $P(^OR(100,+ORIFN,3),U,7)=1,X=$P(^(0),U,9) K ^(6) 154 . I 'ORSTOP,X S $P(^OR(100,+ORIFN,0),U,9)="" K ^OR(100,"AE",X,+ORIFN) 155 . D SETALL^ORDD100(+ORIFN) 156 Q 157 ; 158 OC ; -- Cancelled <E/L Trays only> / [ack] 159 G:ORTYPE="ORR" UA ;rejected new order 160 I $P($G(^OR(100,+ORIFN,3)),U,3)=6,$P(^(0),U,8)<ORLOG G OD 161 S ^OR(100,+ORIFN,6)=$S($L(ORNATR):+$O(^ORD(100.02,"C",ORNATR,0)),1:"")_U_ORDUZ_U_ORLOG_U_U_OREASON 162 D UPDATE(13,"DC") 163 Q 164 ; 165 CR ; -- Cancelled as requested [ack] 166 D STATUS^ORCSAVE2(+ORIFN,13) 167 Q 168 ; 169 OD ; -- Discontinued <Tubefeedings only> 170 S ^OR(100,+ORIFN,6)=$S($L(ORNATR):+$O(^ORD(100.02,"C",ORNATR,0)),1:"")_U_ORDUZ_U_ORLOG_U_U_OREASON 171 D UPDATE(1,"DC") 172 Q 173 ; 174 DR ; -- Discontinued as requested [ack] 175 D STATUS^ORCSAVE2(+ORIFN,1) 176 Q 177 ; 178 UA ; -- Unable to Accept [ack] 179 S:'$L(ORNATR) ORNATR="X" ;Rejected 180 S ^OR(100,+ORIFN,6)=+$O(^ORD(100.02,"C",ORNATR,0))_U_U_ORLOG_U_U_OREASON 181 D STATUS^ORCSAVE2(+ORIFN,13) 182 UC ; -- Unable to Cancel [ack] 183 UD ; -- Unable to Discontinue [ack] 184 N DA S DA=$P(ORIFN,";",2) I DA D 185 . S:$G(OREJECT) $P(^OR(100,+ORIFN,8,DA,0),U,15)=13 ; request rejected 186 . S:$L(OREASON) ^OR(100,+ORIFN,8,DA,1)=OREASON 187 Q 188 ; 189 UPDATE(ORSTS,ORACT) ; -- continue processing 190 N ORX,DA,ORP D DATES^ORCSAVE2(+ORIFN,ORSTRT,ORSTOP) 191 D:$G(ORSTS) STATUS^ORCSAVE2(+ORIFN,ORSTS) 192 S ORX=$$CREATE^ORX1(ORNATR) D:ORX 193 . S DA=$$ACTION^ORCSAVE(ORACT,+ORIFN,ORNP,OREASON,ORLOG,ORDUZ) 194 . I DA'>0 S ORERR="Cannot create new order action" Q 195 . D RELEASE^ORCSAVE2(+ORIFN,DA,ORLOG,ORDUZ,ORNATR) 196 . D SIGSTS^ORCSAVE2(+ORIFN,DA) 197 . I $G(ORL) S ORP(1)=+ORIFN_";"_DA_"^1" D PRINTS^ORWD1(.ORP,+ORL) 198 . S $P(^OR(100,+ORIFN,3),U,7)=DA 199 I 'ORX,ORACT="DC",'$$ACTV^ORX1(ORNATR) S $P(^OR(100,+ORIFN,3),U,7)=0 200 D:ORACT="DC" CANCEL^ORCSEND(+ORIFN) 201 Q 202 ; 203 PTR(NAME) ; -- Returns ien of prompt NAME in Order Dialog file #101.41 204 Q $O(^ORD(101.41,"AB",$E("OR GTX "_NAME,1,63),0))
Note:
See TracChangeset
for help on using the changeset viewer.
