- ORMBLDPS ;SLC/MKB-Build outgoing Pharmacy ORM msgs ;Jul 20, 2021@14:08:09
- ;;3.0;ORDER ENTRY/RESULTS REPORTING;**7,38,54,86,97,94,116,129,141,190,195,237,254,243,293,280,266,395,405**;Dec 17, 1997;Build 211
- ;
- ;
- 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,INDICATN
- 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 INDICATN=$$PTR("INDICATION") ;*405-IND
- S J=1,ORC(J)=$P(ORMSG(4),"|",1,7)_"|"
- ;removed G NVA1 here, as now introducing complex NVA Meds ability
- 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=$S(+$G(NVA):$$DURATION^ORMPS3($$HL7DUR),1:$$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 ;introduces complex Non-VA order, removed 7 lines of code that only allowed one dosage
- ;
- 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
- . 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)))
- 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)
- S $P(ORMSG(5),"|",21)=$$ESC($G(ORDIALOG(INDICATN,1))) ;*405-IND - Add Indication to RXO segment
- Q
- ;
- INSTR() ; -- Return text instructions for QT-8, instance I
- N Y,OROI S Y=$P($G(ORDIALOG(DOSE,I)),"&",5)
- I $G(ORDIALOG(DRUG,1)),$L(Y) Q $$ESC(Y)
- S Y=$G(ORDIALOG(INSTR,I))
- S OROI=$G(ORDIALOG($$PTR("ORDERABLE ITEM"),1))
- S Y=$$RMVDRGNM(Y,OROI,OUTPT)
- 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)
- ;
- RMVDRGNM(ORIG,OROI,OROUTPT) ;remove the drug name from the dosage string
- N OROUT,ORTYPE,ORDD,ORDGNAME
- S OROUT=ORIG
- S ORTYPE="I"
- I OROUTPT S ORTYPE="O"
- S ORDD=+$$OI2DD^ORKPS(OROI,ORTYPE,0)
- I 'ORDD Q ORIG
- S ORDGNAME=$$GETPSNM^ORKPS(ORDD)
- S ORIG=$$TRIM^ORBCMA32($P(ORIG,ORDGNAME))
- Q ORIG
- ;
- 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 ; duration or total volume for IV order
- N IVTYPE,IVZRX,X,CNT,ROUTE,ORBCMA,DFN,ADDFREQ,INDICATN
- 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 ADDFREQ=$$PTR("ADDITIVE FREQUENCY")
- 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))
- S INDICATN=$$PTR("INDICATION") ;*405-IND
- ;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 $P(ORMSG(5),"|",21)=$$ESC($G(ORDIALOG(INDICATN,1))) ; *405-Add Indication to RXO message
- 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)_"|"_$$ADDFRQCV^ORMBLDP1($G(ORDIALOG(ADDFREQ,INST)),"O")
- . . ;S I=I+1,ORMSG(I)="RXC|A|"_$$USID^ORMBLD(X1)_"|"_$G(ORDIALOG(STR,INST))_"|"_$$HL7UNIT(X2)
- 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 $P(IVZRX,"|",7)=IVTYPE
- 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,ORTITR,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:"")
- ; Send titration info in ZRX-8
- S ORTITR=+$G(ORDIALOG($$PTR("TITRATION"),1))
- S $P(ZRX,"|",9)=ORTITR
- Q ZRX
- ;
- ZRN(IFN,ORMSG,I) ; -- Set ZRN segment
- N ST,ZRN,J,K,TXT
- 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
- Q
- ;
- ORDCHKS ; -- Include order checks in OBX segments
- N ORRET,OC,CNT S CNT=0
- D GETOC5^OROCAPI1(+IFN,"SIGNATURE_CPRS",.ORRET)
- S OC=0 F S OC=$O(ORRET(+IFN,"DATA",OC)) Q:'OC D
- .S I=I+1,CNT=CNT+1
- .S ORMSG(I)="OBX|"_CNT_"|TX|^^^"_+ORRET(+IFN,"DATA",OC,1)_"^^99OCX||"_$$ESC($G(ORRET(+IFN,"DATA",OC,"OC",1,0)))
- .I '$L($G(ORRET(+IFN,"DATA",OC,"OC",2,0))) S ORMSG(I)=ORMSG(I)_"|||||||||"_$$FMTHL7^XLFDT($P(ORRET(+IFN,"DATA",OC,1),U,5))_"||"_$P(ORRET(+IFN,"DATA",OC,1),U,5)
- .I $L($G(ORRET(+IFN,"DATA",OC,"OC",2,0))) D
- ..N J S J=1 F S J=$O(ORRET(+IFN,"DATA",OC,"OC",J)) Q:'J S ORMSG(I,J-1)=$G(ORRET(+IFN,"DATA",OC,"OC",J,0))
- ..S ORMSG(I,$O(ORMSG(I,""),-1))=ORMSG(I,$O(ORMSG(I,""),-1))_"|||||||||"_$$FMTHL7^XLFDT($P(ORRET(+IFN,"DATA",OC,1),U,5))_"||"_$P(ORRET(+IFN,"DATA",OC,1),U,5)
- .I $L($G(ORRET(+IFN,"DATA",OC,"OR",1,0))) S I=I+1,ORMSG(I)="NTE|"_OC_"|P|"_$$ESC($G(ORRET(+IFN,"DATA",OC,"OR",1,0)))
- 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))
- 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,"~|\&^")
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORMBLDPS 11537 printed Feb 18, 2025@23:58:22 Page 2
- ORMBLDPS ;SLC/MKB-Build outgoing Pharmacy ORM msgs ;Jul 20, 2021@14:08:09
- +1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**7,38,54,86,97,94,116,129,141,190,195,237,254,243,293,280,266,395,405**;Dec 17, 1997;Build 211
- +2 ;
- +3 ;
- 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,INDICATN
- +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 ;*405-IND
- SET INDICATN=$$PTR("INDICATION")
- +12 SET J=1
- SET ORC(J)=$PIECE(ORMSG(4),"|",1,7)_"|"
- +13 ;removed G NVA1 here, as now introducing complex NVA Meds ability
- 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=$SELECT(+$GET(NVA):$$DURATION^ORMPS3($$HL7DUR),1:$$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 ;introduces complex Non-VA order, removed 7 lines of code that only allowed one dosage
- +1 ;
- +2 IF $LENGTH($PIECE(OR0,U,8))
- SET $PIECE(ORC(2),U,4)=$$FMTHL7^XLFDT($PIECE(OR0,U,8))
- if J<2
- SET J=2
- +3 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
- +4 ;add to ORMSG(4)
- FOR J=1:1:ORC
- SET Y=ORC(J)
- Begin DoDot:1
- +5 IF $LENGTH(@X)+$LENGTH(Y)'>245
- SET @X=@X_Y
- +6 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
- +7 IF $GET(ORDIALOG(DRUG,1))
- SET X=$$ENDCM^PSJORUTL(ORDIALOG(DRUG,1))
- SET DISPENSE=$PIECE(X,U,3)_"^^99NDF^"_ORDIALOG(DRUG,1)_"^^99PSD"
- +8 SET OITXT=$$USID^ORMBLD($GET(ORDIALOG(OI,1)))
- +9 SET OITXT2=$PIECE(OITXT,U,1,4)_U_$$ESC($PIECE(OITXT,U,5))_U_$PIECE(OITXT,U,6,99)
- +10 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 SET J=$ORDER(^TMP("ORWORD",$JOB,PROVCOMM,1,0))
- if 'J
- QUIT
- +6 SET I=6
- SET ORMSG(6)="NTE|6|P|"_$$ESC($GET(^TMP("ORWORD",$JOB,PROVCOMM,1,J,0)))
- +7 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
- +8 IF $GET(OUTPT)
- IF $LENGTH($GET(ORDIALOG(PI,1)))
- Begin DoDot:1
- +9 SET J=$ORDER(^TMP("ORWORD",$JOB,PI,1,0))
- if 'J
- QUIT
- +10 SET I=I+1
- SET ORMSG(I)="NTE|7|P|"_$GET(^TMP("ORWORD",$JOB,PI,1,J,0))
- +11 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 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 ;*405-IND - Add Indication to RXO segment
- SET $PIECE(ORMSG(5),"|",21)=$$ESC($GET(ORDIALOG(INDICATN,1)))
- +12 QUIT
- +13 ;
- INSTR() ; -- Return text instructions for QT-8, instance I
- +1 NEW Y,OROI
- 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))
- +4 SET OROI=$GET(ORDIALOG($$PTR("ORDERABLE ITEM"),1))
- +5 SET Y=$$RMVDRGNM(Y,OROI,OUTPT)
- +6 IF $GET(OUTPT)
- Begin DoDot:1
- +7 NEW UNITS,UNT
- SET UNITS=$$PTR("FREE TEXT")
- SET UNT=$GET(ORDIALOG(UNITS,I))
- +8 ;old format
- if $LENGTH(UNT)
- SET Y=Y_" "_UNT
- End DoDot:1
- +9 QUIT $$ESC(Y)
- +10 ;
- RMVDRGNM(ORIG,OROI,OROUTPT) ;remove the drug name from the dosage string
- +1 NEW OROUT,ORTYPE,ORDD,ORDGNAME
- +2 SET OROUT=ORIG
- +3 SET ORTYPE="I"
- +4 IF OROUTPT
- SET ORTYPE="O"
- +5 SET ORDD=+$$OI2DD^ORKPS(OROI,ORTYPE,0)
- +6 IF 'ORDD
- QUIT ORIG
- +7 SET ORDGNAME=$$GETPSNM^ORKPS(ORDD)
- +8 SET ORIG=$$TRIM^ORBCMA32($PIECE(ORIG,ORDGNAME))
- +9 QUIT ORIG
- +10 ;
- 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 ; duration or total volume for IV order
- NEW IVLIMIT
- +3 NEW IVTYPE,IVZRX,X,CNT,ROUTE,ORBCMA,DFN,ADDFREQ,INDICATN
- +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 ADDFREQ=$$PTR("ADDITIVE FREQUENCY")
- +11 SET STR=$$PTR("STRENGTH PSIV")
- SET UNITS=$$PTR("UNITS")
- +12 SET WP=$$PTR("WORD PROCESSING 1")
- SET VOL=$$PTR("VOLUME")
- +13 SET SCHTYPE=$$PTR("SCHEDULE TYPE")
- +14 SET SOLN=$$PTR("ORDERABLE ITEM")
- SET URG=+$GET(ORDIALOG($$PTR("URGENCY"),1))
- +15 ;*405-IND
- SET INDICATN=$$PTR("INDICATION")
- +16 ;I IVTYPE="",$G(ORDIALOG(+$$PTR("SCHEDULE"),1))="" S IVTYPE="C"
- +17 IF IVTYPE="I"
- SET QT=U_$$ESC($GET(ORDIALOG(+$$PTR("SCHEDULE"),1)))_"&"_$GET(ORDIALOG(+$$PTR("ADMIN TIMES"),1))_"^^^^"
- +18 IF IVTYPE="C"
- SET QT="^^^^^"
- +19 ;S QT=U_$G(ORDIALOG(+$$PTR("SCHEDULE"),1))_"^^^^"
- +20 if URG
- SET QT=QT_$PIECE($GET(^ORD(101.42,URG,0)),U,2)
- +21 SET $PIECE(ORMSG(4),"|",8)=QT
- +22 ; 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)
- +23 ;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)
- +24 SET IVLIMIT=$GET(ORDIALOG(IVLIMIT,1))
- +25 IF $LENGTH(IVLIMIT)
- SET IVLIMIT=$$HL7IVLMT^ORMBLDP1(IVLIMIT)
- SET ORMSG(5)="RXO|^^"_IVLIMIT_"^PS-1^IV^99OTH|"_RATE
- +26 ; *405-Add Indication to RXO message
- SET $PIECE(ORMSG(5),"|",21)=$$ESC($GET(ORDIALOG(INDICATN,1)))
- +27 SET I=5
- IF $LENGTH($GET(ORDIALOG(WP,1)))
- Begin DoDot:1
- +28 NEW J,K
- SET J=$ORDER(^TMP("ORWORD",$JOB,WP,1,0))
- if 'J
- QUIT
- +29 SET I=6
- SET ORMSG(6)="NTE|6|P|"_$$ESC($GET(^TMP("ORWORD",$JOB,WP,1,J,0)))
- +30 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
- +31 ;S I=I+1,ORMSG(I)=$$RXR(+$$PTR("ROUTE"))
- +32 SET ROUTE=+$$PTR("ROUTE")
- +33 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)_"|"_$$ADDFRQCV^ORMBLDP1($GET(ORDIALOG(ADDFREQ,INST)),"O")
- +8 ;S I=I+1,ORMSG(I)="RXC|A|"_$$USID^ORMBLD(X1)_"|"_$G(ORDIALOG(STR,INST))_"|"_$$HL7UNIT(X2)
- End DoDot:2
- End DoDot:1
- +9 DO ORDCHKS
- +10 SET IVZRX=$$ZRX(IFN,0)
- +11 ;S CNT=0
- +12 ;F X=1:1:$L(IVZRX) I $E(IVZRX,X)="|" S CNT=CNT+1
- +13 ;I CNT<6 F X=CNT:1:5 S IVZRX=IVZRX_"|"
- +14 SET $PIECE(IVZRX,"|",7)=IVTYPE
- +15 ; _IVTYPE
- SET I=I+1
- SET ORMSG(I)=IVZRX
- +16 ; Create DG1 & ZCL segment(s) for Billing Awareness (BA) Project
- +17 DO DG1^ORWDBA3($GET(IFN),"I",I)
- +18 QUIT
- +19 ;
- 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,ORTITR,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 ; Send titration info in ZRX-8
- +14 SET ORTITR=+$GET(ORDIALOG($$PTR("TITRATION"),1))
- +15 SET $PIECE(ZRX,"|",9)=ORTITR
- +16 QUIT ZRX
- +17 ;
- ZRN(IFN,ORMSG,I) ; -- Set ZRN segment
- +1 NEW ST,ZRN,J,K,TXT
- +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 QUIT
- +11 ;
- ORDCHKS ; -- Include order checks in OBX segments
- +1 NEW ORRET,OC,CNT
- SET CNT=0
- +2 DO GETOC5^OROCAPI1(+IFN,"SIGNATURE_CPRS",.ORRET)
- +3 SET OC=0
- FOR
- SET OC=$ORDER(ORRET(+IFN,"DATA",OC))
- if 'OC
- QUIT
- Begin DoDot:1
- +4 SET I=I+1
- SET CNT=CNT+1
- +5 SET ORMSG(I)="OBX|"_CNT_"|TX|^^^"_+ORRET(+IFN,"DATA",OC,1)_"^^99OCX||"_$$ESC($GET(ORRET(+IFN,"DATA",OC,"OC",1,0)))
- +6 IF '$LENGTH($GET(ORRET(+IFN,"DATA",OC,"OC",2,0)))
- SET ORMSG(I)=ORMSG(I)_"|||||||||"_$$FMTHL7^XLFDT($PIECE(ORRET(+IFN,"DATA",OC,1),U,5))_"||"_$PIECE(ORRET(+IFN,"DATA",OC,1),U,5)
- +7 IF $LENGTH($GET(ORRET(+IFN,"DATA",OC,"OC",2,0)))
- Begin DoDot:2
- +8 NEW J
- SET J=1
- FOR
- SET J=$ORDER(ORRET(+IFN,"DATA",OC,"OC",J))
- if 'J
- QUIT
- SET ORMSG(I,J-1)=$GET(ORRET(+IFN,"DATA",OC,"OC",J,0))
- +9 SET ORMSG(I,$ORDER(ORMSG(I,""),-1))=ORMSG(I,$ORDER(ORMSG(I,""),-1))_"|||||||||"_$$FMTHL7^XLFDT($PIECE(ORRET(+IFN,"DATA",OC,1),U,5))_"||"_$PIECE(ORRET(+IFN,"DATA",OC,1),U,5)
- End DoDot:2
- +10 IF $LENGTH($GET(ORRET(+IFN,"DATA",OC,"OR",1,0)))
- SET I=I+1
- SET ORMSG(I)="NTE|"_OC_"|P|"_$$ESC($GET(ORRET(+IFN,"DATA",OC,"OR",1,0)))
- End DoDot:1
- +11 QUIT
- +12 ;
- 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 NEW OR0,ORMSG
- SET OR0=$GET(^OR(100,+IFN,0))
- +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,"~|\&^")