- 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/ORMPS2.m
r613 r623 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 1 ORMPS2 ;SLC/MKB - Process Pharmacy ORM msgs cont ; 1/26/07 11:58am 2 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**94,116,129,134,186,190,195,215,265**;Dec 17, 1997;Build 17 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,I,J,X,X1 S Y=0 14 S NTE=+$$NTE^ORMPS1(21),SPINST=$S(NTE:$P(@ORMSG@(NTE),"|",4),1:"") 15 S I=+$O(^OR(100,+ORIFN,4.5,"ID","COMMENT",0)) I I'>0 S:$L(SPINST) Y=1 G WQ 16 S X=$G(^OR(100,+ORIFN,4.5,I,2,1,0)) ;1st line 17 I '$O(^OR(100,+ORIFN,4.5,I,2,1)) S:X'=SPINST Y=1 G WQ 18 S J=1 F S J=$O(^OR(100,+ORIFN,4.5,I,2,J)) Q:J'>0 S X1=$G(^(J,0)) D Q:$L(X)'<240 19 . I ($L(X)+$L(X1)+1)'>240 S X=X_" "_X1 Q 20 . S X=X_" "_$E(X1,1,239-$L(X)) 21 S:X'=SPINST Y=1 ;changed 22 WQ Q Y 23 ; 24 IVX() ; -- Compare ORMSG to Inpt order ORIFN if IV, return 0 if 'diff or 'IV 25 N Y,RXC,DG,OI,PSOI,XC,RATE,ORA,ORB,ORX,I,J,OI0,INST,VOL,STR,UNT 26 S RXC=$$RXC^ORMPS,Y=0 I RXC'>0 Q Y ;not IV of any kind 27 S DG=+$P($G(^OR(100,+ORIFN,0)),U,11),DG=$P($G(^ORD(100.98,DG,0)),U,3) 28 I DG'="IV RX",DG'="TPN" D Q Y ;not fluid 29 . I $P(ZRX,"|",7)'="" S Y=1 Q 30 . I $$NUMADDS^ORMPS1>1 S Y=1 Q 31 . S OI=$$VALUE("ORDERABLE"),PSOI=+$P($G(^ORD(101.43,+OI,0)),U,2) 32 . S XC=@ORMSG@(RXC) I PSOI'=$P(XC,U,4) S Y=1 Q 33 . N X1,X2,X3 S X1=$P(XC,"|",4),X2=$P($P(XC,"|",5),U,5) 34 . S X3=$$VALUE("INSTR") I (X1_X2)'=X3,(X1_" "_X2)'=X3 S Y=1 Q 35 IV1 S RATE=$$FIND^ORM(+RXE,24),UNT=$P($$FIND^ORM(+RXE,25),U,5) 36 S:$L(UNT) RATE=RATE_" "_UNT I RATE'=$$VALUE("RATE") 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 X,Y,X1,ZSC,NTE,SIG,PI 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 X S X1=$$DURATION^ORMPS1($P($G(ORQT(1)),U,3)) I X'=X1 S Y=1 Q 67 . I $$IVX S Y=1 Q ;IV fields 68 S X=$P($P(RXE,"|",3),U,4) I X'=$$VALUE("DRUG") S Y=1 G CHQ 69 I $P(RXE,"|",11)'=$$VALUE("QTY") S Y=1 G CHQ 70 I $P(RXE,"|",13)'=$$VALUE("REFILLS") S Y=1 G CHQ 71 S X=$P(RXE,"|",23) S:$E(X)="D" X=+$E(X,2,99) I X'=$$VALUE("SUPPLY") S Y=1 G CHQ 72 I $P(ZRX,"|",5)'=$$VALUE("PICKUP") S Y=1 G CHQ 73 S NTE=$$NTE^ORMPS1(21),SIG=+$O(^OR(100,+ORIFN,4.5,"ID","SIG",0)) ;verb 74 I NTE,SIG,$P($P(@ORMSG@(NTE),"|",4)," ")'=$P($G(^OR(100,+ORIFN,4.5,SIG,2,1,0))," ") S Y=1 G CHQ 75 S NTE=$$NTE^ORMPS1(7),PI=+$O(^OR(100,+ORIFN,4.5,"ID","PI",0)) 76 I (NTE&'PI)!('NTE&PI) Q 1 ;added or deleted 77 I NTE,PI,$P(@ORMSG@(NTE),"|",4)'=$G(^OR(100,+ORIFN,4.5,PI,2,1,0)) S Y=1 G CHQ 78 Q:'$P($G(^OR(100,+ORIFN,8,0)),U,3) 79 N LSTACT,PREPRV,CURPRV S LSTACT="?",(PREPRV,CURPRV)=0 80 F S LSTACT=$O(^OR(100,+ORIFN,8,LSTACT),-1) Q:LSTACT 81 S PREPRV=$P($G(^OR(100,+ORIFN,8,LSTACT,0)),U,3) 82 S CURPRV=$P($G(ORC),"|",13) 83 I (PREPRV'=CURPRV) S Y=1 G CHQ 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 ; 97 N RXO,RXC,ORDIALOG,ORDG,ORPKG,ORDA,ORX,ORSIG,ORP,ZSC,NEWSTS 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 S ORDA=$$ACTION^ORCSAVE("XX",ORIFN,ORNP,"",ORNOW,ORWHO) 105 I ORDA'>0 S ORERR="Cannot create new order action" Q 106 RO1 ; -Update sts of order to active, last action to dc/edit: 107 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 108 S:ORX $P(^OR(100,ORIFN,8,ORX,0),U,15)=12 ;dc/edit 109 S $P(^OR(100,ORIFN,3),U,7)=ORDA,NEWSTS=$S('$G(ORSTS):0,ORSTS=$P(^(3),U,3):0,1:1) K ^(6) 110 D STATUS^ORCSAVE2(ORIFN,ORSTS):NEWSTS,SETALL^ORDD100(ORIFN):'NEWSTS 111 D DATES^ORCSAVE2(ORIFN,ORSTRT,ORSTOP) 112 D RELEASE^ORCSAVE2(ORIFN,ORDA,ORNOW,ORWHO,ORNATR) 113 ; -If unsigned edit, leave XX unsigned & mark ORX as Sig Not Req'd 114 S ORSIG=$S($P($G(^OR(100,ORIFN,8,ORX,0)),U,4)'=2:1,1:0) 115 D SIGSTS^ORCSAVE2(ORIFN,ORDA):ORSIG,SIGN^ORCSAVE2(ORIFN,,,5,ORX):'ORSIG 116 RO2 ; -Update responses, get/save new order text: 117 K ^OR(100,ORIFN,4.5) D RESPONSE^ORCSAVE,ORDTEXT^ORCSAVE1(ORIFN_";"_ORDA) 118 S $P(^OR(100,ORIFN,0),U,5)=ORDIALOG_";ORD(101.41,",$P(^(0),U,14)=ORPKG 119 ;I $P(^OR(100,ORIFN,0),U,11)'=ORDG D ;update DG,xrefs 120 ;AGP Changes to handle IMO IV orders CPRS 26v43 121 I $P(^OR(100,ORIFN,0),U,11)'=ORDG,$P(^OR(100,ORIFN,0),U,11)'=$O(^ORD(100.98,"B","CLINIC ORDERS","")) D 122 . N DA,DR,DIE 123 . S DA=ORIFN,DR="23////"_ORDG,DIE="^OR(100," D ^DIE 124 S ^OR(100,ORIFN,4)=PKGIFN,$P(^(8,ORDA,0),U,14)=ORDA 125 S ORIFN=ORIFN_";"_ORDA,ORDCNTRL="SN" ;to send NA msg back 126 I $G(ORL) S ORP(1)=ORIFN_"^1" D PRINTS^ORWD1(.ORP,+ORL) 127 I $G(ORCAT)="O" S ZSC=$$ZSC^ORMPS1 I ZSC,$P(ZSC,"|",2)'?2.3U S ^OR(100,+ORIFN,5)=$TR($P(ZSC,"|",2,7),"|","^") ;1 or 0 instead of [N]SC in #100 128 Q 129 IVLIM(IVDUR) ; 130 I $L(IVDUR) D 131 . N DURU,DURV S DURU="",DURV=0 132 . S DURU=$E(IVDUR,1),DURV=$E(IVDUR,2,$L(IVDUR)) 133 . I (DURU="D")!(DURU="d") S IVDUR="for "_+DURV_$S(+DURV=1:" day",+DURV>1:" days",1:" day") 134 . I (DURU="H")!(DURU="h") S IVDUR="for "_+DURV_$S(+DURV=1:" hours",+DURV>1:" hours",1:" hour") 135 . I (DURU="M")!(DURU="m") S IVDUR="with total volume "_+DURV_" ml" 136 . I (DURU="L")!(DURU="l") S IVDUR="with total volume "_+DURV_" L" 137 Q IVDUR 138 PCOMM ; -- Get Provider Comments from previous order, when changed 139 N OLD,I 140 S OLD=+$G(ORIFN) I OLD<1 S OLD=+$P(ZRX,"|",2) Q:OLD<1 141 S I=+$O(^OR(100,OLD,4.5,"ID","COMMENT",0)) Q:I<1 142 Q:'$O(^OR(100,OLD,4.5,I,2,0)) ;none 143 M ^TMP("ORWORD",$J,PC,1)=^OR(100,OLD,4.5,I,2) 144 S ORDIALOG(PC,1)="^TMP(""ORWORD"",$J,"_PC_",1)" 145 S ORDIALOG(PC,"FORMAT")="@" ;text in Sig already 146 Q
Note:
See TracChangeset
for help on using the changeset viewer.