| 1 | ORM ; SLC/MKB/JDL - ORM msg router ;11/17/00 10:58
|
---|
| 2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**3,97,141,187,195**;Dec 17, 1997
|
---|
| 3 | EN(MSG) ; -- main entry point for OR RECEIVE where MSG contains HL7 msg
|
---|
| 4 | N ORMSG,ORNMSP,ORTYPE,MSH,PID,PV1,ORC,ORVP,ORTS,ORL,ORCAT,ORAPPT
|
---|
| 5 | S ORAPPT="",ORL=0
|
---|
| 6 | S ORMSG=$S($L($G(MSG)):MSG,1:"MSG") ; MSG="NAME" or MSG(#)=message
|
---|
| 7 | I '$O(@ORMSG@(0)) D EN^ORERR("Missing HL7 message",.ORMSG) Q
|
---|
| 8 | S MSH=0 F S MSH=$O(@ORMSG@(MSH)) Q:MSH'>0 Q:$E(@ORMSG@(MSH),1,3)="MSH"
|
---|
| 9 | I 'MSH D EN^ORERR("Missing or invalid MSH segment",.ORMSG) Q
|
---|
| 10 | S ORNMSP=$$NMSP($P(@ORMSG@(MSH),"|",3)),ORTYPE=$P(@ORMSG@(MSH),"|",9)
|
---|
| 11 | I '$L(ORNMSP) D EN^ORERR("Missing or invalid sending application",.ORMSG) Q
|
---|
| 12 | D PID I '$G(ORVP) D EN^ORERR("Missing or invalid patient ID",.ORMSG) Q
|
---|
| 13 | D PV1 S ORC=PID
|
---|
| 14 | EN1 F S ORC=$O(@ORMSG@(+ORC)) Q:ORC'>0 I $E(@ORMSG@(ORC),1,3)="ORC" D
|
---|
| 15 | . N ORDCNTRL,ORDSTS,PKGIFN,ORIFN,ORNP,ORTN,ORERR,ORLOG,ORDUZ,ORQT,ORSTRT,ORSTOP,ORURG,ORNATR,OREASON
|
---|
| 16 | . S ORC=ORC_U_@ORMSG@(ORC),ORDCNTRL=$TR($P(ORC,"|",2),"@","P")
|
---|
| 17 | . I '$L(ORDCNTRL) S ORERR="Invalid control code" D ERROR Q
|
---|
| 18 | . S ORIFN=$P($P(ORC,"|",3),U),PKGIFN=$P($P(ORC,"|",4),U)
|
---|
| 19 | . I ORIFN,$D(^OR(100,+ORIFN,0)),$P(^(0),U,2)'=ORVP S ORERR="Patient doesn't match" D ERROR Q
|
---|
| 20 | . S ORDSTS=$P(ORC,"|",6),ORQT=$P(ORC,"|",8)
|
---|
| 21 | . S ORSTRT=$$FMDATE($P(ORQT,U,4)),ORSTOP=$$FMDATE($P(ORQT,U,5))
|
---|
| 22 | . S ORURG=$$URGENCY($P(ORQT,U,6)),ORLOG=$$FMDATE($P(ORC,"|",10))
|
---|
| 23 | . S ORDUZ=+$P(ORC,"|",11),ORNP=+$P(ORC,"|",13),OREASON=$P(ORC,"|",17)
|
---|
| 24 | . S ORNATR=$S($P(OREASON,U,3)="99ORN":$P(OREASON,U),1:"")
|
---|
| 25 | . S ORTN="EN^ORM"_ORNMSP D @ORTN I $D(ORERR) D ERROR Q
|
---|
| 26 | . I ORDCNTRL="SN",$G(ORIFN) D MSG^ORMBLD(ORIFN,"NA")
|
---|
| 27 | . I $G(DGPMT),ORDCNTRL="OD"!(ORDCNTRL="OC") D XTMP
|
---|
| 28 | Q
|
---|
| 29 | ;
|
---|
| 30 | NMSP(NAME) ; -- Returns pkg namespace
|
---|
| 31 | I NAME="RADIOLOGY"!(NAME="IMAGING") Q "RA"
|
---|
| 32 | I NAME="LABORATORY" Q "LR"
|
---|
| 33 | I NAME="DIETETICS" Q "FH"
|
---|
| 34 | I NAME="PHARMACY" Q "PS"
|
---|
| 35 | I NAME="CONSULTS" Q "GMRC"
|
---|
| 36 | I NAME="PROCEDURES" Q "GMRC"
|
---|
| 37 | I NAME="ORDER ENTRY" Q "ORG"
|
---|
| 38 | Q ""
|
---|
| 39 | ;
|
---|
| 40 | PID ; -- Returns patient from PID segment in current msg
|
---|
| 41 | ; Sets PID, ORVP, ORTS if valid patient
|
---|
| 42 | N I,DFN,SEG S I=MSH,PID=""
|
---|
| 43 | F S I=$O(@ORMSG@(I)) Q:I'>0 S SEG=$E(@ORMSG@(I),1,3) Q:SEG="ORC" I SEG="PID" D Q
|
---|
| 44 | . S DFN=+$P(@ORMSG@(I),"|",4),PID=I
|
---|
| 45 | . I $D(^DPT(DFN,0)) S ORVP=DFN_";DPT(",ORTS=$G(^DPT(DFN,.103)) Q
|
---|
| 46 | . S:$L($P(@ORMSG@(I),"|",5)) ORVP=$P(@ORMSG@(I),"|",5) ; alt ID for Lab
|
---|
| 47 | Q
|
---|
| 48 | ;
|
---|
| 49 | PV1 ; -- Returns patient location in PV1 segment in current msg
|
---|
| 50 | ; Sets PV1, ORCAT, & ORL if valid location, ORAPPT: IMO appointment
|
---|
| 51 | N I,X,SEG S I=PID,PV1=""
|
---|
| 52 | F S I=$O(@ORMSG@(I)) Q:I'>0 S SEG=$E(@ORMSG@(I),1,3) Q:SEG="ORC" I SEG="PV1" D Q
|
---|
| 53 | . S X=+$P(@ORMSG@(I),"|",4),ORCAT=$P(@ORMSG@(I),"|",3),PV1=I
|
---|
| 54 | . S:$D(^SC(X,0)) ORL=X_";SC("
|
---|
| 55 | . S ORAPPT=$P(@ORMSG@(I),"|",45)
|
---|
| 56 | . S:+$G(ORAPPT) ORAPPT=$$FMDATE($G(ORAPPT))
|
---|
| 57 | Q
|
---|
| 58 | ;
|
---|
| 59 | ORDITEM(USID) ; -- Returns pointer to Orderable Item file for USID
|
---|
| 60 | N ID,OI
|
---|
| 61 | S ID=$P(USID,U,4)_";"_$P(USID,U,6)
|
---|
| 62 | S OI=+$O(^ORD(101.43,"ID",ID,0))
|
---|
| 63 | Q OI
|
---|
| 64 | ;
|
---|
| 65 | URGENCY(CODE) ; -- Return ptr to Order Urgency file #101.42
|
---|
| 66 | S:'$L(CODE) CODE="R"
|
---|
| 67 | Q $O(^ORD(101.42,"C",CODE,0))
|
---|
| 68 | ;
|
---|
| 69 | FMDATE(Y) ; -- Convert HL7 date/time to FM format
|
---|
| 70 | Q $$HL7TFM^XLFDT(Y) ;**97
|
---|
| 71 | ;
|
---|
| 72 | ERROR ; -- Sends a DE reply to current msg
|
---|
| 73 | ; Uses ORVP, ORNMSP, ORDUZ, ORIFN, ORERR, and PKGIFN
|
---|
| 74 | N ORV S ORV("XQY0")="" D EN^ORERR(ORERR,.ORMSG,.ORV)
|
---|
| 75 | Q:ORTYPE="ORR" Q:'$L($G(ORNMSP))
|
---|
| 76 | N OREMSG,ORVP,ORTS S:'$G(ORDUZ) ORDUZ=DUZ D:'$G(ORVP) PID
|
---|
| 77 | S OREMSG(1)=$$MSH^ORMBLD("ORR",ORNMSP),OREMSG(2)=$$PID^ORMBLD($G(ORVP))
|
---|
| 78 | S OREMSG(3)="ORC|DE|"_$S($G(ORIFN):ORIFN_"^OR",1:"")_"|"_$S($L($G(PKGIFN)):PKGIFN_U_ORNMSP,1:"")_"|||||||"_ORDUZ_"||||||"_ORERR
|
---|
| 79 | D MSG^XQOR("OR EVSEND "_ORNMSP,.OREMSG)
|
---|
| 80 | Q
|
---|
| 81 | ;
|
---|
| 82 | FIND(SEG,PIECE) ; -- Returns value in $P(@ORMSG@(SEG),"|",PIECE)
|
---|
| 83 | N X,Y,FLDS,I,DONE
|
---|
| 84 | S X=$G(@ORMSG@(SEG)),FLDS=$L(X,"|"),Y="",(I,DONE)=0
|
---|
| 85 | F D Q:DONE
|
---|
| 86 | . I PIECE<FLDS S Y=$P(X,"|",PIECE),DONE=1 Q
|
---|
| 87 | . I PIECE=FLDS D Q
|
---|
| 88 | . . S Y=$P(X,"|",PIECE),I=$O(@ORMSG@(SEG,I)),DONE=1
|
---|
| 89 | . . I I S Y=Y_$P($G(@ORMSG@(SEG,I)),"|")
|
---|
| 90 | . S I=$O(@ORMSG@(SEG,I)) I 'I S Y="",DONE=1 Q
|
---|
| 91 | . S PIECE=PIECE-(FLDS-1),X=$G(@ORMSG@(SEG,I)),FLDS=$L(X,"|")
|
---|
| 92 | FQ Q Y
|
---|
| 93 | ;
|
---|
| 94 | XTMP ; -- Save package auto-dc'd order numbers in ^XTMP
|
---|
| 95 | ; Uses ORIFN, ORNMSP
|
---|
| 96 | Q:'$G(ORIFN) Q:"^1^13^"'[($P($G(^OR(100,+ORIFN,3)),U,3)_U)
|
---|
| 97 | N ORNOW,ORDC S ORNOW=+$$NOW^XLFDT,ORDC="ORDC-"_$G(DGPMDA)
|
---|
| 98 | I $G(^XTMP(ORDC,0)),+^(0)<ORNOW K ^XTMP(ORDC)
|
---|
| 99 | I '$G(^XTMP(ORDC,0)) D
|
---|
| 100 | . N ORNOW1H S ORNOW1H=$$FMADD^XLFDT(ORNOW,,1)
|
---|
| 101 | . S ^XTMP(ORDC,0)=ORNOW1H_U_ORNOW_"^Orders AutoDC'd by Packages on Discharge"
|
---|
| 102 | S ^XTMP(ORDC,+ORIFN)=$G(ORNMSP)
|
---|
| 103 | Q
|
---|