| 1 | ORMPS2 ;SLC/MKB - Process Pharmacy ORM msgs cont ;04/01/2008
|
|---|
| 2 | ;;3.0;ORDER ENTRY/RESULTS REPORTING;**94,116,129,134,186,190,195,215,265,243**;Dec 17, 1997;Build 242
|
|---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | FINISHED() ; -- new order [SN^ORMPS] due to finishing?
|
|---|
| 6 | N Y,ORIG,TYPE,ORIG4 S Y=0
|
|---|
| 7 | S ORIG=+$P(ZRX,"|",2),TYPE=$P(ZRX,"|",4),ORIG4=$G(^OR(100,ORIG,4))
|
|---|
| 8 | I ORIG,TYPE="E",ORIG4?1.N1"P"!(ORIG4?1.N1"S") S ORIFN=+ORIG,Y=1
|
|---|
| 9 | Q Y
|
|---|
| 10 | ;
|
|---|
| 11 | WPX() ; -- Compare comments in @ORMSG@(NTE) with order ORIFN
|
|---|
| 12 | ; Returns 1 if different, or 0 if same
|
|---|
| 13 | N NTE,SPINST,Y,X S Y=0
|
|---|
| 14 | S NTE=+$$NTE^ORMPS3(21),SPINST=$S(NTE:$$NTXT^ORMPS3(NTE),1:"")
|
|---|
| 15 | S X=$$VALTXT^ORMPS3(+ORIFN,"COMMENT")
|
|---|
| 16 | I $TR(X," ")'=$TR(SPINST," ") S Y=1 ;comp text w/o spaces
|
|---|
| 17 | WQ Q Y
|
|---|
| 18 | ;
|
|---|
| 19 | IVX() ; -- Compare ORMSG to Inpt order ORIFN if IV, return 0 if 'diff or 'IV
|
|---|
| 20 | N Y,RXC,DG,OI,PSOI,XC,X,RATE,RXR,ORA,ORB,ORX,I,J,OI0,INST,VOL,STR,UNT
|
|---|
| 21 | S RXC=$$RXC^ORMPS,Y=0 I RXC'>0 Q Y ;not IV of any kind
|
|---|
| 22 | S DG=+$P($G(^OR(100,+ORIFN,0)),U,11),DG=$P($G(^ORD(100.98,DG,0)),U,3)
|
|---|
| 23 | I DG'="IV RX",DG'="TPN" D Q Y ;not fluid
|
|---|
| 24 | . I $P(ZRX,"|",7)'="" S Y=1 Q
|
|---|
| 25 | . I $$NUMADDS^ORMPS3>1 S Y=1 Q
|
|---|
| 26 | . S OI=$$VALUE("ORDERABLE"),PSOI=+$P($G(^ORD(101.43,+OI,0)),U,2)
|
|---|
| 27 | . S XC=@ORMSG@(RXC) I PSOI'=$P(XC,U,4) S Y=1 Q
|
|---|
| 28 | . N X1,X2,X3 S X1=$P(XC,"|",4),X2=$P($P(XC,"|",5),U,5)
|
|---|
| 29 | . S X3=$$VALUE("INSTR") I (X1_X2)'=X3,(X1_" "_X2)'=X3 S Y=1 Q
|
|---|
| 30 | IV1 S RATE=$$FIND^ORM(+RXE,24),UNT=$P($$FIND^ORM(+RXE,25),U,5)
|
|---|
| 31 | S:$L(UNT) RATE=RATE_" "_UNT S X=$$VALUE("RATE") I RATE'=X D Q:Y Y
|
|---|
| 32 | . S:RATE["@" RATE=$P(RATE,"@") S:X["@" X=$P(X,"@") ;rate@labels
|
|---|
| 33 | . I RATE'=X S Y=1 Q
|
|---|
| 34 | I $P(ZRX,"|",7)'=$$VALUE("TYPE") S Y=1 Q Y
|
|---|
| 35 | S RXR=$$RXR^ORMPS
|
|---|
| 36 | I $P($P(RXR,"|",2),U,4)'=$$VALUE("ROUTE") S Y=1 Q Y
|
|---|
| 37 | S ORB=+$$PTR("ORDERABLE ITEM"),ORA=+$$PTR("ADDITIVE"),I=+RXC
|
|---|
| 38 | F S XC=@ORMSG@(I) Q:$E(XC,1,3)'="RXC" D S I=$O(@ORMSG@(I)) Q:I'>0
|
|---|
| 39 | . S ORX($P(XC,"|",2),+$P(XC,U,4))=$P(XC,"|",4)_U_$P($P(XC,"|",5),U,5)
|
|---|
| 40 | . ;ORX("A",PSOI)=str^units or ORX("B",PSOI)=volume^units
|
|---|
| 41 | F I="STRENGTH","UNITS","VOLUME" D ;ORX(I,inst)=value
|
|---|
| 42 | . S J=0 F S J=$O(^OR(100,+ORIFN,4.5,"ID",I,J)) Q:J'>0 D
|
|---|
| 43 | .. S INST=+$P($G(^OR(100,+ORIFN,4.5,J,0)),U,3)
|
|---|
| 44 | .. S:INST ORX(I,INST)=$G(^OR(100,+ORIFN,4.5,J,1))
|
|---|
| 45 | S I=0 F S I=$O(^OR(100,+ORIFN,4.5,"ID","ORDERABLE",I)) Q:I'>0 D Q:Y
|
|---|
| 46 | . S OI0=$G(^OR(100,+ORIFN,4.5,I,0)),OI=+$G(^(1))
|
|---|
| 47 | . S PSOI=+$P($G(^ORD(101.43,OI,0)),U,2)
|
|---|
| 48 | . I $P(OI0,U,2)=ORA,$G(ORX("A",PSOI)) D Q
|
|---|
| 49 | .. S INST=$P(OI0,U,3),STR=+ORX("A",PSOI),UNT=$P(ORX("A",PSOI),U,2)
|
|---|
| 50 | .. I STR'=$G(ORX("STRENGTH",INST)) S Y=1 Q
|
|---|
| 51 | .. I UNT'=$G(ORX("UNITS",INST)) S Y=1 Q
|
|---|
| 52 | .. K ORX("A",PSOI) ;same
|
|---|
| 53 | . I $P(OI0,U,2)=ORB,$G(ORX("B",PSOI)) D Q
|
|---|
| 54 | .. S INST=$P(OI0,U,3),VOL=+$G(ORX("B",PSOI))
|
|---|
| 55 | .. I VOL'=$G(ORX("VOLUME",INST)) S Y=1 Q
|
|---|
| 56 | .. K ORX("B",PSOI) ;same
|
|---|
| 57 | . S Y=1
|
|---|
| 58 | I $O(ORX("A",0))!$O(ORX("B",0)) S Y=1 ;leftover items - changed
|
|---|
| 59 | Q Y
|
|---|
| 60 | ;
|
|---|
| 61 | CHANGED() ; -- Compare ORMSG to order ORIFN, return 1 if different
|
|---|
| 62 | N I,X,Y,X1,NTE,SIG,PI,TRXO S Y=0
|
|---|
| 63 | I $G(ORCAT)="I" D G CHQ
|
|---|
| 64 | . I $$WPX S Y=1 Q ;Special Instructions
|
|---|
| 65 | . S X=$$VALUE("DAYS") ;duration
|
|---|
| 66 | . I $G(X)'="" D I $G(X)'=X1 S Y=1 Q
|
|---|
| 67 | . .S X=$$HL7IVLMT^ORMBLDP1(X)
|
|---|
| 68 | . .S TRXO=$$RXO^ORMPS,X1=$P($P($G(TRXO),"|",2),U,3)
|
|---|
| 69 | . .;S X1=$$DURATION^ORMPS3($P($P(TRXO,"|",2),U,3))
|
|---|
| 70 | . I $$IVX S Y=1 Q ;IV fields
|
|---|
| 71 | ;S X=+$P($P(RXE,"|",3),U,4) I X'=+$$VALUE("DRUG") S Y=1 G CHQ
|
|---|
| 72 | I +$P(RXE,"|",11)'=+$$VALUE("QTY") S Y=1 G CHQ
|
|---|
| 73 | I +$P(RXE,"|",13)'=+$$VALUE("REFILLS") S Y=1 G CHQ
|
|---|
| 74 | ;S X=$P(RXE,"|",23) S:$E(X)="D" X=+$E(X,2,99) I X'=+$$VALUE("SUPPLY") S Y=1 G CHQ
|
|---|
| 75 | ;I $P(ZRX,"|",5)'=$$VALUE("PICKUP") S Y=1 G CHQ
|
|---|
| 76 | S NTE=$$NTE^ORMPS3(21),SIG=+$O(^OR(100,+ORIFN,4.5,"ID","SIG",0)) ;verb
|
|---|
| 77 | I NTE,SIG,$P($P(@ORMSG@(NTE),"|",4)," ")'=$P($G(^OR(100,+ORIFN,4.5,SIG,2,1,0))," ") S Y=1 G CHQ
|
|---|
| 78 | S NTE=$$NTE^ORMPS3(7),PI=+$O(^OR(100,+ORIFN,4.5,"ID","PI",0))
|
|---|
| 79 | I (NTE&'PI)!('NTE&PI) Q 1 ;added or deleted
|
|---|
| 80 | I NTE,PI D G CHQ ;compare text
|
|---|
| 81 | . S PI=$$VALTXT^ORMPS3(+ORIFN,PI)_$$VALTXT^ORMPS3(+ORIFN,"COMMENT")
|
|---|
| 82 | . S NTE=$$NTXT^ORMPS3(NTE)
|
|---|
| 83 | . I $TR(NTE," ")'=$TR(PI," ") S Y=1 Q ;comp text w/o spaces
|
|---|
| 84 | CHQ Q Y
|
|---|
| 85 | ;
|
|---|
| 86 | VALUE(ID) ; -- Return value of ID in ^OR(100,+ORIFN,4.5,"ID")
|
|---|
| 87 | N I,Y I '$L($G(ID)) Q ""
|
|---|
| 88 | S I=+$O(^OR(100,+ORIFN,4.5,"ID",ID,0))
|
|---|
| 89 | S Y=$G(^OR(100,+ORIFN,4.5,I,1))
|
|---|
| 90 | Q Y
|
|---|
| 91 | ;
|
|---|
| 92 | PTR(X) ; -- Return ptr to prompt OR GTX X
|
|---|
| 93 | Q +$O(^ORD(101.41,"AB","OR GTX "_X,0))
|
|---|
| 94 | ;
|
|---|
| 95 | RO ; -- Replacement order (finished)
|
|---|
| 96 | N RXO,RXC,ORDIALOG,ORDG,ORPKG,ORDA,ORX,ORSIG,ORP,ZSC,NEWSTS
|
|---|
| 97 | N ADMIN,IVTYPE
|
|---|
| 98 | K ^TMP("ORWORD",$J)
|
|---|
| 99 | I '$D(^VA(200,ORNP,0)) S ORERR="Missing or invalid ordering provider" Q
|
|---|
| 100 | I 'RXE S ORERR="Missing or invalid RXE segment" Q
|
|---|
| 101 | S RXO=$$RXO^ORMPS,RXC=$$RXC^ORMPS,ORIFN=+$G(ORIFN)
|
|---|
| 102 | I ORIFN'>0 S ORERR="Missing or invalid order number" Q
|
|---|
| 103 | D @($S(RXC:"IV",$G(ORCAT)="I":"UDOSE",1:"OUT")_"^ORMPS1") Q:$D(ORERR)
|
|---|
| 104 | ;Check keep Admin Time with order if not define in the RXE segment on
|
|---|
| 105 | ;verify
|
|---|
| 106 | I RXC,$$VALUE("TYPE")="I" S ORDIALOG($$PTR("ADMIN TIMES"),1)=$$VALUE("ADMIN")
|
|---|
| 107 | S ORDA=$$ACTION^ORCSAVE("XX",ORIFN,ORNP,"",ORNOW,ORWHO)
|
|---|
| 108 | I ORDA'>0 S ORERR="Cannot create new order action" Q
|
|---|
| 109 | RO1 ; -Update sts of order to active, last action to dc/edit:
|
|---|
| 110 | S ORX=ORDA F S ORX=+$O(^OR(100,ORIFN,8,ORX),-1) Q:ORX'>0 I $D(^(ORX,0)),$P(^(0),U,15)="" Q ;ORX=last released action
|
|---|
| 111 | S:ORX $P(^OR(100,ORIFN,8,ORX,0),U,15)=12 ;dc/edit
|
|---|
| 112 | S $P(^OR(100,ORIFN,3),U,7)=ORDA,NEWSTS=$S('$G(ORSTS):0,ORSTS=$P(^(3),U,3):0,1:1) K ^(6)
|
|---|
| 113 | D STATUS^ORCSAVE2(ORIFN,ORSTS):NEWSTS,SETALL^ORDD100(ORIFN):'NEWSTS
|
|---|
| 114 | D DATES^ORCSAVE2(ORIFN,ORSTRT,ORSTOP)
|
|---|
| 115 | D RELEASE^ORCSAVE2(ORIFN,ORDA,ORNOW,ORWHO,ORNATR)
|
|---|
| 116 | ; -If unsigned edit, leave XX unsigned & mark ORX as Sig Not Req'd
|
|---|
| 117 | S ORSIG=$S($P($G(^OR(100,ORIFN,8,ORX,0)),U,4)'=2:1,1:0)
|
|---|
| 118 | D SIGSTS^ORCSAVE2(ORIFN,ORDA):ORSIG,SIGN^ORCSAVE2(ORIFN,,,5,ORX):'ORSIG
|
|---|
| 119 | RO2 ; -Update responses, get/save new order text:
|
|---|
| 120 | K ^OR(100,ORIFN,4.5) D RESPONSE^ORCSAVE,ORDTEXT^ORCSAVE1(ORIFN_";"_ORDA)
|
|---|
| 121 | S $P(^OR(100,ORIFN,0),U,5)=ORDIALOG_";ORD(101.41,",$P(^(0),U,14)=ORPKG
|
|---|
| 122 | ;I $P(^OR(100,ORIFN,0),U,11)'=ORDG D ;update DG,xrefs
|
|---|
| 123 | ;AGP Changes to handle IMO IV orders CPRS 26v43
|
|---|
| 124 | I $P(^OR(100,ORIFN,0),U,11)'=ORDG,$P(^OR(100,ORIFN,0),U,11)'=$O(^ORD(100.98,"B","CLINIC ORDERS","")) D
|
|---|
| 125 | . N DA,DR,DIE
|
|---|
| 126 | . S DA=ORIFN,DR="23////"_ORDG,DIE="^OR(100," D ^DIE
|
|---|
| 127 | S ^OR(100,ORIFN,4)=PKGIFN,$P(^(8,ORDA,0),U,14)=ORDA
|
|---|
| 128 | S ORIFN=ORIFN_";"_ORDA,ORDCNTRL="SN" ;to send NA msg back
|
|---|
| 129 | I $G(ORL) S ORP(1)=ORIFN_"^1" D PRINTS^ORWD1(.ORP,+ORL)
|
|---|
| 130 | I $G(ORCAT)="O" S ZSC=$$ZSC^ORMPS3 I ZSC,$P(ZSC,"|",2)'?2.3U S ^OR(100,+ORIFN,5)=$TR($P(ZSC,"|",2,9),"|","^") ;1 or 0 instead of [N]SC in #100
|
|---|
| 131 | Q
|
|---|
| 132 | IVLIM(IVDUR) ;
|
|---|
| 133 | I $L(IVDUR) D
|
|---|
| 134 | . N DURU,DURV S DURU="",DURV=0
|
|---|
| 135 | . S DURU=$E(IVDUR,1),DURV=$E(IVDUR,2,$L(IVDUR))
|
|---|
| 136 | . I IVDUR["dose" S DURV=$E(IVDUR,6,$L(IVDUR)),IVDUR="for a total of "_+DURV_$S(+DURV=1:" doses",+DURV>1:" doses",1:" dose") Q
|
|---|
| 137 | . I (DURU="D")!(DURU="d") S IVDUR="for "_+DURV_$S(+DURV=1:" day",+DURV>1:" days",1:" day")
|
|---|
| 138 | . I (DURU="H")!(DURU="h") S IVDUR="for "_+DURV_$S(+DURV=1:" hours",+DURV>1:" hours",1:" hour")
|
|---|
| 139 | . I (DURU="M")!(DURU="m") S IVDUR="with total volume "_+DURV_" ml"
|
|---|
| 140 | . I (DURU="L")!(DURU="l") S IVDUR="with total volume "_+DURV_" L"
|
|---|
| 141 | Q IVDUR
|
|---|
| 142 | UNESC(STRING) ;
|
|---|
| 143 | Q $$UNESC^ORHLESC(STRING)
|
|---|
| 144 | UNESCARR(ARR) ;
|
|---|
| 145 | N I S I="" F S I=$O(@ARR@(I)) Q:'$L(I) D
|
|---|
| 146 | .N IND S IND=$S(ARR["(":$E(ARR,0,$L(ARR)-1)_","""_I_""")",1:ARR_"("""_I_""")")
|
|---|
| 147 | .N TYPE S TYPE=$D(@ARR@(I))
|
|---|
| 148 | .I TYPE=11!(TYPE=10) D UNESCARR(IND)
|
|---|
| 149 | .I TYPE=1!(TYPE=11) S @ARR@(I)=$$UNESC(@ARR@(I))
|
|---|
| 150 | Q
|
|---|
| 151 | PCOMM ; -- Get Provider Comments from previous order, when changed
|
|---|
| 152 | N OLD,I
|
|---|
| 153 | S OLD=+$G(ORIFN) I OLD<1 S OLD=+$P(ZRX,"|",2) Q:OLD<1
|
|---|
| 154 | S I=+$O(^OR(100,OLD,4.5,"ID","COMMENT",0)) Q:I<1
|
|---|
| 155 | Q:'$O(^OR(100,OLD,4.5,I,2,0)) ;none
|
|---|
| 156 | M ^TMP("ORWORD",$J,PC,1)=^OR(100,OLD,4.5,I,2)
|
|---|
| 157 | S ORDIALOG(PC,1)="^TMP(""ORWORD"",$J,"_PC_",1)"
|
|---|
| 158 | S ORDIALOG(PC,"FORMAT")="@" ;text in Sig already
|
|---|
| 159 | Q
|
|---|
