source: FOIAVistA/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIULO.m@ 1783

TIULO ; SLC/JER - Embedded Objects ;11/29/02
 ;;1.0;TEXT INTEGRATION UTILITIES;**34,70,101,148,204**;Jun 20, 1997
DEM(DFN,VADM) ; Calls DEM^VADPT
 D DEM^VADPT
 Q
NAME(DFN) ; Patient NAME
 I '$D(VADM(1)) D DEM(DFN,.VADM)
 Q $S(VADM(1)]"":VADM(1),1:"NAME UNKNOWN")
SSN(DFN) ; Patient SSN
 I '$D(VADM(2)) D DEM(DFN,.VADM)
 Q $S($P(VADM(2),U,2)]"":$P(VADM(2),U,2),1:"SSN UNKNOWN")
AGE(DFN) ; Patient AGE
 I '$D(VADM(4)) D DEM(DFN,.VADM)
 Q $S(VADM(4)]"":VADM(4),1:"AGE UNKNOWN")
DOB(DFN) ; Patient DATE OF BIRTH
 I '$D(VADM(3)) D DEM(DFN,.VADM)
 Q $S($P(VADM(3),U,2)]"":$P(VADM(3),U,2),1:"DOB UNKNOWN")
DOD(DFN) ; Patient DATE OF DEATH
 I '$D(VADM(6)) D DEM(DFN,.VADM)
 Q $S($P(VADM(6),U,2)]"":$P(VADM(6),U,2),1:"DATE OF DEATH UNKNOWN")
SEX(DFN) ; Patient SEX
 I '$D(VADM(5)) D DEM(DFN,.VADM)
 Q $S($P(VADM(5),U,2)]"":$P(VADM(5),U,2),1:"SEX UNKNOWN")
RACE(DFN) ; Patient RACE TIU*148
 N TIUI
 I '$D(VADM(12)) D DEM(DFN,.VADM)
 I +$G(VADM(12))=1 S X=$P($G(VADM(12,1)),U,2)
 I +$G(VADM(12))>1 D
 . S X=$P($G(VADM(12,1)),U,2) F TIUI=2:1:VADM(12) D
 . . S X=X_", "_$P($G(VADM(12,TIUI)),U,2)
 I +$G(VADM(12))=0,$P(VADM(8),U,2)="" S X="RACE UNKNOWN"
 I +$G(VADM(12))=0,$P(VADM(8),U,2)]"" S X=$P(VADM(8),U,2)
 Q X
ETHNIC(DFN) ; Patient ETHNICITY  TIU*148
 N TIUI
 I '$D(VADM(11,1)) D DEM(DFN,.VADM)
 I +$G(VADM(11))=0 S X="ETHNICITY UNKNOWN"
 I +$G(VADM(11))=1 S X=$P($G(VADM(11,1)),U,2)
 I +$G(VADM(11))>1 D
 . S X=$P($G(VADM(11,1)),U,2) F TIUI=2:1:VADM(11) D
 . . S X=X_", "_$P($G(VADM(11,TIUI)),U,2)
 I +$G(VADM(11))=0 S X="ETHNICITY UNKNOWN"
 Q X
HEIGHT(DFN) ; Gets most recent Height from VITALS
 Q $$DOVITALS(DFN,"HT")
WEIGHT(DFN) ; Gets most recent Weight from VITALS
 Q $$DOVITALS(DFN,"WT")
TEMP(DFN) ; Gets most recent Temperature from VITALS
 Q $$DOVITALS(DFN,"T")
PULSE(DFN) ; Gets most recent Pulse from VITALS
 Q $$DOVITALS(DFN,"P")
RESP(DFN) ; Gets most recent Respiration from VITALS
 Q $$DOVITALS(DFN,"R")
BP(DFN) ; Gets most recent Blood Pressure from VITALS
 Q $$DOVITALS(DFN,"BP")
PAIN(DFN) ; Gets most recent Pain score from VITALS
 Q $$DOVITALS(DFN,"PN")
