ORMBLDPS ;SLC/MKB-Build outgoing Pharmacy ORM msgs ;19-Sep-2012 09:48;MGH
;;3.0;ORDER ENTRY/RESULTS REPORTING;**7,38,54,86,97,94,116,129,141,190,195,237,254,243,1010**;Dec 17, 1997;Build 47
;Modified - IHS/MSC/PLS - 08/06/2010 - Line ZRN+10
;Modified - IHS/MSC/MGH - 09/19/2012 - Lines added UD2 5-9
PTR(NAME) ; -- Returns ptr value of prompt in Dialog file
Q +$O(^ORD(101.41,"AB",$E("OR GTX "_NAME,1,63),0))
;
NVA ; -- new Non-VA Meds order
N NVA S NVA=1
OUT ; -- new Outpt Meds order [same as UD, +3 fields]
UD ; -- new Inpt (Unit Dose) Meds order
N ADMIN,OI,DRUG,INSTR,DOSE,ROUTE,SCHED,DUR,URG,PROVCOMM,PI,DISPENSE,X,Y,I,J,K,L,QT1,QT2,QT3,QT4,QT6,QT9,CONJ,ORC,SC,OUTPT,OITXT,OITXT2
N QT7,SCHTYPE
S OUTPT=$S($P(OR0,U,12)="O":1,1:0) ;outpt flag
S X=$G(^OR(100,IFN,8,1,0)) I $P(X,U,5),$P(X,U,5)'=$P(X,U,3) S $P(ORMSG(4),"|",13)=$P(X,U,5) ; Send signer instead of orderer if different
S OI=$$PTR("ORDERABLE ITEM"),DRUG=$$PTR("DISPENSE DRUG")
S INSTR=$$PTR("INSTRUCTIONS"),SCHED=$$PTR("SCHEDULE"),ADMIN=$$PTR("ADMIN TIMES")
S SCHTYPE=$$PTR("SCHEDULE TYPE")
S DUR=$$PTR("DURATION"),URG=$$PTR("URGENCY"),DOSE=$$PTR("DOSE")
S ROUTE=$$PTR("ROUTE"),PROVCOMM=$$PTR("WORD PROCESSING 1")
S PI=$$PTR("PATIENT INSTRUCTIONS"),CONJ=$$PTR("AND/THEN")
S J=1,ORC(J)=$P(ORMSG(4),"|",1,7)_"|"
I +$G(NVA)=1 G NVA1
UD1 S I=0 F S I=$O(ORDIALOG(INSTR,I)) Q:I'>0 D
. S X=$G(ORDIALOG(DOSE,I))
. ;S QT1=$S($L(X):$P(X,"&",1,4)_"&"_$P(X,"&",6),1:"")
. S QT2=$$ESC($G(ORDIALOG(SCHED,I)))_$S(OUTPT:"",1:"&"_$G(ORDIALOG(ADMIN,I)))
. S QT3=$$HL7DUR
. S QT1=$S($L(X):$P(X,"&",1,6),1:"")
. S QT6=$P($G(^ORD(101.42,+$G(ORDIALOG(URG,I)),0)),U,2)
. S QT7=$G(ORDIALOG(SCHTYPE,I))
. S QT9=$G(ORDIALOG(CONJ,I))_"~" S:$E(QT9)="T" QT9="S~"
. S J=J+1,ORC(J)=QT1_U_QT2_U_QT3_"^^^"_QT6_U_QT7_U_$$INSTR_U_QT9
;
NVA1 I +$G(NVA)=1 D
. S I=1 ;only one dosage possible for non-va meds
. S QT2=$G(ORDIALOG(SCHED,I)),QT3=$$HL7DUR,X=$G(ORDIALOG(DOSE,I))
. S QT1=$S($L(X):$P(X,"&",1,6),1:"")
. S QT6=$P($G(^ORD(101.42,+$G(ORDIALOG(URG,I)),0)),U,2)
. S QT9=$G(ORDIALOG(CONJ,I))_"~" S:$E(QT9)="T" QT9="S~"
. S J=J+1,ORC(J)=QT1_U_$$ESC(QT2)_U_QT3_"^^^"_QT6_"^^"_$$INSTR_U_QT9
;
I $L($P(OR0,U,8)) S $P(ORC(2),U,4)=$$FMTHL7^XLFDT($P(OR0,U,8)) S:J<2 J=2
S J=J+1,ORC(J)="|"_$P(ORMSG(4),"|",9,999),ORC=J,X="ORMSG(4)",ORMSG(4)="",I=0
F J=1:1:ORC S Y=ORC(J) D ;add to ORMSG(4)
. I $L(@X)+$L(Y)'>245 S @X=@X_Y
. E S L=245-$L(@X),@X=@X_$E(Y,1,L),I=I+1,X="ORMSG(4,"_I_")",@X=$E(Y,L+1,$L(Y))
I $G(ORDIALOG(DRUG,1)) S X=$$ENDCM^PSJORUTL(ORDIALOG(DRUG,1)),DISPENSE=$P(X,U,3)_"^^99NDF^"_ORDIALOG(DRUG,1)_"^^99PSD"
S OITXT=$$USID^ORMBLD($G(ORDIALOG(OI,1)))
S OITXT2=$P(OITXT,U,1,4)_U_$$ESC($P(OITXT,U,5))_U_$P(OITXT,U,6,99)
S ORMSG(5)="RXO|"_OITXT2_"|||||||||"_$G(DISPENSE)
UD2 I $G(OUTPT) D
. N QTY,REFS,DSPY
. S QTY=$$PTR("QUANTITY"),REFS=$$PTR("REFILLS"),DSPY=$$PTR("DAYS SUPPLY")
. S ORMSG(5)=ORMSG(5)_"|"_$G(ORDIALOG(QTY,1))_"||"_$G(ORDIALOG(REFS,1))_"||||D"_$G(ORDIALOG(DSPY,1))
S I=5 I $L($G(ORDIALOG(PROVCOMM,1))) D
. ;IHS/MSC/MGH First check and make sure its not empty
. N Y,Z S Z=""
. S Y=$O(^TMP("ORWORD",$J,PROVCOMM,1,0)) Q:'Y
. S Z=Z_$G(^TMP("ORWORD",$J,PROVCOMM,1,Y,0))
. Q:Z=""
. ;end mod
. S J=$O(^TMP("ORWORD",$J,PROVCOMM,1,0)) Q:'J
. S I=6,ORMSG(6)="NTE|6|P|"_$$ESC($G(^TMP("ORWORD",$J,PROVCOMM,1,J,0)))
. S K=0 F S J=$O(^TMP("ORWORD",$J,PROVCOMM,1,J)) Q:J'>0 S K=K+1,ORMSG(6,K)=$G(^(J,0))
I $G(OUTPT),$L($G(ORDIALOG(PI,1))) D
. S J=$O(^TMP("ORWORD",$J,PI,1,0)) Q:'J
. S I=I+1,ORMSG(I)="NTE|7|P|"_$G(^TMP("ORWORD",$J,PI,1,J,0))
. S K=0 F S J=$O(^TMP("ORWORD",$J,PI,1,J)) Q:J'>0 S K=K+1,ORMSG(I,K)=$G(^(J,0))
UD3 S J=0 F S J=$O(ORDIALOG(ROUTE,J)) Q:J'>0 S I=I+1,ORMSG(I)=$$RXR($G(ORDIALOG(ROUTE,J)))
I $D(^OR(100,IFN,9)) D ORDCHKS
S I=I+1,ORMSG(I)=$$ZRX(IFN,OUTPT)
I $G(OUTPT) D ;add SC data
. N OR5 S OR5=$G(^OR(100,IFN,5))
. I $L(OR5),OR5'?5"^" S I=I+1,ORMSG(I)="ZSC|"_$TR(OR5,"^","|") Q
. S SC=$$PTR("SERVICE CONNECTED") S:$D(ORDIALOG(SC,1)) I=I+1,ORMSG(I)="ZSC|"_$S(ORDIALOG(SC,1):"SC",1:"NSC")
; Create DG1 & ZCL segment(s) for Billing Awareness (BA) Project
D DG1^ORWDBA3($G(IFN),"I",I)
I $P(^ORD(100.98,$P(OR0,U,11),0),U)="NON-VA MEDICATIONS" D
. S I=I+1 D ZRN(IFN,.ORMSG,I)
Q
;
INSTR() ; -- Return text instructions for QT-8, instance I
N Y S Y=$P($G(ORDIALOG(DOSE,I)),"&",5)
I $G(ORDIALOG(DRUG,1)),$L(Y) Q $$ESC(Y)
S Y=$G(ORDIALOG(INSTR,I)) I $G(OUTPT) D
. N UNITS,UNT S UNITS=$$PTR("FREE TEXT"),UNT=$G(ORDIALOG(UNITS,I))
. S:$L(UNT) Y=Y_" "_UNT ;old format
Q $$ESC(Y)
;
HL7DUR() ; -- Returns HL7 form of duration X
N X,X1,X2,Y S X=$G(ORDIALOG(DUR,I))
S X1=+$G(X),Y="" G:X1'>0 HDQ
S X2=$$UP^XLFSTR($P(X,X1,2)) S:$E(X2)=" " X2=$E(X2,2,99)
S Y=$S($E(X2,1,2)="MO":"L",'$L(X2):"D",1:$E(X2))_X1
HDQ Q Y
;
IV ; -- new IV Meds order
N SOLN,VOL,ADDS,STR,UNITS,RATE,URG,WP,QT,I,X1,X2,INST
N IVLIMIT ; duratioin or total volume for IV order
N IVTYPE,IVZRX,X,CNT,ROUTE,ORBCMA,DFN
S IVLIMIT=$$PTR("DURATION")
S IVTYPE=$G(ORDIALOG(+$$PTR("IV TYPE"),1))
I IVTYPE="",$P($G(^OR(100,IFN,3)),U,11)="B" D
.S IVTYPE=$$MOB^ORMBLDP1(IFN,+$P($G(^OR(100,IFN,0)),U,2))
.D RESP^ORCSAVE2(IFN,"OR GTX IV TYPE",IVTYPE)
S RATE=$$PTR("INFUSION RATE"),ADDS=$$PTR("ADDITIVE")
S STR=$$PTR("STRENGTH PSIV"),UNITS=$$PTR("UNITS")
S WP=$$PTR("WORD PROCESSING 1"),VOL=$$PTR("VOLUME")
S SCHTYPE=$$PTR("SCHEDULE TYPE")
S SOLN=$$PTR("ORDERABLE ITEM"),URG=+$G(ORDIALOG($$PTR("URGENCY"),1))
;I IVTYPE="",$G(ORDIALOG(+$$PTR("SCHEDULE"),1))="" S IVTYPE="C"
I IVTYPE="I" S QT=U_$$ESC($G(ORDIALOG(+$$PTR("SCHEDULE"),1)))_"&"_$G(ORDIALOG(+$$PTR("ADMIN TIMES"),1))_"^^^^"
I IVTYPE="C" S QT="^^^^^"
;S QT=U_$G(ORDIALOG(+$$PTR("SCHEDULE"),1))_"^^^^"
S:URG QT=QT_$P($G(^ORD(101.42,URG,0)),U,2)
S $P(ORMSG(4),"|",8)=QT
S X=$G(^OR(100,IFN,8,1,0)) I $P(X,U,5),$P(X,U,5)'=$P(X,U,3) S $P(ORMSG(4),"|",13)=$P(X,U,5) ; Send signer instead of orderer if different
S RATE=$G(ORDIALOG(RATE,1)) S:$E(RATE,$L(RATE))=" " RATE=$E(RATE,1,($L(RATE)-1)) S ORMSG(5)="RXO|^^^PS-1^IV^99OTH|"_$$ESC(RATE) ;strip any trailing spaces
S IVLIMIT=$G(ORDIALOG(IVLIMIT,1))
I $L(IVLIMIT) S IVLIMIT=$$HL7IVLMT^ORMBLDP1(IVLIMIT),ORMSG(5)="RXO|^^"_IVLIMIT_"^PS-1^IV^99OTH|"_RATE
S I=5 I $L($G(ORDIALOG(WP,1))) D
. N J,K S J=$O(^TMP("ORWORD",$J,WP,1,0)) Q:'J
. S I=6,ORMSG(6)="NTE|6|P|"_$$ESC($G(^TMP("ORWORD",$J,WP,1,J,0)))
. S K=0 F S J=$O(^TMP("ORWORD",$J,WP,1,J)) Q:J'>0 S K=K+1,ORMSG(6,K)=^(J,0)
;S I=I+1,ORMSG(I)=$$RXR(+$$PTR("ROUTE"))
S ROUTE=+$$PTR("ROUTE")
S I=I+1,ORMSG(I)=$$RXR($G(ORDIALOG(ROUTE,1)))
IV1 S INST=0 F S INST=$O(ORDIALOG(SOLN,INST)) Q:INST'>0 D
. S X1="B",X2=+$G(ORDIALOG(SOLN,INST))
. I $P($G(^ORD(101.43,X2,"PS")),U,4) S X1=X1_"A" ;pre-mix
. S I=I+1,ORMSG(I)="RXC|"_X1_"|"_$$USID^ORMBLD(X2)_"|"_$G(ORDIALOG(VOL,INST))_"|"_$$HL7UNIT("ML")
I $O(ORDIALOG(ADDS,0)) D
. S INST=0 F S INST=$O(ORDIALOG(ADDS,INST)) Q:INST'>0 D
. . S X1=$G(ORDIALOG(ADDS,INST)),X2=$G(ORDIALOG(UNITS,INST))
. . S I=I+1,ORMSG(I)="RXC|A|"_$$USID^ORMBLD(X1)_"|"_$G(ORDIALOG(STR,INST))_"|"_$$HL7UNIT(X2)
I $D(^OR(100,IFN,9)) D ORDCHKS
S IVZRX=$$ZRX(IFN,0)
S CNT=0
F X=1:1:$L(IVZRX) I $E(IVZRX,X)="|" S CNT=CNT+1
I CNT<6 F X=CNT:1:5 S IVZRX=IVZRX_"|"
S I=I+1,ORMSG(I)=IVZRX_IVTYPE
; Create DG1 & ZCL segment(s) for Billing Awareness (BA) Project
D DG1^ORWDBA3($G(IFN),"I",I)
Q
;
RXR(ROUTE) ; -- Returns RXR segment
N IEN,NAME
I +ROUTE=0 Q "RXR|^^^^^99PSR"
K ^TMP($J,"ORMBLDPS RXR")
D ALL^PSS51P2(+ROUTE,,,,"ORMBLDPS RXR")
S NAME=^TMP($J,"ORMBLDPS RXR",+ROUTE,.01)
;N NAME S NAME=$$GET1^DIQ(51.2,+ROUTE_",",.01)
K ^TMP($J,"ORMBLDPS RXR")
Q "RXR|^^^"_+ROUTE_U_NAME_"^99PSR"
;
ZRX(IFN,OUTPT) ; -- Returns ZRX segment
N NATURE,TYPE,ORIG,PSORIG,ROUTING,ZRX
S TYPE=$P($G(^OR(100,IFN,3)),U,11),NATURE=$P($G(^(8,1,0)),U,12)
S:NATURE NATURE=$P($G(^ORD(100.02,+NATURE,0)),U,2) ;code
S PSORIG="" I (TYPE=1)!(TYPE=2) D
. S ORIG=$P($G(^OR(100,IFN,3)),U,5),PSORIG=$G(^OR(100,+ORIG,4))
. I PSORIG'>0 S PSORIG="",TYPE=0 ;edit of unreleased order
S ZRX="ZRX|"_PSORIG_"|"_NATURE_"|"_$S(TYPE=1:"E",TYPE=2:"R",1:"N")
S ROUTING=$G(ORDIALOG($$PTR("ROUTING"),1))
;AGP FIX FOR PROBLEM WITH ROUTING BE SET TO DAY SUPPLY ONCE ROOT CAUSE
;IS FOUND THIS CODE WILL BE REMOVE
I OUTPT=1,ROUTING'="",ROUTING>0 S ROUTING="M"
I $G(OUTPT) S ZRX=ZRX_"|"_ROUTING_$S($L($P($G(^OR(100,ORIFN,8,1,2)),"^",3)):"|||1",1:"")
Q ZRX
;
ZRN(IFN,ORMSG,I) ; -- Set ZRN segment
N ST,ZRN,J,K,TXT,LSTDOSE,HMMEDLST,RESN,LOCALE
S ORMSG(I)="ZRN|N|"
S ST=$$PTR("STATEMENTS")
I $L($G(ORDIALOG(ST,1))) D
. S J=$O(^TMP("ORWORD",$J,ST,1,0)) Q:'J
. S K=0,TXT=$G(^TMP("ORWORD",$J,ST,1,J,0))
. I $L(TXT) S K=K+1,ORMSG(I,K)=TXT
. F S J=$O(^TMP("ORWORD",$J,ST,1,J)) Q:J'>0 S TXT=$G(^(J,0)) D
. . I $L(TXT) S K=K+1,ORMSG(I,K)=TXT
;IHS/MSC/REC/PLS - 08/06/2010 - Support for Med Rec
S LSTDOSE=$$PTR^ORCD("OR GTX HM LAST DOSE TAKEN")
S HMMEDLST=$$PTR^ORCD("OR GTX HM LIST SOURCE")
S RESN=$$PTR^ORCD("OR GTX HM REASON")
S LOCALE=$$PTR^ORCD("OR GTX HM LOCATION OF MEDICATION")
I $L($G(ORDIALOG(LSTDOSE,1))) D
.N %DT,Y,X
.S %DT="X",X=ORDIALOG(LSTDOSE,1) I X]"" D ^%DT
.S:Y $P(ORMSG(I),"|",4)=$$FMTHL7^XLFDT(Y)
I $L($G(ORDIALOG(HMMEDLST,1))) D
.N LIST,X,OK
.S LIST=$P(ORDIALOG(HMMEDLST,0),U,2)
.S X=ORDIALOG(HMMEDLST,1)
.F J=1:1 Q:$P(LIST,";",J)="" Q:$G(OK) I X=$P($P(LIST,";",J),":") S $P(ORMSG(I),"|",5)=$P($P(LIST,";",J),":",2),OK=1
I $L($G(ORDIALOG(LOCALE,1))) D
.N LIST,X,OK
.S LIST=$P(ORDIALOG(LOCALE,0),U,2)
.S X=ORDIALOG(LOCALE,1)
.F J=1:1 Q:$P(LIST,";",J)="" Q:$G(OK) I X=$P($P(LIST,";",J),":") S $P(ORMSG(I),"|",6)=$P($P(LIST,";",J),":",2),OK=1
I $L($G(ORDIALOG(RESN,1))) D
.S I=I+1,ORMSG(I)="ZHM||"
.S J=$O(^TMP("ORWORD",$J,RESN,1,0)) Q:'J
.S TXT=$G(^TMP("ORWORD",$J,RESN,1,J,0))
.I $L(TXT) S $P(ORMSG(I),"|",2)=J,$P(ORMSG(I),"|",3)=TXT
.F S J=$O(^TMP("ORWORD",$J,RESN,1,J)) Q:J'>0 S TXT=$G(^(J,0)) D
..I $L(TXT) S I=I+1,ORMSG(I)="ZHM|"_J_"|"_TXT
Q
;
ORDCHKS ; -- Include order checks in OBX segments
N OC,X,X1 S OC=0
F S OC=$O(^OR(100,IFN,9,OC)) Q:OC'>0 S X=$G(^(OC,0)),X1=$G(^(1)) D
. S I=I+1,ORMSG(I)="OBX|"_OC_"|TX|^^^"_+X_"^^99OCX||"_$$ESC($S($L(X1):X1,1:$P(X,U,3)))_"|||||||||"_$$FMTHL7^XLFDT($P(X,U,6))_"||"_$P(X,U,5)
. I $L($P(X,U,4)) S I=I+1,ORMSG(I)="NTE|"_OC_"|P|"_$$ESC($P(X,U,4))
Q
;
HL7UNIT(X) ; -- Return coded element for volume/strength units
N I,UNIT,Y
F I=1:1:$L(X) I $E(X,I)?1A Q ; first letter
S UNIT=$$UP^XLFSTR($E(X,I,$L(X))),Y=""
F I=1:1:14 S X=$P("ML^LITER^MCG^MG^GM^UNITS^IU^MEQ^MM^MU^THOUU^MG-PE^NANOGRAM^MMOL","^",I) I UNIT=X S Y="^^^PSIV-"_I_U_UNIT_"^99OTH" Q
Q Y
;
VER(IFN) ; -- Send msg for nurse-verified orders
N OR0,ORMSG S OR0=$G(^OR(100,+IFN,0)) Q:$P(OR0,U,12)'="I" ;Inpt only
S ORMSG(1)=$$MSH^ORMBLD("ORM","PS"),ORMSG(2)=$$PID^ORMBLD($P(OR0,U,2))
S ORMSG(3)=$$PV1^ORMBLD($P(OR0,U,2),$P(OR0,U,12),+$P(OR0,U,10))
S ORMSG(4)="ORC|ZV|"_IFN_"^OR|"_$G(^OR(100,+IFN,4))_"^PS||||||||"_DUZ_"||||"_$$FMTHL7^XLFDT($$NOW^XLFDT)
D MSG^XQOR("OR EVSEND PS",.ORMSG)
Q
;
REF(IFN,ROUTING,CLINIC) ; -- Send msg for refill request
N OR0,ORMSG S OR0=$G(^OR(100,+IFN,0)) Q:$P(OR0,U,12)'="O"
S:'$G(CLINIC) CLINIC=$S($G(ORL):+ORL,1:+$P(OR0,U,10))
S ORMSG(1)=$$MSH^ORMBLD("ORM","PS"),ORMSG(2)=$$PID^ORMBLD($P(OR0,U,2))
S ORMSG(3)=$$PV1^ORMBLD($P(OR0,U,2),"O",CLINIC)
S ORMSG(4)="ORC|ZF|"_IFN_"^OR|"_$G(^OR(100,+IFN,4))_"^PS|||||||"_DUZ_"||"_$G(ORNP)_"|||"_$$FMTHL7^XLFDT($$NOW^XLFDT)
S ORMSG(5)="ZRX||||"_ROUTING
D MSG^XQOR("OR EVSEND PS",.ORMSG)
Q
ESC(STR) ;
Q $$ESC^ORHLESC(STR,"~|\&^")
ORMBLDPS ;SLC/MKB-Build outgoing Pharmacy ORM msgs ;19-Sep-2012 09:48;MGH
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**7,38,54,86,97,94,116,129,141,190,195,237,254,243,1010**;Dec 17, 1997;Build 47
+2 ;Modified - IHS/MSC/PLS - 08/06/2010 - Line ZRN+10
+3 ;Modified - IHS/MSC/MGH - 09/19/2012 - Lines added UD2 5-9
PTR(NAME) ; -- Returns ptr value of prompt in Dialog file
+1 QUIT +$ORDER(^ORD(101.41,"AB",$EXTRACT("OR GTX "_NAME,1,63),0))
+2 ;
NVA ; -- new Non-VA Meds order
+1 NEW NVA
SET NVA=1
OUT ; -- new Outpt Meds order [same as UD, +3 fields]
UD ; -- new Inpt (Unit Dose) Meds order
+1 NEW ADMIN,OI,DRUG,INSTR,DOSE,ROUTE,SCHED,DUR,URG,PROVCOMM,PI,DISPENSE,X,Y,I,J,K,L,QT1,QT2,QT3,QT4,QT6,QT9,CONJ,ORC,SC,OUTPT,OITXT,OITXT2
+2 NEW QT7,SCHTYPE
+3 ;outpt flag
SET OUTPT=$SELECT($PIECE(OR0,U,12)="O":1,1:0)
+4 ; Send signer instead of orderer if different
SET X=$GET(^OR(100,IFN,8,1,0))
IF $PIECE(X,U,5)
IF $PIECE(X,U,5)'=$PIECE(X,U,3)
SET $PIECE(ORMSG(4),"|",13)=$PIECE(X,U,5)
+5 SET OI=$$PTR("ORDERABLE ITEM")
SET DRUG=$$PTR("DISPENSE DRUG")
+6 SET INSTR=$$PTR("INSTRUCTIONS")
SET SCHED=$$PTR("SCHEDULE")
SET ADMIN=$$PTR("ADMIN TIMES")
+7 SET SCHTYPE=$$PTR("SCHEDULE TYPE")
+8 SET DUR=$$PTR("DURATION")
SET URG=$$PTR("URGENCY")
SET DOSE=$$PTR("DOSE")
+9 SET ROUTE=$$PTR("ROUTE")
SET PROVCOMM=$$PTR("WORD PROCESSING 1")
+10 SET PI=$$PTR("PATIENT INSTRUCTIONS")
SET CONJ=$$PTR("AND/THEN")
+11 SET J=1
SET ORC(J)=$PIECE(ORMSG(4),"|",1,7)_"|"
+12 IF +$GET(NVA)=1
GOTO NVA1
UD1 SET I=0
FOR
SET I=$ORDER(ORDIALOG(INSTR,I))
IF I'>0
QUIT
Begin DoDot:1
+1 SET X=$GET(ORDIALOG(DOSE,I))
+2 ;S QT1=$S($L(X):$P(X,"&",1,4)_"&"_$P(X,"&",6),1:"")
+3 SET QT2=$$ESC($GET(ORDIALOG(SCHED,I)))_$SELECT(OUTPT:"",1:"&"_$GET(ORDIALOG(ADMIN,I)))
+4 SET QT3=$$HL7DUR
+5 SET QT1=$SELECT($LENGTH(X):$PIECE(X,"&",1,6),1:"")
+6 SET QT6=$PIECE($GET(^ORD(101.42,+$GET(ORDIALOG(URG,I)),0)),U,2)
+7 SET QT7=$GET(ORDIALOG(SCHTYPE,I))
+8 SET QT9=$GET(ORDIALOG(CONJ,I))_"~"
IF $EXTRACT(QT9)="T"
SET QT9="S~"
+9 SET J=J+1
SET ORC(J)=QT1_U_QT2_U_QT3_"^^^"_QT6_U_QT7_U_$$INSTR_U_QT9
End DoDot:1
+10 ;
NVA1 IF +$GET(NVA)=1
Begin DoDot:1
+1 ;only one dosage possible for non-va meds
SET I=1
+2 SET QT2=$GET(ORDIALOG(SCHED,I))
SET QT3=$$HL7DUR
SET X=$GET(ORDIALOG(DOSE,I))
+3 SET QT1=$SELECT($LENGTH(X):$PIECE(X,"&",1,6),1:"")
+4 SET QT6=$PIECE($GET(^ORD(101.42,+$GET(ORDIALOG(URG,I)),0)),U,2)
+5 SET QT9=$GET(ORDIALOG(CONJ,I))_"~"
IF $EXTRACT(QT9)="T"
SET QT9="S~"
+6 SET J=J+1
SET ORC(J)=QT1_U_$$ESC(QT2)_U_QT3_"^^^"_QT6_"^^"_$$INSTR_U_QT9
End DoDot:1
+7 ;
+8 IF $LENGTH($PIECE(OR0,U,8))
SET $PIECE(ORC(2),U,4)=$$FMTHL7^XLFDT($PIECE(OR0,U,8))
IF J<2
SET J=2
+9 SET J=J+1
SET ORC(J)="|"_$PIECE(ORMSG(4),"|",9,999)
SET ORC=J
SET X="ORMSG(4)"
SET ORMSG(4)=""
SET I=0
+10 ;add to ORMSG(4)
FOR J=1:1:ORC
SET Y=ORC(J)
Begin DoDot:1
+11 IF $LENGTH(@X)+$LENGTH(Y)'>245
SET @X=@X_Y
+12 IF '$TEST
SET L=245-$LENGTH(@X)
SET @X=@X_$EXTRACT(Y,1,L)
SET I=I+1
SET X="ORMSG(4,"_I_")"
SET @X=$EXTRACT(Y,L+1,$LENGTH(Y))
End DoDot:1
+13 IF $GET(ORDIALOG(DRUG,1))
SET X=$$ENDCM^PSJORUTL(ORDIALOG(DRUG,1))
SET DISPENSE=$PIECE(X,U,3)_"^^99NDF^"_ORDIALOG(DRUG,1)_"^^99PSD"
+14 SET OITXT=$$USID^ORMBLD($GET(ORDIALOG(OI,1)))
+15 SET OITXT2=$PIECE(OITXT,U,1,4)_U_$$ESC($PIECE(OITXT,U,5))_U_$PIECE(OITXT,U,6,99)
+16 SET ORMSG(5)="RXO|"_OITXT2_"|||||||||"_$GET(DISPENSE)
UD2 IF $GET(OUTPT)
Begin DoDot:1
+1 NEW QTY,REFS,DSPY
+2 SET QTY=$$PTR("QUANTITY")
SET REFS=$$PTR("REFILLS")
SET DSPY=$$PTR("DAYS SUPPLY")
+3 SET ORMSG(5)=ORMSG(5)_"|"_$GET(ORDIALOG(QTY,1))_"||"_$GET(ORDIALOG(REFS,1))_"||||D"_$GET(ORDIALOG(DSPY,1))
End DoDot:1
+4 SET I=5
IF $LENGTH($GET(ORDIALOG(PROVCOMM,1)))
Begin DoDot:1
+5 ;IHS/MSC/MGH First check and make sure its not empty
+6 NEW Y,Z
SET Z=""
+7 SET Y=$ORDER(^TMP("ORWORD",$JOB,PROVCOMM,1,0))
IF 'Y
QUIT
+8 SET Z=Z_$GET(^TMP("ORWORD",$JOB,PROVCOMM,1,Y,0))
+9 IF Z=""
QUIT
+10 ;end mod
+11 SET J=$ORDER(^TMP("ORWORD",$JOB,PROVCOMM,1,0))
IF 'J
QUIT
+12 SET I=6
SET ORMSG(6)="NTE|6|P|"_$$ESC($GET(^TMP("ORWORD",$JOB,PROVCOMM,1,J,0)))
+13 SET K=0
FOR
SET J=$ORDER(^TMP("ORWORD",$JOB,PROVCOMM,1,J))
IF J'>0
QUIT
SET K=K+1
SET ORMSG(6,K)=$GET(^(J,0))
End DoDot:1
+14 IF $GET(OUTPT)
IF $LENGTH($GET(ORDIALOG(PI,1)))
Begin DoDot:1
+15 SET J=$ORDER(^TMP("ORWORD",$JOB,PI,1,0))
IF 'J
QUIT
+16 SET I=I+1
SET ORMSG(I)="NTE|7|P|"_$GET(^TMP("ORWORD",$JOB,PI,1,J,0))
+17 SET K=0
FOR
SET J=$ORDER(^TMP("ORWORD",$JOB,PI,1,J))
IF J'>0
QUIT
SET K=K+1
SET ORMSG(I,K)=$GET(^(J,0))
End DoDot:1
UD3 SET J=0
FOR
SET J=$ORDER(ORDIALOG(ROUTE,J))
IF J'>0
QUIT
SET I=I+1
SET ORMSG(I)=$$RXR($GET(ORDIALOG(ROUTE,J)))
+1 IF $DATA(^OR(100,IFN,9))
DO ORDCHKS
+2 SET I=I+1
SET ORMSG(I)=$$ZRX(IFN,OUTPT)
+3 ;add SC data
IF $GET(OUTPT)
Begin DoDot:1
+4 NEW OR5
SET OR5=$GET(^OR(100,IFN,5))
+5 IF $LENGTH(OR5)
IF OR5'?5"^"
SET I=I+1
SET ORMSG(I)="ZSC|"_$TRANSLATE(OR5,"^","|")
QUIT
+6 SET SC=$$PTR("SERVICE CONNECTED")
IF $DATA(ORDIALOG(SC,1))
SET I=I+1
SET ORMSG(I)="ZSC|"_$SELECT(ORDIALOG(SC,1):"SC",1:"NSC")
End DoDot:1
+7 ; Create DG1 & ZCL segment(s) for Billing Awareness (BA) Project
+8 DO DG1^ORWDBA3($GET(IFN),"I",I)
+9 IF $PIECE(^ORD(100.98,$PIECE(OR0,U,11),0),U)="NON-VA MEDICATIONS"
Begin DoDot:1
+10 SET I=I+1
DO ZRN(IFN,.ORMSG,I)
End DoDot:1
+11 QUIT
+12 ;
INSTR() ; -- Return text instructions for QT-8, instance I
+1 NEW Y
SET Y=$PIECE($GET(ORDIALOG(DOSE,I)),"&",5)
+2 IF $GET(ORDIALOG(DRUG,1))
IF $LENGTH(Y)
QUIT $$ESC(Y)
+3 SET Y=$GET(ORDIALOG(INSTR,I))
IF $GET(OUTPT)
Begin DoDot:1
+4 NEW UNITS,UNT
SET UNITS=$$PTR("FREE TEXT")
SET UNT=$GET(ORDIALOG(UNITS,I))
+5 ;old format
IF $LENGTH(UNT)
SET Y=Y_" "_UNT
End DoDot:1
+6 QUIT $$ESC(Y)
+7 ;
HL7DUR() ; -- Returns HL7 form of duration X
+1 NEW X,X1,X2,Y
SET X=$GET(ORDIALOG(DUR,I))
+2 SET X1=+$GET(X)
SET Y=""
IF X1'>0
GOTO HDQ
+3 SET X2=$$UP^XLFSTR($PIECE(X,X1,2))
IF $EXTRACT(X2)=" "
SET X2=$EXTRACT(X2,2,99)
+4 SET Y=$SELECT($EXTRACT(X2,1,2)="MO":"L",'$LENGTH(X2):"D",1:$EXTRACT(X2))_X1
HDQ QUIT Y
+1 ;
IV ; -- new IV Meds order
+1 NEW SOLN,VOL,ADDS,STR,UNITS,RATE,URG,WP,QT,I,X1,X2,INST
+2 ; duratioin or total volume for IV order
NEW IVLIMIT
+3 NEW IVTYPE,IVZRX,X,CNT,ROUTE,ORBCMA,DFN
+4 SET IVLIMIT=$$PTR("DURATION")
+5 SET IVTYPE=$GET(ORDIALOG(+$$PTR("IV TYPE"),1))
+6 IF IVTYPE=""
IF $PIECE($GET(^OR(100,IFN,3)),U,11)="B"
Begin DoDot:1
+7 SET IVTYPE=$$MOB^ORMBLDP1(IFN,+$PIECE($GET(^OR(100,IFN,0)),U,2))
+8 DO RESP^ORCSAVE2(IFN,"OR GTX IV TYPE",IVTYPE)
End DoDot:1
+9 SET RATE=$$PTR("INFUSION RATE")
SET ADDS=$$PTR("ADDITIVE")
+10 SET STR=$$PTR("STRENGTH PSIV")
SET UNITS=$$PTR("UNITS")
+11 SET WP=$$PTR("WORD PROCESSING 1")
SET VOL=$$PTR("VOLUME")
+12 SET SCHTYPE=$$PTR("SCHEDULE TYPE")
+13 SET SOLN=$$PTR("ORDERABLE ITEM")
SET URG=+$GET(ORDIALOG($$PTR("URGENCY"),1))
+14 ;I IVTYPE="",$G(ORDIALOG(+$$PTR("SCHEDULE"),1))="" S IVTYPE="C"
+15 IF IVTYPE="I"
SET QT=U_$$ESC($GET(ORDIALOG(+$$PTR("SCHEDULE"),1)))_"&"_$GET(ORDIALOG(+$$PTR("ADMIN TIMES"),1))_"^^^^"
+16 IF IVTYPE="C"
SET QT="^^^^^"
+17 ;S QT=U_$G(ORDIALOG(+$$PTR("SCHEDULE"),1))_"^^^^"
+18 IF URG
SET QT=QT_$PIECE($GET(^ORD(101.42,URG,0)),U,2)
+19 SET $PIECE(ORMSG(4),"|",8)=QT
+20 ; Send signer instead of orderer if different
SET X=$GET(^OR(100,IFN,8,1,0))
IF $PIECE(X,U,5)
IF $PIECE(X,U,5)'=$PIECE(X,U,3)
SET $PIECE(ORMSG(4),"|",13)=$PIECE(X,U,5)
+21 ;strip any trailing spaces
SET RATE=$GET(ORDIALOG(RATE,1))
IF $EXTRACT(RATE,$LENGTH(RATE))=" "
SET RATE=$EXTRACT(RATE,1,($LENGTH(RATE)-1))
SET ORMSG(5)="RXO|^^^PS-1^IV^99OTH|"_$$ESC(RATE)
+22 SET IVLIMIT=$GET(ORDIALOG(IVLIMIT,1))
+23 IF $LENGTH(IVLIMIT)
SET IVLIMIT=$$HL7IVLMT^ORMBLDP1(IVLIMIT)
SET ORMSG(5)="RXO|^^"_IVLIMIT_"^PS-1^IV^99OTH|"_RATE
+24 SET I=5
IF $LENGTH($GET(ORDIALOG(WP,1)))
Begin DoDot:1
+25 NEW J,K
SET J=$ORDER(^TMP("ORWORD",$JOB,WP,1,0))
IF 'J
QUIT
+26 SET I=6
SET ORMSG(6)="NTE|6|P|"_$$ESC($GET(^TMP("ORWORD",$JOB,WP,1,J,0)))
+27 SET K=0
FOR
SET J=$ORDER(^TMP("ORWORD",$JOB,WP,1,J))
IF J'>0
QUIT
SET K=K+1
SET ORMSG(6,K)=^(J,0)
End DoDot:1
+28 ;S I=I+1,ORMSG(I)=$$RXR(+$$PTR("ROUTE"))
+29 SET ROUTE=+$$PTR("ROUTE")
+30 SET I=I+1
SET ORMSG(I)=$$RXR($GET(ORDIALOG(ROUTE,1)))
IV1 SET INST=0
FOR
SET INST=$ORDER(ORDIALOG(SOLN,INST))
IF INST'>0
QUIT
Begin DoDot:1
+1 SET X1="B"
SET X2=+$GET(ORDIALOG(SOLN,INST))
+2 ;pre-mix
IF $PIECE($GET(^ORD(101.43,X2,"PS")),U,4)
SET X1=X1_"A"
+3 SET I=I+1
SET ORMSG(I)="RXC|"_X1_"|"_$$USID^ORMBLD(X2)_"|"_$GET(ORDIALOG(VOL,INST))_"|"_$$HL7UNIT("ML")
End DoDot:1
+4 IF $ORDER(ORDIALOG(ADDS,0))
Begin DoDot:1
+5 SET INST=0
FOR
SET INST=$ORDER(ORDIALOG(ADDS,INST))
IF INST'>0
QUIT
Begin DoDot:2
+6 SET X1=$GET(ORDIALOG(ADDS,INST))
SET X2=$GET(ORDIALOG(UNITS,INST))
+7 SET I=I+1
SET ORMSG(I)="RXC|A|"_$$USID^ORMBLD(X1)_"|"_$GET(ORDIALOG(STR,INST))_"|"_$$HL7UNIT(X2)
End DoDot:2
End DoDot:1
+8 IF $DATA(^OR(100,IFN,9))
DO ORDCHKS
+9 SET IVZRX=$$ZRX(IFN,0)
+10 SET CNT=0
+11 FOR X=1:1:$LENGTH(IVZRX)
IF $EXTRACT(IVZRX,X)="|"
SET CNT=CNT+1
+12 IF CNT<6
FOR X=CNT:1:5
SET IVZRX=IVZRX_"|"
+13 SET I=I+1
SET ORMSG(I)=IVZRX_IVTYPE
+14 ; Create DG1 & ZCL segment(s) for Billing Awareness (BA) Project
+15 DO DG1^ORWDBA3($GET(IFN),"I",I)
+16 QUIT
+17 ;
RXR(ROUTE) ; -- Returns RXR segment
+1 NEW IEN,NAME
+2 IF +ROUTE=0
QUIT "RXR|^^^^^99PSR"
+3 KILL ^TMP($JOB,"ORMBLDPS RXR")
+4 DO ALL^PSS51P2(+ROUTE,,,,"ORMBLDPS RXR")
+5 SET NAME=^TMP($JOB,"ORMBLDPS RXR",+ROUTE,.01)
+6 ;N NAME S NAME=$$GET1^DIQ(51.2,+ROUTE_",",.01)
+7 KILL ^TMP($JOB,"ORMBLDPS RXR")
+8 QUIT "RXR|^^^"_+ROUTE_U_NAME_"^99PSR"
+9 ;
ZRX(IFN,OUTPT) ; -- Returns ZRX segment
+1 NEW NATURE,TYPE,ORIG,PSORIG,ROUTING,ZRX
+2 SET TYPE=$PIECE($GET(^OR(100,IFN,3)),U,11)
SET NATURE=$PIECE($GET(^(8,1,0)),U,12)
+3 ;code
IF NATURE
SET NATURE=$PIECE($GET(^ORD(100.02,+NATURE,0)),U,2)
+4 SET PSORIG=""
IF (TYPE=1)!(TYPE=2)
Begin DoDot:1
+5 SET ORIG=$PIECE($GET(^OR(100,IFN,3)),U,5)
SET PSORIG=$GET(^OR(100,+ORIG,4))
+6 ;edit of unreleased order
IF PSORIG'>0
SET PSORIG=""
SET TYPE=0
End DoDot:1
+7 SET ZRX="ZRX|"_PSORIG_"|"_NATURE_"|"_$SELECT(TYPE=1:"E",TYPE=2:"R",1:"N")
+8 SET ROUTING=$GET(ORDIALOG($$PTR("ROUTING"),1))
+9 ;AGP FIX FOR PROBLEM WITH ROUTING BE SET TO DAY SUPPLY ONCE ROOT CAUSE
+10 ;IS FOUND THIS CODE WILL BE REMOVE
+11 IF OUTPT=1
IF ROUTING'=""
IF ROUTING>0
SET ROUTING="M"
+12 IF $GET(OUTPT)
SET ZRX=ZRX_"|"_ROUTING_$SELECT($LENGTH($PIECE($GET(^OR(100,ORIFN,8,1,2)),"^",3)):"|||1",1:"")
+13 QUIT ZRX
+14 ;
ZRN(IFN,ORMSG,I) ; -- Set ZRN segment
+1 NEW ST,ZRN,J,K,TXT,LSTDOSE,HMMEDLST,RESN,LOCALE
+2 SET ORMSG(I)="ZRN|N|"
+3 SET ST=$$PTR("STATEMENTS")
+4 IF $LENGTH($GET(ORDIALOG(ST,1)))
Begin DoDot:1
+5 SET J=$ORDER(^TMP("ORWORD",$JOB,ST,1,0))
IF 'J
QUIT
+6 SET K=0
SET TXT=$GET(^TMP("ORWORD",$JOB,ST,1,J,0))
+7 IF $LENGTH(TXT)
SET K=K+1
SET ORMSG(I,K)=TXT
+8 FOR
SET J=$ORDER(^TMP("ORWORD",$JOB,ST,1,J))
IF J'>0
QUIT
SET TXT=$GET(^(J,0))
Begin DoDot:2
+9 IF $LENGTH(TXT)
SET K=K+1
SET ORMSG(I,K)=TXT
End DoDot:2
End DoDot:1
+10 ;IHS/MSC/REC/PLS - 08/06/2010 - Support for Med Rec
+11 SET LSTDOSE=$$PTR^ORCD("OR GTX HM LAST DOSE TAKEN")
+12 SET HMMEDLST=$$PTR^ORCD("OR GTX HM LIST SOURCE")
+13 SET RESN=$$PTR^ORCD("OR GTX HM REASON")
+14 SET LOCALE=$$PTR^ORCD("OR GTX HM LOCATION OF MEDICATION")
+15 IF $LENGTH($GET(ORDIALOG(LSTDOSE,1)))
Begin DoDot:1
+16 NEW %DT,Y,X
+17 SET %DT="X"
SET X=ORDIALOG(LSTDOSE,1)
IF X]""
DO ^%DT
+18 IF Y
SET $PIECE(ORMSG(I),"|",4)=$$FMTHL7^XLFDT(Y)
End DoDot:1
+19 IF $LENGTH($GET(ORDIALOG(HMMEDLST,1)))
Begin DoDot:1
+20 NEW LIST,X,OK
+21 SET LIST=$PIECE(ORDIALOG(HMMEDLST,0),U,2)
+22 SET X=ORDIALOG(HMMEDLST,1)
+23 FOR J=1:1
IF $PIECE(LIST,";",J)=""
QUIT
IF $GET(OK)
QUIT
IF X=$PIECE($PIECE(LIST,";",J),":")
SET $PIECE(ORMSG(I),"|",5)=$PIECE($PIECE(LIST,";",J),":",2)
SET OK=1
End DoDot:1
+24 IF $LENGTH($GET(ORDIALOG(LOCALE,1)))
Begin DoDot:1
+25 NEW LIST,X,OK
+26 SET LIST=$PIECE(ORDIALOG(LOCALE,0),U,2)
+27 SET X=ORDIALOG(LOCALE,1)
+28 FOR J=1:1
IF $PIECE(LIST,";",J)=""
QUIT
IF $GET(OK)
QUIT
IF X=$PIECE($PIECE(LIST,";",J),":")
SET $PIECE(ORMSG(I),"|",6)=$PIECE($PIECE(LIST,";",J),":",2)
SET OK=1
End DoDot:1
+29 IF $LENGTH($GET(ORDIALOG(RESN,1)))
Begin DoDot:1
+30 SET I=I+1
SET ORMSG(I)="ZHM||"
+31 SET J=$ORDER(^TMP("ORWORD",$JOB,RESN,1,0))
IF 'J
QUIT
+32 SET TXT=$GET(^TMP("ORWORD",$JOB,RESN,1,J,0))
+33 IF $LENGTH(TXT)
SET $PIECE(ORMSG(I),"|",2)=J
SET $PIECE(ORMSG(I),"|",3)=TXT
+34 FOR
SET J=$ORDER(^TMP("ORWORD",$JOB,RESN,1,J))
IF J'>0
QUIT
SET TXT=$GET(^(J,0))
Begin DoDot:2
+35 IF $LENGTH(TXT)
SET I=I+1
SET ORMSG(I)="ZHM|"_J_"|"_TXT
End DoDot:2
End DoDot:1
+36 QUIT
+37 ;
ORDCHKS ; -- Include order checks in OBX segments
+1 NEW OC,X,X1
SET OC=0
+2 FOR
SET OC=$ORDER(^OR(100,IFN,9,OC))
IF OC'>0
QUIT
SET X=$GET(^(OC,0))
SET X1=$GET(^(1))
Begin DoDot:1
+3 SET I=I+1
SET ORMSG(I)="OBX|"_OC_"|TX|^^^"_+X_"^^99OCX||"_$$ESC($SELECT($LENGTH(X1):X1,1:$PIECE(X,U,3)))_"|||||||||"_$$FMTHL7^XLFDT($PIECE(X,U,6))_"||"_$PIECE(X,U,5)
+4 IF $LENGTH($PIECE(X,U,4))
SET I=I+1
SET ORMSG(I)="NTE|"_OC_"|P|"_$$ESC($PIECE(X,U,4))
End DoDot:1
+5 QUIT
+6 ;
HL7UNIT(X) ; -- Return coded element for volume/strength units
+1 NEW I,UNIT,Y
+2 ; first letter
FOR I=1:1:$LENGTH(X)
IF $EXTRACT(X,I)?1A
QUIT
+3 SET UNIT=$$UP^XLFSTR($EXTRACT(X,I,$LENGTH(X)))
SET Y=""
+4 FOR I=1:1:14
SET X=$PIECE("ML^LITER^MCG^MG^GM^UNITS^IU^MEQ^MM^MU^THOUU^MG-PE^NANOGRAM^MMOL","^",I)
IF UNIT=X
SET Y="^^^PSIV-"_I_U_UNIT_"^99OTH"
QUIT
+5 QUIT Y
+6 ;
VER(IFN) ; -- Send msg for nurse-verified orders
+1 ;Inpt only
NEW OR0,ORMSG
SET OR0=$GET(^OR(100,+IFN,0))
IF $PIECE(OR0,U,12)'="I"
QUIT
+2 SET ORMSG(1)=$$MSH^ORMBLD("ORM","PS")
SET ORMSG(2)=$$PID^ORMBLD($PIECE(OR0,U,2))
+3 SET ORMSG(3)=$$PV1^ORMBLD($PIECE(OR0,U,2),$PIECE(OR0,U,12),+$PIECE(OR0,U,10))
+4 SET ORMSG(4)="ORC|ZV|"_IFN_"^OR|"_$GET(^OR(100,+IFN,4))_"^PS||||||||"_DUZ_"||||"_$$FMTHL7^XLFDT($$NOW^XLFDT)
+5 DO MSG^XQOR("OR EVSEND PS",.ORMSG)
+6 QUIT
+7 ;
REF(IFN,ROUTING,CLINIC) ; -- Send msg for refill request
+1 NEW OR0,ORMSG
SET OR0=$GET(^OR(100,+IFN,0))
IF $PIECE(OR0,U,12)'="O"
QUIT
+2 IF '$GET(CLINIC)
SET CLINIC=$SELECT($GET(ORL):+ORL,1:+$PIECE(OR0,U,10))
+3 SET ORMSG(1)=$$MSH^ORMBLD("ORM","PS")
SET ORMSG(2)=$$PID^ORMBLD($PIECE(OR0,U,2))
+4 SET ORMSG(3)=$$PV1^ORMBLD($PIECE(OR0,U,2),"O",CLINIC)
+5 SET ORMSG(4)="ORC|ZF|"_IFN_"^OR|"_$GET(^OR(100,+IFN,4))_"^PS|||||||"_DUZ_"||"_$GET(ORNP)_"|||"_$$FMTHL7^XLFDT($$NOW^XLFDT)
+6 SET ORMSG(5)="ZRX||||"_ROUTING
+7 DO MSG^XQOR("OR EVSEND PS",.ORMSG)
+8 QUIT
ESC(STR) ;
+1 QUIT $$ESC^ORHLESC(STR,"~|\&^")
