GMTSVS ;SLC/KER - Vital Signs Component ;Jan 17, 2025@14:36
;;2.7;Health Summary;**8,20,28,35,49,78,107,147**;Oct 20, 1995;Build 5
;
; Reference to EN1^GMVHS in ICR #4791
; Reference to ORQQVI METRIC FIRST in ICR #7502
;
; Health Summary patch GMTS*2.7*35 will require
; Vitals version 4.0, patch GMRV*4.0*7
;
OUTPAT ; Outpatient Vital Signs Main Control
N GMRVSTR
S CNTR=$S(+($G(GMTSNDM))>0:+($G(GMTSNDM)),1:100)
K ^UTILITY($J,"GMRVD"),ARRAY
S T1=GMTSEND,T2=GMTSBEG,END=0,TN=0,LF=0
S GMRVSTR="T"_";"_"P"_";"_"R"_";"_"BP"_";"_"HT"_";"_"WT"_";"_"CVP"_";"_"PO2"_";"_"CG"_";"_"PN"
S GMRVSTR(0)=T2_U_T1_U_CNTR_U_1
S GMRVSTR("LT")="^C^" ;Set to only get Vital Sign for Clinics
D EN1^GMVHS
; If no data, display message and get
; most recent inpatient measurements
I '$D(^UTILITY($J,"GMRVD")) D Q
. D CKP^GMTSUP Q:$D(GMTSQIT) W "*** No Outpatient measurements ***",!!
. S CNTR=1 D ENVS
S GMTSMVF=$$IMDSORD
D FIRST,SECOND:GMTSVMVR>3,THIRD:GMTSVMVR>3,KILLVS Q ;p.107 moved pain to a third line and changed 99 to "Unable to respond"
;
ENVS ; Set up for Vitals Extraction Routine
S CNTR=$S(+($G(CNTR))>0:+($G(CNTR)),+($G(CNTR))'>0&(+($G(GMTSNDM))>0):+($G(GMTSNDM)),1:100)
K ^UTILITY($J,"GMRVD"),ARRAY,GMRVSTR("LT")
S T1=GMTSEND,T2=GMTSBEG,END=0,TN=0,LF=0
S GMRVSTR="T"_";"_"P"_";"_"R"_";"_"BP"_";"_"HT"_";"_"WT"_";"_"CVP"_";"_"PO2"_";"_"CG"_";"_"PN"
S GMRVSTR(0)=T2_U_T1_U_CNTR_U_1
D EN1^GMVHS I '$D(^UTILITY($J,"GMRVD")) D KILLVS Q
S:'$D(GMTSMVF) GMTSMVF=$$IMDSORD
D FIRST,SECOND:GMTSVMVR>3,THIRD:GMTSVMVR>3,KILLVS Q ;p.107 moved pain to a third line and changed 99 to "Unable to respond"
;
FIRST ; First Set of Vitals
; 1 2 3 4 5 6 7 8
; Date^Temp()^Pulse^Respt^BP^Height()^Weight()^Control
N GMW,GMTSCCNT,GMTSCTL S CNTR("HOLDER")=CNTR S GMTSVMVR=$$VERSION^XPDUTL("GMRV")
I GMTSVMVR'>3 D Q:$D(GMTSQIT)
. D CKP^GMTSUP Q:$D(GMTSQIT) W "Measurement DT",?20,"TEMP",?29,"PULSE",?36,"RESP",?45,"BP",?55,"HT",?68,"WT",!
. D CKP^GMTSUP Q:$D(GMTSQIT)
. I GMTSMVF W ?20,"C(F)",?55,"CM(IN)",?68,"KG(LB)",!
. E W ?20,"F(C)",?55,"IN(CM)",?68,"LB(KG)",!
. D CKP^GMTSUP Q:$D(GMTSQIT) W ?20,"----",?29,"-----",?36,"----",?45,"--",?55,"------",?68,"------",!!
I GMTSVMVR>3 D Q:$D(GMTSQIT)
. D CKP^GMTSUP Q:$D(GMTSQIT) W "Measurement DT",?18,"TEMP",?30,"PULSE",?36,"RESP",?41,"BP",?53,"HT",?63,"WT",!
. D CKP^GMTSUP Q:$D(GMTSQIT)
. I GMTSMVF W ?18,"C(F)",?53,"CM(IN)",?63,"KG(LB)[BMI]",!
. E W ?18,"F(C)",?53,"IN(CM)",?63,"LB(KG)[BMI]",!
. D CKP^GMTSUP Q:$D(GMTSQIT) W ?18,"----",?30,"-----",?36,"----",?41,"--",?53,"------",?63,"-----------",!!
S GMTSCCNT=0,GMT="" F S GMT=$O(^UTILITY($J,"GMRVD",GMT)) Q:GMT<0!(GMT="")!(END=1) D FLOOP,FWRT
W:GMTSCCNT=0 "No data",!
Q
FLOOP ; Loop through first set of vitals by date
S (GMTSCTL,GMTSVT)=""
F S GMTSVT=$O(^UTILITY($J,"GMRVD",GMT,GMTSVT)) Q:GMTSVT="" S IEN=$O(^UTILITY($J,"GMRVD",GMT,GMTSVT,0)) D FFMT
Q
FFMT ; Extract and format first set of vitals
S GMTSVS=^UTILITY($J,"GMRVD",GMT,GMTSVT,IEN),X=$P(GMTSVS,U,1) D REGDT4^GMTSU S TDT=X
S X=$P(GMTSVS,U,1) D MTIM^GMTSU S TI=X S TDT=TDT_" "_TI,$P(ARRAY,U,1)=TDT
S GMTAB=$S(GMTSVT="T":2,GMTSVT="P":3,GMTSVT="R":4,GMTSVT="BP":5,GMTSVT="HT":6,GMTSVT="WT":7,1:0)
I GMTAB="2" D
.I GMTSMVF S $P(ARRAY,U,GMTAB)=$$FN($P(GMTSVS,U,13),1)_"("_$$FN($P(GMTSVS,U,8),1)_")"
.I 'GMTSMVF S $P(ARRAY,U,GMTAB)=$$FN($P(GMTSVS,U,8),1)_"("_$$FN($P(GMTSVS,U,13),1)_")"
I GMTAB="6" D
.I GMTSMVF S $P(ARRAY,U,GMTAB)=$$FN($P(GMTSVS,U,13),0)_"("_$$FN($P(GMTSVS,U,8),1)_")"
.I 'GMTSMVF S $P(ARRAY,U,GMTAB)=$$FN($P(GMTSVS,U,8),1)_"("_$$FN($P(GMTSVS,U,13),0)_")"
I GMTAB="7" D
.I GMTSMVF S $P(ARRAY,U,GMTAB)=$$FN($P(GMTSVS,U,13),1)_"("_$$FN($P(GMTSVS,U,8),0)_")"
.I 'GMTSMVF S $P(ARRAY,U,GMTAB)=$$FN($P(GMTSVS,U,8),0)_"("_$$FN($P(GMTSVS,U,13),1)_")"
I "^2^7^"[GMTAB,$P(GMTSVS,U,8)?1A.E S $P(ARRAY,U,GMTAB)=$P(GMTSVS,U,8)
I GMTAB=6,$P(GMTSVS,U,8)?1A.E S $P(ARRAY,U,GMTAB)=$E($P(GMTSVS,U,8),1,9)
I "^2^6^7^"'[GMTAB S $P(ARRAY,U,GMTAB)=$P(GMTSVS,U,8)
I GMTAB=3,$P(ARRAY,U,GMTAB)?1A.E S $P(ARRAY,U,GMTAB)=$E($P(ARRAY,U,GMTAB),1,5)
I GMTAB=4,$P(ARRAY,U,GMTAB)?1A.E S $P(ARRAY,U,GMTAB)=$E($P(ARRAY,U,GMTAB),1,4)
I GMTAB=7,$P(GMTSVS,U,14)]"" S $P(ARRAY,U,GMTAB)=$P(ARRAY,U,GMTAB)_"["_$P(GMTSVS,U,14)_"]"
S:GMTAB>1 GMTSCTL=GMTSCTL_$P(ARRAY,U,GMTAB),$P(ARRAY,U,8)=GMTSCTL
Q
FWRT ; Write first set of vitals by date
Q:$P($G(ARRAY),U,8)="" S GMTSCCNT=$G(GMTSCCNT)+1
D CKP^GMTSUP Q:$D(GMTSQIT)
I GMTSVMVR'>3 W $P(ARRAY,U,1),?18,$P(ARRAY,U,2),?30,$P(ARRAY,U,3),?37,$P(ARRAY,U,4),?42,$P(ARRAY,U,5),?54,$P(ARRAY,U,6),?67,$P(ARRAY,U,7),!
I GMTSVMVR>3 W $P(ARRAY,U,1),?18,$P(ARRAY,U,2),?30,$P(ARRAY,U,3),?36,$P(ARRAY,U,4),?41,$P(ARRAY,U,5),?53,$P(ARRAY,U,6),?63,$P(ARRAY,U,7),!
S CNTR=CNTR-1 I CNTR=0 S END=1
K ARRAY
Q
;
SECOND ; Second Set of Vitals
; 1 2 3 4 5
; Date^CVP^POx^Cir/Gir^Control
N GMW,GMTSCCNT,GMTSCTL S (GMTSCCNT,END)=0,CNTR=CNTR("HOLDER")
D CKP^GMTSUP Q:$D(GMTSQIT)
W !,"Measurement DT",?18,"CVP",?32,"POx",?45,"CG"
I $G(GMTSMVF) W !,?18,"MMHG(CMH2O)",?32,"(L/MIN)(%)",?45,"CM(IN)",!
E W !,?18,"CMH2O(MMHG)",?32,"(L/MIN)(%)",?45,"IN(CM)",!
W ?18,"-----------",?32,"----------",?45,"------",!!
S GMT="" F S GMT=$O(^UTILITY($J,"GMRVD",GMT)) Q:GMT<0!(GMT="")!(END=1) D SLOOP,SWRT
W:GMTSCCNT=0 "No data",!
Q
SLOOP ; Loop through second set of vitals by date
S (GMTSCTL,GMTSVT)="" F S GMTSVT=$O(^UTILITY($J,"GMRVD",GMT,GMTSVT)) Q:GMTSVT="" S IEN=$O(^UTILITY($J,"GMRVD",GMT,GMTSVT,0)) D SFMT
Q
SFMT ; Extract and format second set of vitals
S GMTSVS=^UTILITY($J,"GMRVD",GMT,GMTSVT,IEN)
S X=$P(GMTSVS,U,1) D REGDT4^GMTSU S TDT=X S X=$P(GMTSVS,U,1) D MTIM^GMTSU S TI=X S TDT=TDT_" "_TI,$P(ARRAY,U,1)=TDT
S GMTAB=$S(GMTSVT="CVP":2,GMTSVT="PO2":3,GMTSVT="CG":4,1:0)
I GMTAB=2 D
.I $G(GMTSMVF) S $P(ARRAY,U,GMTAB)=$S($P(ARRAY,U,GMTAB)?1A.E:"",1:$P(GMTSVS,U,13))_"("_$P(GMTSVS,U,8)_")"
.I '$G(GMTSMVF) S $P(ARRAY,U,GMTAB)=$P(GMTSVS,U,8)_$S($P(ARRAY,U,GMTAB)?1A.E:"",1:"("_$P(GMTSVS,U,13)_")")
I GMTAB=4 D
.I $G(GMTSMVF) S $P(ARRAY,U,GMTAB)=$S($P(ARRAY,U,GMTAB)?1A.E:"",1:$$FN($P(GMTSVS,U,13),0))_"("_$P(GMTSVS,U,8)_")"
.I '$G(GMTSMVF) S $P(ARRAY,U,GMTAB)=$P(GMTSVS,U,8)_$S($P(ARRAY,U,GMTAB)?1A.E:"",1:"("_$$FN($P(GMTSVS,U,13),0)_")")
.I $P(GMTSVS,U,17)]"" S $P(ARRAY,U,GMTAB)=$P(ARRAY,U,GMTAB)_"["_$P(GMTSVS,U,17)_"]"
I "^2^4^"'[GMTAB S $P(ARRAY,U,GMTAB)=$P(GMTSVS,U,8)
I GMTAB=3 S $P(ARRAY,U,GMTAB)=$P(ARRAY,U,GMTAB)_$S($P(ARRAY,U,GMTAB)?1A.E:"",($P($G(GMTSVS),U,15)="")&($P($G(GMTSVS),U,16)=""):"",1:"("_$P(GMTSVS,U,15)_")("_$P(GMTSVS,U,16)_")")
S:GMTAB>1 GMTSCTL=$G(GMTSCTL)_$P($G(ARRAY),U,GMTAB),$P(ARRAY,U,5)=GMTSCTL
Q
SWRT ; Write second set of vitals by date
Q:$P($G(ARRAY),U,5)=""
D CKP^GMTSUP Q:$D(GMTSQIT)
I GMTSNPG=1 D
. W !,"Measurement DT",?18,"CVP",?34,"POx",?46,"CG"
. I GMTSMVF W !,?18,"MMHG(CMH2O)",?32,"(L/MIN)(%)",?45,"CM(IN)"
. E W !,?18,"CMH2O(MMHG)",?32,"(L/MIN)(%)",?45,"IN(CM)"
. W !,?18,"-----------",?32,"----------",?45,"------",!!
S GMTSCCNT=$G(GMTSCCNT)+1
W $P(ARRAY,U,1),?18,$P(ARRAY,U,2),?32,$P(ARRAY,U,3),?45,$P(ARRAY,U,4),!
S CNTR=CNTR-1 I CNTR=0 S END=1
K ARRAY
Q
THIRD ; Third Set of Vitals
;p.107 moved pain to a third line and changed 99 to "Unable to respond"
; 1 2 3
; Date^Pain^Control
N GMW,GMTSCCNT,GMTSCTL S (GMTSCCNT,END)=0,CNTR=CNTR("HOLDER")
D CKP^GMTSUP Q:$D(GMTSQIT)
W !,"Measurement DT",?18,"Pain"
W !,?18,"----",!!
S GMT="" F S GMT=$O(^UTILITY($J,"GMRVD",GMT)) Q:GMT<0!(GMT="")!(END=1) D TLOOP,TWRT
W:GMTSCCNT=0 "No data",!
Q
TLOOP ; Loop through third set of vitals by date
S (GMTSCTL,GMTSVT)="" F S GMTSVT=$O(^UTILITY($J,"GMRVD",GMT,GMTSVT)) Q:GMTSVT="" S IEN=$O(^UTILITY($J,"GMRVD",GMT,GMTSVT,0)) D TFMT
Q
TFMT ; Extract and format third set of vitals
S GMTSVS=^UTILITY($J,"GMRVD",GMT,GMTSVT,IEN)
S X=$P(GMTSVS,U,1) D REGDT4^GMTSU S TDT=X S X=$P(GMTSVS,U,1) D MTIM^GMTSU S TI=X S TDT=TDT_" "_TI,$P(ARRAY,U,1)=TDT
S GMTAB=$S(GMTSVT="PN":2,1:0)
S $P(ARRAY,U,GMTAB)=$P(GMTSVS,U,8)
I GMTAB=2 D
.S $P(ARRAY,U,GMTAB)=$S($L($P(ARRAY,U,GMTAB))&(+($P(ARRAY,U,GMTAB))=0):$P(ARRAY,U,GMTAB),$L($P(ARRAY,U,GMTAB))&(+($P(ARRAY,U,GMTAB))'=99):$$FN($P(ARRAY,U,GMTAB),0),$L($P(ARRAY,U,GMTAB))&(+($P(ARRAY,U,GMTAB))=99):"Unable to Respond",1:"")
S:GMTAB>1 GMTSCTL=$G(GMTSCTL)_$P($G(ARRAY),U,GMTAB),$P(ARRAY,U,3)=GMTSCTL
Q
TWRT ; Write third set of vitals by date
Q:$P($G(ARRAY),U,3)=""
D CKP^GMTSUP Q:$D(GMTSQIT)
I GMTSNPG=1 D
. W !,"Measurement DT",?18,"Pain"
. W !,?18,"----",!!
S GMTSCCNT=$G(GMTSCCNT)+1
W $P(ARRAY,U,1),?18,$P(ARRAY,U,2),!
S CNTR=CNTR-1 I CNTR=0 S END=1
K ARRAY
Q
;
KILLVS ; Kill Variables
K CNTR,T1,T2,TDT,TI,END,TN,IEN,LF,GMTSVMVR,GMTSVS,GMTSVT,GMT,ARRAY,GMTAB,X
K ^UTILITY($J,"GMRVD"),GMTSMVF
Q
FN(X,Y) ; Format Number
N VAL S VAL=+($G(X)),Y=$G(Y) Q:+Y'=Y X
S X=$FN(VAL,"",Y) Q X
IMDSORD() ; Return imperial/metric display order
; 1: Metric first
; 0: Imperial first
Q +$$GET^XPAR("ALL","ORQQVI METRIC FIRST",,"I")
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSVS 9135 printed Apr 22, 2026@13:57:36 Page 2
GMTSVS ;SLC/KER - Vital Signs Component ;Jan 17, 2025@14:36
+1 ;;2.7;Health Summary;**8,20,28,35,49,78,107,147**;Oct 20, 1995;Build 5
+2 ;
+3 ; Reference to EN1^GMVHS in ICR #4791
+4 ; Reference to ORQQVI METRIC FIRST in ICR #7502
+5 ;
+6 ; Health Summary patch GMTS*2.7*35 will require
+7 ; Vitals version 4.0, patch GMRV*4.0*7
+8 ;
OUTPAT ; Outpatient Vital Signs Main Control
+1 NEW GMRVSTR
+2 SET CNTR=$SELECT(+($GET(GMTSNDM))>0:+($GET(GMTSNDM)),1:100)
+3 KILL ^UTILITY($JOB,"GMRVD"),ARRAY
+4 SET T1=GMTSEND
SET T2=GMTSBEG
SET END=0
SET TN=0
SET LF=0
+5 SET GMRVSTR="T"_";"_"P"_";"_"R"_";"_"BP"_";"_"HT"_";"_"WT"_";"_"CVP"_";"_"PO2"_";"_"CG"_";"_"PN"
+6 SET GMRVSTR(0)=T2_U_T1_U_CNTR_U_1
+7 ;Set to only get Vital Sign for Clinics
SET GMRVSTR("LT")="^C^"
+8 DO EN1^GMVHS
+9 ; If no data, display message and get
+10 ; most recent inpatient measurements
+11 IF '$DATA(^UTILITY($JOB,"GMRVD"))
Begin DoDot:1
+12 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE "*** No Outpatient measurements ***",!!
+13 SET CNTR=1
DO ENVS
End DoDot:1
QUIT
+14 SET GMTSMVF=$$IMDSORD
+15 ;p.107 moved pain to a third line and changed 99 to "Unable to respond"
DO FIRST
if GMTSVMVR>3
DO SECOND
if GMTSVMVR>3
DO THIRD
DO KILLVS
QUIT
+16 ;
ENVS ; Set up for Vitals Extraction Routine
+1 SET CNTR=$SELECT(+($GET(CNTR))>0:+($GET(CNTR)),+($GET(CNTR))'>0&(+($GET(GMTSNDM))>0):+($GET(GMTSNDM)),1:100)
+2 KILL ^UTILITY($JOB,"GMRVD"),ARRAY,GMRVSTR("LT")
+3 SET T1=GMTSEND
SET T2=GMTSBEG
SET END=0
SET TN=0
SET LF=0
+4 SET GMRVSTR="T"_";"_"P"_";"_"R"_";"_"BP"_";"_"HT"_";"_"WT"_";"_"CVP"_";"_"PO2"_";"_"CG"_";"_"PN"
+5 SET GMRVSTR(0)=T2_U_T1_U_CNTR_U_1
+6 DO EN1^GMVHS
IF '$DATA(^UTILITY($JOB,"GMRVD"))
DO KILLVS
QUIT
+7 if '$DATA(GMTSMVF)
SET GMTSMVF=$$IMDSORD
+8 ;p.107 moved pain to a third line and changed 99 to "Unable to respond"
DO FIRST
if GMTSVMVR>3
DO SECOND
if GMTSVMVR>3
DO THIRD
DO KILLVS
QUIT
+9 ;
FIRST ; First Set of Vitals
+1 ; 1 2 3 4 5 6 7 8
+2 ; Date^Temp()^Pulse^Respt^BP^Height()^Weight()^Control
+3 NEW GMW,GMTSCCNT,GMTSCTL
SET CNTR("HOLDER")=CNTR
SET GMTSVMVR=$$VERSION^XPDUTL("GMRV")
+4 IF GMTSVMVR'>3
Begin DoDot:1
+5 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE "Measurement DT",?20,"TEMP",?29,"PULSE",?36,"RESP",?45,"BP",?55,"HT",?68,"WT",!
+6 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+7 IF GMTSMVF
WRITE ?20,"C(F)",?55,"CM(IN)",?68,"KG(LB)",!
+8 IF '$TEST
WRITE ?20,"F(C)",?55,"IN(CM)",?68,"LB(KG)",!
+9 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE ?20,"----",?29,"-----",?36,"----",?45,"--",?55,"------",?68,"------",!!
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+10 IF GMTSVMVR>3
Begin DoDot:1
+11 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE "Measurement DT",?18,"TEMP",?30,"PULSE",?36,"RESP",?41,"BP",?53,"HT",?63,"WT",!
+12 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+13 IF GMTSMVF
WRITE ?18,"C(F)",?53,"CM(IN)",?63,"KG(LB)[BMI]",!
+14 IF '$TEST
WRITE ?18,"F(C)",?53,"IN(CM)",?63,"LB(KG)[BMI]",!
+15 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
WRITE ?18,"----",?30,"-----",?36,"----",?41,"--",?53,"------",?63,"-----------",!!
End DoDot:1
if $DATA(GMTSQIT)
QUIT
+16 SET GMTSCCNT=0
SET GMT=""
FOR
SET GMT=$ORDER(^UTILITY($JOB,"GMRVD",GMT))
if GMT<0!(GMT="")!(END=1)
QUIT
DO FLOOP
DO FWRT
+17 if GMTSCCNT=0
WRITE "No data",!
+18 QUIT
FLOOP ; Loop through first set of vitals by date
+1 SET (GMTSCTL,GMTSVT)=""
+2 FOR
SET GMTSVT=$ORDER(^UTILITY($JOB,"GMRVD",GMT,GMTSVT))
if GMTSVT=""
QUIT
SET IEN=$ORDER(^UTILITY($JOB,"GMRVD",GMT,GMTSVT,0))
DO FFMT
+3 QUIT
FFMT ; Extract and format first set of vitals
+1 SET GMTSVS=^UTILITY($JOB,"GMRVD",GMT,GMTSVT,IEN)
SET X=$PIECE(GMTSVS,U,1)
DO REGDT4^GMTSU
SET TDT=X
+2 SET X=$PIECE(GMTSVS,U,1)
DO MTIM^GMTSU
SET TI=X
SET TDT=TDT_" "_TI
SET $PIECE(ARRAY,U,1)=TDT
+3 SET GMTAB=$SELECT(GMTSVT="T":2,GMTSVT="P":3,GMTSVT="R":4,GMTSVT="BP":5,GMTSVT="HT":6,GMTSVT="WT":7,1:0)
+4 IF GMTAB="2"
Begin DoDot:1
+5 IF GMTSMVF
SET $PIECE(ARRAY,U,GMTAB)=$$FN($PIECE(GMTSVS,U,13),1)_"("_$$FN($PIECE(GMTSVS,U,8),1)_")"
+6 IF 'GMTSMVF
SET $PIECE(ARRAY,U,GMTAB)=$$FN($PIECE(GMTSVS,U,8),1)_"("_$$FN($PIECE(GMTSVS,U,13),1)_")"
End DoDot:1
+7 IF GMTAB="6"
Begin DoDot:1
+8 IF GMTSMVF
SET $PIECE(ARRAY,U,GMTAB)=$$FN($PIECE(GMTSVS,U,13),0)_"("_$$FN($PIECE(GMTSVS,U,8),1)_")"
+9 IF 'GMTSMVF
SET $PIECE(ARRAY,U,GMTAB)=$$FN($PIECE(GMTSVS,U,8),1)_"("_$$FN($PIECE(GMTSVS,U,13),0)_")"
End DoDot:1
+10 IF GMTAB="7"
Begin DoDot:1
+11 IF GMTSMVF
SET $PIECE(ARRAY,U,GMTAB)=$$FN($PIECE(GMTSVS,U,13),1)_"("_$$FN($PIECE(GMTSVS,U,8),0)_")"
+12 IF 'GMTSMVF
SET $PIECE(ARRAY,U,GMTAB)=$$FN($PIECE(GMTSVS,U,8),0)_"("_$$FN($PIECE(GMTSVS,U,13),1)_")"
End DoDot:1
+13 IF "^2^7^"[GMTAB
IF $PIECE(GMTSVS,U,8)?1A.E
SET $PIECE(ARRAY,U,GMTAB)=$PIECE(GMTSVS,U,8)
+14 IF GMTAB=6
IF $PIECE(GMTSVS,U,8)?1A.E
SET $PIECE(ARRAY,U,GMTAB)=$EXTRACT($PIECE(GMTSVS,U,8),1,9)
+15 IF "^2^6^7^"'[GMTAB
SET $PIECE(ARRAY,U,GMTAB)=$PIECE(GMTSVS,U,8)
+16 IF GMTAB=3
IF $PIECE(ARRAY,U,GMTAB)?1A.E
SET $PIECE(ARRAY,U,GMTAB)=$EXTRACT($PIECE(ARRAY,U,GMTAB),1,5)
+17 IF GMTAB=4
IF $PIECE(ARRAY,U,GMTAB)?1A.E
SET $PIECE(ARRAY,U,GMTAB)=$EXTRACT($PIECE(ARRAY,U,GMTAB),1,4)
+18 IF GMTAB=7
IF $PIECE(GMTSVS,U,14)]""
SET $PIECE(ARRAY,U,GMTAB)=$PIECE(ARRAY,U,GMTAB)_"["_$PIECE(GMTSVS,U,14)_"]"
+19 if GMTAB>1
SET GMTSCTL=GMTSCTL_$PIECE(ARRAY,U,GMTAB)
SET $PIECE(ARRAY,U,8)=GMTSCTL
+20 QUIT
FWRT ; Write first set of vitals by date
+1 if $PIECE($GET(ARRAY),U,8)=""
QUIT
SET GMTSCCNT=$GET(GMTSCCNT)+1
+2 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+3 IF GMTSVMVR'>3
WRITE $PIECE(ARRAY,U,1),?18,$PIECE(ARRAY,U,2),?30,$PIECE(ARRAY,U,3),?37,$PIECE(ARRAY,U,4),?42,$PIECE(ARRAY,U,5),?54,$PIECE(ARRAY,U,6),?67,$PIECE(ARRAY,U,7),!
+4 IF GMTSVMVR>3
WRITE $PIECE(ARRAY,U,1),?18,$PIECE(ARRAY,U,2),?30,$PIECE(ARRAY,U,3),?36,$PIECE(ARRAY,U,4),?41,$PIECE(ARRAY,U,5),?53,$PIECE(ARRAY,U,6),?63,$PIECE(ARRAY,U,7),!
+5 SET CNTR=CNTR-1
IF CNTR=0
SET END=1
+6 KILL ARRAY
+7 QUIT
+8 ;
SECOND ; Second Set of Vitals
+1 ; 1 2 3 4 5
+2 ; Date^CVP^POx^Cir/Gir^Control
+3 NEW GMW,GMTSCCNT,GMTSCTL
SET (GMTSCCNT,END)=0
SET CNTR=CNTR("HOLDER")
+4 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+5 WRITE !,"Measurement DT",?18,"CVP",?32,"POx",?45,"CG"
+6 IF $GET(GMTSMVF)
WRITE !,?18,"MMHG(CMH2O)",?32,"(L/MIN)(%)",?45,"CM(IN)",!
+7 IF '$TEST
WRITE !,?18,"CMH2O(MMHG)",?32,"(L/MIN)(%)",?45,"IN(CM)",!
+8 WRITE ?18,"-----------",?32,"----------",?45,"------",!!
+9 SET GMT=""
FOR
SET GMT=$ORDER(^UTILITY($JOB,"GMRVD",GMT))
if GMT<0!(GMT="")!(END=1)
QUIT
DO SLOOP
DO SWRT
+10 if GMTSCCNT=0
WRITE "No data",!
+11 QUIT
SLOOP ; Loop through second set of vitals by date
+1 SET (GMTSCTL,GMTSVT)=""
FOR
SET GMTSVT=$ORDER(^UTILITY($JOB,"GMRVD",GMT,GMTSVT))
if GMTSVT=""
QUIT
SET IEN=$ORDER(^UTILITY($JOB,"GMRVD",GMT,GMTSVT,0))
DO SFMT
+2 QUIT
SFMT ; Extract and format second set of vitals
+1 SET GMTSVS=^UTILITY($JOB,"GMRVD",GMT,GMTSVT,IEN)
+2 SET X=$PIECE(GMTSVS,U,1)
DO REGDT4^GMTSU
SET TDT=X
SET X=$PIECE(GMTSVS,U,1)
DO MTIM^GMTSU
SET TI=X
SET TDT=TDT_" "_TI
SET $PIECE(ARRAY,U,1)=TDT
+3 SET GMTAB=$SELECT(GMTSVT="CVP":2,GMTSVT="PO2":3,GMTSVT="CG":4,1:0)
+4 IF GMTAB=2
Begin DoDot:1
+5 IF $GET(GMTSMVF)
SET $PIECE(ARRAY,U,GMTAB)=$SELECT($PIECE(ARRAY,U,GMTAB)?1A.E:"",1:$PIECE(GMTSVS,U,13))_"("_$PIECE(GMTSVS,U,8)_")"
+6 IF '$GET(GMTSMVF)
SET $PIECE(ARRAY,U,GMTAB)=$PIECE(GMTSVS,U,8)_$SELECT($PIECE(ARRAY,U,GMTAB)?1A.E:"",1:"("_$PIECE(GMTSVS,U,13)_")")
End DoDot:1
+7 IF GMTAB=4
Begin DoDot:1
+8 IF $GET(GMTSMVF)
SET $PIECE(ARRAY,U,GMTAB)=$SELECT($PIECE(ARRAY,U,GMTAB)?1A.E:"",1:$$FN($PIECE(GMTSVS,U,13),0))_"("_$PIECE(GMTSVS,U,8)_")"
+9 IF '$GET(GMTSMVF)
SET $PIECE(ARRAY,U,GMTAB)=$PIECE(GMTSVS,U,8)_$SELECT($PIECE(ARRAY,U,GMTAB)?1A.E:"",1:"("_$$FN($PIECE(GMTSVS,U,13),0)_")")
+10 IF $PIECE(GMTSVS,U,17)]""
SET $PIECE(ARRAY,U,GMTAB)=$PIECE(ARRAY,U,GMTAB)_"["_$PIECE(GMTSVS,U,17)_"]"
End DoDot:1
+11 IF "^2^4^"'[GMTAB
SET $PIECE(ARRAY,U,GMTAB)=$PIECE(GMTSVS,U,8)
+12 IF GMTAB=3
SET $PIECE(ARRAY,U,GMTAB)=$PIECE(ARRAY,U,GMTAB)_$SELECT($PIECE(ARRAY,U,GMTAB)?1A.E:"",($PIECE($GET(GMTSVS),U,15)="")&($PIECE($GET(GMTSVS),U,16)=""):"",1:"("_$PIECE(GMTSVS,U,15)_")("_$PIECE(GMTSVS,U,16)_")")
+13 if GMTAB>1
SET GMTSCTL=$GET(GMTSCTL)_$PIECE($GET(ARRAY),U,GMTAB)
SET $PIECE(ARRAY,U,5)=GMTSCTL
+14 QUIT
SWRT ; Write second set of vitals by date
+1 if $PIECE($GET(ARRAY),U,5)=""
QUIT
+2 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+3 IF GMTSNPG=1
Begin DoDot:1
+4 WRITE !,"Measurement DT",?18,"CVP",?34,"POx",?46,"CG"
+5 IF GMTSMVF
WRITE !,?18,"MMHG(CMH2O)",?32,"(L/MIN)(%)",?45,"CM(IN)"
+6 IF '$TEST
WRITE !,?18,"CMH2O(MMHG)",?32,"(L/MIN)(%)",?45,"IN(CM)"
+7 WRITE !,?18,"-----------",?32,"----------",?45,"------",!!
End DoDot:1
+8 SET GMTSCCNT=$GET(GMTSCCNT)+1
+9 WRITE $PIECE(ARRAY,U,1),?18,$PIECE(ARRAY,U,2),?32,$PIECE(ARRAY,U,3),?45,$PIECE(ARRAY,U,4),!
+10 SET CNTR=CNTR-1
IF CNTR=0
SET END=1
+11 KILL ARRAY
+12 QUIT
THIRD ; Third Set of Vitals
+1 ;p.107 moved pain to a third line and changed 99 to "Unable to respond"
+2 ; 1 2 3
+3 ; Date^Pain^Control
+4 NEW GMW,GMTSCCNT,GMTSCTL
SET (GMTSCCNT,END)=0
SET CNTR=CNTR("HOLDER")
+5 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+6 WRITE !,"Measurement DT",?18,"Pain"
+7 WRITE !,?18,"----",!!
+8 SET GMT=""
FOR
SET GMT=$ORDER(^UTILITY($JOB,"GMRVD",GMT))
if GMT<0!(GMT="")!(END=1)
QUIT
DO TLOOP
DO TWRT
+9 if GMTSCCNT=0
WRITE "No data",!
+10 QUIT
TLOOP ; Loop through third set of vitals by date
+1 SET (GMTSCTL,GMTSVT)=""
FOR
SET GMTSVT=$ORDER(^UTILITY($JOB,"GMRVD",GMT,GMTSVT))
if GMTSVT=""
QUIT
SET IEN=$ORDER(^UTILITY($JOB,"GMRVD",GMT,GMTSVT,0))
DO TFMT
+2 QUIT
TFMT ; Extract and format third set of vitals
+1 SET GMTSVS=^UTILITY($JOB,"GMRVD",GMT,GMTSVT,IEN)
+2 SET X=$PIECE(GMTSVS,U,1)
DO REGDT4^GMTSU
SET TDT=X
SET X=$PIECE(GMTSVS,U,1)
DO MTIM^GMTSU
SET TI=X
SET TDT=TDT_" "_TI
SET $PIECE(ARRAY,U,1)=TDT
+3 SET GMTAB=$SELECT(GMTSVT="PN":2,1:0)
+4 SET $PIECE(ARRAY,U,GMTAB)=$PIECE(GMTSVS,U,8)
+5 IF GMTAB=2
Begin DoDot:1
+6 SET $PIECE(ARRAY,U,GMTAB)=$SELECT($LENGTH(...
SET $PIECE(ARRAY,U,GMTAB))&(+($PIECE(ARRAY,U,GMTAB))=0):$PIECE(ARRAY,U,GMTAB),$LENGTH($PIECE(ARRAY,U,GMTAB))&(+($PIECE(ARRAY,U,GMTAB))'=99):$$FN($PIECE(ARRAY,U,GMTAB),0),$LENGTH($PIECE(ARRAY,U,GMTAB))&(+(...
... $PIECE(ARRAY,U,GMTAB))=99):"Unable to Respond",1:"")
End DoDot:1
+7 if GMTAB>1
SET GMTSCTL=$GET(GMTSCTL)_$PIECE($GET(ARRAY),U,GMTAB)
SET $PIECE(ARRAY,U,3)=GMTSCTL
+8 QUIT
TWRT ; Write third set of vitals by date
+1 if $PIECE($GET(ARRAY),U,3)=""
QUIT
+2 DO CKP^GMTSUP
if $DATA(GMTSQIT)
QUIT
+3 IF GMTSNPG=1
Begin DoDot:1
+4 WRITE !,"Measurement DT",?18,"Pain"
+5 WRITE !,?18,"----",!!
End DoDot:1
+6 SET GMTSCCNT=$GET(GMTSCCNT)+1
+7 WRITE $PIECE(ARRAY,U,1),?18,$PIECE(ARRAY,U,2),!
+8 SET CNTR=CNTR-1
IF CNTR=0
SET END=1
+9 KILL ARRAY
+10 QUIT
+11 ;
KILLVS ; Kill Variables
+1 KILL CNTR,T1,T2,TDT,TI,END,TN,IEN,LF,GMTSVMVR,GMTSVS,GMTSVT,GMT,ARRAY,GMTAB,X
+2 KILL ^UTILITY($JOB,"GMRVD"),GMTSMVF
+3 QUIT
FN(X,Y) ; Format Number
+1 NEW VAL
SET VAL=+($GET(X))
SET Y=$GET(Y)
if +Y'=Y
QUIT X
+2 SET X=$FNUMBER(VAL,"",Y)
QUIT X
IMDSORD() ; Return imperial/metric display order
+1 ; 1: Metric first
+2 ; 0: Imperial first
+3 QUIT +$$GET^XPAR("ALL","ORQQVI METRIC FIRST",,"I")
