- 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/ORMRA.m
r613 r623 1 ORMRA ; SLC/MKB/RV - Process Radiology ORM msgs ;2/21/02 15:44 [05/30/06 12:30pm] 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**3,53,92,110,136,153,174,195,243**;Dec 17, 1997;Build 242 3 ;DBIA 2968 allows for reading ^DIC(34 4 EN ; -- entry point for RA 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 OREASON=$S($P(OREASON,U,6)="99RAR":$P(OREASON,U,5),1:$P(OREASON,U,2)) 8 S:'ORDUZ ORDUZ=DUZ S:'ORLOG ORLOG=+$E($$NOW^XLFDT,1,12) 9 D @ORDCNTRL 10 Q 11 ; 12 ZP ; -- Purged 13 Q:'ORIFN Q:'$D(^OR(100,+ORIFN,0)) K ^OR(100,+ORIFN,4) 14 ; - Set status=lapsed, if still active 15 I "^3^5^6^8^"[(U_$P($G(^(3)),U,3)_U) D STATUS^ORCSAVE2(ORIFN,14) 16 Q 17 ; 18 ZR ; -- Purged as requested [ack] 19 D DELETE^ORCSAVE2(+ORIFN) 20 Q 21 ; 22 ZU ; -- Unable to purge [ack] 23 S $P(^OR(100,+ORIFN,3),U)=$$NOW^XLFDT ; update Last Activity 24 Q 25 ; 26 OK ; -- Order accepted, RA order # assigned [ack] 27 N ORSTS,OBR S ^OR(100,+ORIFN,4)=PKGIFN,ORSTS=5 ; 5=pending 28 ; Ck if also scheduled, else quit 29 S OBR=$O(@ORMSG@(+ORC)) G:'OBR OKQ G:$E(@ORMSG@(OBR),1,3)'="OBR" OKQ 30 S ORSTRT=$$FMDATE^ORM($P(@ORMSG@(OBR),"|",37)) 31 D:ORSTRT DATES^ORCSAVE2(+ORIFN,ORSTRT) 32 OKQ D STATUS^ORCSAVE2(ORIFN,ORSTS) 33 ;Save the Radiology pre-certification Account Reference in the PV1 34 ;segment of the HL7 message from the Radiology package to the Order 35 ;File (#100). Support for Patch OR*3.0*228 36 I +$$SWSTAT^IBBAPI() D PRECERT^ORWPFSS2 ;IA #4663 37 Q 38 ; 39 XX ; -- Change order 40 N ORDIALOG,ORDG,ORDA,ORX,ORP S:'$L(ORNATR) ORNATR="S" 41 D DLG Q:$D(ORERR) Q:'$D(ORDIALOG) S ORIFN=+ORIFN 42 S ORDA=$$ACTION^ORCSAVE("XX",ORIFN,ORNP,OREASON,ORLOG,ORDUZ) 43 I ORDA'>0 S ORERR="Cannot create new order action" Q 44 ; -Update sts of order to active, last action to dc/edit: 45 S ORX=+$P($G(^OR(100,ORIFN,3)),U,7) 46 S:$P($G(^OR(100,ORIFN,8,ORX,0)),U,15)="" $P(^(0),U,15)=12 47 S $P(^OR(100,ORIFN,3),U,7)=ORDA D STATUS^ORCSAVE2(ORIFN,6) 48 D RELEASE^ORCSAVE2(ORIFN,ORDA,ORLOG,ORDUZ,ORNATR) 49 ; -If unsigned edit, leave XX unsigned & mark ORX as Sig Not Req'd 50 S ORSIG=$S($P($G(^OR(100,ORIFN,8,ORX,0)),U,4)'=2:1,1:0) 51 D SIGSTS^ORCSAVE2(ORIFN,ORDA):ORSIG,SIGN^ORCSAVE2(ORIFN,,,5,ORX):'ORSIG 52 ; -Update responses, get/save new order text: 53 K ^OR(100,ORIFN,4.5) D RESPONSE^ORCSAVE,ORDTEXT^ORCSAVE1(ORIFN_";"_ORDA) 54 S $P(^OR(100,ORIFN,8,ORDA,0),U,14)=ORDA 55 I $G(ORL) S ORP(1)=+ORIFN_";"_ORDA_"^1" D PRINTS^ORWD1(.ORP,+ORL) 56 Q 57 ; 58 SN ; -- New backdoor order: return NA msg w/ORIFN, or DE msg 59 N ORDIALOG,ORDG,ORP K ^TMP("ORWORD",$J) S:'$L(ORNATR) ORNATR="W" 60 I ORDUZ,'$D(^VA(200,ORDUZ,0)) S ORERR="Invalid entering person" Q 61 I '$D(^VA(200,ORNP,0)) S ORERR="Missing or invalid ordering provider" Q 62 I '$G(ORL) S ORERR="Missing or invalid patient location" Q 63 D DLG Q:$D(ORERR) Q:'$D(ORDIALOG) 64 SNQ D EN^ORCSAVE K ^TMP("ORWORD",$J) 65 I '$G(ORIFN) S ORERR="Cannot create new order" Q 66 ;Save DG1 and ZCL segments of HL7 message from backdoor orders 67 D BDOSTR^ORWDBA3 68 ;Save the Radiology pre-certification Account Reference in the PV1 69 ;segment of the HL7 message from the Radiology package to the Order 70 ;File (#100). Support for Patch OR*3.0*228 71 I +$$SWSTAT^IBBAPI() D PRECERT^ORWPFSS2 ;IA #4663 72 D RELEASE^ORCSAVE2(ORIFN,1,ORLOG,ORDUZ,ORNATR),SIGSTS^ORCSAVE2(ORIFN,1) 73 D STATUS^ORCSAVE2(ORIFN,5) S ^OR(100,ORIFN,4)=PKGIFN 74 I $G(ORL) S ORP(1)=ORIFN_";1^1" D PRINTS^ORWD1(.ORP,+ORL) ; chart copy 75 Q 76 ; 77 DLG ; -- Build ORDIALOG() from msg 78 N OBR,OI,MODS,J,X,Y,ILOC,MODE,CH,CHI,OBX,NTE,REASON 79 S ORDIALOG=$O(^ORD(101.41,"AB","RA OERR EXAM",0)) 80 D GETDLG1^ORCD(ORDIALOG) 81 S ORDIALOG($$PTR("CATEGORY"),1)=$G(ORCAT) 82 S ORDIALOG($$PTR("START DATE/TIME"),1)=ORSTRT 83 S ORDIALOG($$PTR("URGENCY"),1)=ORURG 84 S:$P(ORC,"|",12) ORDIALOG($$PTR("PROVIDER"),1)=+$P(ORC,"|",12) 85 D1 S OBR=$O(@ORMSG@(+ORC)) I 'OBR!($E($G(@ORMSG@(OBR)),1,3)'="OBR") S ORERR="Missing OBR segment" Q 86 S OI=$$ORDITEM^ORM($P(@ORMSG@(OBR),"|",5)) 87 I 'OI S ORERR="Invalid procedure" Q 88 S ORDIALOG($$PTR("ORDERABLE ITEM"),1)=OI 89 S ORDG=$P($G(^ORD(101.43,+OI,"RA")),U,3) S:$L(ORDG) ORDG=+$O(^ORD(100.98,"B",ORDG,0)) I 'ORDG S ORDG=$P(^ORD(101.41,+ORDIALOG,0),U,5) ; Im Type 90 S MODS=$P(@ORMSG@(OBR),"|",19) I $L(MODS) D 91 . F J=1:1:$L(MODS,"~") S X=$P(MODS,"~",J) I $L(X) S Y=$O(^RAMIS(71.2,"B",X,0)) S:Y ORDIALOG($$PTR("MODIFIERS"),J)=Y 92 S ILOC=+$P(@ORMSG@(OBR),"|",20),MODE=$P(@ORMSG@(OBR),"|",31),REASON=$P($P(@ORMSG@(OBR),"|",32),U,2) 93 S:ILOC ORDIALOG($$PTR("IMAGING LOCATION"),1)=ILOC 94 S ORDIALOG($$PTR("MODE OF TRANSPORT"),1)=$S(MODE="WALK":"A",MODE="CART":"S",1:$E(MODE)) 95 S:$L(REASON) ORDIALOG($$PTR("STUDY REASON"),1)=REASON 96 I ORDCNTRL="XX" S NTE=+$O(@ORMSG@(OBR)) I NTE,$E($G(@ORMSG@(NTE)),1,3)="NTE" S OREASON=$P(@ORMSG@(NTE),"|",4) ;Tech's Comments 97 D2 ; might the procedure be scheduled at this point ?? Not in spec 98 S CH=$$PTR("WORD PROCESSING 1"),CHI=0 99 S OBX=OBR F S OBX=$O(@ORMSG@(OBX)) Q:OBX'>0 S J=$E(@ORMSG@(OBX),1,3) Q:J="ORC" Q:J="MSH" I J="OBX" D 100 . N NAME,VALUE,X0 S VALUE=$P(@ORMSG@(OBX),"|",6) 101 . S NAME=$$UP^XLFSTR($P($P(@ORMSG@(OBX),"|",4),U,2)) 102 . I NAME="CONTRACT/SHARING SOURCE" S X0=$G(^DIC(34,+VALUE,0)) S:$L(X0) ORDIALOG($$PTR(NAME),1)=+VALUE,ORDIALOG($$PTR("CATEGORY"),1)=$P(X0,U,2) Q 103 . I NAME="RESEARCH SOURCE" S ORDIALOG($$PTR(NAME),1)=VALUE,ORDIALOG($$PTR("CATEGORY"),1)="R" Q 104 . I NAME="PREGNANT" S ORDIALOG($$PTR(NAME),1)=VALUE Q 105 . I NAME="PRE-OP SCHEDULED DATE/TIME" S ORDIALOG($$PTR(NAME),1)=$$FMDATE^ORM(VALUE) Q 106 . S CHI=CHI+1,^TMP("ORWORD",$J,CH,1,CHI,0)=VALUE 107 S:CHI ^TMP("ORWORD",$J,CH,1,0)="^^"_CHI_U_CHI_U_DT_U,ORDIALOG(CH,1)="^TMP(""ORWORD"",$J,"_CH_",1)" 108 Q 109 ; 110 PTR(X) ; -- Returns ptr to prompt in Order Dialog file #101.41 111 Q +$O(^ORD(101.41,"AB",$E("OR GTX "_X,1,63),0)) 112 ; 113 SC ; -- Status changed (scheduled, registered, or unverified) 114 N ORSTS,OBR,OR3 ;110 115 S ORSTS=$S(ORDSTS="ZR":6,ORDSTS="ZU":6,1:8),OR3=$G(^OR(100,+ORIFN,3)) ;110 116 G:ORSTS=6 SCQ ;136 Done if active, else get scheduled data 117 S OBR=$O(@ORMSG@(+ORC)) I 'OBR!($E($G(@ORMSG@(OBR)),1,3)'="OBR") S ORERR="Missing OBR segment" Q 118 S ORSTRT=$$FMDATE^ORM($P(@ORMSG@(OBR),"|",37)) 119 D:ORSTRT DATES^ORCSAVE2(+ORIFN,ORSTRT) 120 I $P(OR3,U,3)=3,$P($G(^OR(100,+ORIFN,8,+$P(OR3,U,7),0)),U,2)="HD" D RL ;If status is hold and current action is hold then release. Added with 110 121 SCQ D STATUS^ORCSAVE2(ORIFN,ORSTS) 122 Q 123 ; 124 RE ; -- Completed, w/results 125 N I,SEG,OBX 126 D STATUS^ORCSAVE2(ORIFN,2) 127 S OBX="" D ;get Results D/T [from OBR] 128 . N DA,DR,DIE,X,Y,OBR 129 . S DA=+ORIFN,DIE="^OR(100,",OBR=+$O(@ORMSG@(+ORC)),X="" 130 . I OBR,$E($G(@ORMSG@(OBR)),1,3)="OBR" S X=$P(@ORMSG@(OBR),"|",23) 131 . S DR="71////"_$S(X:$$FMDATE^ORM(X),1:+$E($$NOW^XLFDT,1,12)) D ^DIE 132 S I=+ORC F S I=$O(@ORMSG@(I)) Q:I<1 S SEG=$G(@ORMSG@(I)) Q:$E(SEG,1,3)="ORC" I $E(SEG,1,3)="OBX" S OBX=I_U_SEG Q ;first one 133 S $P(^OR(100,+ORIFN,7),U,2)=$S($P(OBX,"|",9)="A":1,1:"") 134 S:'$G(ORNP) ORNP=+$P($G(^OR(100,+ORIFN,0)),U,4) 135 I $L($T(ADD^ORRCACK)) D ADD^ORRCACK(+ORIFN,ORNP) ;Ack stub for prov 136 Q 137 ; 138 OH ; -- Held 139 D UPDATE(3,"HD") 140 Q 141 ; 142 OC ; -- Cancelled/Unable to accept [ack] 143 UA ; -- Unable to accept [ack] 144 S:'$L(ORNATR) ORNATR="X" ;Rejected 145 S ^OR(100,+ORIFN,6)=$O(^ORD(100.02,"C",ORNATR,0))_U_U_ORLOG_U_U_OREASON 146 D STATUS^ORCSAVE2(ORIFN,13) 147 UD ; -- Unable to discontinue [ack] 148 N DA S DA=+$P(ORIFN,";",2) I DA D 149 . S $P(^OR(100,+ORIFN,8,DA,0),U,15)=13 ;Request rejected 150 . S:$L(OREASON) ^OR(100,+ORIFN,8,DA,1)=OREASON 151 Q 152 ; 153 OD ; -- Discontinued 154 S:$G(DGPMT) ORDUZ="" ;auto-dc on movement 155 S ^OR(100,+ORIFN,6)=$S($L(ORNATR):$O(^ORD(100.02,"C",ORNATR,0)),1:"")_U_ORDUZ_U_ORLOG_U_U_OREASON 156 D UPDATE(1,"DC") 157 Q 158 ; 159 DR ; -- Discontinued [ack] 160 D STATUS^ORCSAVE2(ORIFN,1) 161 Q 162 ; 163 UPDATE(ORSTS,ORACT) ; -- continue processing 164 N ORX,ORDA,ORP D:$G(ORSTS) STATUS^ORCSAVE2(ORIFN,ORSTS) 165 S ORX=$$CREATE^ORX1(ORNATR) D:ORX 166 . S ORDA=$$ACTION^ORCSAVE(ORACT,+ORIFN,ORNP,OREASON,ORLOG,ORDUZ) 167 . I ORDA'>0 S ORERR="Cannot create new order action" Q 168 . D RELEASE^ORCSAVE2(+ORIFN,ORDA,ORLOG,ORDUZ,ORNATR) 169 . D SIGSTS^ORCSAVE2(+ORIFN,ORDA) 170 . I $G(ORL) S ORP(1)=+ORIFN_";"_ORDA_"^1" D PRINTS^ORWD1(.ORP,+ORL) 171 . S $P(^OR(100,+ORIFN,3),U,7)=ORDA 172 I 'ORX D ;no new action created 173 . ;I ORACT="DC" S:'$$ACTV^ORX1(ORNATR) $P(^OR(100,+ORIFN,3),U,7)=0 Q 174 . S:ORACT="HD"&$L(OREASON) ^OR(100,+ORIFN,8,1,1)=OREASON ;pend/sch only 175 I ORACT="DC" D CANCEL^ORCSEND(+ORIFN) S:'$$ACTV^ORX1(ORNATR) $P(^OR(100,+ORIFN,3),U,7)=0 176 Q 177 ; 178 RL ;Release hold --entire section added with patch 110 179 S ^OR(100,+ORIFN,8,$P(OR3,U,7),2)=ORLOG_"^"_ORDUZ ;Set release hold date/time and release hold user 180 S ORNATR=$S($L(ORNATR):ORNATR,1:$P(^OR(100,+ORIFN,8,$P(OR3,U,7),0),U,12)) ;set nature of order for release equal to nature of order for hold if it doesn't exist 181 I $G(ORSTS)="" S ORSTS=6 182 D UPDATE(ORSTS,"RL") 183 Q 1 ORMRA ; SLC/MKB - Process Radiology ORM msgs ;2/21/02 15:44 [3/4/04 10:43am] 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**3,53,92,110,136,153,174,195,228**;Dec 17, 1997 3 ;DBIA 2968 allows for reading ^DIC(34 4 EN ; -- entry point for RA 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 OREASON=$S($P(OREASON,U,6)="99RAR":$P(OREASON,U,5),1:$P(OREASON,U,2)) 8 S:'ORDUZ ORDUZ=DUZ S:'ORLOG ORLOG=+$E($$NOW^XLFDT,1,12) 9 D @ORDCNTRL 10 Q 11 ; 12 ZP ; -- Purged 13 Q:'ORIFN Q:'$D(^OR(100,+ORIFN,0)) K ^OR(100,+ORIFN,4) 14 ; - Set status=lapsed, if still active 15 I "^3^5^6^8^"[(U_$P($G(^OR(100,+ORIFN,3)),U,3)_U) D STATUS^ORCSAVE2(ORIFN,14) 16 Q 17 ; 18 ZR ; -- Purged as requested [ack] 19 D DELETE^ORCSAVE2(+ORIFN) 20 Q 21 ; 22 ZU ; -- Unable to purge [ack] 23 S $P(^OR(100,+ORIFN,3),U)=$$NOW^XLFDT ; update Last Activity 24 Q 25 ; 26 OK ; -- Order accepted, RA order # assigned [ack] 27 N ORSTS,OBR S ^OR(100,+ORIFN,4)=PKGIFN,ORSTS=5 ; 5=pending 28 ; Ck if also scheduled, else quit 29 S OBR=$O(@ORMSG@(+ORC)) G:'OBR OKQ G:$E(@ORMSG@(OBR),1,3)'="OBR" OKQ 30 S ORSTRT=$$FMDATE^ORM($P(@ORMSG@(OBR),"|",37)) 31 D:ORSTRT DATES^ORCSAVE2(+ORIFN,ORSTRT) 32 OKQ D STATUS^ORCSAVE2(ORIFN,ORSTS) 33 ;Save the Radiology pre-certification Account Reference in the PV1 34 ;segment of the HL7 message from the Radiology package to the Order 35 ;File (#100). Support for Patch OR*3.0*228 36 D PRECERT^ORWPFSS2 37 Q 38 ; 39 XX ; -- Change order 40 N ORDIALOG,ORDG,ORDA,ORX,ORP S:'$L(ORNATR) ORNATR="S" 41 D DLG Q:$D(ORERR) Q:'$D(ORDIALOG) S ORIFN=+ORIFN 42 S ORDA=$$ACTION^ORCSAVE("XX",ORIFN,ORNP,OREASON,ORLOG,ORDUZ) 43 I ORDA'>0 S ORERR="Cannot create new order action" Q 44 ; -Update sts of order to active, last action to dc/edit: 45 S ORX=+$P($G(^OR(100,ORIFN,3)),U,7) 46 S:$P($G(^OR(100,ORIFN,8,ORX,0)),U,15)="" $P(^(0),U,15)=12 47 S $P(^OR(100,ORIFN,3),U,7)=ORDA D STATUS^ORCSAVE2(ORIFN,6) 48 D RELEASE^ORCSAVE2(ORIFN,ORDA,ORLOG,ORDUZ,ORNATR) 49 ; -If unsigned edit, leave XX unsigned & mark ORX as Sig Not Req'd 50 S ORSIG=$S($P($G(^OR(100,ORIFN,8,ORX,0)),U,4)'=2:1,1:0) 51 D SIGSTS^ORCSAVE2(ORIFN,ORDA):ORSIG,SIGN^ORCSAVE2(ORIFN,,,5,ORX):'ORSIG 52 ; -Update responses, get/save new order text: 53 K ^OR(100,ORIFN,4.5) D RESPONSE^ORCSAVE,ORDTEXT^ORCSAVE1(ORIFN_";"_ORDA) 54 S $P(^OR(100,ORIFN,8,ORDA,0),U,14)=ORDA 55 I $G(ORL) S ORP(1)=+ORIFN_";"_ORDA_"^1" D PRINTS^ORWD1(.ORP,+ORL) 56 Q 57 ; 58 SN ; -- New backdoor order: return NA msg w/ORIFN, or DE msg 59 N ORDIALOG,ORDG,ORP K ^TMP("ORWORD",$J) S:'$L(ORNATR) ORNATR="W" 60 I ORDUZ,'$D(^VA(200,ORDUZ,0)) S ORERR="Invalid entering person" Q 61 I '$D(^VA(200,ORNP,0)) S ORERR="Missing or invalid ordering provider" Q 62 I '$G(ORL) S ORERR="Missing or invalid patient location" Q 63 D DLG Q:$D(ORERR) Q:'$D(ORDIALOG) 64 SNQ D EN^ORCSAVE K ^TMP("ORWORD",$J) 65 I '$G(ORIFN) S ORERR="Cannot create new order" Q 66 ;Save DG1 and ZCL segments of HL7 message from backdoor orders 67 D BDOSTR^ORWDBA3 68 ;Save the Rediology pre-certification Account Reference in the PV1 69 ;segment of the HL7 message from the Radiology package to the Order 70 ;File (#100). Support for Patch OR*3.0*228 71 D PRECERT^ORWPFSS2 72 D RELEASE^ORCSAVE2(ORIFN,1,ORLOG,ORDUZ,ORNATR),SIGSTS^ORCSAVE2(ORIFN,1) 73 D STATUS^ORCSAVE2(ORIFN,5) S ^OR(100,ORIFN,4)=PKGIFN 74 I $G(ORL) S ORP(1)=ORIFN_";1^1" D PRINTS^ORWD1(.ORP,+ORL) ; chart copy 75 Q 76 ; 77 DLG ; -- Build ORDIALOG() from msg 78 N OBR,OI,MODS,J,X,Y,ILOC,MODE,CH,CHI,OBX,NTE 79 S ORDIALOG=$O(^ORD(101.41,"AB","RA OERR EXAM",0)) 80 D GETDLG1^ORCD(ORDIALOG) 81 S ORDIALOG($$PTR("CATEGORY"),1)=$G(ORCAT) 82 S ORDIALOG($$PTR("START DATE/TIME"),1)=ORSTRT 83 S ORDIALOG($$PTR("URGENCY"),1)=ORURG 84 S:$P(ORC,"|",12) ORDIALOG($$PTR("PROVIDER"),1)=+$P(ORC,"|",12) 85 D1 S OBR=$O(@ORMSG@(+ORC)) I 'OBR!($E($G(@ORMSG@(OBR)),1,3)'="OBR") S ORERR="Missing OBR segment" Q 86 S OI=$$ORDITEM^ORM($P(@ORMSG@(OBR),"|",5)) 87 I 'OI S ORERR="Invalid procedure" Q 88 S ORDIALOG($$PTR("ORDERABLE ITEM"),1)=OI 89 S ORDG=$P($G(^ORD(101.43,+OI,"RA")),U,3) S:$L(ORDG) ORDG=+$O(^ORD(100.98,"B",ORDG,0)) I 'ORDG S ORDG=$P(^ORD(101.41,+ORDIALOG,0),U,5) ; Im Type 90 S MODS=$P(@ORMSG@(OBR),"|",19) I $L(MODS) D 91 . F J=1:1:$L(MODS,"~") S X=$P(MODS,"~",J) I $L(X) S Y=$O(^RAMIS(71.2,"B",X,0)) S:Y ORDIALOG($$PTR("MODIFIERS"),J)=Y 92 S ILOC=+$P(@ORMSG@(OBR),"|",20),MODE=$P(@ORMSG@(OBR),"|",31) 93 S:ILOC ORDIALOG($$PTR("IMAGING LOCATION"),1)=ILOC 94 S ORDIALOG($$PTR("MODE OF TRANSPORT"),1)=$S(MODE="WALK":"A",MODE="CART":"S",1:$E(MODE)) 95 I ORDCNTRL="XX" S NTE=+$O(@ORMSG@(OBR)) I NTE,$E($G(@ORMSG@(NTE)),1,3)="NTE" S OREASON=$P(@ORMSG@(NTE),"|",4) ;Tech's Comments 96 D2 ; might the procedure be scheduled at this point ?? Not in spec 97 S CH=$$PTR("WORD PROCESSING 1"),CHI=0 98 S OBX=OBR F S OBX=$O(@ORMSG@(OBX)) Q:OBX'>0 S J=$E(@ORMSG@(OBX),1,3) Q:J="ORC" Q:J="MSH" I J="OBX" D 99 . N NAME,VALUE,X0 S VALUE=$P(@ORMSG@(OBX),"|",6) 100 . S NAME=$$UP^XLFSTR($P($P(@ORMSG@(OBX),"|",4),U,2)) 101 . I NAME="CONTRACT/SHARING SOURCE" S X0=$G(^DIC(34,+VALUE,0)) S:$L(X0) ORDIALOG($$PTR(NAME),1)=+VALUE,ORDIALOG($$PTR("CATEGORY"),1)=$P(X0,U,2) Q 102 . I NAME="RESEARCH SOURCE" S ORDIALOG($$PTR(NAME),1)=VALUE,ORDIALOG($$PTR("CATEGORY"),1)="R" Q 103 . I NAME="PREGNANT" S ORDIALOG($$PTR(NAME),1)=VALUE Q 104 . I NAME="PRE-OP SCHEDULED DATE/TIME" S ORDIALOG($$PTR(NAME),1)=$$FMDATE^ORM(VALUE) Q 105 . S CHI=CHI+1,^TMP("ORWORD",$J,CH,1,CHI,0)=VALUE 106 S:CHI ^TMP("ORWORD",$J,CH,1,0)="^^"_CHI_U_CHI_U_DT_U,ORDIALOG(CH,1)="^TMP(""ORWORD"",$J,"_CH_",1)" 107 Q 108 ; 109 PTR(X) ; -- Returns ptr to prompt in Order Dialog file #101.41 110 Q +$O(^ORD(101.41,"AB",$E("OR GTX "_X,1,63),0)) 111 ; 112 SC ; -- Status changed (scheduled, registered, or unverified) 113 N ORSTS,OBR,OR3 ;110 114 S ORSTS=$S(ORDSTS="ZR":6,ORDSTS="ZU":6,1:8),OR3=$G(^OR(100,+ORIFN,3)) ;110 115 G:ORSTS=6 SCQ ;136 Done if active, else get scheduled data 116 S OBR=$O(@ORMSG@(+ORC)) I 'OBR!($E($G(@ORMSG@(OBR)),1,3)'="OBR") S ORERR="Missing OBR segment" Q 117 S ORSTRT=$$FMDATE^ORM($P(@ORMSG@(OBR),"|",37)) 118 D:ORSTRT DATES^ORCSAVE2(+ORIFN,ORSTRT) 119 I $P(OR3,U,3)=3,$P($G(^OR(100,+ORIFN,8,+$P(OR3,U,7),0)),U,2)="HD" D RL ;If status is hold and current action is hold then release. Added with 110 120 SCQ D STATUS^ORCSAVE2(ORIFN,ORSTS) 121 Q 122 ; 123 RE ; -- Completed, w/results 124 N I,SEG,OBX 125 D STATUS^ORCSAVE2(ORIFN,2) 126 S OBX="" D ;get Results D/T [from OBR] 127 . N DA,DR,DIE,X,Y,OBR 128 . S DA=+ORIFN,DIE="^OR(100,",OBR=+$O(@ORMSG@(+ORC)),X="" 129 . I OBR,$E($G(@ORMSG@(OBR)),1,3)="OBR" S X=$P(@ORMSG@(OBR),"|",23) 130 . S DR="71////"_$S(X:$$FMDATE^ORM(X),1:+$E($$NOW^XLFDT,1,12)) D ^DIE 131 S I=+ORC F S I=$O(@ORMSG@(I)) Q:I<1 S SEG=$G(@ORMSG@(I)) Q:$E(SEG,1,3)="ORC" I $E(SEG,1,3)="OBX" S OBX=I_U_SEG Q ;first one 132 S $P(^OR(100,+ORIFN,7),U,2)=$S($P(OBX,"|",9)="A":1,1:"") 133 S:'$G(ORNP) ORNP=+$P($G(^OR(100,+ORIFN,0)),U,4) 134 I $L($T(ADD^ORRCACK)) D ADD^ORRCACK(+ORIFN,ORNP) ;Ack stub for prov 135 Q 136 ; 137 OH ; -- Held 138 D UPDATE(3,"HD") 139 Q 140 ; 141 OC ; -- Cancelled/Unable to accept [ack] 142 UA ; -- Unable to accept [ack] 143 S:'$L(ORNATR) ORNATR="X" ;Rejected 144 S ^OR(100,+ORIFN,6)=$O(^ORD(100.02,"C",ORNATR,0))_U_U_ORLOG_U_U_OREASON 145 D STATUS^ORCSAVE2(ORIFN,13) 146 UD ; -- Unable to discontinue [ack] 147 N DA S DA=+$P(ORIFN,";",2) I DA D 148 . S $P(^OR(100,+ORIFN,8,DA,0),U,15)=13 ;Request rejected 149 . S:$L(OREASON) ^OR(100,+ORIFN,8,DA,1)=OREASON 150 Q 151 ; 152 OD ; -- Discontinued 153 S:$G(DGPMT) ORDUZ="" ;auto-dc on movement 154 S ^OR(100,+ORIFN,6)=$S($L(ORNATR):$O(^ORD(100.02,"C",ORNATR,0)),1:"")_U_ORDUZ_U_ORLOG_U_U_OREASON 155 D UPDATE(1,"DC") 156 Q 157 ; 158 DR ; -- Discontinued [ack] 159 D STATUS^ORCSAVE2(ORIFN,1) 160 Q 161 ; 162 UPDATE(ORSTS,ORACT) ; -- continue processing 163 N ORX,ORDA,ORP D:$G(ORSTS) STATUS^ORCSAVE2(ORIFN,ORSTS) 164 S ORX=$$CREATE^ORX1(ORNATR) D:ORX 165 . S ORDA=$$ACTION^ORCSAVE(ORACT,+ORIFN,ORNP,OREASON,ORLOG,ORDUZ) 166 . I ORDA'>0 S ORERR="Cannot create new order action" Q 167 . D RELEASE^ORCSAVE2(+ORIFN,ORDA,ORLOG,ORDUZ,ORNATR) 168 . D SIGSTS^ORCSAVE2(+ORIFN,ORDA) 169 . I $G(ORL) S ORP(1)=+ORIFN_";"_ORDA_"^1" D PRINTS^ORWD1(.ORP,+ORL) 170 . S $P(^OR(100,+ORIFN,3),U,7)=ORDA 171 I 'ORX D ;no new action created 172 . I ORACT="DC" S:'$$ACTV^ORX1(ORNATR) $P(^OR(100,+ORIFN,3),U,7)=0 Q 173 . S:ORACT="HD"&$L(OREASON) ^OR(100,+ORIFN,8,1,1)=OREASON ;pend/sch only 174 D:ORACT="DC" CANCEL^ORCSEND(+ORIFN) 175 Q 176 ; 177 RL ;Release hold --entire section added with patch 110 178 S ^OR(100,+ORIFN,8,$P(OR3,U,7),2)=ORLOG_"^"_ORDUZ ;Set release hold date/time and release hold user 179 S ORNATR=$S($L(ORNATR):ORNATR,1:$P(^OR(100,+ORIFN,8,$P(OR3,U,7),0),U,12)) ;set nature of order for release equal to nature of order for hold if it doesn't exist 180 I $G(ORSTS)="" S ORSTS=6 181 D UPDATE(ORSTS,"RL") 182 Q
Note:
See TracChangeset
for help on using the changeset viewer.
