- 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/ORMBLDPS.m
r613 r623 1 ORMBLDPS ;SLC/MKB-Build outgoing Pharmacy ORM msgs ;6/16/08 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**7,38,54,86,97,94,116,129,141,190,195,237,254,243**;Dec 17, 1997;Build 242 3 PTR(NAME) ; -- Returns ptr value of prompt in Dialog file 4 Q +$O(^ORD(101.41,"AB",$E("OR GTX "_NAME,1,63),0)) 5 ; 6 NVA ; -- new Non-VA Meds order 7 N NVA S NVA=1 8 OUT ; -- new Outpt Meds order [same as UD, +3 fields] 9 UD ; -- new Inpt (Unit Dose) Meds order 10 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 11 N QT7,SCHTYPE 12 S OUTPT=$S($P(OR0,U,12)="O":1,1:0) ;outpt flag 13 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 14 S OI=$$PTR("ORDERABLE ITEM"),DRUG=$$PTR("DISPENSE DRUG") 15 S INSTR=$$PTR("INSTRUCTIONS"),SCHED=$$PTR("SCHEDULE"),ADMIN=$$PTR("ADMIN TIMES") 16 S SCHTYPE=$$PTR("SCHEDULE TYPE") 17 S DUR=$$PTR("DURATION"),URG=$$PTR("URGENCY"),DOSE=$$PTR("DOSE") 18 S ROUTE=$$PTR("ROUTE"),PROVCOMM=$$PTR("WORD PROCESSING 1") 19 S PI=$$PTR("PATIENT INSTRUCTIONS"),CONJ=$$PTR("AND/THEN") 20 S J=1,ORC(J)=$P(ORMSG(4),"|",1,7)_"|" 21 I +$G(NVA)=1 G NVA1 22 UD1 S I=0 F S I=$O(ORDIALOG(INSTR,I)) Q:I'>0 D 23 . S X=$G(ORDIALOG(DOSE,I)) 24 . ;S QT1=$S($L(X):$P(X,"&",1,4)_"&"_$P(X,"&",6),1:"") 25 . S QT2=$$ESC($G(ORDIALOG(SCHED,I)))_$S(OUTPT:"",1:"&"_$G(ORDIALOG(ADMIN,I))) 26 . S QT3=$$HL7DUR 27 . S QT1=$S($L(X):$P(X,"&",1,6),1:"") 28 . S QT6=$P($G(^ORD(101.42,+$G(ORDIALOG(URG,I)),0)),U,2) 29 . S QT7=$G(ORDIALOG(SCHTYPE,I)) 30 . S QT9=$G(ORDIALOG(CONJ,I))_"~" S:$E(QT9)="T" QT9="S~" 31 . S J=J+1,ORC(J)=QT1_U_QT2_U_QT3_"^^^"_QT6_U_QT7_U_$$INSTR_U_QT9 32 ; 33 NVA1 I +$G(NVA)=1 D 34 . S I=1 ;only one dosage possible for non-va meds 35 . S QT2=$G(ORDIALOG(SCHED,I)),QT3=$$HL7DUR,X=$G(ORDIALOG(DOSE,I)) 36 . S QT1=$S($L(X):$P(X,"&",1,6),1:"") 37 . S QT6=$P($G(^ORD(101.42,+$G(ORDIALOG(URG,I)),0)),U,2) 38 . S QT9=$G(ORDIALOG(CONJ,I))_"~" S:$E(QT9)="T" QT9="S~" 39 . S J=J+1,ORC(J)=QT1_U_$$ESC(QT2)_U_QT3_"^^^"_QT6_"^^"_$$INSTR_U_QT9 40 ; 41 I $L($P(OR0,U,8)) S $P(ORC(2),U,4)=$$FMTHL7^XLFDT($P(OR0,U,8)) S:J<2 J=2 42 S J=J+1,ORC(J)="|"_$P(ORMSG(4),"|",9,999),ORC=J,X="ORMSG(4)",ORMSG(4)="",I=0 43 F J=1:1:ORC S Y=ORC(J) D ;add to ORMSG(4) 44 . I $L(@X)+$L(Y)'>245 S @X=@X_Y 45 . 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)) 46 I $G(ORDIALOG(DRUG,1)) S X=$$ENDCM^PSJORUTL(ORDIALOG(DRUG,1)),DISPENSE=$P(X,U,3)_"^^99NDF^"_ORDIALOG(DRUG,1)_"^^99PSD" 47 S OITXT=$$USID^ORMBLD($G(ORDIALOG(OI,1))) 48 S OITXT2=$P(OITXT,U,1,4)_U_$$ESC($P(OITXT,U,5))_U_$P(OITXT,U,6,99) 49 S ORMSG(5)="RXO|"_OITXT2_"|||||||||"_$G(DISPENSE) 50 UD2 I $G(OUTPT) D 51 . N QTY,REFS,DSPY 52 . S QTY=$$PTR("QUANTITY"),REFS=$$PTR("REFILLS"),DSPY=$$PTR("DAYS SUPPLY") 53 . S ORMSG(5)=ORMSG(5)_"|"_$G(ORDIALOG(QTY,1))_"||"_$G(ORDIALOG(REFS,1))_"||||D"_$G(ORDIALOG(DSPY,1)) 54 S I=5 I $L($G(ORDIALOG(PROVCOMM,1))) D 55 . S J=$O(^TMP("ORWORD",$J,PROVCOMM,1,0)) Q:'J 56 . S I=6,ORMSG(6)="NTE|6|P|"_$$ESC($G(^TMP("ORWORD",$J,PROVCOMM,1,J,0))) 57 . 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)) 58 I $G(OUTPT),$L($G(ORDIALOG(PI,1))) D 59 . S J=$O(^TMP("ORWORD",$J,PI,1,0)) Q:'J 60 . S I=I+1,ORMSG(I)="NTE|7|P|"_$G(^TMP("ORWORD",$J,PI,1,J,0)) 61 . 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)) 62 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))) 63 I $D(^OR(100,IFN,9)) D ORDCHKS 64 S I=I+1,ORMSG(I)=$$ZRX(IFN,OUTPT) 65 I $G(OUTPT) D ;add SC data 66 . N OR5 S OR5=$G(^OR(100,IFN,5)) 67 . I $L(OR5),OR5'?5"^" S I=I+1,ORMSG(I)="ZSC|"_$TR(OR5,"^","|") Q 68 . S SC=$$PTR("SERVICE CONNECTED") S:$D(ORDIALOG(SC,1)) I=I+1,ORMSG(I)="ZSC|"_$S(ORDIALOG(SC,1):"SC",1:"NSC") 69 ; Create DG1 & ZCL segment(s) for Billing Awareness (BA) Project 70 D DG1^ORWDBA3($G(IFN),"I",I) 71 I $P(^ORD(100.98,$P(OR0,U,11),0),U)="NON-VA MEDICATIONS" D 72 . S I=I+1 D ZRN(IFN,.ORMSG,I) 73 Q 74 ; 75 INSTR() ; -- Return text instructions for QT-8, instance I 76 N Y S Y=$P($G(ORDIALOG(DOSE,I)),"&",5) 77 I $G(ORDIALOG(DRUG,1)),$L(Y) Q $$ESC(Y) 78 S Y=$G(ORDIALOG(INSTR,I)) I $G(OUTPT) D 79 . N UNITS,UNT S UNITS=$$PTR("FREE TEXT"),UNT=$G(ORDIALOG(UNITS,I)) 80 . S:$L(UNT) Y=Y_" "_UNT ;old format 81 Q $$ESC(Y) 82 ; 83 HL7DUR() ; -- Returns HL7 form of duration X 84 N X,X1,X2,Y S X=$G(ORDIALOG(DUR,I)) 85 S X1=+$G(X),Y="" G:X1'>0 HDQ 86 S X2=$$UP^XLFSTR($P(X,X1,2)) S:$E(X2)=" " X2=$E(X2,2,99) 87 S Y=$S($E(X2,1,2)="MO":"L",'$L(X2):"D",1:$E(X2))_X1 88 HDQ Q Y 89 ; 90 IV ; -- new IV Meds order 91 N SOLN,VOL,ADDS,STR,UNITS,RATE,URG,WP,QT,I,X1,X2,INST 92 N IVLIMIT ; duratioin or total volume for IV order 93 N IVTYPE,IVZRX,X,CNT,ROUTE,ORBCMA,DFN 94 S IVLIMIT=$$PTR("DURATION") 95 S IVTYPE=$G(ORDIALOG(+$$PTR("IV TYPE"),1)) 96 I IVTYPE="",$P($G(^OR(100,IFN,3)),U,11)="B" D 97 .S IVTYPE=$$MOB^ORMBLDP1(IFN,+$P($G(^OR(100,IFN,0)),U,2)) 98 .D RESP^ORCSAVE2(IFN,"OR GTX IV TYPE",IVTYPE) 99 S RATE=$$PTR("INFUSION RATE"),ADDS=$$PTR("ADDITIVE") 100 S STR=$$PTR("STRENGTH PSIV"),UNITS=$$PTR("UNITS") 101 S WP=$$PTR("WORD PROCESSING 1"),VOL=$$PTR("VOLUME") 102 S SCHTYPE=$$PTR("SCHEDULE TYPE") 103 S SOLN=$$PTR("ORDERABLE ITEM"),URG=+$G(ORDIALOG($$PTR("URGENCY"),1)) 104 ;I IVTYPE="",$G(ORDIALOG(+$$PTR("SCHEDULE"),1))="" S IVTYPE="C" 105 I IVTYPE="I" S QT=U_$$ESC($G(ORDIALOG(+$$PTR("SCHEDULE"),1)))_"&"_$G(ORDIALOG(+$$PTR("ADMIN TIMES"),1))_"^^^^" 106 I IVTYPE="C" S QT="^^^^^" 107 ;S QT=U_$G(ORDIALOG(+$$PTR("SCHEDULE"),1))_"^^^^" 108 S:URG QT=QT_$P($G(^ORD(101.42,URG,0)),U,2) 109 S $P(ORMSG(4),"|",8)=QT 110 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 111 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 112 S IVLIMIT=$G(ORDIALOG(IVLIMIT,1)) 113 I $L(IVLIMIT) S IVLIMIT=$$HL7IVLMT^ORMBLDP1(IVLIMIT),ORMSG(5)="RXO|^^"_IVLIMIT_"^PS-1^IV^99OTH|"_RATE 114 S I=5 I $L($G(ORDIALOG(WP,1))) D 115 . N J,K S J=$O(^TMP("ORWORD",$J,WP,1,0)) Q:'J 116 . S I=6,ORMSG(6)="NTE|6|P|"_$$ESC($G(^TMP("ORWORD",$J,WP,1,J,0))) 117 . 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) 118 ;S I=I+1,ORMSG(I)=$$RXR(+$$PTR("ROUTE")) 119 S ROUTE=+$$PTR("ROUTE") 120 S I=I+1,ORMSG(I)=$$RXR($G(ORDIALOG(ROUTE,1))) 121 IV1 S INST=0 F S INST=$O(ORDIALOG(SOLN,INST)) Q:INST'>0 D 122 . S X1="B",X2=+$G(ORDIALOG(SOLN,INST)) 123 . I $P($G(^ORD(101.43,X2,"PS")),U,4) S X1=X1_"A" ;pre-mix 124 . S I=I+1,ORMSG(I)="RXC|"_X1_"|"_$$USID^ORMBLD(X2)_"|"_$G(ORDIALOG(VOL,INST))_"|"_$$HL7UNIT("ML") 125 I $O(ORDIALOG(ADDS,0)) D 126 . S INST=0 F S INST=$O(ORDIALOG(ADDS,INST)) Q:INST'>0 D 127 . . S X1=$G(ORDIALOG(ADDS,INST)),X2=$G(ORDIALOG(UNITS,INST)) 128 . . S I=I+1,ORMSG(I)="RXC|A|"_$$USID^ORMBLD(X1)_"|"_$G(ORDIALOG(STR,INST))_"|"_$$HL7UNIT(X2) 129 I $D(^OR(100,IFN,9)) D ORDCHKS 130 S IVZRX=$$ZRX(IFN,0) 131 S CNT=0 132 F X=1:1:$L(IVZRX) I $E(IVZRX,X)="|" S CNT=CNT+1 133 I CNT<6 F X=CNT:1:5 S IVZRX=IVZRX_"|" 134 S I=I+1,ORMSG(I)=IVZRX_IVTYPE 135 ; Create DG1 & ZCL segment(s) for Billing Awareness (BA) Project 136 D DG1^ORWDBA3($G(IFN),"I",I) 137 Q 138 ; 139 RXR(ROUTE) ; -- Returns RXR segment 140 N IEN,NAME 141 I +ROUTE=0 Q "RXR|^^^^^99PSR" 142 K ^TMP($J,"ORMBLDPS RXR") 143 D ALL^PSS51P2(+ROUTE,,,,"ORMBLDPS RXR") 144 S NAME=^TMP($J,"ORMBLDPS RXR",+ROUTE,.01) 145 ;N NAME S NAME=$$GET1^DIQ(51.2,+ROUTE_",",.01) 146 K ^TMP($J,"ORMBLDPS RXR") 147 Q "RXR|^^^"_+ROUTE_U_NAME_"^99PSR" 148 ; 149 ZRX(IFN,OUTPT) ; -- Returns ZRX segment 150 N NATURE,TYPE,ORIG,PSORIG,ROUTING,ZRX 151 S TYPE=$P($G(^OR(100,IFN,3)),U,11),NATURE=$P($G(^(8,1,0)),U,12) 152 S:NATURE NATURE=$P($G(^ORD(100.02,+NATURE,0)),U,2) ;code 153 S PSORIG="" I (TYPE=1)!(TYPE=2) D 154 . S ORIG=$P($G(^OR(100,IFN,3)),U,5),PSORIG=$G(^OR(100,+ORIG,4)) 155 . I PSORIG'>0 S PSORIG="",TYPE=0 ;edit of unreleased order 156 S ZRX="ZRX|"_PSORIG_"|"_NATURE_"|"_$S(TYPE=1:"E",TYPE=2:"R",1:"N") 157 S ROUTING=$G(ORDIALOG($$PTR("ROUTING"),1)) 158 ;AGP FIX FOR PROBLEM WITH ROUTING BE SET TO DAY SUPPLY ONCE ROOT CAUSE 159 ;IS FOUND THIS CODE WILL BE REMOVE 160 I OUTPT=1,ROUTING'="",ROUTING>0 S ROUTING="M" 161 I $G(OUTPT) S ZRX=ZRX_"|"_ROUTING_$S($L($P($G(^OR(100,ORIFN,8,1,2)),"^",3)):"|||1",1:"") 162 Q ZRX 163 ; 164 ZRN(IFN,ORMSG,I) ; -- Set ZRN segment 165 N ST,ZRN,J,K,TXT 166 S ORMSG(I)="ZRN|N|" 167 S ST=$$PTR("STATEMENTS") 168 I $L($G(ORDIALOG(ST,1))) D 169 . S J=$O(^TMP("ORWORD",$J,ST,1,0)) Q:'J 170 . S K=0,TXT=$G(^TMP("ORWORD",$J,ST,1,J,0)) 171 . I $L(TXT) S K=K+1,ORMSG(I,K)=TXT 172 . F S J=$O(^TMP("ORWORD",$J,ST,1,J)) Q:J'>0 S TXT=$G(^(J,0)) D 173 . . I $L(TXT) S K=K+1,ORMSG(I,K)=TXT 174 Q 175 ; 176 ORDCHKS ; -- Include order checks in OBX segments 177 N OC,X,X1 S OC=0 178 F S OC=$O(^OR(100,IFN,9,OC)) Q:OC'>0 S X=$G(^(OC,0)),X1=$G(^(1)) D 179 . 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) 180 . I $L($P(X,U,4)) S I=I+1,ORMSG(I)="NTE|"_OC_"|P|"_$$ESC($P(X,U,4)) 181 Q 182 ; 183 HL7UNIT(X) ; -- Return coded element for volume/strength units 184 N I,UNIT,Y 185 F I=1:1:$L(X) I $E(X,I)?1A Q ; first letter 186 S UNIT=$$UP^XLFSTR($E(X,I,$L(X))),Y="" 187 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 188 Q Y 189 ; 190 VER(IFN) ; -- Send msg for nurse-verified orders 191 N OR0,ORMSG S OR0=$G(^OR(100,+IFN,0)) Q:$P(OR0,U,12)'="I" ;Inpt only 192 S ORMSG(1)=$$MSH^ORMBLD("ORM","PS"),ORMSG(2)=$$PID^ORMBLD($P(OR0,U,2)) 193 S ORMSG(3)=$$PV1^ORMBLD($P(OR0,U,2),$P(OR0,U,12),+$P(OR0,U,10)) 194 S ORMSG(4)="ORC|ZV|"_IFN_"^OR|"_$G(^OR(100,+IFN,4))_"^PS||||||||"_DUZ_"||||"_$$FMTHL7^XLFDT($$NOW^XLFDT) 195 D MSG^XQOR("OR EVSEND PS",.ORMSG) 196 Q 197 ; 198 REF(IFN,ROUTING,CLINIC) ; -- Send msg for refill request 199 N OR0,ORMSG S OR0=$G(^OR(100,+IFN,0)) Q:$P(OR0,U,12)'="O" 200 S:'$G(CLINIC) CLINIC=$S($G(ORL):+ORL,1:+$P(OR0,U,10)) 201 S ORMSG(1)=$$MSH^ORMBLD("ORM","PS"),ORMSG(2)=$$PID^ORMBLD($P(OR0,U,2)) 202 S ORMSG(3)=$$PV1^ORMBLD($P(OR0,U,2),"O",CLINIC) 203 S ORMSG(4)="ORC|ZF|"_IFN_"^OR|"_$G(^OR(100,+IFN,4))_"^PS|||||||"_DUZ_"||"_$G(ORNP)_"|||"_$$FMTHL7^XLFDT($$NOW^XLFDT) 204 S ORMSG(5)="ZRX||||"_ROUTING 205 D MSG^XQOR("OR EVSEND PS",.ORMSG) 206 Q 207 ESC(STR) ; 208 Q $$ESC^ORHLESC(STR,"~|\&^") 1 ORMBLDPS ;SLC/MKB-Build outgoing Pharmacy ORM msgs ;11:26 AM 2 Apr 2001 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**7,38,54,86,97,94,116,129,141,190,195,237,254**;Dec 17, 1997 3 PTR(NAME) ; -- Returns ptr value of prompt in Dialog file 4 Q +$O(^ORD(101.41,"AB",$E("OR GTX "_NAME,1,63),0)) 5 ; 6 NVA ; -- new Non-VA Meds order 7 N NVA S NVA=1 8 OUT ; -- new Outpt Meds order 9 ; fall through to UD: same msg, +3 fields 10 UD ; -- new Inpt (Unit Dose) Meds order 11 N 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 12 S OUTPT=$S($P(OR0,U,12)="O":1,1:0) ;outpt flag 13 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 14 S OI=$$PTR("ORDERABLE ITEM"),DRUG=$$PTR("DISPENSE DRUG") 15 S INSTR=$$PTR("INSTRUCTIONS"),SCHED=$$PTR("SCHEDULE") 16 S DUR=$$PTR("DURATION"),URG=$$PTR("URGENCY"),DOSE=$$PTR("DOSE") 17 S ROUTE=$$PTR("ROUTE"),PROVCOMM=$$PTR("WORD PROCESSING 1") 18 S PI=$$PTR("PATIENT INSTRUCTIONS"),CONJ=$$PTR("AND/THEN") 19 S J=1,ORC(J)=$P(ORMSG(4),"|",1,7)_"|" 20 I +$G(NVA)=1 G NVA1 21 UD1 S I=0 F S I=$O(ORDIALOG(INSTR,I)) Q:I'>0 D 22 . S QT2=$G(ORDIALOG(SCHED,I)),QT3=$$HL7DUR,X=$G(ORDIALOG(DOSE,I)) 23 . ;S QT1=$S($L(X):$P(X,"&",1,4)_"&"_$P(X,"&",6),1:"") 24 . S QT1=$S($L(X):$P(X,"&",1,6),1:"") 25 . S QT6=$P($G(^ORD(101.42,+$G(ORDIALOG(URG,I)),0)),U,2) 26 . S QT9=$G(ORDIALOG(CONJ,I))_"~" S:$E(QT9)="T" QT9="S~" 27 . S J=J+1,ORC(J)=QT1_U_QT2_U_QT3_"^^^"_QT6_"^^"_$$INSTR_U_QT9 28 ; 29 NVA1 I +$G(NVA)=1 D 30 . S I=1 ;only one dosage possible for non-va meds 31 . S QT2=$G(ORDIALOG(SCHED,I)),QT3=$$HL7DUR,X=$G(ORDIALOG(DOSE,I)) 32 . S QT1=$S($L(X):$P(X,"&",1,6),1:"") 33 . S QT6=$P($G(^ORD(101.42,+$G(ORDIALOG(URG,I)),0)),U,2) 34 . S QT9=$G(ORDIALOG(CONJ,I))_"~" S:$E(QT9)="T" QT9="S~" 35 . S J=J+1,ORC(J)=QT1_U_QT2_U_QT3_"^^^"_QT6_"^^"_$$INSTR_U_QT9 36 ; 37 I $L($P(OR0,U,8)) S $P(ORC(2),U,4)=$$FMTHL7^XLFDT($P(OR0,U,8)) S:J<2 J=2 38 S J=J+1,ORC(J)="|"_$P(ORMSG(4),"|",9,999),ORC=J,X="ORMSG(4)",ORMSG(4)="",I=0 39 F J=1:1:ORC S Y=ORC(J) D ;add to ORMSG(4) 40 . I $L(@X)+$L(Y)'>245 S @X=@X_Y 41 . 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)) 42 I $G(ORDIALOG(DRUG,1)) S X=$$ENDCM^PSJORUTL(ORDIALOG(DRUG,1)),DISPENSE=$P(X,U,3)_"^^99NDF^"_ORDIALOG(DRUG,1)_"^^99PSD" 43 S ORMSG(5)="RXO|"_$$USID^ORMBLD($G(ORDIALOG(OI,1)))_"|||||||||"_$G(DISPENSE) 44 UD2 I $G(OUTPT) D 45 . N QTY,REFS,DSPY 46 . S QTY=$$PTR("QUANTITY"),REFS=$$PTR("REFILLS"),DSPY=$$PTR("DAYS SUPPLY") 47 . S ORMSG(5)=ORMSG(5)_"|"_$G(ORDIALOG(QTY,1))_"||"_$G(ORDIALOG(REFS,1))_"||||D"_$G(ORDIALOG(DSPY,1)) 48 S I=5 I $L($G(ORDIALOG(PROVCOMM,1))) D 49 . S J=$O(^TMP("ORWORD",$J,PROVCOMM,1,0)) Q:'J 50 . S I=6,ORMSG(6)="NTE|6|P|"_$G(^TMP("ORWORD",$J,PROVCOMM,1,J,0)) 51 . 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)) 52 I $G(OUTPT),$L($G(ORDIALOG(PI,1))) D 53 . S J=$O(^TMP("ORWORD",$J,PI,1,0)) Q:'J 54 . S I=I+1,ORMSG(I)="NTE|7|P|"_$G(^TMP("ORWORD",$J,PI,1,J,0)) 55 . 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)) 56 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))) 57 I $D(^OR(100,IFN,9)) D ORDCHKS 58 S I=I+1,ORMSG(I)=$$ZRX(IFN) 59 I $G(OUTPT) D ;add SC data 60 . N OR5 S OR5=$G(^OR(100,IFN,5)) 61 . I $L(OR5),OR5'?5"^" S I=I+1,ORMSG(I)="ZSC|"_$TR(OR5,"^","|") Q 62 . S SC=$$PTR("SERVICE CONNECTED") S:$D(ORDIALOG(SC,1)) I=I+1,ORMSG(I)="ZSC|"_$S(ORDIALOG(SC,1):"SC",1:"NSC") 63 ; Create DG1 & ZCL segment(s) for Billing Awareness (BA) Project 64 D DG1^ORWDBA3($G(IFN),"I",I) 65 I $P(^ORD(100.98,$P(OR0,U,11),0),U)="NON-VA MEDICATIONS" D 66 . S I=I+1 D ZRN(IFN,.ORMSG,I) 67 Q 68 ; 69 INSTR() ; -- Return text instructions for QT-8, instance I 70 N Y S Y=$P($G(ORDIALOG(DOSE,I)),"&",5) 71 I $G(ORDIALOG(DRUG,1)),$L(Y) Q Y 72 S Y=$G(ORDIALOG(INSTR,I)) I $G(OUTPT) D 73 . N UNITS,UNT S UNITS=$$PTR("FREE TEXT"),UNT=$G(ORDIALOG(UNITS,I)) 74 . S:$L(UNT) Y=Y_" "_UNT ;old format 75 Q Y 76 ; 77 HL7DUR() ; -- Returns HL7 form of duration X 78 N X,X1,X2,Y S X=$G(ORDIALOG(DUR,I)) 79 S X1=+$G(X),Y="" G:X1'>0 HDQ 80 S X2=$$UP^XLFSTR($P(X,X1,2)) S:$E(X2)=" " X2=$E(X2,2,99) 81 S Y=$S($E(X2,1,2)="MO":"L",'$L(X2):"D",1:$E(X2))_X1 82 HDQ Q Y 83 ; 84 IV ; -- new IV Meds order 85 N SOLN,VOL,ADDS,STR,UNITS,RATE,URG,WP,QT,I,X1,X2,INST 86 N IVLIMIT ; duratioin or total volume for IV order 87 S IVLIMIT=$$PTR("DURATION") 88 S RATE=$$PTR("INFUSION RATE"),ADDS=$$PTR("ADDITIVE") 89 S STR=$$PTR("STRENGTH PSIV"),UNITS=$$PTR("UNITS") 90 S WP=$$PTR("WORD PROCESSING 1"),VOL=$$PTR("VOLUME") 91 S SOLN=$$PTR("ORDERABLE ITEM"),URG=+$G(ORDIALOG($$PTR("URGENCY"),1)) 92 S QT=U_$G(ORDIALOG(+$$PTR("SCHEDULE"),1))_"^^^^" 93 S:URG QT=QT_$P($G(^ORD(101.42,URG,0)),U,2) S $P(ORMSG(4),"|",8)=QT 94 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 95 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|"_RATE ;strip any trailing spaces 96 S IVLIMIT=$G(ORDIALOG(IVLIMIT,1)) 97 I $L(IVLIMIT) S IVLIMIT=$$HL7IVLMT(IVLIMIT),ORMSG(5)="RXO|^^"_IVLIMIT_"^PS-1^IV^99OTH|"_RATE 98 S I=5 I $L($G(ORDIALOG(WP,1))) D 99 . N J,K S J=$O(^TMP("ORWORD",$J,WP,1,0)) Q:'J 100 . S I=6,ORMSG(6)="NTE|6|P|"_$G(^TMP("ORWORD",$J,WP,1,J,0)) 101 . 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) 102 IV1 S INST=0 F S INST=$O(ORDIALOG(SOLN,INST)) Q:INST'>0 D 103 . S X1="B",X2=+$G(ORDIALOG(SOLN,INST)) 104 . I $P($G(^ORD(101.43,X2,"PS")),U,4) S X1=X1_"A" ;pre-mix 105 . S I=I+1,ORMSG(I)="RXC|"_X1_"|"_$$USID^ORMBLD(X2)_"|"_$G(ORDIALOG(VOL,INST))_"|"_$$HL7UNIT("ML") 106 I $O(ORDIALOG(ADDS,0)) D 107 . S INST=0 F S INST=$O(ORDIALOG(ADDS,INST)) Q:INST'>0 D 108 . . S X1=$G(ORDIALOG(ADDS,INST)),X2=$G(ORDIALOG(UNITS,INST)) 109 . . S I=I+1,ORMSG(I)="RXC|A|"_$$USID^ORMBLD(X1)_"|"_$G(ORDIALOG(STR,INST))_"|"_$$HL7UNIT(X2) 110 I $D(^OR(100,IFN,9)) D ORDCHKS 111 S I=I+1,ORMSG(I)=$$ZRX(IFN) 112 ; Create DG1 & ZCL segment(s) for Billing Awareness (BA) Project 113 D DG1^ORWDBA3($G(IFN),"I",I) 114 Q 115 ; 116 RXR(ROUTE) ; -- Returns RXR segment 117 N NAME S NAME=$$GET1^DIQ(51.2,+ROUTE_",",.01) 118 Q "RXR|^^^"_+ROUTE_U_NAME_"^99PSR" 119 ; 120 ZRX(IFN) ; -- Returns ZRX segment 121 N NATURE,TYPE,ORIG,PSORIG,ZRX 122 S TYPE=$P($G(^OR(100,IFN,3)),U,11),NATURE=$P($G(^(8,1,0)),U,12) 123 S:NATURE NATURE=$P($G(^ORD(100.02,+NATURE,0)),U,2) ;code 124 S PSORIG="" I (TYPE=1)!(TYPE=2) D 125 . S ORIG=$P($G(^OR(100,IFN,3)),U,5),PSORIG=$G(^OR(100,+ORIG,4)) 126 . I PSORIG'>0 S PSORIG="",TYPE=0 ;edit of unreleased order 127 S ZRX="ZRX|"_PSORIG_"|"_NATURE_"|"_$S(TYPE=1:"E",TYPE=2:"R",1:"N") 128 I $G(OUTPT) S ZRX=ZRX_"|"_$G(ORDIALOG($$PTR("ROUTING"),1))_$S($L($P($G(^OR(100,ORIFN,8,1,2)),"^",3)):"|||1",1:"") 129 Q ZRX 130 ; 131 ZRN(IFN,ORMSG,I) ; -- Set ZRN segment 132 N ST,ZRN,J,K,TXT 133 S ORMSG(I)="ZRN|N|" 134 S ST=$$PTR("STATEMENTS") 135 I $L($G(ORDIALOG(ST,1))) D 136 . S J=$O(^TMP("ORWORD",$J,ST,1,0)) Q:'J 137 . S K=0,TXT=$G(^TMP("ORWORD",$J,ST,1,J,0)) 138 . I $L(TXT) S K=K+1,ORMSG(I,K)=TXT 139 . F S J=$O(^TMP("ORWORD",$J,ST,1,J)) Q:J'>0 S TXT=$G(^(J,0)) D 140 . . I $L(TXT) S K=K+1,ORMSG(I,K)=TXT 141 Q 142 ; 143 ORDCHKS ; -- Include order checks in OBX segments 144 N OC,X,X1 S OC=0 145 F S OC=$O(^OR(100,IFN,9,OC)) Q:OC'>0 S X=$G(^(OC,0)),X1=$G(^(1)) D 146 . S I=I+1,ORMSG(I)="OBX|"_OC_"|TX|^^^"_+X_"^^99OCX||"_$S($L(X1):X1,1:$P(X,U,3))_"|||||||||"_$$FMTHL7^XLFDT($P(X,U,6))_"||"_$P(X,U,5) 147 . I $L($P(X,U,4)) S I=I+1,ORMSG(I)="NTE|"_OC_"|P|"_$P(X,U,4) 148 Q 149 ; 150 HL7UNIT(X) ; -- Return coded element for volume/strength units 151 N I,UNIT,Y 152 F I=1:1:$L(X) I $E(X,I)?1A Q ; first letter 153 S UNIT=$$UP^XLFSTR($E(X,I,$L(X))),Y="" 154 F I=1:1:13 S X=$P("ML^LITER^MCG^MG^GM^UNITS^IU^MEQ^MM^MU^THOUU^MG-PE^NANOGRAM","^",I) I UNIT=X S Y="^^^PSIV-"_I_U_UNIT_"^99OTH" Q 155 Q Y 156 ; 157 HL7TIME(X) ; -- Return HL7 formatted duration 158 N I,Y S Y="" 159 F I=1:1:$L(X) I $E(X,I)?1A S Y=$$UP^XLFSTR($E(X,I)) Q ; first letter 160 S Y=Y_+X 161 Q Y 162 ; 163 VER(IFN) ; -- Send msg for nurse-verified orders 164 N OR0,ORMSG S OR0=$G(^OR(100,+IFN,0)) Q:$P(OR0,U,12)'="I" ;Inpt only 165 S ORMSG(1)=$$MSH^ORMBLD("ORM","PS"),ORMSG(2)=$$PID^ORMBLD($P(OR0,U,2)) 166 S ORMSG(3)=$$PV1^ORMBLD($P(OR0,U,2),$P(OR0,U,12),+$P(OR0,U,10)) 167 S ORMSG(4)="ORC|ZV|"_IFN_"^OR|"_$G(^OR(100,+IFN,4))_"^PS||||||||"_DUZ_"||||"_$$FMTHL7^XLFDT($$NOW^XLFDT) 168 D MSG^XQOR("OR EVSEND PS",.ORMSG) 169 Q 170 ; 171 REF(IFN,ROUTING,CLINIC) ; -- Send msg for refill request 172 N OR0,ORMSG S OR0=$G(^OR(100,+IFN,0)) Q:$P(OR0,U,12)'="O" 173 S:'$G(CLINIC) CLINIC=$S($G(ORL):+ORL,1:+$P(OR0,U,10)) 174 S ORMSG(1)=$$MSH^ORMBLD("ORM","PS"),ORMSG(2)=$$PID^ORMBLD($P(OR0,U,2)) 175 S ORMSG(3)=$$PV1^ORMBLD($P(OR0,U,2),"O",CLINIC) 176 S ORMSG(4)="ORC|ZF|"_IFN_"^OR|"_$G(^OR(100,+IFN,4))_"^PS|||||||"_DUZ_"||"_$G(ORNP)_"|||"_$$FMTHL7^XLFDT($$NOW^XLFDT) 177 S ORMSG(5)="ZRX||||"_ROUTING 178 D MSG^XQOR("OR EVSEND PS",.ORMSG) 179 Q 180 HL7IVLMT(STR) ; 181 N VAL,UNIT,IVLMT,TVAL,LEN 182 S (UNIT,IVLMT)="",VAL=0 183 I $E($$LOW^XLFSTR(STR))="f" D 184 . S VAL=$P(STR," ",2) 185 . S UNIT=$E($P(STR," ",3)) 186 I $E($$LOW^XLFSTR(STR))="w" D 187 . S TVAL=$P(STR," ",4) ;pull data in total example 0.5ml 188 . S VAL=+TVAL ;this will strip out leading zero and alpha 00.5L becomes .5 or 05.5 becomes 5.5 189 . S LEN=$F(TVAL,VAL) ;get length up to alphas or trailing zeros 190 . I $P(VAL,".")="" S VAL=0_VAL ;make sure decimal values have only one leading zero .5 becomes 0.5. 191 . F S UNIT=$E(TVAL,LEN) Q:((UNIT'=0)&(UNIT'=".")) D ;get first alpha m or l 192 . . S LEN=LEN+1 193 I $L(UNIT),$L(VAL) S IVLMT=$$LOW^XLFSTR(UNIT)_VAL 194 Q IVLMT 195 ;
Note:
See TracChangeset
for help on using the changeset viewer.
