HMPDJ05 ;SLC/MKB,ASMR/RRB,CPC - Medications by order;Jun 28, 2016 15:12:10
;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**2**;Sep 01, 2011;Build 28
;Per VA Directive 6402, this routine should not be modified.
;
; External References: see HMPDJ05V for DBIA list
; ^OR(100) references - ICR 5771
;
; All tags expect DFN, ID, [HMPSTART, HMPSTOP, HMPMAX, HMPTEXT]
Q
;
PS1(ID) ; -- med order
N $ES,$ET,ERRPAT,ERRMSG
S $ET="D ERRHDLR^HMPDERRH",ERRPAT=DFN
S ERRMSG="A problem occurred converting order "_ID_" for the medication domain"
N ORPK,TYPE S ID=+$G(ID)
S ORPK=$$PKGID^ORX8(ID),TYPE=$E(ORPK,$L(ORPK)) S:TYPE=+TYPE TYPE="R"
;
N ORUPCHUK,ORVP,ORPCL,ORDUZ,ORODT,ORSTRT,ORSTOP,ORL,ORTO,ORSTS,ORNP,ORPV,ORTX
N MED,CLS,OI,X,LOC,FAC,DRUG,DA,CNT,HMPESP
S X=$S(ORPK:$E(ORPK,$L(ORPK)),1:"Z") S:X=+X X="R" ;last char = PS file
S CLS=$S("RSN"[X:"O","UV"[X:"I",1:$$GET1^DIQ(100,ID_",",10,"I"))
S MED("uid")=$$SETUID^HMPUTILS("med",DFN,ID)
S MED("orders",1,"orderUid")=$$SETUID^HMPUTILS("order",DFN,ID)
D KIN(ID) ;DE5462 add parent/child structure
S X=$$GET1^DIQ(100,ID_",",9,"I") S:X MED("orders",1,"predecessor")=$$SETUID^HMPUTILS("med",DFN,+X)
S X=$$GET1^DIQ(100,ID_",",9.1,"I") S:X MED("orders",1,"successor")=$$SETUID^HMPUTILS("med",DFN,+X)
S:ORPK MED("localId")=ORPK_";"_CLS
D EN^ORX8(ID) S X="" F S X=$O(ORUPCHUK(X)) Q:X="" S:$D(ORUPCHUK(X))#2 @X=ORUPCHUK(X)
S:$G(ORODT) MED("orders",1,"ordered")=$$JSONDT^HMPUTILS(ORODT)
S:$G(ORNP) MED("orders",1,"providerUid")=$$SETUID^HMPUTILS("user",,+ORNP),MED("orders",1,"providerName")=$P(ORNP,U,2)
S LOC=+$G(ORL),FAC=$$FAC^HMPD(LOC) I LOC D
. S MED("orders",1,"locationUid")=$$SETUID^HMPUTILS("location",,LOC)
. S MED("orders",1,"locationName")=$$GET1^DIQ(44,LOC_",",.01) ;DE2818, ICR 10040
D FACILITY^HMPUTILS(FAC,"MED")
S:$G(ORSTRT) MED("overallStart")=$$JSONDT^HMPUTILS(ORSTRT)
S:$G(ORSTOP) (MED("stopped"),MED("overallStop"))=$$JSONDT^HMPUTILS(ORSTOP)
S MED("vaStatus")=$P($G(ORSTS),U,2)
S MED("medStatusName")=$$STATUS^HMPDPSOR(+$G(ORSTS))
S MED("medStatus")=$$MEDSTAT^HMPDJ05V(MED("medStatusName"))
I CLS="I" D
. S:$$GET1^DIQ(44,LOC_",",2802,"I") MED("IMO")="true" ;DE2818, ICR 10040, (#2802) ADMINISTER INPATIENT MEDS? [25S]
. S X=$$GET1^DIQ(100,ID_",",36) S:X MED("parent")=X ;DE2818, ICR 5771, (#36) PARENT
I ORPK D OEL^PSOORRL(DFN,ORPK_";"_CLS)
S X=$S(ORPK["N":"N",1:CLS),MED("vaType")=X,MED("medType")=$$TYPE^HMPDJ05V(X)
I CLS="O" S MED("type")=$S(ORPK["N":"OTC",1:"Prescription")
S X=$G(HMPESP("COMMENT",1)) S:$L(X) MED("comment")=X
I $$ISIV^HMPDJ05V G IV1^HMPDJ05V
;
A ; - Get order responses
S OI=$$OI^ORX8(ID) I OI D
. S X=$P(OI,U,2) S:$E(X,$L(X))=" " X=$E(X,1,$L(X)-1)
. S MED("name")=X
. D ZERO^PSS50P7(+$P(OI,U,3),,,"PSOI")
. S MED("productFormName")=$P($G(^TMP($J,"PSOI",+$P(OI,U,3),.02)),U,2)
. S:+$G(^TMP($J,"PSOI",+$P(OI,U,3),.09)) MED("supply")="true"
D RESP^HMPDPSOR(ID,.HMPESP) ;order responses
S DRUG=+$G(^TMP("PS",$J,"DD",1,0)) S:'DRUG DRUG=+$G(HMPESP("DRUG",1))
S MED("sig")=$S(CLS="I":"Give: ",1:"")_$G(HMPESP("SIG",1)) ;ORTX(2)
I CLS="O",'$L($G(HMPESP("SIG",1))),'$D(HMPESP("INSTR")) S MED("sig")=$G(HMPESP("COMMENT",1)) ;old Rx
;
B ; - Get dosages
;DE2818 begin, ^OR(100) references - ICR 5771
I '$O(^OR(100,ID,2,0)) D ;single dose or OP
. N HMPY,START,STOP,DUR,CONJ,MIN
. S START=$G(ORSTRT),STOP=$G(ORSTOP),MIN=0
. S CNT=0 F S CNT=$O(HMPESP("INSTR",CNT)) Q:CNT<1 D
.. K HMPY D DOSE(.HMPY,CNT) M MED("dosages",CNT)=HMPY
.. ;determine start & stop per dose
.. S MED("dosages",CNT,"relativeStart")=MIN
.. S DUR=$G(HMPY("complexDuration")),CONJ=$G(HMPY("complexConjunction"))
.. S STOP=$S(DUR:$$STOP(START,DUR),1:STOP)
.. S:START MED("dosages",CNT,"start")=$$JSONDT^HMPUTILS(START)
.. S:STOP MED("dosages",CNT,"stop")=$$JSONDT^HMPUTILS(STOP)
.. S X=$$RELTIME(START,STOP,DUR,MIN),MED("dosages",CNT,"relativeStop")=$S($E(X)=".":0_X,1:X)
.. I $E(CONJ)="T",DUR S START=STOP,MIN=X
I $O(^OR(100,ID,2,0)) D
. N DD,CONJ,HMPY,MIN
. M CONJ=HMPESP("CONJ"),DUR=HMPESP("DAYS") S MIN=0
. S (DA,CNT)=0 F S DA=$O(^OR(100,ID,2,DA)) Q:DA<1 D ;child orders
.. K HMPESP,HMPY D RESP^HMPDPSOR(DA,.HMPESP),DOSE(.HMPY,1)
.. S CNT=CNT+1 M MED("dosages",CNT)=HMPY
.. S MED("dosages",CNT,"relativeStart")=MIN
.. S MED("dosages",CNT,"complexConjunction")=$G(CONJ(CNT))
.. S MED("dosages",CNT,"complexDuration")=$G(DUR(CNT))
.. S MED("dosages",CNT,"relatedOrder")=DA
.. S X=$P($G(^OR(100,DA,0)),U,8,9)
.. S:$P(X,U) MED("dosages",CNT,"start")=$$JSONDT^HMPUTILS($P(X,U))
.. S:$P(X,U,2) MED("dosages",CNT,"stop")=$$JSONDT^HMPUTILS($P(X,U,2))
.. I $P(X,U,2)>$G(ORSTOP) S ORSTOP=$P(X,U,2) ;get last stop time
.. S X=$$RELTIME($P(X,U),$P(X,U,2),$G(DUR(CNT)),MIN)
.. S MED("dosages",CNT,"relativeStop")=$S($E(X)=".":0_X,1:X) S:$G(CONJ(CNT))="T" MIN=X
.. S:'DRUG DD=+$G(HMPESP("DRUG",1)),DD(DD,DA)="" ;dispense drug(s)
.. ; get ^TMP("PS",$J) from 1st child, if Inpt parent:
.. I '$D(^TMP("PS",$J)) S ORPK=$$PKGID^ORX8(DA) D OEL^PSOORRL(DFN,ORPK_";"_CLS)
. S MED("stopped")=$$JSONDT^HMPUTILS($G(ORSTOP)) ;reset from last child order
. S DD=$O(DD(0)) I DD,'$O(DD(DD)) S DRUG=DD Q ;1 drug for order
. S (DD,CNT)=0 F S DD=$O(DD(DD)) Q:DD<1 S DA=0 F S DA=$O(DD(DD,DA)) Q:DA<1 S CNT=CNT+1 D NDF(DD,CNT,DA)
;
;DE2818 end
C ; - Get OP data
I CLS="O",ORPK'["N" D
. S MED("orders",1,"quantityOrdered")=$G(HMPESP("QTY",1))
. S MED("orders",1,"daysSupply")=$G(HMPESP("SUPPLY",1))
. S MED("orders",1,"vaRouting")=$G(HMPESP("PICKUP",1))
. S MED("orders",1,"fillsAllowed")=$G(HMPESP("REFILLS",1))
. S MED("patientInstruction")=$G(HMPESP("PI",1))
. Q:ORPK["P"!(ORPK["S") ;pending
. N HMP,RX0,RX1,FILL,RFD,MW,REL
. K ^TMP("PSOR",$J) D EN^PSOORDER(DFN,+ORPK)
. S RX0=$G(^TMP("PSOR",$J,+ORPK,0)),RX1=$G(^(1)),MED("orders",1,"prescriptionId")=$P(RX0,U,5)
. I '$G(HMPESP("QTY",1)) S MED("orders",1,"quantityOrdered")=$P(RX0,U,6)
. I '$G(HMPESP("SUPPLY",1)) S MED("orders",1,"daysSupply")=$P(RX0,U,7)
. S MED("orders",1,"fillsRemaining")=$P(RX0,U,9),MED("lastFilled")=$$JSONDT^HMPUTILS($P(RX0,U,3))
. S I=$P(RX0,U,2) I I S FILL(I)=I_"^^^"_$P(RX0,U,6,7)_"^^^"_$P(RX0,U,13)_"^^"_$P(RX1,U,6) ;original fill
. S I=0 F S I=$O(^TMP("PSOR",$J,+ORPK,"REF",I)) Q:I<1 S X=$G(^(I,0)),FILL(+X)=X
. S I=0 F S I=$O(^TMP("PSOR",$J,+ORPK,"RPAR",I)) Q:I<1 S X=$G(^(I,0)),$P(X,U,14)=1,FILL(+X)=X
. S (I,RFD)=0 F S RFD=$O(FILL(RFD)) Q:RFD<1 S X=$G(FILL(RFD)) D ;sort 1st
.. S I=I+1,MW=$P($P(X,U,10),";"),REL=$P($P(X,U,8),".")
.. S MED("fills",I,"dispenseDate")=$$JSONDT^HMPUTILS($P(RFD,"."))
.. S MED("fills",I,"releaseDate")=$$JSONDT^HMPUTILS(REL)
.. S MED("fills",I,"routing")=MW
.. S MED("fills",I,"quantityDispensed")=$P(X,U,4)
.. S MED("fills",I,"daysSupplyDispensed")=$P(X,U,5)
.. S:$P(X,U,14) MED("fills",I,"partial")=1 ;"true"
. S X=$S($P(RX0,U,11):$P(RX0,U,11),$P(RX0,U,10):$P(RX0,U,10),1:0)
. S:X MED("orders",1,"fillCost")=X
. S X=$$GET1^PSODI(52,+ORPK_",",26,"I") S:X MED("overallStop")=$$JSONDT^HMPUTILS($P(X,U,2)) ;1^expirationDate
. S X=$$GET1^PSODI(52,+ORPK_",",38.3,"I") S:X MED("prescriptionFinished")=$$JSONDT^HMPUTILS($P(X,U,2)) ;DE5723 1^date prescription finished
I CLS="I" D
. S X=$$GET1^DIQ(55.06,+ORPK_","_DFN_",",25,"I")
. S:X MED("overallStop")=$$JSONDT^HMPUTILS(X)
. D BCMA^HMPDJ05V(.MED,DFN,ORPK)
;
PSQ ; finish
D:DRUG NDF(+DRUG)
S MED("qualifiedName")=$G(MED("name"))
S X=+$P($G(^TMP("PS",$J,"RXN",0)),U,5)
S:X MED("orders",1,"pharmacistUid")=$$SETUID^HMPUTILS("user",,X),MED("orders",1,"pharmacistName")=$$GET1^DIQ(200,X_",",.01) ;DE2818, ICR 10035
K ^TMP("PS",$J),^TMP($J,"PSOI"),^TMP("PSOR",$J)
S MED("lastUpdateTime")=$$EN^HMPSTMP("med") ;RHL 20150102
S MED("stampTime")=MED("lastUpdateTime") ; RHL 20150102
;US6734 - pre-compile metastamp
I $G(HMPMETA) D ADD^HMPMETA("med",MED("uid"),MED("stampTime")) Q:HMPMETA=1 ;US6734,US11019
D ADD^HMPDJ("MED","med")
Q
;
KIN(IFN) ; DE5462 - Add parents/children (kin) to order
N HMPNOJS,HMPORKIN,I
S HMPNOJS=1 D RELATED^HMPORRPC(.HMPORKIN,IFN)
S:$D(@HMPORKIN@("parent")) MED("orders",1,"parentOrderUid")=$$SETUID^HMPUTILS("order",DFN,+@HMPORKIN@("parent"))
S I="" F S I=$O(@HMPORKIN@("children",I)) Q:I="" D
. S MED("orders",1,"childrenOrderUids",I)=$$SETUID^HMPUTILS("order",DFN,+@HMPORKIN@("children",I))
Q
DOSE(Y,N) ; -- return dosage data from HMPESP(ID,N) to Y("name")
N X,DOSE,DUR,CONJ S N=+$G(N,1) K Y
S Y("instructions")=$G(HMPESP("INSTR",N))
S DOSE=$G(HMPESP("DOSE",N)),X=$P(DOSE,"&",1,2)
S:$L(X)>1 Y("dose")=$P(X,"&"),Y("units")=$P(X,"&",2)
S X=$P(DOSE,"&",3,4) S:X Y("amount")=$P(X,"&"),Y("noun")=$P(X,"&",2)
; Y("dose")=$S($L(X)>2:$TR(X,"&"," "),1:$P(X,"&"))
S X=+$G(HMPESP("ROUTE",N)) D ALL^PSS51P2(X,,,,"HMPTE")
S Y("routeName")=$G(^TMP($J,"HMPTE",X,1))
S X=$G(HMPESP("SCHEDULE",N)) I $L(X) S Y("scheduleName")=X D SCH^HMPDJ05V(X)
S X=$G(HMPESP("ADMIN",N)) S:$L(X) Y("adminTimes")=X
S X=$G(HMPESP("DAYS",N)) S:$L(X) Y("complexDuration")=X,DUR=X
S X=$G(HMPESP("CONJ",N)) S:$L(X) Y("complexConjunction")=X,CONJ=X
I $L($G(CONJ)),'$L($G(DUR)) D ;look ahead to find duration
. N I,D S I=$O(HMPESP("DAYS",N)),D=$S(I:$G(HMPESP("DAYS",I)),1:"")
. S:$L(D) Y("complexDuration")=D
K ^TMP($J,"HMPTE")
Q
;
STOP(BEG,X) ; -- Return date after adding X to BEG
N D,H,M,UNT,Y
S Y=BEG,(D,H,M)=0,UNT=$P(X,+X,2),X=+X
S UNT=$S($E(UNT)=" ":$E(UNT,2),1:$E(UNT)) I UNT="" S UNT="D"
S:UNT="L" D=30*X
S:UNT="W" D=7*X
S:UNT="D" D=X
S:UNT="H" H=X
S:UNT="M" M=X
S Y=$$FMADD^XLFDT(BEG,D,H,M)
Q Y
;
NDF(DRUG,VPI,ORD) ; -- Set NDF data for dispense DRUG ien
; code ^ name ^ vuid [^ role ^ concentration ^ order]
N LEN,HMPX,STR,VUID,X,I
S DRUG=+$G(DRUG) Q:'DRUG
D EN^PSSDI(50,,50,"901;902",DRUG,"HMPX")
S STR=$S($G(HMPX(50,DRUG,901)):$G(HMPX(50,DRUG,901))_" "_$G(HMPX(50,DRUG,902)),1:"")
D NDF^PSS50(DRUG,,,,,"NDF") S VPI=+$G(VPI,1)
;
S MED("products",VPI,"ingredientRole")="urn:sct:410942007" ;Drug
S:$G(ORD) MED("products",VPI,"relatedOrder")=ORD
S:$G(STR) MED("products",VPI,"strength")=STR
S X=$G(MED("name")) S:$L(X) MED("products",VPI,"ingredientName")=X
;
S X=$G(^TMP($J,"NDF",DRUG,20)) ;VA Generic
S MED("products",VPI,"ingredientCode")="urn:va:vuid:"_$$VUID^HMPD(+X,50.6)
S MED("products",VPI,"ingredientCodeName")=$P(X,U,2)
;
S X=$G(^TMP($J,"NDF",DRUG,22)) ;VA Product
S MED("products",VPI,"suppliedCode")="urn:va:vuid:"_$$VUID^HMPD(+X,50.68)
S MED("products",VPI,"suppliedName")=$P(X,U,2)
;
S X=$G(^TMP($J,"NDF",DRUG,25)) ;VA Drug Class
S MED("products",VPI,"drugClassCode")="urn:vadc:"_$P(X,U,2)
S MED("products",VPI,"drugClassName")=$P(X,U,3)
;
K ^TMP($J,"NDF")
Q
;
RELTIME(START,STOP,DUR,MIN) ; -- Return #min for dose
N Y S Y=0
I START>0,STOP>0 S Y=$$FMDIFF^XLFDT(STOP,START,2)\60 I 1
E I DUR S Y=$$TOMIN(DUR) I 1
E S Y=$G(HMPESP("SUPPLY",1))*1440
S Y=$S(Y:Y+MIN,1:MIN)
Q Y
;
TOMIN(DUR) ;
N RESULT,TIME,UNIT
S UNIT=$$UP^XLFSTR($E($P(DUR," ",2)))
I UNIT="" Q 0
S TIME=$P(DUR," ")
S RESULT=$S(UNIT="M":TIME,UNIT="H":TIME*60,UNIT="D":TIME*1440,UNIT="W":TIME*10080,UNIT="L":TIME*43200,1:0)
Q RESULT
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHMPDJ05 11222 printed Apr 09, 2024@20:58:43 Page 2
HMPDJ05 ;SLC/MKB,ASMR/RRB,CPC - Medications by order;Jun 28, 2016 15:12:10
+1 ;;2.0;ENTERPRISE HEALTH MANAGEMENT PLATFORM;**2**;Sep 01, 2011;Build 28
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; External References: see HMPDJ05V for DBIA list
+5 ; ^OR(100) references - ICR 5771
+6 ;
+7 ; All tags expect DFN, ID, [HMPSTART, HMPSTOP, HMPMAX, HMPTEXT]
+8 QUIT
+9 ;
PS1(ID) ; -- med order
+1 NEW $ESTACK,$ETRAP,ERRPAT,ERRMSG
+2 SET $ETRAP="D ERRHDLR^HMPDERRH"
SET ERRPAT=DFN
+3 SET ERRMSG="A problem occurred converting order "_ID_" for the medication domain"
+4 NEW ORPK,TYPE
SET ID=+$GET(ID)
+5 SET ORPK=$$PKGID^ORX8(ID)
SET TYPE=$EXTRACT(ORPK,$LENGTH(ORPK))
if TYPE=+TYPE
SET TYPE="R"
+6 ;
+7 NEW ORUPCHUK,ORVP,ORPCL,ORDUZ,ORODT,ORSTRT,ORSTOP,ORL,ORTO,ORSTS,ORNP,ORPV,ORTX
+8 NEW MED,CLS,OI,X,LOC,FAC,DRUG,DA,CNT,HMPESP
+9 ;last char = PS file
SET X=$SELECT(ORPK:$EXTRACT(ORPK,$LENGTH(ORPK)),1:"Z")
if X=+X
SET X="R"
+10 SET CLS=$SELECT("RSN"[X:"O","UV"[X:"I",1:$$GET1^DIQ(100,ID_",",10,"I"))
+11 SET MED("uid")=$$SETUID^HMPUTILS("med",DFN,ID)
+12 SET MED("orders",1,"orderUid")=$$SETUID^HMPUTILS("order",DFN,ID)
+13 ;DE5462 add parent/child structure
DO KIN(ID)
+14 SET X=$$GET1^DIQ(100,ID_",",9,"I")
if X
SET MED("orders",1,"predecessor")=$$SETUID^HMPUTILS("med",DFN,+X)
+15 SET X=$$GET1^DIQ(100,ID_",",9.1,"I")
if X
SET MED("orders",1,"successor")=$$SETUID^HMPUTILS("med",DFN,+X)
+16 if ORPK
SET MED("localId")=ORPK_";"_CLS
+17 DO EN^ORX8(ID)
SET X=""
FOR
SET X=$ORDER(ORUPCHUK(X))
if X=""
QUIT
if $DATA(ORUPCHUK(X))#2
SET @X=ORUPCHUK(X)
+18 if $GET(ORODT)
SET MED("orders",1,"ordered")=$$JSONDT^HMPUTILS(ORODT)
+19 if $GET(ORNP)
SET MED("orders",1,"providerUid")=$$SETUID^HMPUTILS("user",,+ORNP)
SET MED("orders",1,"providerName")=$PIECE(ORNP,U,2)
+20 SET LOC=+$GET(ORL)
SET FAC=$$FAC^HMPD(LOC)
IF LOC
Begin DoDot:1
+21 SET MED("orders",1,"locationUid")=$$SETUID^HMPUTILS("location",,LOC)
+22 ;DE2818, ICR 10040
SET MED("orders",1,"locationName")=$$GET1^DIQ(44,LOC_",",.01)
End DoDot:1
+23 DO FACILITY^HMPUTILS(FAC,"MED")
+24 if $GET(ORSTRT)
SET MED("overallStart")=$$JSONDT^HMPUTILS(ORSTRT)
+25 if $GET(ORSTOP)
SET (MED("stopped"),MED("overallStop"))=$$JSONDT^HMPUTILS(ORSTOP)
+26 SET MED("vaStatus")=$PIECE($GET(ORSTS),U,2)
+27 SET MED("medStatusName")=$$STATUS^HMPDPSOR(+$GET(ORSTS))
+28 SET MED("medStatus")=$$MEDSTAT^HMPDJ05V(MED("medStatusName"))
+29 IF CLS="I"
Begin DoDot:1
+30 ;DE2818, ICR 10040, (#2802) ADMINISTER INPATIENT MEDS? [25S]
if $$GET1^DIQ(44,LOC_",",2802,"I")
SET MED("IMO")="true"
+31 ;DE2818, ICR 5771, (#36) PARENT
SET X=$$GET1^DIQ(100,ID_",",36)
if X
SET MED("parent")=X
End DoDot:1
+32 IF ORPK
DO OEL^PSOORRL(DFN,ORPK_";"_CLS)
+33 SET X=$SELECT(ORPK["N":"N",1:CLS)
SET MED("vaType")=X
SET MED("medType")=$$TYPE^HMPDJ05V(X)
+34 IF CLS="O"
SET MED("type")=$SELECT(ORPK["N":"OTC",1:"Prescription")
+35 SET X=$GET(HMPESP("COMMENT",1))
if $LENGTH(X)
SET MED("comment")=X
+36 IF $$ISIV^HMPDJ05V
GOTO IV1^HMPDJ05V
+37 ;
A ; - Get order responses
+1 SET OI=$$OI^ORX8(ID)
IF OI
Begin DoDot:1
+2 SET X=$PIECE(OI,U,2)
if $EXTRACT(X,$LENGTH(X))=" "
SET X=$EXTRACT(X,1,$LENGTH(X)-1)
+3 SET MED("name")=X
+4 DO ZERO^PSS50P7(+$PIECE(OI,U,3),,,"PSOI")
+5 SET MED("productFormName")=$PIECE($GET(^TMP($JOB,"PSOI",+$PIECE(OI,U,3),.02)),U,2)
+6 if +$GET(^TMP($JOB,"PSOI",+$PIECE(OI,U,3),.09))
SET MED("supply")="true"
End DoDot:1
+7 ;order responses
DO RESP^HMPDPSOR(ID,.HMPESP)
+8 SET DRUG=+$GET(^TMP("PS",$JOB,"DD",1,0))
if 'DRUG
SET DRUG=+$GET(HMPESP("DRUG",1))
+9 ;ORTX(2)
SET MED("sig")=$SELECT(CLS="I":"Give: ",1:"")_$GET(HMPESP("SIG",1))
+10 ;old Rx
IF CLS="O"
IF '$LENGTH($GET(HMPESP("SIG",1)))
IF '$DATA(HMPESP("INSTR"))
SET MED("sig")=$GET(HMPESP("COMMENT",1))
+11 ;
B ; - Get dosages
+1 ;DE2818 begin, ^OR(100) references - ICR 5771
+2 ;single dose or OP
IF '$ORDER(^OR(100,ID,2,0))
Begin DoDot:1
+3 NEW HMPY,START,STOP,DUR,CONJ,MIN
+4 SET START=$GET(ORSTRT)
SET STOP=$GET(ORSTOP)
SET MIN=0
+5 SET CNT=0
FOR
SET CNT=$ORDER(HMPESP("INSTR",CNT))
if CNT<1
QUIT
Begin DoDot:2
+6 KILL HMPY
DO DOSE(.HMPY,CNT)
MERGE MED("dosages",CNT)=HMPY
+7 ;determine start & stop per dose
+8 SET MED("dosages",CNT,"relativeStart")=MIN
+9 SET DUR=$GET(HMPY("complexDuration"))
SET CONJ=$GET(HMPY("complexConjunction"))
+10 SET STOP=$SELECT(DUR:$$STOP(START,DUR),1:STOP)
+11 if START
SET MED("dosages",CNT,"start")=$$JSONDT^HMPUTILS(START)
+12 if STOP
SET MED("dosages",CNT,"stop")=$$JSONDT^HMPUTILS(STOP)
+13 SET X=$$RELTIME(START,STOP,DUR,MIN)
SET MED("dosages",CNT,"relativeStop")=$SELECT($EXTRACT(X)=".":0_X,1:X)
+14 IF $EXTRACT(CONJ)="T"
IF DUR
SET START=STOP
SET MIN=X
End DoDot:2
End DoDot:1
+15 IF $ORDER(^OR(100,ID,2,0))
Begin DoDot:1
+16 NEW DD,CONJ,HMPY,MIN
+17 MERGE CONJ=HMPESP("CONJ"),DUR=HMPESP("DAYS")
SET MIN=0
+18 ;child orders
SET (DA,CNT)=0
FOR
SET DA=$ORDER(^OR(100,ID,2,DA))
if DA<1
QUIT
Begin DoDot:2
+19 KILL HMPESP,HMPY
DO RESP^HMPDPSOR(DA,.HMPESP)
DO DOSE(.HMPY,1)
+20 SET CNT=CNT+1
MERGE MED("dosages",CNT)=HMPY
+21 SET MED("dosages",CNT,"relativeStart")=MIN
+22 SET MED("dosages",CNT,"complexConjunction")=$GET(CONJ(CNT))
+23 SET MED("dosages",CNT,"complexDuration")=$GET(DUR(CNT))
+24 SET MED("dosages",CNT,"relatedOrder")=DA
+25 SET X=$PIECE($GET(^OR(100,DA,0)),U,8,9)
+26 if $PIECE(X,U)
SET MED("dosages",CNT,"start")=$$JSONDT^HMPUTILS($PIECE(X,U))
+27 if $PIECE(X,U,2)
SET MED("dosages",CNT,"stop")=$$JSONDT^HMPUTILS($PIECE(X,U,2))
+28 ;get last stop time
IF $PIECE(X,U,2)>$GET(ORSTOP)
SET ORSTOP=$PIECE(X,U,2)
+29 SET X=$$RELTIME($PIECE(X,U),$PIECE(X,U,2),$GET(DUR(CNT)),MIN)
+30 SET MED("dosages",CNT,"relativeStop")=$SELECT($EXTRACT(X)=".":0_X,1:X)
if $GET(CONJ(CNT))="T"
SET MIN=X
+31 ;dispense drug(s)
if 'DRUG
SET DD=+$GET(HMPESP("DRUG",1))
SET DD(DD,DA)=""
+32 ; get ^TMP("PS",$J) from 1st child, if Inpt parent:
+33 IF '$DATA(^TMP("PS",$JOB))
SET ORPK=$$PKGID^ORX8(DA)
DO OEL^PSOORRL(DFN,ORPK_";"_CLS)
End DoDot:2
+34 ;reset from last child order
SET MED("stopped")=$$JSONDT^HMPUTILS($GET(ORSTOP))
+35 ;1 drug for order
SET DD=$ORDER(DD(0))
IF DD
IF '$ORDER(DD(DD))
SET DRUG=DD
QUIT
+36 SET (DD,CNT)=0
FOR
SET DD=$ORDER(DD(DD))
if DD<1
QUIT
SET DA=0
FOR
SET DA=$ORDER(DD(DD,DA))
if DA<1
QUIT
SET CNT=CNT+1
DO NDF(DD,CNT,DA)
End DoDot:1
+37 ;
+38 ;DE2818 end
C ; - Get OP data
+1 IF CLS="O"
IF ORPK'["N"
Begin DoDot:1
+2 SET MED("orders",1,"quantityOrdered")=$GET(HMPESP("QTY",1))
+3 SET MED("orders",1,"daysSupply")=$GET(HMPESP("SUPPLY",1))
+4 SET MED("orders",1,"vaRouting")=$GET(HMPESP("PICKUP",1))
+5 SET MED("orders",1,"fillsAllowed")=$GET(HMPESP("REFILLS",1))
+6 SET MED("patientInstruction")=$GET(HMPESP("PI",1))
+7 ;pending
if ORPK["P"!(ORPK["S")
QUIT
+8 NEW HMP,RX0,RX1,FILL,RFD,MW,REL
+9 KILL ^TMP("PSOR",$JOB)
DO EN^PSOORDER(DFN,+ORPK)
+10 SET RX0=$GET(^TMP("PSOR",$JOB,+ORPK,0))
SET RX1=$GET(^(1))
SET MED("orders",1,"prescriptionId")=$PIECE(RX0,U,5)
+11 IF '$GET(HMPESP("QTY",1))
SET MED("orders",1,"quantityOrdered")=$PIECE(RX0,U,6)
+12 IF '$GET(HMPESP("SUPPLY",1))
SET MED("orders",1,"daysSupply")=$PIECE(RX0,U,7)
+13 SET MED("orders",1,"fillsRemaining")=$PIECE(RX0,U,9)
SET MED("lastFilled")=$$JSONDT^HMPUTILS($PIECE(RX0,U,3))
+14 ;original fill
SET I=$PIECE(RX0,U,2)
IF I
SET FILL(I)=I_"^^^"_$PIECE(RX0,U,6,7)_"^^^"_$PIECE(RX0,U,13)_"^^"_$PIECE(RX1,U,6)
+15 SET I=0
FOR
SET I=$ORDER(^TMP("PSOR",$JOB,+ORPK,"REF",I))
if I<1
QUIT
SET X=$GET(^(I,0))
SET FILL(+X)=X
+16 SET I=0
FOR
SET I=$ORDER(^TMP("PSOR",$JOB,+ORPK,"RPAR",I))
if I<1
QUIT
SET X=$GET(^(I,0))
SET $PIECE(X,U,14)=1
SET FILL(+X)=X
+17 ;sort 1st
SET (I,RFD)=0
FOR
SET RFD=$ORDER(FILL(RFD))
if RFD<1
QUIT
SET X=$GET(FILL(RFD))
Begin DoDot:2
+18 SET I=I+1
SET MW=$PIECE($PIECE(X,U,10),";")
SET REL=$PIECE($PIECE(X,U,8),".")
+19 SET MED("fills",I,"dispenseDate")=$$JSONDT^HMPUTILS($PIECE(RFD,"."))
+20 SET MED("fills",I,"releaseDate")=$$JSONDT^HMPUTILS(REL)
+21 SET MED("fills",I,"routing")=MW
+22 SET MED("fills",I,"quantityDispensed")=$PIECE(X,U,4)
+23 SET MED("fills",I,"daysSupplyDispensed")=$PIECE(X,U,5)
+24 ;"true"
if $PIECE(X,U,14)
SET MED("fills",I,"partial")=1
End DoDot:2
+25 SET X=$SELECT($PIECE(RX0,U,11):$PIECE(RX0,U,11),$PIECE(RX0,U,10):$PIECE(RX0,U,10),1:0)
+26 if X
SET MED("orders",1,"fillCost")=X
+27 ;1^expirationDate
SET X=$$GET1^PSODI(52,+ORPK_",",26,"I")
if X
SET MED("overallStop")=$$JSONDT^HMPUTILS($PIECE(X,U,2))
+28 ;DE5723 1^date prescription finished
SET X=$$GET1^PSODI(52,+ORPK_",",38.3,"I")
if X
SET MED("prescriptionFinished")=$$JSONDT^HMPUTILS($PIECE(X,U,2))
End DoDot:1
+29 IF CLS="I"
Begin DoDot:1
+30 SET X=$$GET1^DIQ(55.06,+ORPK_","_DFN_",",25,"I")
+31 if X
SET MED("overallStop")=$$JSONDT^HMPUTILS(X)
+32 DO BCMA^HMPDJ05V(.MED,DFN,ORPK)
End DoDot:1
+33 ;
PSQ ; finish
+1 if DRUG
DO NDF(+DRUG)
+2 SET MED("qualifiedName")=$GET(MED("name"))
+3 SET X=+$PIECE($GET(^TMP("PS",$JOB,"RXN",0)),U,5)
+4 ;DE2818, ICR 10035
if X
SET MED("orders",1,"pharmacistUid")=$$SETUID^HMPUTILS("user",,X)
SET MED("orders",1,"pharmacistName")=$$GET1^DIQ(200,X_",",.01)
+5 KILL ^TMP("PS",$JOB),^TMP($JOB,"PSOI"),^TMP("PSOR",$JOB)
+6 ;RHL 20150102
SET MED("lastUpdateTime")=$$EN^HMPSTMP("med")
+7 ; RHL 20150102
SET MED("stampTime")=MED("lastUpdateTime")
+8 ;US6734 - pre-compile metastamp
+9 ;US6734,US11019
IF $GET(HMPMETA)
DO ADD^HMPMETA("med",MED("uid"),MED("stampTime"))
if HMPMETA=1
QUIT
+10 DO ADD^HMPDJ("MED","med")
+11 QUIT
+12 ;
KIN(IFN) ; DE5462 - Add parents/children (kin) to order
+1 NEW HMPNOJS,HMPORKIN,I
+2 SET HMPNOJS=1
DO RELATED^HMPORRPC(.HMPORKIN,IFN)
+3 if $DATA(@HMPORKIN@("parent"))
SET MED("orders",1,"parentOrderUid")=$$SETUID^HMPUTILS("order",DFN,+@HMPORKIN@("parent"))
+4 SET I=""
FOR
SET I=$ORDER(@HMPORKIN@("children",I))
if I=""
QUIT
Begin DoDot:1
+5 SET MED("orders",1,"childrenOrderUids",I)=$$SETUID^HMPUTILS("order",DFN,+@HMPORKIN@("children",I))
End DoDot:1
+6 QUIT
DOSE(Y,N) ; -- return dosage data from HMPESP(ID,N) to Y("name")
+1 NEW X,DOSE,DUR,CONJ
SET N=+$GET(N,1)
KILL Y
+2 SET Y("instructions")=$GET(HMPESP("INSTR",N))
+3 SET DOSE=$GET(HMPESP("DOSE",N))
SET X=$PIECE(DOSE,"&",1,2)
+4 if $LENGTH(X)>1
SET Y("dose")=$PIECE(X,"&")
SET Y("units")=$PIECE(X,"&",2)
+5 SET X=$PIECE(DOSE,"&",3,4)
if X
SET Y("amount")=$PIECE(X,"&")
SET Y("noun")=$PIECE(X,"&",2)
+6 ; Y("dose")=$S($L(X)>2:$TR(X,"&"," "),1:$P(X,"&"))
+7 SET X=+$GET(HMPESP("ROUTE",N))
DO ALL^PSS51P2(X,,,,"HMPTE")
+8 SET Y("routeName")=$GET(^TMP($JOB,"HMPTE",X,1))
+9 SET X=$GET(HMPESP("SCHEDULE",N))
IF $LENGTH(X)
SET Y("scheduleName")=X
DO SCH^HMPDJ05V(X)
+10 SET X=$GET(HMPESP("ADMIN",N))
if $LENGTH(X)
SET Y("adminTimes")=X
+11 SET X=$GET(HMPESP("DAYS",N))
if $LENGTH(X)
SET Y("complexDuration")=X
SET DUR=X
+12 SET X=$GET(HMPESP("CONJ",N))
if $LENGTH(X)
SET Y("complexConjunction")=X
SET CONJ=X
+13 ;look ahead to find duration
IF $LENGTH($GET(CONJ))
IF '$LENGTH($GET(DUR))
Begin DoDot:1
+14 NEW I,D
SET I=$ORDER(HMPESP("DAYS",N))
SET D=$SELECT(I:$GET(HMPESP("DAYS",I)),1:"")
+15 if $LENGTH(D)
SET Y("complexDuration")=D
End DoDot:1
+16 KILL ^TMP($JOB,"HMPTE")
+17 QUIT
+18 ;
STOP(BEG,X) ; -- Return date after adding X to BEG
+1 NEW D,H,M,UNT,Y
+2 SET Y=BEG
SET (D,H,M)=0
SET UNT=$PIECE(X,+X,2)
SET X=+X
+3 SET UNT=$SELECT($EXTRACT(UNT)=" ":$EXTRACT(UNT,2),1:$EXTRACT(UNT))
IF UNT=""
SET UNT="D"
+4 if UNT="L"
SET D=30*X
+5 if UNT="W"
SET D=7*X
+6 if UNT="D"
SET D=X
+7 if UNT="H"
SET H=X
+8 if UNT="M"
SET M=X
+9 SET Y=$$FMADD^XLFDT(BEG,D,H,M)
+10 QUIT Y
+11 ;
NDF(DRUG,VPI,ORD) ; -- Set NDF data for dispense DRUG ien
+1 ; code ^ name ^ vuid [^ role ^ concentration ^ order]
+2 NEW LEN,HMPX,STR,VUID,X,I
+3 SET DRUG=+$GET(DRUG)
if 'DRUG
QUIT
+4 DO EN^PSSDI(50,,50,"901;902",DRUG,"HMPX")
+5 SET STR=$SELECT($GET(HMPX(50,DRUG,901)):$GET(HMPX(50,DRUG,901))_" "_$GET(HMPX(50,DRUG,902)),1:"")
+6 DO NDF^PSS50(DRUG,,,,,"NDF")
SET VPI=+$GET(VPI,1)
+7 ;
+8 ;Drug
SET MED("products",VPI,"ingredientRole")="urn:sct:410942007"
+9 if $GET(ORD)
SET MED("products",VPI,"relatedOrder")=ORD
+10 if $GET(STR)
SET MED("products",VPI,"strength")=STR
+11 SET X=$GET(MED("name"))
if $LENGTH(X)
SET MED("products",VPI,"ingredientName")=X
+12 ;
+13 ;VA Generic
SET X=$GET(^TMP($JOB,"NDF",DRUG,20))
+14 SET MED("products",VPI,"ingredientCode")="urn:va:vuid:"_$$VUID^HMPD(+X,50.6)
+15 SET MED("products",VPI,"ingredientCodeName")=$PIECE(X,U,2)
+16 ;
+17 ;VA Product
SET X=$GET(^TMP($JOB,"NDF",DRUG,22))
+18 SET MED("products",VPI,"suppliedCode")="urn:va:vuid:"_$$VUID^HMPD(+X,50.68)
+19 SET MED("products",VPI,"suppliedName")=$PIECE(X,U,2)
+20 ;
+21 ;VA Drug Class
SET X=$GET(^TMP($JOB,"NDF",DRUG,25))
+22 SET MED("products",VPI,"drugClassCode")="urn:vadc:"_$PIECE(X,U,2)
+23 SET MED("products",VPI,"drugClassName")=$PIECE(X,U,3)
+24 ;
+25 KILL ^TMP($JOB,"NDF")
+26 QUIT
+27 ;
RELTIME(START,STOP,DUR,MIN) ; -- Return #min for dose
+1 NEW Y
SET Y=0
+2 IF START>0
IF STOP>0
SET Y=$$FMDIFF^XLFDT(STOP,START,2)\60
IF 1
+3 IF '$TEST
IF DUR
SET Y=$$TOMIN(DUR)
IF 1
+4 IF '$TEST
SET Y=$GET(HMPESP("SUPPLY",1))*1440
+5 SET Y=$SELECT(Y:Y+MIN,1:MIN)
+6 QUIT Y
+7 ;
TOMIN(DUR) ;
+1 NEW RESULT,TIME,UNIT
+2 SET UNIT=$$UP^XLFSTR($EXTRACT($PIECE(DUR," ",2)))
+3 IF UNIT=""
QUIT 0
+4 SET TIME=$PIECE(DUR," ")
+5 SET RESULT=$SELECT(UNIT="M":TIME,UNIT="H":TIME*60,UNIT="D":TIME*1440,UNIT="W":TIME*10080,UNIT="L":TIME*43200,1:0)
+6 QUIT RESULT