DOVITALS(DFN,TIUVITC) ; INTERNAL ROUTINE TO GET SPECIFIED VITALS (**34**)
 N TIUVIT,TIUVT,TIUVDT,TIUVDA,TIUY,VDT,TIUI,TIUCWRAP,TIUMAXW
 N TIUVCNT,TIUVCNT2,TIUVDONE,TIUVDATE,TIUY1,TIUVTEMP,CONV
 D VITALS(.TIUVIT,DFN,TIUVITC)
 S (TIUVDT,TIUVDONE,TIUVCNT)=0
 F  S TIUVDT=$O(TIUVIT(TIUVITC,TIUVDT)) Q:+TIUVDT'>0!TIUVDONE  D
 . S TIUVDA=0
 . F  S TIUVDA=$O(TIUVIT(TIUVITC,TIUVDT,TIUVDA)) Q:+TIUVDA'>0!TIUVDONE  D
 . . I $D(TIUVDATE),TIUVDATE'=TIUVDT S TIUVDONE=1
 . . E  D
 . . . S TIUVDATE=TIUVDT,TIUVCNT=TIUVCNT+1
 . . . S TIUVTEMP=$G(TIUVIT(TIUVITC,TIUVDT,TIUVDA))
 . . . S VDT=$$DATE^TIULS($P(TIUVTEMP,U,1),"MM/DD/CCYY HR:MIN")
 . . . S TIUY=$P(TIUVTEMP,U,8)
 . . . I TIUVITC="WT" D
 . . . . Q:+TIUY'>0
 . . . . S CONV=$J((+TIUY/2.2),3,1)
 . . . . S TIUY=TIUY_" lb ["_CONV_" kg]"
 . . . I TIUVITC="HT" D
 . . . . Q:+TIUY'>0
 . . . . S CONV=$J((+TIUY*2.54),3,1)
 . . . . S TIUY=TIUY_" in ["_CONV_" cm]"
 . . . I TIUVITC="T" D
 . . . . Q:+TIUY'>0
 . . . . S CONV=+TIUY-32
 . . . . S CONV=$J((CONV*(5/9)),3,1)
 . . . . S TIUY=TIUY_" F ["_CONV_" C]"
 . . . S TIUY=TIUY_" ("_VDT
 . . . S TIUCWRAP=$L(TIUY)+17
 . . . I TIUVCNT=1 S TIUY1=TIUY_")",TIUMAXW=59
 . . . E  S TIUY="               "_TIUY,TIUMAXW=74
 . . . S TIUVTEMP=$P(TIUVTEMP,U,17)
 . . . I $L(TIUVTEMP)>0  D
 . . . . S TIUVTEMP=", "_TIUVTEMP
 . . . . F  S TIUI=$F(TIUVTEMP,";") Q:TIUI'>0  D
 . . . . . S TIUVTEMP=$E(TIUVTEMP,1,TIUI-2)_", "_$E(TIUVTEMP,TIUI,999)
 . . . S TIUY=TIUY_TIUVTEMP_")"
 . . . I $L(TIUY)<TIUMAXW S TIUVITMP(TIUVCNT,0)=TIUY
 . . . E  D  ; Wrap the line if it's too long
 . . . . S TIUVCNT2=0,TIUVTEMP="",$P(TIUVTEMP," ",TIUCWRAP)=" "
 . . . . F  Q:$L(TIUY)'>0  D
 . . . . . F TIUI=TIUMAXW:-1:1  Q:$E(TIUY,TIUI,TIUI+1)=", "
 . . . . . I TIUI>1 D
 . . . . . . S TIUVITMP(TIUVCNT+TIUVCNT2,0)=$E(TIUY,1,TIUI)
 . . . . . . S TIUVCNT2=TIUVCNT2+.01
 . . . . . . S TIUY=TIUVTEMP_$E(TIUY,TIUI+2,999)
 . . . . . E  D
 . . . . . . S TIUVITMP(TIUVCNT+TIUVCNT2,0)=TIUY
 . . . . . . S TIUY=""
 I TIUVCNT<2 D
 . S TIUY=$G(TIUY1)
 . K TIUVITMP
 E  S TIUY="~@TIUVITMP"
 Q $G(TIUY)
VITALS(TIUY,DFN,GMRVSTR,TIUEDT,TIULDT,TIUOCC) ; Vital measurements
 N TIUVT,TIUVDT,TIUVDA K ^UTILITY($J,"GMRVD")
 S GMRVSTR(0)=$G(TIUEDT)_U_$G(TIULDT)_U_$G(TIUOCC,1)_"^0"
 I $L($T(EN1^GMRVUT0)) D EN1^GMRVUT0
 I +$D(^UTILITY($J,"GMRVD")) D
 . S TIUVT=""
 . F  S TIUVT=$O(^UTILITY($J,"GMRVD",TIUVT)) Q:TIUVT']""  D
 . . S TIUVDT=0
 . . F  S TIUVDT=$O(^UTILITY($J,"GMRVD",TIUVT,TIUVDT)) Q:+TIUVDT'>0  D
 . . . S TIUVDA=0
 . . . F  S TIUVDA=$O(^UTILITY($J,"GMRVD",TIUVT,TIUVDT,TIUVDA)) Q:+TIUVDA'>0  D
 . . . . S TIUY(TIUVT,TIUVDT,TIUVDA)=$G(^UTILITY($J,"GMRVD",TIUVT,TIUVDT,TIUVDA))
 K ^UTILITY($J,"GMRVD")
 Q
LIPIDS(TIUY,DFN,TIUEDT,TIULDT) ; Get LIPID profile
 N TIUTST,TIUI,TIURY,TIUDT,TIULDT
 S TIUTST=$O(^LAB(60,"B","LIPID PROFILE",0))
 I '+$G(TIUTST) Q
 D TEST^LR7OR2(.TIUY,DFN,"",$G(TIUEDT),$G(TIULDT),"",TIUTST)
 I '$D(TIUY)!($G(TIUY(1))="No Lab Data") Q
 S TIUI=0 F  S TIUI=$O(@TIUY@(TIUI)) Q:+TIUI'>0  D
 . S TIUTST=$$MAPPER($P(@TIUY@(TIUI),U,17)),TIUDT=+@TIUY@(TIUI)
 . S:TIUDT'=+$G(TIULDT) TIURY("BASELINE LIPID PROFILES",TIUDT)=$$DATE^TIULS(TIUDT,"MM/DD/YY")
 . S TIURY(TIUTST,TIUDT)=$P(@TIUY@(TIUI),U,4)
 F TIUI="CHYLOMI","TURBID","VLDL" K TIURY(TIUI)
 K @TIUY
 I $D(TIURY) M TIUY=TIURY
 Q
