- 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/ORMLR.m
r613 r623 1 ORMLR ; SLC/MKB - Process Lab ORM msgs ;11:59 AM 26 Jul 2000 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**3,92,153,174,195,243**;Dec 17, 1997;Build 242 3 EN ; -- entry point for LR messages 4 I '$L($T(@ORDCNTRL)) Q ;S ORERR="Invalid order control code" Q 5 I ORDCNTRL'="SN",ORDCNTRL'="ZC",ORDCNTRL'="ZP" D Q:$L($G(ORERR)) 6 . I 'ORIFN!('$D(^OR(100,+ORIFN,0))) S ORERR="Invalid OE/RR order number" Q 7 . S ORDUZ=DUZ,ORLOG=+$E($$NOW^XLFDT,1,12) 8 S OREASON=$$REASON I 'ORNATR,OREASON S ORNATR=+$P($G(^ORD(100.03,+OREASON,0)),U,7) 9 D @ORDCNTRL 10 Q 11 ; 12 STATUS(X) ; -- Returns Order Status for HL7 code X 13 N Y S Y=$S(X="DC":1,X="CM":2,X="IP":5,X="SC":6,X="ZS":9,X="CA":13,1:"") 14 Q Y 15 ; 16 OK ; -- Order accepted, LR order # assigned [ack] 17 S ^OR(100,+ORIFN,4)=PKGIFN ; LR identifier 18 D STATUS^ORCSAVE2(+ORIFN,5) ; pending 19 Q 20 ; 21 ZC ; -- Convert existing 2.5 orders to 3.0 format 22 S ORNATR="" I 'ORIFN!('$D(^OR(100,+ORIFN,0))) D Q ;create 23 . K ORIFN D SN Q:'$G(ORIFN) S ORDCNTRL="SN" 24 . I ORSTOP,ORSTOP<$$NOW^XLFDT S $P(^OR(100,+ORIFN,3),U)=ORSTOP 25 N ORDIALOG,I,X,OBR,NTE S ORIFN=+ORIFN 26 S I=+ORC F S I=$O(@ORMSG@(I)) Q:'I S SEG=$E(@ORMSG@(I),1,3) Q:SEG="ORC" Q:SEG="MSH" I SEG="OBR" S OBR=I Q 27 I '$G(OBR) S ORERR="Missing OBR segment" Q 28 S ORDIALOG=+$O(^ORD(101.41,"AB","LR OTHER LAB TESTS",0)) 29 D GETDLG1^ORCD(ORDIALOG) 30 S X=$$FIND^ORM(OBR,5),X=$$ORDITEM^ORM(X) I 'X S ORERR="Invalid test" Q 31 S ORDIALOG($$PTR("ORDERABLE ITEM"),1)=X,X=$$FIND^ORM(OBR,16) 32 S ORDIALOG($$PTR("COLLECTION SAMPLE"),1)=$P(X,";",4) 33 S ORDIALOG($$PTR("SPECIMEN"),1)=$S($L($P(X,";")):+$O(^LAB(61,"C",$P(X,";"),0)),1:+$P(X,U,4)) 34 S X=$$FIND^ORM(OBR,28),ORDIALOG($$PTR("LAB URGENCY"),1)=+$P($P(X,U,6),";",2) 35 S X=$$FIND^ORM(OBR,12),ORDIALOG($$PTR("COLLECTION TYPE"),1)=$S(X="L":"LC",X="O":"WC",X=2:"I",1:"SP") 36 ZC1 S NTE=$O(@ORMSG@(OBR)) I NTE,$E(@ORMSG@(NTE),1,3)="NTE" D 37 . N LCNT,WP S WP=$$PTR("WORD PROCESSING 1") K ^TMP("ORWORD",$J) 38 . S LCNT=1,^TMP("ORWORD",$J,WP,1,LCNT,0)=$P(@ORMSG@(NTE),"|",4) 39 . S I=0 F S I=$O(@ORMSG@(NTE,I)) Q:I'>0 S LCNT=LCNT+1,^TMP("ORWORD",$J,WP,1,LCNT,0)=@ORMSG@(NTE,I) 40 . S ^TMP("ORWORD",$J,WP,1,0)="^^"_LCNT_U_LCNT_U_DT_U 41 . S ORDIALOG(WP,1)="^TMP(""ORWORD"","_$J_","_WP_",1)" 42 S ORDIALOG($$PTR("START DATE/TIME"),1)=ORSTRT 43 S ^OR(100,ORIFN,4)=PKGIFN,$P(^(0),U,5)=+ORDIALOG_";ORD(101.41," 44 D RESPONSE^ORCSAVE ; save ORDIALOG() into ^(4.5) 45 K ^TMP("ORWORD",$J) 46 Q 47 ; 48 SN ; -- New backdoor order: return NA msg w/ORIFN, or DE msg 49 N X,ORDIALOG,ORDG,OBR,NTE,CMMT,OI,LCNT,I,ORSTS,LRSUB,ORNEW,ORP 50 I ORDUZ,'$D(^VA(200,+ORDUZ,0)) S ORERR="Invalid entering person" Q 51 ; I '$G(ORL) S ORERR="Missing or invalid patient location" Q 52 ;S LRSUB=$E($P($P(@ORMSG@(+ORC),"|",4),U,2),3,4),ORDG=$$DGRP(LRSUB) 53 S ORDIALOG="LR OTHER LAB TESTS" ; $S(LRSUB="AP",LRSUB="BB") 54 S ORDIALOG=$O(^ORD(101.41,"AB",ORDIALOG,0)) D GETDLG1^ORCD(ORDIALOG) 55 S ORDIALOG($$PTR("START DATE/TIME"),1)=ORSTRT 56 S CMMT=$$PTR("WORD PROCESSING 1") K ^TMP("ORWORD",$J) 57 SN1 S OBR=$O(@ORMSG@(+ORC)) I 'OBR!($E($G(@ORMSG@(OBR)),1,3)'="OBR") S ORERR="Missing OBR segment" Q 58 S X=$$FIND^ORM(OBR,5),OI=$$ORDITEM^ORM(X) I 'OI S ORERR="Invalid test" Q 59 S LRSUB=$P(^ORD(101.43,OI,"LR"),U,6),ORDG=$$DGRP(LRSUB) 60 S ORDIALOG($$PTR("ORDERABLE ITEM"),1)=OI 61 I LRSUB="BB" S ORDIALOG($$PTR("QUANTITY"),1)=+ORQT G SN2 62 S X=$$FIND^ORM(OBR,16),ORDIALOG($$PTR("COLLECTION SAMPLE"),1)=$P(X,";",4) 63 S ORDIALOG($$PTR("SPECIMEN"),1)=$S($L($P(X,";")):$O(^LAB(61,"C",$P(X,";"),0)),1:+$P(X,U,4)) 64 S X=+$P($P($$FIND^ORM(OBR,28),U,6),";",2),ORDIALOG($$PTR("LAB URGENCY"),1)=$S(X:X,1:9) 65 S X=$$FIND^ORM(OBR,12),ORDIALOG($$PTR("COLLECTION TYPE"),1)=$S(X="L":"LC",X="O":"WC",X=2:"I",1:"SP") 66 SN2 S NTE=$O(@ORMSG@(+OBR)) I NTE,$E(@ORMSG@(NTE),1,3)="NTE" D 67 . S LCNT=1,^TMP("ORWORD",$J,CMMT,1,LCNT,0)=$P(@ORMSG@(NTE),"|",4) 68 . I $O(@ORMSG@(NTE,0)) S I=0 F S I=$O(@ORMSG@(NTE,I)) Q:I'>0 S LCNT=LCNT+1,^TMP("ORWORD",$J,CMMT,1,LCNT,0)=@ORMSG@(NTE,I) 69 . S ^TMP("ORWORD",$J,CMMT,1,0)="^^"_LCNT_U_LCNT_U_DT_U,ORDIALOG(CMMT,1)="^TMP(""ORWORD"",$J,"_CMMT_",1)" 70 SNQ D EN^ORCSAVE K ^TMP("ORWORD",$J) 71 I '$G(ORIFN) S ORERR="Cannot create new order" Q 72 ;Save DG1 and ZCL segments of HL7 message from backdoor orders 73 D BDOSTR^ORWDBA3 74 D RELEASE^ORCSAVE2(ORIFN,1,ORLOG,ORDUZ,ORNATR),SIGSTS^ORCSAVE2(ORIFN,1) 75 D:ORSTOP DATES^ORCSAVE2(ORIFN,,ORSTOP) ;Start date in order itself 76 S ORSTS=$$STATUS(ORDSTS) D:ORSTS STATUS^ORCSAVE2(ORIFN,ORSTS) 77 I ORDCNTRL="SN",$G(ORL) S ORP(1)=ORIFN_";1^1" D PRINTS^ORWD1(.ORP,+ORL) 78 S ^OR(100,ORIFN,4)=PKGIFN 79 Q 80 ; 81 PTR(NAME) ; -- Returns ien of prompt NAME in Order Dialog file #101.41 82 Q $O(^ORD(101.41,"AB",$E("OR GTX "_NAME,1,63),0)) 83 ; 84 DGRP(DG) ; -- Returns Display Group ptr based on Lab section 85 N Y S:'$L($G(DG)) DG="CH" S Y=$O(^ORD(100.98,"B",DG,0)) 86 S:'Y Y=$O(^ORD(100.98,"B","LAB",0)) 87 Q Y 88 ; 89 XX ; -- Changed: NOT IN USE 90 D XX^ORMLR1 91 Q 92 ; 93 XR ; -- Changed [ack]: NOT IN USE 94 N ORIG 95 S ^OR(100,+ORIFN,4)=PKGIFN,ORIG=$P(^(3),U,5) 96 D:ORIG STATUS^ORCSAVE2(ORIG,12) 97 D STATUS^ORCSAVE2(+ORIFN,5) ; pending 98 Q 99 ; 100 ZP ; -- Purged 101 Q:'ORIFN Q:'$D(^OR(100,+ORIFN,0)) 102 S $P(^OR(100,+ORIFN,4),";",1,3)=";;" I "^5^6^"[(U_$P($G(^(3)),U,3)_U) D STATUS^ORCSAVE2(+ORIFN,$S($P(^(4),";",5):2,1:14)) ; Remove pkg reference, sts=lapsed if still active 103 Q 104 ; 105 ZR ; -- Purged as requested [ack] 106 D DELETE^ORCSAVE2(+ORIFN) 107 Q 108 ; 109 ZU ; -- Unable to purge [ack] 110 S $P(^OR(100,+ORIFN,3),U)=$$NOW^XLFDT ; update Last Activity 111 Q 112 ; 113 SC ; -- Status changed (collected) 114 N ORSTS D DATES^ORCSAVE2(+ORIFN,ORSTRT,ORSTOP) 115 S ORSTS=$$STATUS(ORDSTS) D:ORSTS STATUS^ORCSAVE2(+ORIFN,ORSTS) 116 S:$L($P(OREASON,U,2)) ^OR(100,+ORIFN,8,1,1)=$P(OREASON,U,2) 117 Q 118 ; 119 RE ; -- Completed, w/results 120 N ORSTS,ORX,I,SEG,DONE,X,Y,ORABN,ORFIND,LRSA,LRSB 121 S ORSTS=$$STATUS(ORDSTS) D:ORSTS STATUS^ORCSAVE2(+ORIFN,ORSTS) 122 S ^OR(100,+ORIFN,4)=PKGIFN,ORX="" D ;get Results D/T [from OBR] 123 . N OBR S OBR=+$O(@ORMSG@(+ORC)),X="" 124 . I OBR,$E($G(@ORMSG@(OBR)),1,3)="OBR" S X=$P(@ORMSG@(OBR),"|",23) 125 . S X=$S(X:$$FMDATE^ORM(X),1:+$E($$NOW^XLFDT,1,12)) 126 . S $P(^OR(100,+ORIFN,7),U)=X,^OR(100,"ARS",ORVP,9999999-X,+ORIFN)="" 127 D RR^LR7OR1(DFN,PKGIFN) 128 S ORABN="",ORFIND="" 129 I $D(^TMP("LRRR",$J)) D 130 . N IDT,DNAM,ORSLT 131 . S IDT=0 F S IDT=$O(^TMP("LRRR",$J,DFN,"CH",IDT)) Q:'IDT D 132 .. S DNAM=0 F S DNAM=$O(^TMP("LRRR",$J,DFN,"CH",IDT,DNAM)) Q:'DNAM D 133 ... S ORSLT=$G(^TMP("LRRR",$J,DFN,"CH",IDT,DNAM)) 134 ... I '$L($P(ORSLT,U,3)) Q 135 ... S ORABN=1,ORFIND=$S($L(ORFIND):(ORFIND_", "),1:"") 136 ... S ORFIND=ORFIND_$P(ORSLT,U,15)_"="_$P(ORSLT,U,2) 137 . Q 138 K ^TMP("LRRR",$J),^TMP("LRX",$J) 139 S $P(^OR(100,+ORIFN,7),U,2,3)=ORABN_U_ORFIND 140 S:'$G(ORNP) ORNP=+$P($G(^OR(100,+ORIFN,0)),U,4) 141 I $L($T(ADD^ORRCACK)) D ADD^ORRCACK(+ORIFN,ORNP) ;Ack stub for prov 142 Q 143 ; 144 OC ; -- Cancelled 145 G:ORTYPE="ORR" UA S:ORNATR=+$O(^ORD(100.02,"C","A",0)) ORDUZ="" 146 S ^OR(100,+ORIFN,6)=ORNATR_U_ORDUZ_U_ORLOG_U_$P(OREASON,U)_U_$E($P(OREASON,U,2),1,80) 147 D UPDATE(1,"DC") 148 Q 149 ; 150 CR ; -- Cancelled [ack] 151 D STATUS^ORCSAVE2(+ORIFN,1) 152 Q 153 ; 154 UA ; -- Unable to accept [ack] 155 UX ; -- Unable to change [ack]: NOT IN USE 156 S:'ORNATR ORNATR=$O(^ORD(100.02,"C","X",0)) ;rejected 157 S ^OR(100,+ORIFN,6)=ORNATR_U_U_ORLOG_U_$P(OREASON,U)_U_$E($P(OREASON,U,2),1,80) 158 D STATUS^ORCSAVE2(+ORIFN,13) 159 UC ; -- Unable to cancel [ack] 160 DE ; -- Data Error [ack] 161 N DA S DA=$P(ORIFN,";",2) Q:'DA 162 S $P(^OR(100,+ORIFN,8,DA,0),U,15)=13 ;request rejected 163 S:$L($P(OREASON,U,2)) ^OR(100,+ORIFN,8,DA,1)=$E($P(OREASON,U,2),1,240) 164 Q 165 ; 166 UPDATE(ORSTS,ORACT) ; -- continue processing 167 N DA,ORX,ORCMMT,ORP 168 D DATES^ORCSAVE2(+ORIFN,ORSTRT,ORSTOP) 169 D:$G(ORSTS) STATUS^ORCSAVE2(+ORIFN,ORSTS) 170 S ORCMMT=$E($P(OREASON,U,2),1,240),ORX=$$CREATE^ORX1(ORNATR) D:ORX 171 . S DA=$$ACTION^ORCSAVE(ORACT,+ORIFN,ORNP,ORCMMT,ORLOG,ORDUZ) 172 . I DA'>0 S ORERR="Cannot create new order action" Q 173 . D RELEASE^ORCSAVE2(+ORIFN,DA,ORLOG,ORDUZ,ORNATR) 174 . D SIGSTS^ORCSAVE2(+ORIFN,DA) 175 . I $G(ORL) S ORP(1)=+ORIFN_";"_DA_"^1" D PRINTS^ORWD1(.ORP,+ORL) 176 . S $P(^OR(100,+ORIFN,3),U,7)=DA 177 I '$$ACTV^ORX1(ORNATR) S $P(^OR(100,+ORIFN,3),U,7)=0 178 D:ORACT="DC" CANCEL^ORCSEND(+ORIFN) 179 Q 180 ; 181 REASON() ; -- Get reason from OREASON or NTE segments 182 N NTE,CMMT,X,Y,I,L 183 S NTE=+$O(@ORMSG@(+ORC)),CMMT=$P(OREASON,U,4,5) 184 G:'NTE RQ G:$E(@ORMSG@(NTE),1,3)'="NTE" RQ ; no add'l comments 185 S Y=$P(@ORMSG@(NTE),"|",4),I=0 186 F S I=$O(@ORMSG@(NTE,I)) Q:I'>0 S X=$G(@ORMSG@(NTE,I)),L=$L(Y)+1+$L(X) S:L'>240 Y=Y_" "_X I L>240 S Y=Y_" "_$E(X,1,239-$L(Y)) Q 187 S $P(CMMT,U,2)=Y 188 RQ Q CMMT 1 ORMLR ; SLC/MKB - Process Lab ORM msgs ;11:59 AM 26 Jul 2000 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**3,92,153,174,195**;Dec 17, 1997 3 EN ; -- entry point for LR messages 4 I '$L($T(@ORDCNTRL)) Q ;S ORERR="Invalid order control code" Q 5 I ORDCNTRL'="SN",ORDCNTRL'="ZC",ORDCNTRL'="ZP" D Q:$L($G(ORERR)) 6 . I 'ORIFN!('$D(^OR(100,+ORIFN,0))) S ORERR="Invalid OE/RR order number" Q 7 . S ORDUZ=DUZ,ORLOG=+$E($$NOW^XLFDT,1,12) 8 S OREASON=$$REASON I 'ORNATR,OREASON S ORNATR=+$P($G(^ORD(100.03,+OREASON,0)),U,7) 9 D @ORDCNTRL 10 Q 11 ; 12 STATUS(X) ; -- Returns Order Status for HL7 code X 13 N Y S Y=$S(X="DC":1,X="CM":2,X="IP":5,X="SC":6,X="ZS":9,X="CA":13,1:"") 14 Q Y 15 ; 16 OK ; -- Order accepted, LR order # assigned [ack] 17 S ^OR(100,+ORIFN,4)=PKGIFN ; LR identifier 18 D STATUS^ORCSAVE2(+ORIFN,5) ; pending 19 Q 20 ; 21 ZC ; -- Convert existing 2.5 orders to 3.0 format 22 S ORNATR="" I 'ORIFN!('$D(^OR(100,+ORIFN,0))) D Q ;create 23 . K ORIFN D SN Q:'$G(ORIFN) S ORDCNTRL="SN" 24 . I ORSTOP,ORSTOP<$$NOW^XLFDT S $P(^OR(100,+ORIFN,3),U)=ORSTOP 25 N ORDIALOG,I,X,OBR,NTE S ORIFN=+ORIFN 26 S I=+ORC F S I=$O(@ORMSG@(I)) Q:'I S SEG=$E(@ORMSG@(I),1,3) Q:SEG="ORC" Q:SEG="MSH" I SEG="OBR" S OBR=I Q 27 I '$G(OBR) S ORERR="Missing OBR segment" Q 28 S ORDIALOG=+$O(^ORD(101.41,"AB","LR OTHER LAB TESTS",0)) 29 D GETDLG1^ORCD(ORDIALOG) 30 S X=$$FIND^ORM(OBR,5),X=$$ORDITEM^ORM(X) I 'X S ORERR="Invalid test" Q 31 S ORDIALOG($$PTR("ORDERABLE ITEM"),1)=X,X=$$FIND^ORM(OBR,16) 32 S ORDIALOG($$PTR("COLLECTION SAMPLE"),1)=$P(X,";",4) 33 S ORDIALOG($$PTR("SPECIMEN"),1)=$S($L($P(X,";")):+$O(^LAB(61,"C",$P(X,";"),0)),1:+$P(X,U,4)) 34 S X=$$FIND^ORM(OBR,28),ORDIALOG($$PTR("LAB URGENCY"),1)=+$P($P(X,U,6),";",2) 35 S X=$$FIND^ORM(OBR,12),ORDIALOG($$PTR("COLLECTION TYPE"),1)=$S(X="L":"LC",X="O":"WC",X=2:"I",1:"SP") 36 ZC1 S NTE=$O(@ORMSG@(OBR)) I NTE,$E(@ORMSG@(NTE),1,3)="NTE" D 37 . N LCNT,WP S WP=$$PTR("WORD PROCESSING 1") K ^TMP("ORWORD",$J) 38 . S LCNT=1,^TMP("ORWORD",$J,WP,1,LCNT,0)=$P(@ORMSG@(NTE),"|",4) 39 . S I=0 F S I=$O(@ORMSG@(NTE,I)) Q:I'>0 S LCNT=LCNT+1,^TMP("ORWORD",$J,WP,1,LCNT,0)=@ORMSG@(NTE,I) 40 . S ^TMP("ORWORD",$J,WP,1,0)="^^"_LCNT_U_LCNT_U_DT_U 41 . S ORDIALOG(WP,1)="^TMP(""ORWORD"","_$J_","_WP_",1)" 42 S ORDIALOG($$PTR("START DATE/TIME"),1)=ORSTRT 43 S ^OR(100,ORIFN,4)=PKGIFN,$P(^(0),U,5)=+ORDIALOG_";ORD(101.41," 44 D RESPONSE^ORCSAVE ; save ORDIALOG() into ^(4.5) 45 K ^TMP("ORWORD",$J) 46 Q 47 ; 48 SN ; -- New backdoor order: return NA msg w/ORIFN, or DE msg 49 N X,ORDIALOG,ORDG,OBR,NTE,CMMT,OI,LCNT,I,ORSTS,LRSUB,ORNEW,ORP 50 I ORDUZ,'$D(^VA(200,+ORDUZ,0)) S ORERR="Invalid entering person" Q 51 ; I '$G(ORL) S ORERR="Missing or invalid patient location" Q 52 S LRSUB=$E($P($P(@ORMSG@(+ORC),"|",4),U,2),3,4),ORDG=$$DGRP(LRSUB) 53 S ORDIALOG="LR OTHER LAB TESTS" ; $S(LRSUB="AP",LRSUB="BB") 54 S ORDIALOG=$O(^ORD(101.41,"AB",ORDIALOG,0)) D GETDLG1^ORCD(ORDIALOG) 55 S ORDIALOG($$PTR("START DATE/TIME"),1)=ORSTRT 56 S CMMT=$$PTR("WORD PROCESSING 1") K ^TMP("ORWORD",$J) 57 SN1 S OBR=$O(@ORMSG@(+ORC)) I 'OBR!($E($G(@ORMSG@(OBR)),1,3)'="OBR") S ORERR="Missing OBR segment" Q 58 S X=$$FIND^ORM(OBR,5),OI=$$ORDITEM^ORM(X) I 'OI S ORERR="Invalid test" Q 59 S ORDIALOG($$PTR("ORDERABLE ITEM"),1)=OI 60 I LRSUB="BB" S ORDIALOG($$PTR("QUANTITY"),1)=+ORQT G SN2 61 S X=$$FIND^ORM(OBR,16),ORDIALOG($$PTR("COLLECTION SAMPLE"),1)=$P(X,";",4) 62 S ORDIALOG($$PTR("SPECIMEN"),1)=$S($L($P(X,";")):$O(^LAB(61,"C",$P(X,";"),0)),1:+$P(X,U,4)) 63 S X=+$P($P($$FIND^ORM(OBR,28),U,6),";",2),ORDIALOG($$PTR("LAB URGENCY"),1)=$S(X:X,1:9) 64 S X=$$FIND^ORM(OBR,12),ORDIALOG($$PTR("COLLECTION TYPE"),1)=$S(X="L":"LC",X="O":"WC",X=2:"I",1:"SP") 65 SN2 S NTE=$O(@ORMSG@(+OBR)) I NTE,$E(@ORMSG@(NTE),1,3)="NTE" D 66 . S LCNT=1,^TMP("ORWORD",$J,CMMT,1,LCNT,0)=$P(@ORMSG@(NTE),"|",4) 67 . I $O(@ORMSG@(NTE,0)) S I=0 F S I=$O(@ORMSG@(NTE,I)) Q:I'>0 S LCNT=LCNT+1,^TMP("ORWORD",$J,CMMT,1,LCNT,0)=@ORMSG@(NTE,I) 68 . S ^TMP("ORWORD",$J,CMMT,1,0)="^^"_LCNT_U_LCNT_U_DT_U,ORDIALOG(CMMT,1)="^TMP(""ORWORD"",$J,"_CMMT_",1)" 69 SNQ D EN^ORCSAVE K ^TMP("ORWORD",$J) 70 I '$G(ORIFN) S ORERR="Cannot create new order" Q 71 ;Save DG1 and ZCL segments of HL7 message from backdoor orders 72 D BDOSTR^ORWDBA3 73 D RELEASE^ORCSAVE2(ORIFN,1,ORLOG,ORDUZ,ORNATR),SIGSTS^ORCSAVE2(ORIFN,1) 74 D:ORSTOP DATES^ORCSAVE2(ORIFN,,ORSTOP) ;Start date in order itself 75 S ORSTS=$$STATUS(ORDSTS) D:ORSTS STATUS^ORCSAVE2(ORIFN,ORSTS) 76 I ORDCNTRL="SN",$G(ORL) S ORP(1)=ORIFN_";1^1" D PRINTS^ORWD1(.ORP,+ORL) 77 S ^OR(100,ORIFN,4)=PKGIFN 78 Q 79 ; 80 PTR(NAME) ; -- Returns ien of prompt NAME in Order Dialog file #101.41 81 Q $O(^ORD(101.41,"AB",$E("OR GTX "_NAME,1,63),0)) 82 ; 83 DGRP(DG) ; -- Returns Display Group ptr based on Lab section 84 N Y S:'$L($G(DG)) DG="CH" S Y=$O(^ORD(100.98,"B",DG,0)) 85 S:'Y Y=$O(^ORD(100.98,"B","LAB",0)) 86 Q Y 87 ; 88 XX ; -- Changed: NOT IN USE 89 D XX^ORMLR1 90 Q 91 ; 92 XR ; -- Changed [ack]: NOT IN USE 93 N ORIG 94 S ^OR(100,+ORIFN,4)=PKGIFN,ORIG=$P(^(3),U,5) 95 D:ORIG STATUS^ORCSAVE2(ORIG,12) 96 D STATUS^ORCSAVE2(+ORIFN,5) ; pending 97 Q 98 ; 99 ZP ; -- Purged 100 Q:'ORIFN Q:'$D(^OR(100,+ORIFN,0)) 101 S $P(^OR(100,+ORIFN,4),";",1,3)=";;" I "^5^6^"[(U_$P($G(^(3)),U,3)_U) D STATUS^ORCSAVE2(+ORIFN,$S($P(^(4),";",5):2,1:14)) ; Remove pkg reference, sts=lapsed if still active 102 Q 103 ; 104 ZR ; -- Purged as requested [ack] 105 D DELETE^ORCSAVE2(+ORIFN) 106 Q 107 ; 108 ZU ; -- Unable to purge [ack] 109 S $P(^OR(100,+ORIFN,3),U)=$$NOW^XLFDT ; update Last Activity 110 Q 111 ; 112 SC ; -- Status changed (collected) 113 N ORSTS D DATES^ORCSAVE2(+ORIFN,ORSTRT,ORSTOP) 114 S ORSTS=$$STATUS(ORDSTS) D:ORSTS STATUS^ORCSAVE2(+ORIFN,ORSTS) 115 S:$L($P(OREASON,U,2)) ^OR(100,+ORIFN,8,1,1)=$P(OREASON,U,2) 116 Q 117 ; 118 RE ; -- Completed, w/results 119 N ORSTS,ORX,I,SEG,DONE,X,Y,ORABN,ORFIND,LRSA,LRSB 120 S ORSTS=$$STATUS(ORDSTS) D:ORSTS STATUS^ORCSAVE2(+ORIFN,ORSTS) 121 S ^OR(100,+ORIFN,4)=PKGIFN,ORX="" D ;get Results D/T [from OBR] 122 . N OBR S OBR=+$O(@ORMSG@(+ORC)),X="" 123 . I OBR,$E($G(@ORMSG@(OBR)),1,3)="OBR" S X=$P(@ORMSG@(OBR),"|",23) 124 . S X=$S(X:$$FMDATE^ORM(X),1:+$E($$NOW^XLFDT,1,12)) 125 . S $P(^OR(100,+ORIFN,7),U)=X,^OR(100,"ARS",ORVP,9999999-X,+ORIFN)="" 126 D RR^LR7OR1(DFN,PKGIFN) 127 S ORABN="",ORFIND="" 128 I $D(^TMP("LRRR",$J)) D 129 . N IDT,DNAM,ORSLT 130 . S IDT=0 F S IDT=$O(^TMP("LRRR",$J,DFN,"CH",IDT)) Q:'IDT D 131 .. S DNAM=0 F S DNAM=$O(^TMP("LRRR",$J,DFN,"CH",IDT,DNAM)) Q:'DNAM D 132 ... S ORSLT=$G(^TMP("LRRR",$J,DFN,"CH",IDT,DNAM)) 133 ... I '$L($P(ORSLT,U,3)) Q 134 ... S ORABN=1,ORFIND=$S($L(ORFIND):(ORFIND_", "),1:"") 135 ... S ORFIND=ORFIND_$P(ORSLT,U,15)_"="_$P(ORSLT,U,2) 136 . Q 137 K ^TMP("LRRR",$J),^TMP("LRX",$J) 138 S $P(^OR(100,+ORIFN,7),U,2,3)=ORABN_U_ORFIND 139 S:'$G(ORNP) ORNP=+$P($G(^OR(100,+ORIFN,0)),U,4) 140 I $L($T(ADD^ORRCACK)) D ADD^ORRCACK(+ORIFN,ORNP) ;Ack stub for prov 141 Q 142 ; 143 OC ; -- Cancelled 144 G:ORTYPE="ORR" UA S:ORNATR=+$O(^ORD(100.02,"C","A",0)) ORDUZ="" 145 S ^OR(100,+ORIFN,6)=ORNATR_U_ORDUZ_U_ORLOG_U_$P(OREASON,U)_U_$E($P(OREASON,U,2),1,80) 146 D UPDATE(1,"DC") 147 Q 148 ; 149 CR ; -- Cancelled [ack] 150 D STATUS^ORCSAVE2(+ORIFN,1) 151 Q 152 ; 153 UA ; -- Unable to accept [ack] 154 UX ; -- Unable to change [ack]: NOT IN USE 155 S:'ORNATR ORNATR=$O(^ORD(100.02,"C","X",0)) ;rejected 156 S ^OR(100,+ORIFN,6)=ORNATR_U_U_ORLOG_U_$P(OREASON,U)_U_$E($P(OREASON,U,2),1,80) 157 D STATUS^ORCSAVE2(+ORIFN,13) 158 UC ; -- Unable to cancel [ack] 159 DE ; -- Data Error [ack] 160 N DA S DA=$P(ORIFN,";",2) Q:'DA 161 S $P(^OR(100,+ORIFN,8,DA,0),U,15)=13 ;request rejected 162 S:$L($P(OREASON,U,2)) ^OR(100,+ORIFN,8,DA,1)=$E($P(OREASON,U,2),1,240) 163 Q 164 ; 165 UPDATE(ORSTS,ORACT) ; -- continue processing 166 N DA,ORX,ORCMMT,ORP 167 D DATES^ORCSAVE2(+ORIFN,ORSTRT,ORSTOP) 168 D:$G(ORSTS) STATUS^ORCSAVE2(+ORIFN,ORSTS) 169 S ORCMMT=$E($P(OREASON,U,2),1,240),ORX=$$CREATE^ORX1(ORNATR) D:ORX 170 . S DA=$$ACTION^ORCSAVE(ORACT,+ORIFN,ORNP,ORCMMT,ORLOG,ORDUZ) 171 . I DA'>0 S ORERR="Cannot create new order action" Q 172 . D RELEASE^ORCSAVE2(+ORIFN,DA,ORLOG,ORDUZ,ORNATR) 173 . D SIGSTS^ORCSAVE2(+ORIFN,DA) 174 . I $G(ORL) S ORP(1)=+ORIFN_";"_DA_"^1" D PRINTS^ORWD1(.ORP,+ORL) 175 . S $P(^OR(100,+ORIFN,3),U,7)=DA 176 I 'ORX,'$$ACTV^ORX1(ORNATR) S $P(^OR(100,+ORIFN,3),U,7)=0 177 D:ORACT="DC" CANCEL^ORCSEND(+ORIFN) 178 Q 179 ; 180 REASON() ; -- Get reason from OREASON or NTE segments 181 N NTE,CMMT,X,Y,I,L 182 S NTE=+$O(@ORMSG@(+ORC)),CMMT=$P(OREASON,U,4,5) 183 G:'NTE RQ G:$E(@ORMSG@(NTE),1,3)'="NTE" RQ ; no add'l comments 184 S Y=$P(@ORMSG@(NTE),"|",4),I=0 185 F S I=$O(@ORMSG@(NTE,I)) Q:I'>0 S X=$G(@ORMSG@(NTE,I)),L=$L(Y)+1+$L(X) S:L'>240 Y=Y_" "_X I L>240 S Y=Y_" "_$E(X,1,239-$L(Y)) Q 186 S $P(CMMT,U,2)=Y 187 RQ Q CMMT
Note:
See TracChangeset
for help on using the changeset viewer.
