Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: LRPXAPIU

LRPXAPIU.m

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