EDPMED ;SLC/MKB - EDIS medication utilities ;2/28/12 08:33am
;;2.0;EMERGENCY DEPARTMENT;;May 2, 2012;Build 103
;
OEL(Y,DFN,ORDER,IDT) ; -- Return ^TMP("PS",$J) data
; in Y("attribute")=value
K ^TMP("PS",$J) D OEL^PSOORRL(DFN,ORDER)
N X0,X,XC,FAC,SEQ,SUB
S X0=$G(^TMP("LRRR",$J,DFN,"CH",IDT,SEQ))
S Y("subscript")=SUB,Y("accession")=SUB_";"_IDT
S Y("collected")=$$FMTHL7^XLFDT(9999999-IDT)
S Y("testID")=+X0,Y("testName")=$P($G(^LAB(60,+X0,0)),U),X=+$P($G(^(.1)),U,6)
S Y("printOrder")=$S(X:+X,1:SEQ/1000000)
S:$L($P(X0,U,2)) Y("result")=$P(X0,U,2)
S:$L($P(X0,U,4)) Y("units")=$P(X0,U,4)
S:$L($P(X0,U,3)) Y("deviation")=$P(X0,U,3)
S X=$P(X0,U,5) I $L(X),X["-" S Y("low")=$P(X,"-"),Y("high")=$P(X,"-",2)
S Y("printName")=$P(X0,U,15)
S Y("number")=$P(X0,U,16)
S X=+$P(X0,U,19) D ;sample & specimen
. N SPC,CS,LRDFN
. S:X<1 LRDFN=+$G(^DPT(DFN,"LR")),X=+$P($G(^LR(LRDFN,SUB,IDT,0)),U,5)
. S SPC=$G(^LAB(61,X,0)) Q:'$L(SPC)
. S Y("specimen")=$P(SPC,U),CS=+$P(SPC,U,6)
. S:CS Y("sample")=$P($G(^LAB(62,CS,0)),U)
S X=+$P(X0,U,17),XC=$Q(^LRO(69,"C",X))
I $P(XC,",",1,3)=("^LRO(69,""C"","_X) D ;get Lab Order info
. N LRO,LR3
. S LRO=$G(^LRO(69,+$P(XC,",",4),1,+$P(XC,",",5),0)),LR3=$G(^(3))
. ;S X=+$P(LRO,U,6) S:X Y("provider")=X_U_$P($G(^VA(200,X,0)),U)
. S X=+$P(LRO,U,11) S:X Y("order")=X
. S X=$P(LR3,U,2) S:X Y("resultedTS")=$$FMTHL7^XLFDT(X)
S FAC=$$SITE^VASITE S:FAC Y("stnNum")=$P(FAC,U,3),Y("stnName")=$P(FAC,U,2)
I $D(^TMP("LRRR",$J,DFN,SUB,IDT,"N")) D ;M Y("comment")=^("N")
. N I S I=1,X=$G(^TMP("LRRR",$J,DFN,SUB,IDT,"N",I))
. F S I=$O(^TMP("LRRR",$J,DFN,SUB,IDT,"N",I)) Q:I<1 S X=X_$C(13,10)_^(I)
. S Y("comment")=X
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HEDPMED 1702 printed Dec 13, 2024@01:52:04 Page 2
EDPMED ;SLC/MKB - EDIS medication utilities ;2/28/12 08:33am
+1 ;;2.0;EMERGENCY DEPARTMENT;;May 2, 2012;Build 103
+2 ;
OEL(Y,DFN,ORDER,IDT) ; -- Return ^TMP("PS",$J) data
+1 ; in Y("attribute")=value
+2 KILL ^TMP("PS",$JOB)
DO OEL^PSOORRL(DFN,ORDER)
+3 NEW X0,X,XC,FAC,SEQ,SUB
+4 SET X0=$GET(^TMP("LRRR",$JOB,DFN,"CH",IDT,SEQ))
+5 SET Y("subscript")=SUB
SET Y("accession")=SUB_";"_IDT
+6 SET Y("collected")=$$FMTHL7^XLFDT(9999999-IDT)
+7 SET Y("testID")=+X0
SET Y("testName")=$PIECE($GET(^LAB(60,+X0,0)),U)
SET X=+$PIECE($GET(^(.1)),U,6)
+8 SET Y("printOrder")=$SELECT(X:+X,1:SEQ/1000000)
+9 if $LENGTH($PIECE(X0,U,2))
SET Y("result")=$PIECE(X0,U,2)
+10 if $LENGTH($PIECE(X0,U,4))
SET Y("units")=$PIECE(X0,U,4)
+11 if $LENGTH($PIECE(X0,U,3))
SET Y("deviation")=$PIECE(X0,U,3)
+12 SET X=$PIECE(X0,U,5)
IF $LENGTH(X)
IF X["-"
SET Y("low")=$PIECE(X,"-")
SET Y("high")=$PIECE(X,"-",2)
+13 SET Y("printName")=$PIECE(X0,U,15)
+14 SET Y("number")=$PIECE(X0,U,16)
+15 ;sample & specimen
SET X=+$PIECE(X0,U,19)
Begin DoDot:1
+16 NEW SPC,CS,LRDFN
+17 if X<1
SET LRDFN=+$GET(^DPT(DFN,"LR"))
SET X=+$PIECE($GET(^LR(LRDFN,SUB,IDT,0)),U,5)
+18 SET SPC=$GET(^LAB(61,X,0))
if '$LENGTH(SPC)
QUIT
+19 SET Y("specimen")=$PIECE(SPC,U)
SET CS=+$PIECE(SPC,U,6)
+20 if CS
SET Y("sample")=$PIECE($GET(^LAB(62,CS,0)),U)
End DoDot:1
+21 SET X=+$PIECE(X0,U,17)
SET XC=$QUERY(^LRO(69,"C",X))
+22 ;get Lab Order info
IF $PIECE(XC,",",1,3)=("^LRO(69,""C"","_X)
Begin DoDot:1
+23 NEW LRO,LR3
+24 SET LRO=$GET(^LRO(69,+$PIECE(XC,",",4),1,+$PIECE(XC,",",5),0))
SET LR3=$GET(^(3))
+25 ;S X=+$P(LRO,U,6) S:X Y("provider")=X_U_$P($G(^VA(200,X,0)),U)
+26 SET X=+$PIECE(LRO,U,11)
if X
SET Y("order")=X
+27 SET X=$PIECE(LR3,U,2)
if X
SET Y("resultedTS")=$$FMTHL7^XLFDT(X)
End DoDot:1
+28 SET FAC=$$SITE^VASITE
if FAC
SET Y("stnNum")=$PIECE(FAC,U,3)
SET Y("stnName")=$PIECE(FAC,U,2)
+29 ;M Y("comment")=^("N")
IF $DATA(^TMP("LRRR",$JOB,DFN,SUB,IDT,"N"))
Begin DoDot:1
+30 NEW I
SET I=1
SET X=$GET(^TMP("LRRR",$JOB,DFN,SUB,IDT,"N",I))
+31 FOR
SET I=$ORDER(^TMP("LRRR",$JOB,DFN,SUB,IDT,"N",I))
if I<1
QUIT
SET X=X_$CHAR(13,10)_^(I)
+32 SET Y("comment")=X
End DoDot:1
+33 QUIT
