VistA-WorldVistAEHR/r/HEALTH_SUMMARY-GMTS/GMTSVSD.m

162 lines
8.3 KiB
Mathematica

GMTSVSD ; SLC/KER - Vital Signs (Detailed) ; 01/06/2003
;;2.7;Health Summary;**35,49,58,78**;Oct 20, 1995
;
; External References
; DBIA 4791 EN1^GMVHS
; DBIA 10141 $$VERSION^XPDUTL
; DBIA 10103 $$NOW^XLFDT
;
; Health Summary patch GMTS*2.7*35 will require
; Vitals version 4.0, patch GMRV*4.0*7
;
Q
EN ; Detailed Vital Signs main control
N GMRVSTR,GMTSC1,GMTSC2,GMTSC3,GMTSC4,GMTSCNT,GMTSCD,GMTSCHR,GMTSCI
N GMTSCW1,GMTSCW2,GMTSCW3,GMTSCW4,GMTSCW5,GMTSLN,GMTSMEAS,GMTSMAX
N GMTSN,GMTSOK,GMTSP,GMTSPSN,GMTSQ,GMTSREM,GMTSROV,GMTST,GMTSTO,GMTSV
N GMTSVCT,GMTSVD,GMTSVI,GMTSVSD,GMTSVSDT,GMTSVT,X,Y,GMTSLM,GMTSLML
S GMTSLM=0 S:$D(VALM("BM"))&($G(VALM("LINES"))>0) GMTSLM=1
S GMTSLML=9999999009 S:GMTSLM GMTSLML=+($G(VALM("LINES")))
S GMTSLO=+($G(GMTSLO)) S:GMTSLO=0 GMTSLO=3 S GMTSLPG=+($G(GMTSLPG)),GMTSDTM=$G(GMTSDTM) S:'$L(GMTSDTM) GMTSDTM=$$DTM
S:'$D(GMTSTITL)!('$L($G(GMTSTITL))) GMTSTITL="VITALS DETAILED DISPLAY" K ^TMP("GMTSVSD",$J),^UTILITY($J,"GMRVD")
S (GMTSVCT,GMTSMAX)=$S(+($G(GMTSNDM))>0:+($G(GMTSNDM)),1:1)
S GMRVSTR("LT")="^C^"
D GET D:$D(^UTILITY($J,"GMRVD")) ST K GMRVSTR("LT")
D GET D:$D(^UTILITY($J,"GMRVD")) ST K ^UTILITY($J,"GMRVD")
S GMTSCW1=0,GMTSCW2=18,GMTSCW3=36,GMTSCW4=53,GMTSCW5=+($G(IOM))-2
S:GMTSCW5'>49 GMTSCW5=78
I '$D(^TMP("GMTSVSD",$J)) Q
D REM,OUT
Q
;
GET ; Get Data
K ^UTILITY($J,"GMRVD") N GMTSMAX
S GMTSMAX=$S(+($G(GMTSVCT))>0:+($G(GMTSVCT)),1:1) S GMTSMAX=GMTSMAX*100
S GMRVSTR="T"_";"_"P"_";"_"R"_";"_"BP"_";"_"HT"_";"_"WT"_";"_"CVP"_";"_"PO2"_";"_"CG"_";"_"PN"
S GMRVSTR(0)=$G(GMTSBEG)_"^"_$G(GMTSEND)_"^"_$G(GMTSMAX)_"^"_1
;D EN1^GMRVUT0 S GMTSMAX=+($G(GMTSVCT))
D EN1^GMVHS S GMTSMAX=+($G(GMTSVCT))
Q
NOD ; No Data Found
D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG=1 HDR
W "*** No vital measurements ***",! S GMTSMAX=1 Q
REM ; Remove Excess Data
N GMTSMAX S GMTSMAX=$S(+($G(GMTSNDM))>0:+($G(GMTSNDM)),1:1)
N GMTSVD,GMTSVT,GMTSVI,GMTST
S GMTSVD=0 F S GMTSVD=$O(^TMP("GMTSVSD",$J,GMTSVD)) Q:+GMTSVD=0 D
. S GMTSVT="" F S GMTSVT=$O(^TMP("GMTSVSD",$J,GMTSVD,GMTSVT)) Q:GMTSVT="" D
. . S GMTSVI=0 F S GMTSVI=$O(^TMP("GMTSVSD",$J,GMTSVD,GMTSVT,GMTSVI)) Q:+GMTSVI=0 D
. . . I +($G(GMTST(GMTSVT)))>(GMTSMAX-1) K ^TMP("GMTSVSD",$J,GMTSVD,GMTSVT,GMTSVI) Q
. . . S GMTST(GMTSVT)=+($G(GMTST(GMTSVT)))+1
Q
;
OUT ; Output Data
D HDR Q:$D(GMTSQIT) N GMTSVD,GMTSVT,GMTSVSDT,GMTSVSD,GMTSVI,GMTSCNT S GMTSCNT=0
S GMTSVD=0 F S GMTSVD=$O(^TMP("GMTSVSD",$J,GMTSVD)) Q:GMTSVD<1!(GMTSVD="") D
. S GMTSVT="" F S GMTSVT=$O(^TMP("GMTSVSD",$J,GMTSVD,GMTSVT)) Q:GMTSVT="" D
. . S GMTSVI=0 F S GMTSVI=$O(^TMP("GMTSVSD",$J,GMTSVD,GMTSVT,GMTSVI)) Q:+GMTSVI=0 D
. . . S GMTSVSD=$G(^TMP("GMTSVSD",$J,GMTSVD,GMTSVT,GMTSVI)) Q:'$L(GMTSVSD) S GMTSVSDT=$P(GMTSVSD,"^",1) Q:'$L(GMTSVSDT) Q:+GMTSVSDT'>0 D ADD
. I +($O(^TMP("GMTSVSD",$J,GMTSVD)))'=GMTSVD D WRL
I GMTSCNT=0 D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG=1 HDR W "No data",!
Q
ADD ; Add to Output Array
N GMTST,GMTSTO,GMTSV,GMTSQ S GMTST=$G(GMTSVT) Q:'$L(GMTST)
S GMTSTO=$$VO(GMTST) Q:GMTSTO'>0 S GMTST=$$VT(GMTST) Q:'$L(GMTST)
S GMTSV=$$VM(GMTSVT,GMTSVSD)
S GMTSQ=$$VQ(GMTSVSD),GMTSROV(GMTSTO)=GMTST_"^"_GMTSV_"^"_GMTSQ,GMTSCNT=+($G(GMTSCNT))+1,GMTSROV("DT")=$$EDT^GMTSU(GMTSVSDT)
Q
WRL ; Write Line from Array
N GMTSCI,GMTSCD,GMTSC1,GMTSC2,GMTSC3,GMTSC4
S (GMTSCD,GMTSC1)=$G(GMTSROV("DT")) I '$L(GMTSC1) K GMTSROV Q
S GMTSCI=0 F S GMTSCI=$O(GMTSROV(GMTSCI)) Q:+GMTSCI=0 Q:$D(GMTSQIT) D Q:$D(GMTSQIT)
. S GMTSC2=$G(GMTSROV(GMTSCI)),GMTSC3=$P(GMTSC2,"^",2),GMTSC4=$P(GMTSC2,"^",3),GMTSC2=$P(GMTSC2,"^",1)
. D CKP^GMTSUP Q:$D(GMTSQIT)
. I +($G(GMTSLM))>0 S:+($$LMP)>0 GMTSC1=GMTSCD
. I GMTSNPG'=1 W GMTSC1,?GMTSCW2,GMTSC2,?GMTSCW3,GMTSC3 D QUAL
. I GMTSNPG=1 S GMTSC1=GMTSCD D HDR W GMTSC1,?GMTSCW2,GMTSC2,?GMTSCW3,GMTSC3 D QUAL
. S GMTSC1=" "" "" "
. Q:$D(GMTSQIT)
K GMTSROV
Q
LMP(X) ;
Q:+($G(GMTSLML))'>0 0
N GMTSP,GMTSD S GMTSP=$Y,GMTSD=0 S:GMTSP#GMTSLML=0 GMTSD=1 S X=GMTSD Q X
QUAL ; Write Vital Qualifiers
N GMTSOK,GMTSLN,GMTSTO,GMTSREM,GMTSPSN,GMTSCHR S GMTSLN=GMTSCW5-GMTSCW4
I $L(GMTSC4)'>(GMTSLN-1) D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG=1 HDR W ?GMTSCW4,GMTSC4,! Q
S GMTSREM=GMTSC4 F Q:$D(GMTSQIT) D QPARSE Q:$D(GMTSQIT) Q:'$L(GMTSREM)
Q
QPARSE ; Parse Qualifier (wrap)
I $L(GMTSREM)'>(GMTSLN-1) D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG=1 HDR W ?GMTSCW4,GMTSREM,! S GMTSREM="" Q
S GMTSOK=0 F GMTSPSN=GMTSLN:-1:0 Q:+GMTSOK=1 D Q:+GMTSOK=1
. I $E(GMTSREM,GMTSPSN)=" " S GMTSCHR=" ",GMTSOK=1 Q
. I $E(GMTSREM,GMTSPSN)="," S GMTSCHR=",",GMTSOK=1 Q
. I $E(GMTSREM,GMTSPSN)="/"!($E(GMTSREM,GMTSPSN)="-")!($E(GMTSREM,GMTSPSN)=")") S GMTSCHR=$E(GMTSREM,GMTSPSN),GMTSOK=1 Q
I GMTSCHR=" " D Q:$D(GMTSQIT)
. S GMTSTO=$E(GMTSREM,1,(GMTSPSN-1)),GMTSREM=$E(GMTSREM,(GMTSPSN+1),$L(GMTSREM)),GMTSREM=$$TRIM(GMTSREM) D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG=1 HDR W ?GMTSCW4,$G(GMTSTO),!
I GMTSCHR="/"!(GMTSCHR=",")!(GMTSCHR="-")!(GMTSCHR=")") D Q:$D(GMTSQIT)
. S GMTSTO=$E(GMTSREM,1,(GMTSPSN)),GMTSREM=$E(GMTSREM,(GMTSPSN+1),$L(GMTSREM)),GMTSREM=$$TRIM(GMTSREM) D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG=1 HDR W ?GMTSCW4,$G(GMTSTO),!
Q
;
; Miscellaneous
FM(X) ; Format Vitals Measurement
S X=$$TRIM($G(X)) Q:+X'=X X
S:X["." X=$FN(X,"",2) Q X
TRIM(X) ; Trim Blank Spaces
F Q:$E(X,1)'=" " S X=$E(X,2,$L(X))
F Q:$E(X,$L(X))'=" " S X=$E(X,1,($L(X)-1))
Q X
VO(X) ; Vital Array Order
S X=$G(X) Q:X="T" 1 Q:X="P" 2 Q:X="R" 3 Q:X="BP" 4 Q:X="HT" 5 Q:X="WT" 6 Q:X="CG" 7 Q:X="PN" 8 Q:X="CVP" 9 Q:X="PO2" 10 Q ""
VT(X) ; Vital Type
S X=$G(X) Q:X="BP" "BP" Q:X="T" "Temp F (C)" Q:X="R" "Respir" Q:X="P" "Pulse" Q:X="HT" "Ht in (cm)"
Q:X="WT" "Wt lbs (kg)[BMI]" Q:X="CVP" "CVP cm H2O(mm HG)" Q:X="PO2" "POx (L/Min)(%)" Q:X="CG" "C/G in (cm)" Q:X="PN" "Pain" Q ""
VM(X,Y) ; Vital Type Measurement
N GMTSMEAS,GMTSID S GMTSMEAS="",(GMTSID,X)=$G(X) Q:"^BP^T^R^P^HT^WT^CVP^PO2^CG^PN^"'[("^"_X_"^") ""
S Y=$G(Y) Q:'$L(Y) ""
; If data for T, Ht or Wt piece 8 and 13 else piece 8
I X="T"!(X="HT")!(X="WT") S GMTSMEAS=$S($P(Y,"^",8)?1A.E:$P(Y,"^",8),1:$P(Y,"^",8)_" ("_$P(Y,"^",13)_")")
E S GMTSMEAS=$P(Y,"^",8)
; WT - Weight and BMI (piece 14)
I X="WT",$L($P(Y,"^",14)) S GMTSMEAS=GMTSMEAS_"["_$P(Y,"^",14)_"]"
; CVP - Central Venous Pressure/CG - Circum/Girth
I X="CVP"!(X="CG") S GMTSMEAS=$P(Y,"^",8) S:$L($P(Y,"^",13)) GMTSMEAS=GMTSMEAS_" ("_$P(Y,"^",13)_")"
; POx - Pulse Oximetry
I X="PO2" S GMTSMEAS=$P(Y,"^",8) S:$L($P(Y,"^",15))!($L($P(Y,"^",16))) GMTSMEAS=GMTSMEAS_" ("_$P(Y,"^",15)_")("_$P(Y,"^",16)_")"
; PN - Pain
S:X="PN" GMTSMEAS=$P(Y,"^",8) S:X="PN"&(GMTSMEAS=99) GMTSMEAS="No Response"
S X=GMTSMEAS Q X
VQ(X) ; Vital Qualifiers
S X=$G(X),X=$P(X,"^",17) S:$L(X) X=$$AQ(X) Q X
HDR ; Header
N GMTSLN D CKP^GMTSUP Q:$D(GMTSQIT) G:GMTSNPG=1 HDR
W "Date",?GMTSCW2,"Vital",?GMTSCW3,"Measurement",?GMTSCW4,"Qualifiers"
W:'$D(GMTSOBJ)!($D(GMTSOBJ)&($D(GMTSOBJ("UNDERLINE")))) !
D CKP^GMTSUP Q:$D(GMTSQIT) G:GMTSNPG=1 HDR
W:'$D(GMTSOBJ)!($D(GMTSOBJ)&($D(GMTSOBJ("UNDERLINE")))) $$LN((GMTSCW2-2)) W ?GMTSCW2
W:'$D(GMTSOBJ)!($D(GMTSOBJ)&($D(GMTSOBJ("UNDERLINE")))) $$LN((GMTSCW3-(GMTSCW2+2))) W ?GMTSCW3
W:'$D(GMTSOBJ)!($D(GMTSOBJ)&($D(GMTSOBJ("UNDERLINE")))) $$LN((GMTSCW4-(GMTSCW3+2))) W ?GMTSCW4
W:'$D(GMTSOBJ)!($D(GMTSOBJ)&($D(GMTSOBJ("UNDERLINE")))) $$LN((GMTSCW5-(GMTSCW4+2)))
D CKP^GMTSUP Q:$D(GMTSQIT) G:GMTSNPG=1 HDR W !
;
S GMTSNPG=0 Q
ST ; Save in ^TMP Global
Q:'$D(^UTILITY($J,"GMRVD")) M ^TMP("GMTSVSD",$J)=^UTILITY($J,"GMRVD") Q
AQ(X) ; All Qualifiers Field
S X=$G(X) F Q:X'[";" S X=$P(X,";",1)_", "_$P(X,";",2,299)
S X=$$MC(X) Q X
MC(X) ; Mix Case for Qualifiers
N GMTSP S X=$TR($G(X),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz") F GMTSP=1:1:$L(X) D
. S:GMTSP=1 X=$TR($E(X,GMTSP),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")_$E(X,(GMTSP+1),$L(X)) Q:GMTSP=1
. S:" /-,"[$E(X,(GMTSP-1)) X=$E(X,1,(GMTSP-1))_$TR($E(X,GMTSP),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")_$E(X,(GMTSP+1),$L(X))
Q X
DTM(X) ; Current Date and Time
S X=$$NOW^XLFDT D REGDTM4^GMTSU Q X
FN(X,Y) ; Format Number
N GMTSV S X=$G(X),GMTSV=+($G(X)),Y=$G(Y) S:+Y=Y X=$FN(GMTSV,"",+Y) Q X
LN(X) ; Dashed Line
S X=+($G(X)) Q:X=0 "" N GMTSLN S GMTSLN="",$P(GMTSLN,"-",X)="-" S X=GMTSLN Q X
EDT(X) ; External Date and Time
S X=$G(X) Q:'$L(X) ""
D REGDTM4^GMTSU Q X