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