LA7MUSPM ;ihs/cmi/maw - MU2 SPM segment utility ; 22-Oct-2013 09:22 ; MAW
;;5.2;BLR IHS REFERENCE LAB;**1033**;NOV 01, 1997
;
SPM2(CS,SC,AC) ;-- specimen id
N SPM2
S SPM2=CS_AC_SC_"Filler_LIS"_SC_"2.16.840.1.113883.3.72.5.21"_SC_"ISO"
Q SPM2
;
SPM4(CS,ACC,SPC) ;-- specimen type
N SPM4,SNM
S SNM=$$GET1^DIQ(61,SPC,2)
S SPM4=SNM_CS_$$GET1^DIQ(61,SPC,.01)_CS_"SCT"_CS_$$GET1^DIQ(61,SPC,.08)_CS_$$GET1^DIQ(61,SPC,.01)_CS_"L"_CS_LA7VER_CS_$G(^DIC(9.4,$O(^DIC(9.4,"C","BLR",0)),"VERSION"))
Q SPM4
;
SPM5(CS,ACC,SPC,RI) ;-- specimen type modifier
N SPM5
S SPM5=""
N RA,ID,TX
S RA=0 F S RA=$O(^BLRRLO(RI,4,RA)) Q:'RA D
. Q:$P($G(^BLRRLO(RI,4,RA,0)),U,3)'="SPM5"
. S ID=$P($G(^BLRRLO(RI,4,RA,0)),U,4)
. S TX=$P($G(^BLRRLO(RI,4,RA,0)),U,5)
. S SPM5=ID_CS_TX_CS_"SCT"_CS_$E(TX,1,3)_CS_TX_CS_"L"_CS_"2.40"_CS_LA7VER
Q SPM5
;
SPM6(CS,ACC,SPC) ;-- specimen additives
;file 62 new field
N SPM6,ADD,ADDD
S SPM6=""
S ADD=$P($G(^LAB(62,LRSAMP,9,LRAA,1,LA760,"IHS")),U)
I $G(ADD)]"" S ADDD=$$LOOKTAB^LA7CQRY1("HL7","0371",ADD,$E(LA7ECH))
I $G(ADD)]"" S SPM6=ADDD_CS_$E($P(ADDD,U),1)_CS_$P(ADDD,U,2)_CS_"L"_CS_"2.5.1"_CS_LA7VER
Q SPM6
;
SPM7(CS,ACC,SPC) ;-- specimen collection method
;file 62 new field
N SPM7,MTH,METH
S SPM7=""
S MTH=$P($G(^LAB(62,LRSAMP,9,LRAA,1,LA760,"IHS")),U,2)
I $G(MTH)]"",$E(MTH,1)?.N S METH=$$LOOKTAB^LA7CQRY1("","SCT",MTH,$E(LA7ECH))
I $G(MTH)]"",$E(MTH,1)'?.N S METH=$$LOOKTAB^LA7CQRY1("HL7","0488",MTH,$E(LA7ECH))
I $G(MTH)]"" S SPM7=METH_CS_$E($P(METH,U),1,4)_CS_$P(METH,U,2)_CS_"L"_CS_"07/31/2012"_CS_LA7VER
Q SPM7
;
SPM8(CS,ACC,SPC) ;-- specimen source site
;file 62 new field, points to 61
N SPM8,SS,SSS,SSE
S SPM8=""
S SS=$P($G(^LAB(62,LRSAMP,9,LRAA,1,LA760,"IHS")),U,3)
I 'SS Q SPM8
S SSS=$P($G(^LAB(61,SS,0)),U,2)
I $G(SSS)]"" S SSE=$$LOOKTAB^LA7CQRY1("","SCT",SSS,$E(LA7ECH))
I $G(SSS)]"" S SPM8=SSE_CS_$E($P(SSE,U),1,4)_CS_$P(SSE,U,2)_CS_"L"_CS_"07/31/2012"_CS_LA7VER
Q SPM8
;
SPM9(CS,ACC,SPC,RI) ;-- specimen source site modifier
N SPM9
S SPM9=""
N RA,ID,TX
S RA=0 F S RA=$O(^BLRRLO(RI,4,RA)) Q:'RA D
. Q:$P($G(^BLRRLO(RI,4,RA,0)),U,3)'="SPM9"
. S ID=$P($G(^BLRRLO(RI,4,RA,0)),U,4)
. S TX=$P($G(^BLRRLO(RI,4,RA,0)),U,5)
. S SPM9=ID_CS_TX_CS_"SCT"_CS_$E(TX,1,3)_CS_TX_CS_"L"_CS_"2.40"_CS_LA7VER
Q SPM9
;
SPM11(CS,ACC,SPC) ;-- specimen role
;file 61 time aspect field
N SPM11,TA,ID,IDD
S SPM11=""
S TA=$P($G(^LAB(61,SPC,0)),U,10)
I 'TA Q SPM11
S ID=$E($P($G(^LAB(64.061,TA,0)),U,2),1)
I $G(ID)]"" S IDD=$$LOOKTAB^LA7CQRY1("HL7","0369",ID,$E(LA7ECH))
I $G(ID)]"" S SPM11=IDD_CS_ID_CS_$P(IDD,U,2)_CS_"L"_CS_"2.5.1"_CS_LA7VER
Q SPM11
;
SPM12(CS,SC,ACC,SPC) ;-- specimen collection amount
N SPM12
S SPM12=""
;TODO MU2 add the following once we determine specimen collection amount
;MU2 hard coded per team 7/1/2013
S SPM12=1_CS_"{#}"_SC_"Number"_SC_"UCUM"_SC_"unit"_SC_"unit"_SC_"L"_SC_"1.1"_SC_LA7VER
Q SPM12
;
SPM17(CS,LDFN,LIDT) ;-- speciment collection date/time
N SPM17
S SPM17=$$FMTHL7^XLFDT($P($G(^LR(LRDFN,LRSS,LRIDT,0)),U))_CS_$$FMTHL7^XLFDT($P($G(^LR(LRDFN,LRSS,LRIDT,0)),U))
Q SPM17
;
SPM18(CS,LDFN,LIDT) ;-- specimen received date/time
N SPM18
S SPM18=$$FMTHL7^XLFDT($P($G(^LR(LRDFN,LRSS,LRIDT,0)),U))
Q SPM18
;
SPM21(CS,ACC,SPC) ;-- specimen reject reason
N SPM21
S SPM21=""
Q SPM21
;
LA7MUSPM ;ihs/cmi/maw - MU2 SPM segment utility ; 22-Oct-2013 09:22 ; MAW
+1 ;;5.2;BLR IHS REFERENCE LAB;**1033**;NOV 01, 1997
+2 ;
SPM2(CS,SC,AC) ;-- specimen id
+1 NEW SPM2
+2 SET SPM2=CS_AC_SC_"Filler_LIS"_SC_"2.16.840.1.113883.3.72.5.21"_SC_"ISO"
+3 QUIT SPM2
+4 ;
SPM4(CS,ACC,SPC) ;-- specimen type
+1 NEW SPM4,SNM
+2 SET SNM=$$GET1^DIQ(61,SPC,2)
+3 SET SPM4=SNM_CS_$$GET1^DIQ(61,SPC,.01)_CS_"SCT"_CS_$$GET1^DIQ(61,SPC,.08)_CS_$$GET1^DIQ(61,SPC,.01)_CS_"L"_CS_LA7VER_CS_$GET(^DIC(9.4,$ORDER(^DIC(9.4,"C","BLR",0)),"VERSION"))
+4 QUIT SPM4
+5 ;
SPM5(CS,ACC,SPC,RI) ;-- specimen type modifier
+1 NEW SPM5
+2 SET SPM5=""
+3 NEW RA,ID,TX
+4 SET RA=0
FOR
SET RA=$ORDER(^BLRRLO(RI,4,RA))
IF 'RA
QUIT
Begin DoDot:1
+5 IF $PIECE($GET(^BLRRLO(RI,4,RA,0)),U,3)'="SPM5"
QUIT
+6 SET ID=$PIECE($GET(^BLRRLO(RI,4,RA,0)),U,4)
+7 SET TX=$PIECE($GET(^BLRRLO(RI,4,RA,0)),U,5)
+8 SET SPM5=ID_CS_TX_CS_"SCT"_CS_$EXTRACT(TX,1,3)_CS_TX_CS_"L"_CS_"2.40"_CS_LA7VER
End DoDot:1
+9 QUIT SPM5
+10 ;
SPM6(CS,ACC,SPC) ;-- specimen additives
+1 ;file 62 new field
+2 NEW SPM6,ADD,ADDD
+3 SET SPM6=""
+4 SET ADD=$PIECE($GET(^LAB(62,LRSAMP,9,LRAA,1,LA760,"IHS")),U)
+5 IF $GET(ADD)]""
SET ADDD=$$LOOKTAB^LA7CQRY1("HL7","0371",ADD,$EXTRACT(LA7ECH))
+6 IF $GET(ADD)]""
SET SPM6=ADDD_CS_$EXTRACT($PIECE(ADDD,U),1)_CS_$PIECE(ADDD,U,2)_CS_"L"_CS_"2.5.1"_CS_LA7VER
+7 QUIT SPM6
+8 ;
SPM7(CS,ACC,SPC) ;-- specimen collection method
+1 ;file 62 new field
+2 NEW SPM7,MTH,METH
+3 SET SPM7=""
+4 SET MTH=$PIECE($GET(^LAB(62,LRSAMP,9,LRAA,1,LA760,"IHS")),U,2)
+5 IF $GET(MTH)]""
IF $EXTRACT(MTH,1)?.N
SET METH=$$LOOKTAB^LA7CQRY1("","SCT",MTH,$EXTRACT(LA7ECH))
+6 IF $GET(MTH)]""
IF $EXTRACT(MTH,1)'?.N
SET METH=$$LOOKTAB^LA7CQRY1("HL7","0488",MTH,$EXTRACT(LA7ECH))
+7 IF $GET(MTH)]""
SET SPM7=METH_CS_$EXTRACT($PIECE(METH,U),1,4)_CS_$PIECE(METH,U,2)_CS_"L"_CS_"07/31/2012"_CS_LA7VER
+8 QUIT SPM7
+9 ;
SPM8(CS,ACC,SPC) ;-- specimen source site
+1 ;file 62 new field, points to 61
+2 NEW SPM8,SS,SSS,SSE
+3 SET SPM8=""
+4 SET SS=$PIECE($GET(^LAB(62,LRSAMP,9,LRAA,1,LA760,"IHS")),U,3)
+5 IF 'SS
QUIT SPM8
+6 SET SSS=$PIECE($GET(^LAB(61,SS,0)),U,2)
+7 IF $GET(SSS)]""
SET SSE=$$LOOKTAB^LA7CQRY1("","SCT",SSS,$EXTRACT(LA7ECH))
+8 IF $GET(SSS)]""
SET SPM8=SSE_CS_$EXTRACT($PIECE(SSE,U),1,4)_CS_$PIECE(SSE,U,2)_CS_"L"_CS_"07/31/2012"_CS_LA7VER
+9 QUIT SPM8
+10 ;
SPM9(CS,ACC,SPC,RI) ;-- specimen source site modifier
+1 NEW SPM9
+2 SET SPM9=""
+3 NEW RA,ID,TX
+4 SET RA=0
FOR
SET RA=$ORDER(^BLRRLO(RI,4,RA))
IF 'RA
QUIT
Begin DoDot:1
+5 IF $PIECE($GET(^BLRRLO(RI,4,RA,0)),U,3)'="SPM9"
QUIT
+6 SET ID=$PIECE($GET(^BLRRLO(RI,4,RA,0)),U,4)
+7 SET TX=$PIECE($GET(^BLRRLO(RI,4,RA,0)),U,5)
+8 SET SPM9=ID_CS_TX_CS_"SCT"_CS_$EXTRACT(TX,1,3)_CS_TX_CS_"L"_CS_"2.40"_CS_LA7VER
End DoDot:1
+9 QUIT SPM9
+10 ;
SPM11(CS,ACC,SPC) ;-- specimen role
+1 ;file 61 time aspect field
+2 NEW SPM11,TA,ID,IDD
+3 SET SPM11=""
+4 SET TA=$PIECE($GET(^LAB(61,SPC,0)),U,10)
+5 IF 'TA
QUIT SPM11
+6 SET ID=$EXTRACT($PIECE($GET(^LAB(64.061,TA,0)),U,2),1)
+7 IF $GET(ID)]""
SET IDD=$$LOOKTAB^LA7CQRY1("HL7","0369",ID,$EXTRACT(LA7ECH))
+8 IF $GET(ID)]""
SET SPM11=IDD_CS_ID_CS_$PIECE(IDD,U,2)_CS_"L"_CS_"2.5.1"_CS_LA7VER
+9 QUIT SPM11
+10 ;
SPM12(CS,SC,ACC,SPC) ;-- specimen collection amount
+1 NEW SPM12
+2 SET SPM12=""
+3 ;TODO MU2 add the following once we determine specimen collection amount
+4 ;MU2 hard coded per team 7/1/2013
+5 SET SPM12=1_CS_"{#}"_SC_"Number"_SC_"UCUM"_SC_"unit"_SC_"unit"_SC_"L"_SC_"1.1"_SC_LA7VER
+6 QUIT SPM12
+7 ;
SPM17(CS,LDFN,LIDT) ;-- speciment collection date/time
+1 NEW SPM17
+2 SET SPM17=$$FMTHL7^XLFDT($PIECE($GET(^LR(LRDFN,LRSS,LRIDT,0)),U))_CS_$$FMTHL7^XLFDT($PIECE($GET(^LR(LRDFN,LRSS,LRIDT,0)),U))
+3 QUIT SPM17
+4 ;
SPM18(CS,LDFN,LIDT) ;-- specimen received date/time
+1 NEW SPM18
+2 SET SPM18=$$FMTHL7^XLFDT($PIECE($GET(^LR(LRDFN,LRSS,LRIDT,0)),U))
+3 QUIT SPM18
+4 ;
SPM21(CS,ACC,SPC) ;-- specimen reject reason
+1 NEW SPM21
+2 SET SPM21=""
+3 QUIT SPM21
+4 ;
