LRPXAPIU ; SLC/STAFF Lab Extract API Utilities ;1/29/04 14:32
;;5.2;LAB SERVICE;**295,315**;Sep 27, 1994;Build 25
;
; lab APIs
; dbia 4246
;
; ------------ internal number conversions -----------
;
LRDFN(DFN) ; API $$(dfn) -> lrdfn
Q +$G(^DPT(+$G(DFN),"LR"))
;
DFN(LRDFN) ; API $$(lrdfn) -> dfn
S LRDFN=+$G(LRDFN)
I $P($G(^LR(LRDFN,0)),U,2)'=2 Q 0
Q +$P(^LR(LRDFN,0),U,3)
;
LRIDT(DATETIME) ; API $$(datetime) -> lridt (or lridt to datetime)
I +$G(DATETIME)'>0 Q 0
Q 9999999-DATETIME
;
LRDN(TEST) ; API $$(test) -> data number (subscript for test in ^LR)
Q +$P($P($G(^LAB(60,+$G(TEST),0)),U,5),";",2)
;
TEST(LRDN) ; API $$(lrdn) -> test
Q +$O(^LAB(60,"C","CH;"_$G(LRDN)_";1",0))
;
AB(ABDN) ; API $$(antimicrobial data number) -> antimicrobial ien
Q +$G(^LAB(62.06,"AI",+$G(ABDN)))
;
ABDN(AB) ; API $$(62.06 ien) -> antimicrobial data number
N ABDN
S ABDN=+$P($G(^LAB(62.06,+$G(AB),0)),U,2)
I ABDN'["2." Q 0
Q ABDN
;
TB(TBDN) ; API $$(mycobacteria data number) -> mycobacteria field number
Q +$O(^DD(63.39,"GL",+$G(TBDN),1,0)) ; dbia 999
;
TBDN(TB) ; API $$(mycobacteria field number) -> mycobacteria data number
N TBDN
S TBDN=+$P($G(^DD(63.39,+$G(TB),0)),U,4) ; dbia 999
I TBDN'["2." Q 0
Q TBDN
;
CATEGORY(SUB,TYPE) ; API $$(subscript, type) -> Micro category [B P F M V], AP category [A C E M S]
N CAT
S SUB=+$G(SUB)
I TYPE="M" D Q CAT
. I SUB=3 S CAT="B" Q
. I SUB=6 S CAT="P" Q
. I SUB=9 S CAT="F" Q
. I SUB=12 S CAT="M" Q
. I SUB=17 S CAT="V" Q
. S CAT=-1
I SUB="SP" Q "S"
I SUB="CY" Q "C"
I SUB="EM" Q "E"
I SUB="AU" Q "A"
I SUB="AY" Q "A"
I SUB=33 Q "A"
I SUB=80 Q "A"
Q -1
;
CATSUB(CAT,TYPE) ; API $$(category letter, type) -> subscript
N SUB
S CAT=$G(CAT)
I TYPE="M" D Q SUB
. I CAT="B" S SUB=3 Q
. I CAT="P" S SUB=6 Q
. I CAT="F" S SUB=9 Q
. I CAT="M" S SUB=12 Q
. I CAT="V" S SUB=17 Q
. S SUB=-1
I CAT="S" Q "SP"
I CAT="C" Q "CY"
I CAT="E" Q "EM"
I CAT="A" Q "AU" ; must check - could be AY, 33, 80
Q -1
;
; ----------- external names ---------------
;
DFNM(DFN) ; API $$(dfn) -> patient name
Q $P($G(^DPT(+$G(DFN),0)),U)
;
LRDFNM(LRDFN) ; API $$(lrdfn) -> patient name
Q $$DFNM($$DFN(+$G(LRDFN)))
;
TESTNM(TEST) ; API $$(test ien) -> test name
Q $P($G(^LAB(60,+$G(TEST),0)),U)
;
LRDNM(LRDN) ; API $$(data number) -> test name
Q $$TESTNM($$TEST($G(LRDN)))
;
SPECNM(SPEC) ; API $$(spec ien) -> specimen name
Q $P($G(^LAB(61,+$G(SPEC),0)),U)
;
BUGNM(BUG) ; API $$(organism ien) -> organism name
Q $P($G(^LAB(61.2,+$G(BUG),0)),U)
;
ABNM(AB) ; API $$(antimicrobial ien) -> antimicrobial name
Q $P($G(^LAB(62.06,+$G(AB),0)),U)
;
TBNM(TB) ; API $$(mycobacteria field number) -> mycobacteria drug name
Q $P($G(^DD(63.39,+$G(TB),0)),U) ; dbia 999
;
ORGNM(ORGAN) ; API $$(organ/tissue ien) -> organ/tissue name
Q $P($G(^LAB(61,+$G(ORGAN),0)),U)
;
DISNM(DISEASE) ; API $$(disease ien) -> disease name
Q $P($G(^LAB(61.4,+$G(DISEASE),0)),U)
;
ETINM(ETIOLOGY) ; API $$(etiology ien) -> etiology name
Q $P($G(^LAB(61.2,+$G(ETIOLOGY),0)),U)
;
MORPHNM(MORPH) ; API $$(morphology ien) -> morphology name
Q $P($G(^LAB(61.1,+$G(MORPH),0)),U)
;
FUNNM(FUNCTION) ; API $$(function ien) -> function name
Q $P($G(^LAB(61.3,+$G(FUNCTION),0)),U)
;
PROCNM(PROC) ; API $$(procedure ien) -> procedure name
Q $P($G(^LAB(61.5,+$G(PROC),0)),U)
;
ICD9(ICD9) ; API $$(icd9 ien) -> icd code^name
N LRTMP
S ICD9=$P($$ICDDX^ICDCODE(ICD9,,,1),U,2)
S LRTMP=$$ICDD^ICDCODE(ICD9,"LRTMP")
Q ICD9_U_$G(LRTMP(1))
;
DOD(DFN) ; API $$(dfn) -> date of death else 0
Q +$G(^DPT(+$G(DFN),.35)) ; dbia 13
;
EXTVALUE(Y,REF) ; API $$(internal value,index ref) -> external value
N C,FIELD
I $P(REF,";",2)'="CH" Q Y
S FIELD=+$P(REF,";",4)
S C=$P(^DD(63.04,FIELD,0),U,2) ; dbia 999
D Y^DIQ
Q Y
;
ITEMNM(INFO) ; API $$(ap or micro item) -> item name
N FILE,NAME,NUM,TYPE
I INFO=+INFO Q $$TESTNM(INFO)
S NAME=""
S TYPE=$P(INFO,";") I '$L(TYPE) Q NAME
S FILE=$P(INFO,";",2) I '$L(FILE) Q NAME
S NUM=+$P(INFO,";",3) I 'NUM Q NAME
I TYPE="M" D Q NAME
. I FILE="S" S NAME=$$SPECNM(NUM) Q
. I FILE="T" S NAME=$$TESTNM(NUM) Q
. I FILE="O" S NAME=$$BUGNM(NUM) Q
. I FILE="A" S NAME=$$ABNM(NUM) Q
. I FILE="M" S NAME=$$TBNM(NUM) Q
I TYPE="A" D Q NAME
. I FILE="S" S NAME=$P(INFO,".",2) Q
. I FILE="T" S NAME=$$TESTNM(NUM) Q
. I FILE="O" S NAME=$$ORGNM(NUM) Q
. I FILE="D" S NAME=$$DISNM(NUM) Q
. I FILE="M" S NAME=$$MORPHNM(NUM) Q
. I FILE="E" S NAME=$$ETINM(NUM) Q
. I FILE="F" S NAME=$$FUNNM(NUM) Q
. I FILE="P" S NAME=$$PROCNM(NUM) Q
. I FILE="I" S NAME=$$ICD9^LRPXAPIU(NUM) Q
Q NAME
;
; -------------- other utilities -------------
;
CONDOK(COND,TYPE) ; API $$(condition,type) -> 1 for valid condition, else 0
Q $$CONDOK^LRPXAPI2($G(COND),$G(TYPE,"C"))
;
NORMALS(LOW,HIGH,TEST,SPEC) ; API return low and high ref range on test
D NORMALS^LRPXAPI2(.LOW,.HIGH,TEST,SPEC)
Q
;
DATES(DATE1,DATE2) ; API return proper date range
; DATE1 always returns oldest value
N TEMP
S DATE1=$$EXTTOFM($G(DATE1))
S DATE2=$$EXTTOFM($G(DATE2))
I 'DATE2 S DATE2=9999999
I DATE1>DATE2 S TEMP=DATE1,DATE1=DATE2,DATE2=TEMP
I DATE2=+DATE2,DATE2'=9999999,DATE2'["." S DATE2=DATE2+.25
Q
;
EXTTOFM(X) ; $$(external date/time) -> FM date/time
N %DT,Y
S %DT="TS"
D ^%DT
I Y=-1 Q 0
Q +Y
;
VRESULT(TEST,RESULT) ; $$(test,result) -> valid result
Q $$STRIP($$RESULT(TEST,RESULT))
;
RESULT(TEST,RESULT) ; $$(test,result) -> result Convert CH result to external format
;TEST=Test ptr to file 60
;RESULT=Test result
N X,X1,LRCW
S LRCW="",X1=$P($G(^LAB(60,TEST,.1)),U,3),X1=$S($L(X1):X1,1:"$J(X,8)"),X=RESULT,@("X="_X1)
Q X
;
STRIP(TEXT) ; $$(text) -> stripped text Strips white space from text
N I,X
S X="" F I=1:1:$L(TEXT," ") S:$A($P(TEXT," ",I))>0 X=X_$P(TEXT," ",I)
Q X
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HLRPXAPIU 5967 printed Oct 16, 2024@18:20:19 Page 2
LRPXAPIU ; SLC/STAFF Lab Extract API Utilities ;1/29/04 14:32
+1 ;;5.2;LAB SERVICE;**295,315**;Sep 27, 1994;Build 25
+2 ;
+3 ; lab APIs
+4 ; dbia 4246
+5 ;
+6 ; ------------ internal number conversions -----------
+7 ;
LRDFN(DFN) ; API $$(dfn) -> lrdfn
+1 QUIT +$GET(^DPT(+$GET(DFN),"LR"))
+2 ;
DFN(LRDFN) ; API $$(lrdfn) -> dfn
+1 SET LRDFN=+$GET(LRDFN)
+2 IF $PIECE($GET(^LR(LRDFN,0)),U,2)'=2
QUIT 0
+3 QUIT +$PIECE(^LR(LRDFN,0),U,3)
+4 ;
LRIDT(DATETIME) ; API $$(datetime) -> lridt (or lridt to datetime)
+1 IF +$GET(DATETIME)'>0
QUIT 0
+2 QUIT 9999999-DATETIME
+3 ;
LRDN(TEST) ; API $$(test) -> data number (subscript for test in ^LR)
+1 QUIT +$PIECE($PIECE($GET(^LAB(60,+$GET(TEST),0)),U,5),";",2)
+2 ;
TEST(LRDN) ; API $$(lrdn) -> test
+1 QUIT +$ORDER(^LAB(60,"C","CH;"_$GET(LRDN)_";1",0))
+2 ;
AB(ABDN) ; API $$(antimicrobial data number) -> antimicrobial ien
+1 QUIT +$GET(^LAB(62.06,"AI",+$GET(ABDN)))
+2 ;
ABDN(AB) ; API $$(62.06 ien) -> antimicrobial data number
+1 NEW ABDN
+2 SET ABDN=+$PIECE($GET(^LAB(62.06,+$GET(AB),0)),U,2)
+3 IF ABDN'["2."
QUIT 0
+4 QUIT ABDN
+5 ;
TB(TBDN) ; API $$(mycobacteria data number) -> mycobacteria field number
+1 ; dbia 999
QUIT +$ORDER(^DD(63.39,"GL",+$GET(TBDN),1,0))
+2 ;
TBDN(TB) ; API $$(mycobacteria field number) -> mycobacteria data number
+1 NEW TBDN
+2 ; dbia 999
SET TBDN=+$PIECE($GET(^DD(63.39,+$GET(TB),0)),U,4)
+3 IF TBDN'["2."
QUIT 0
+4 QUIT TBDN
+5 ;
CATEGORY(SUB,TYPE) ; API $$(subscript, type) -> Micro category [B P F M V], AP category [A C E M S]
+1 NEW CAT
+2 SET SUB=+$GET(SUB)
+3 IF TYPE="M"
Begin DoDot:1
+4 IF SUB=3
SET CAT="B"
QUIT
+5 IF SUB=6
SET CAT="P"
QUIT
+6 IF SUB=9
SET CAT="F"
QUIT
+7 IF SUB=12
SET CAT="M"
QUIT
+8 IF SUB=17
SET CAT="V"
QUIT
+9 SET CAT=-1
End DoDot:1
QUIT CAT
+10 IF SUB="SP"
QUIT "S"
+11 IF SUB="CY"
QUIT "C"
+12 IF SUB="EM"
QUIT "E"
+13 IF SUB="AU"
QUIT "A"
+14 IF SUB="AY"
QUIT "A"
+15 IF SUB=33
QUIT "A"
+16 IF SUB=80
QUIT "A"
+17 QUIT -1
+18 ;
CATSUB(CAT,TYPE) ; API $$(category letter, type) -> subscript
+1 NEW SUB
+2 SET CAT=$GET(CAT)
+3 IF TYPE="M"
Begin DoDot:1
+4 IF CAT="B"
SET SUB=3
QUIT
+5 IF CAT="P"
SET SUB=6
QUIT
+6 IF CAT="F"
SET SUB=9
QUIT
+7 IF CAT="M"
SET SUB=12
QUIT
+8 IF CAT="V"
SET SUB=17
QUIT
+9 SET SUB=-1
End DoDot:1
QUIT SUB
+10 IF CAT="S"
QUIT "SP"
+11 IF CAT="C"
QUIT "CY"
+12 IF CAT="E"
QUIT "EM"
+13 ; must check - could be AY, 33, 80
IF CAT="A"
QUIT "AU"
+14 QUIT -1
+15 ;
+16 ; ----------- external names ---------------
+17 ;
DFNM(DFN) ; API $$(dfn) -> patient name
+1 QUIT $PIECE($GET(^DPT(+$GET(DFN),0)),U)
+2 ;
LRDFNM(LRDFN) ; API $$(lrdfn) -> patient name
+1 QUIT $$DFNM($$DFN(+$GET(LRDFN)))
+2 ;
TESTNM(TEST) ; API $$(test ien) -> test name
+1 QUIT $PIECE($GET(^LAB(60,+$GET(TEST),0)),U)
+2 ;
LRDNM(LRDN) ; API $$(data number) -> test name
+1 QUIT $$TESTNM($$TEST($GET(LRDN)))
+2 ;
SPECNM(SPEC) ; API $$(spec ien) -> specimen name
+1 QUIT $PIECE($GET(^LAB(61,+$GET(SPEC),0)),U)
+2 ;
BUGNM(BUG) ; API $$(organism ien) -> organism name
+1 QUIT $PIECE($GET(^LAB(61.2,+$GET(BUG),0)),U)
+2 ;
ABNM(AB) ; API $$(antimicrobial ien) -> antimicrobial name
+1 QUIT $PIECE($GET(^LAB(62.06,+$GET(AB),0)),U)
+2 ;
TBNM(TB) ; API $$(mycobacteria field number) -> mycobacteria drug name
+1 ; dbia 999
QUIT $PIECE($GET(^DD(63.39,+$GET(TB),0)),U)
+2 ;
ORGNM(ORGAN) ; API $$(organ/tissue ien) -> organ/tissue name
+1 QUIT $PIECE($GET(^LAB(61,+$GET(ORGAN),0)),U)
+2 ;
DISNM(DISEASE) ; API $$(disease ien) -> disease name
+1 QUIT $PIECE($GET(^LAB(61.4,+$GET(DISEASE),0)),U)
+2 ;
ETINM(ETIOLOGY) ; API $$(etiology ien) -> etiology name
+1 QUIT $PIECE($GET(^LAB(61.2,+$GET(ETIOLOGY),0)),U)
+2 ;
MORPHNM(MORPH) ; API $$(morphology ien) -> morphology name
+1 QUIT $PIECE($GET(^LAB(61.1,+$GET(MORPH),0)),U)
+2 ;
FUNNM(FUNCTION) ; API $$(function ien) -> function name
+1 QUIT $PIECE($GET(^LAB(61.3,+$GET(FUNCTION),0)),U)
+2 ;
PROCNM(PROC) ; API $$(procedure ien) -> procedure name
+1 QUIT $PIECE($GET(^LAB(61.5,+$GET(PROC),0)),U)
+2 ;
ICD9(ICD9) ; API $$(icd9 ien) -> icd code^name
+1 NEW LRTMP
+2 SET ICD9=$PIECE($$ICDDX^ICDCODE(ICD9,,,1),U,2)
+3 SET LRTMP=$$ICDD^ICDCODE(ICD9,"LRTMP")
+4 QUIT ICD9_U_$GET(LRTMP(1))
+5 ;
DOD(DFN) ; API $$(dfn) -> date of death else 0
+1 ; dbia 13
QUIT +$GET(^DPT(+$GET(DFN),.35))
+2 ;
EXTVALUE(Y,REF) ; API $$(internal value,index ref) -> external value
+1 NEW C,FIELD
+2 IF $PIECE(REF,";",2)'="CH"
QUIT Y
+3 SET FIELD=+$PIECE(REF,";",4)
+4 ; dbia 999
SET C=$PIECE(^DD(63.04,FIELD,0),U,2)
+5 DO Y^DIQ
+6 QUIT Y
+7 ;
ITEMNM(INFO) ; API $$(ap or micro item) -> item name
+1 NEW FILE,NAME,NUM,TYPE
+2 IF INFO=+INFO
QUIT $$TESTNM(INFO)
+3 SET NAME=""
+4 SET TYPE=$PIECE(INFO,";")
IF '$LENGTH(TYPE)
QUIT NAME
+5 SET FILE=$PIECE(INFO,";",2)
IF '$LENGTH(FILE)
QUIT NAME
+6 SET NUM=+$PIECE(INFO,";",3)
IF 'NUM
QUIT NAME
+7 IF TYPE="M"
Begin DoDot:1
+8 IF FILE="S"
SET NAME=$$SPECNM(NUM)
QUIT
+9 IF FILE="T"
SET NAME=$$TESTNM(NUM)
QUIT
+10 IF FILE="O"
SET NAME=$$BUGNM(NUM)
QUIT
+11 IF FILE="A"
SET NAME=$$ABNM(NUM)
QUIT
+12 IF FILE="M"
SET NAME=$$TBNM(NUM)
QUIT
End DoDot:1
QUIT NAME
+13 IF TYPE="A"
Begin DoDot:1
+14 IF FILE="S"
SET NAME=$PIECE(INFO,".",2)
QUIT
+15 IF FILE="T"
SET NAME=$$TESTNM(NUM)
QUIT
+16 IF FILE="O"
SET NAME=$$ORGNM(NUM)
QUIT
+17 IF FILE="D"
SET NAME=$$DISNM(NUM)
QUIT
+18 IF FILE="M"
SET NAME=$$MORPHNM(NUM)
QUIT
+19 IF FILE="E"
SET NAME=$$ETINM(NUM)
QUIT
+20 IF FILE="F"
SET NAME=$$FUNNM(NUM)
QUIT
+21 IF FILE="P"
SET NAME=$$PROCNM(NUM)
QUIT
+22 IF FILE="I"
SET NAME=$$ICD9^LRPXAPIU(NUM)
QUIT
End DoDot:1
QUIT NAME
+23 QUIT NAME
+24 ;
+25 ; -------------- other utilities -------------
+26 ;
CONDOK(COND,TYPE) ; API $$(condition,type) -> 1 for valid condition, else 0
+1 QUIT $$CONDOK^LRPXAPI2($GET(COND),$GET(TYPE,"C"))
+2 ;
NORMALS(LOW,HIGH,TEST,SPEC) ; API return low and high ref range on test
+1 DO NORMALS^LRPXAPI2(.LOW,.HIGH,TEST,SPEC)
+2 QUIT
+3 ;
DATES(DATE1,DATE2) ; API return proper date range
+1 ; DATE1 always returns oldest value
+2 NEW TEMP
+3 SET DATE1=$$EXTTOFM($GET(DATE1))
+4 SET DATE2=$$EXTTOFM($GET(DATE2))
+5 IF 'DATE2
SET DATE2=9999999
+6 IF DATE1>DATE2
SET TEMP=DATE1
SET DATE1=DATE2
SET DATE2=TEMP
+7 IF DATE2=+DATE2
IF DATE2'=9999999
IF DATE2'["."
SET DATE2=DATE2+.25
+8 QUIT
+9 ;
EXTTOFM(X) ; $$(external date/time) -> FM date/time
+1 NEW %DT,Y
+2 SET %DT="TS"
+3 DO ^%DT
+4 IF Y=-1
QUIT 0
+5 QUIT +Y
+6 ;
VRESULT(TEST,RESULT) ; $$(test,result) -> valid result
+1 QUIT $$STRIP($$RESULT(TEST,RESULT))
+2 ;
RESULT(TEST,RESULT) ; $$(test,result) -> result Convert CH result to external format
+1 ;TEST=Test ptr to file 60
+2 ;RESULT=Test result
+3 NEW X,X1,LRCW
+4 SET LRCW=""
SET X1=$PIECE($GET(^LAB(60,TEST,.1)),U,3)
SET X1=$SELECT($LENGTH(X1):X1,1:"$J(X,8)")
SET X=RESULT
SET @("X="_X1)
+5 QUIT X
+6 ;
STRIP(TEXT) ; $$(text) -> stripped text Strips white space from text
+1 NEW I,X
+2 SET X=""
FOR I=1:1:$LENGTH(TEXT," ")
if $ASCII($PIECE(TEXT," ",I))>0
SET X=X_$PIECE(TEXT," ",I)
+3 QUIT X
+4 ;
