- 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 Jan 18, 2025@03:20:17 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 ;