MAPPER(TIUX,TIUI) ; Remap test names
 N TIUNM,Y S TIUNM("CHOL","TOTAL CHOLESTEROL")=""
 S (TIUNM("HDL","HDL CHOLESTEROL"),TIUNM("LDL","LDL CHOLESTEROL"))=""
 S TIUNM("TRIGLYC","TRIGLYCERIDES")=""
 S Y=$O(TIUNM(TIUX,"")) I Y']"" S Y=TIUX
 Q Y
TSHT4(DFN,TIUEDT,TIULDT) ; Get TSH/T4
 N TIUY,TIUTSH,TIUT4 S TIUTSH=+$O(^LAB(60,"B","TSH",0))
 S TIUT4=+$O(^LAB(60,"B","T-4",0))
 I '+$G(TIUTSH)!'+$G(TIUT4) G TSHX
 D TEST^LR7OR2(.TIUY,DFN,"",$G(TIUEDT),$G(TIULDT),"",TIUTSH)
 S TIUTSH=$S($D(TIUY)#2:$P($G(@TIUY@(1)),U,4),1:"____")
 I $D(TIUY)#2 K @TIUY
 D TEST^LR7OR2(.TIUY,DFN,"",$G(TIUEDT),$G(TIULDT),"",TIUT4)
 S TIUT4=$S($D(TIUY)#2:$P($G(@TIUY@(1)),U,4),1:"____")
 I $D(TIUY)#2 K @TIUY
 S TIUY=TIUTSH_"/"_TIUT4
TSHX Q $G(TIUY)
SGOT(DFN,TIUEDT,TIULDT) ; Get SGOT
 N TIUY,TIUSGOT S TIUSGOT=+$O(^LAB(60,"B","SGOT",0))
 I '+$G(TIUSGOT) Q
 D TEST^LR7OR2(.TIUY,DFN,"",$G(TIUEDT),$G(TIULDT),"",TIUSGOT)
 S TIUSGOT=$S($D(TIUY)#2:$P($G(@TIUY@(1)),U,4),1:"____")
 I $D(TIUY)#2 K @TIUY
SGOTX Q $G(TIUSGOT)
HGBA1C(DFN,TIUEDT,TIULDT) ; Get Hemoglobin A1C
 N TIUY,TIUHGB S TIUHGB=+$O(^LAB(60,"B","HEMOGLOBIN A1C",0))
 I '+$G(TIUHGB) G HGBX
 D TEST^LR7OR2(.TIUY,DFN,"",$G(TIUEDT),$G(TIULDT),"",TIUHGB)
 S TIUHGB=$S($D(TIUY)#2:$P($G(@TIUY@(1)),U,4),1:"____")
 I $D(TIUY)#2 K @TIUY
HGBX Q $G(TIUHGB)
URICACID(DFN,TIUEDT,TIULDT) ; Get Uric Acid
 N TIUY,TIUURIC S TIUURIC=+$O(^LAB(60,"B","URIC ACID",0))
 I '+$G(TIUURIC) G URICX
 D TEST^LR7OR2(.TIUY,DFN,"",$G(TIUEDT),$G(TIULDT),"",TIUURIC)
 S TIUURIC=$S($D(TIUY)#2:$P($G(@TIUY@(1)),U,4),1:"____")
 I $D(TIUY)#2 K @TIUY
URICX Q $G(TIUURIC)
FBG(DFN,TIUEDT,TIULDT) ; Get FBG
 N TIUY,TIUFBG S TIUFBG=+$O(^LAB(60,"B","FBS",0))
 I '+$G(TIUFBG) G FBGX
 D TEST^LR7OR2(.TIUY,DFN,"",$G(TIUEDT),$G(TIULDT),"",TIUFBG)
 S TIUFBG=$S($D(TIUY)#2:$P($G(@TIUY@(1)),U,4),1:"____")
 I $D(TIUY)#2 K @TIUY
FBGX Q $G(TIUFBG)
ADM(DFN) ;Current Admission Date/Time
 N VAIN,J
 D INP^VADPT
 S J=$P(VAIN(7),U,2),J(1)=$P(J,"@",1),J(2)=$P(J,"@",2),J(3)=$E(J(2),1,5),Y=J(1)_" "_J(3) K J
ADMX Q Y
TODAY() ;Today's Date
 N X,Y
 S X=$G(DT) I X'="" S Y=X D DD^%DT
TODAYX Q Y
NOW() ;Current Date/Time
NOWX Q $$DATE^TIULS($$NOW^TIULC,"AMTH DD, CCYY HR:MIN")