- GMTSVS ; SLC/KER - Vital Signs Component ; 02/27/2002
- ;;2.7;Health Summary;**8,20,28,35,49,78,107**;Oct 20, 1995;Build 3
- ;
- ; External References
- ; DBIA 4791 EN1^GMVHS
- ; DBIA 10141 $$VERSION^XPDUTL
- ;
- ; 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_"^"_T1_"^"_CNTR_"^"_1
- S GMRVSTR("LT")="^C^" ;Set to only get Vital Sign for Clinics
- ;D EN1^GMRVUT0
- 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
- 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_"^"_T1_"^"_CNTR_"^"_1
- ;D EN1^GMRVUT0 I '$D(^UTILITY($J,"GMRVD")) D KILLVS Q
- D EN1^GMVHS I '$D(^UTILITY($J,"GMRVD")) D KILLVS Q
- 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) 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) 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" S $P(ARRAY,U,GMTAB)=$$FN($P(GMTSVS,U,8),1)_"("_$$FN($P(GMTSVS,U,13),1)_")"
- I GMTAB="6" S $P(ARRAY,U,GMTAB)=$$FN($P(GMTSVS,U,8),1)_"("_$$FN($P(GMTSVS,U,13),0)_")"
- I GMTAB="7" 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 "^3^4^5^"[GMTAB,$P(ARRAY,U,GMTAB)?1A.E S $P(ARRAY,U,GMTAB)=$E($P(ARRAY,U,GMTAB),1,7)
- 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"
- W !,?18,"CMH20(MMHG)",?32,"(L/MIN)(%)",?45,"IN(CM)",!,?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)
- S $P(ARRAY,U,GMTAB)=$P(GMTSVS,U,8)
- I GMTAB=2 S $P(ARRAY,U,GMTAB)=$P(ARRAY,U,GMTAB)_$S($P(ARRAY,U,GMTAB)?1A.E:"",1:"("_$P(GMTSVS,U,13)_")")
- 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)_")")
- I GMTAB=4 S $P(ARRAY,U,GMTAB)=$P(ARRAY,U,GMTAB)_$S($P(ARRAY,U,GMTAB)?1A.E:"",1:"("_$$FN($P(GMTSVS,U,13),0)_")"_$S($P(GMTSVS,U,17)]"":"["_$P(GMTSVS,U,17)_"]",1:""))
- 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"
- . W !,?18,"CMH20(MMHG)",?32,"(L/MIN)(%)",?45,"IN(CM)",!,?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")
- 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
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMTSVS 8352 printed Feb 18, 2025@23:27:01 Page 2
- GMTSVS ; SLC/KER - Vital Signs Component ; 02/27/2002
- +1 ;;2.7;Health Summary;**8,20,28,35,49,78,107**;Oct 20, 1995;Build 3
- +2 ;
- +3 ; External References
- +4 ; DBIA 4791 EN1^GMVHS
- +5 ; DBIA 10141 $$VERSION^XPDUTL
- +6 ;
- +7 ; Health Summary patch GMTS*2.7*35 will require
- +8 ; Vitals version 4.0, patch GMRV*4.0*7
- +9 ;
- 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_"^"_T1_"^"_CNTR_"^"_1
- +7 ;Set to only get Vital Sign for Clinics
- SET GMRVSTR("LT")="^C^"
- +8 ;D EN1^GMRVUT0
- +9 DO EN1^GMVHS
- +10 ; If no data, display message and get
- +11 ; most recent inpatient measurements
- +12 IF '$DATA(^UTILITY($JOB,"GMRVD"))
- Begin DoDot:1
- +13 DO CKP^GMTSUP
- if $DATA(GMTSQIT)
- QUIT
- WRITE "*** No Outpatient measurements ***",!!
- +14 SET CNTR=1
- DO ENVS
- End DoDot:1
- QUIT
- +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_"^"_T1_"^"_CNTR_"^"_1
- +6 ;D EN1^GMRVUT0 I '$D(^UTILITY($J,"GMRVD")) D KILLVS Q
- +7 DO EN1^GMVHS
- IF '$DATA(^UTILITY($JOB,"GMRVD"))
- DO KILLVS
- QUIT
- +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
- WRITE ?20,"F(C)",?55,"IN(CM)",?68,"LB(KG)",!
- +7 DO CKP^GMTSUP
- if $DATA(GMTSQIT)
- QUIT
- WRITE ?20,"----",?29,"-----",?36,"----",?45,"--",?55,"------",?68,"------",!!
- End DoDot:1
- if $DATA(GMTSQIT)
- QUIT
- +8 IF GMTSVMVR>3
- Begin DoDot:1
- +9 DO CKP^GMTSUP
- if $DATA(GMTSQIT)
- QUIT
- WRITE "Measurement DT",?18,"TEMP",?30,"PULSE",?36,"RESP",?41,"BP",?53,"HT",?63,"WT",!
- +10 DO CKP^GMTSUP
- if $DATA(GMTSQIT)
- QUIT
- WRITE ?18,"F(C)",?53,"IN(CM)",?63,"LB(KG)[BMI]",!
- +11 DO CKP^GMTSUP
- if $DATA(GMTSQIT)
- QUIT
- WRITE ?18,"----",?30,"-----",?36,"----",?41,"--",?53,"------",?63,"-----------",!!
- End DoDot:1
- if $DATA(GMTSQIT)
- QUIT
- +12 SET GMTSCCNT=0
- SET GMT=""
- FOR
- SET GMT=$ORDER(^UTILITY($JOB,"GMRVD",GMT))
- if GMT<0!(GMT="")!(END=1)
- QUIT
- DO FLOOP
- DO FWRT
- +13 if GMTSCCNT=0
- WRITE "No data",!
- +14 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"
- SET $PIECE(ARRAY,U,GMTAB)=$$FN($PIECE(GMTSVS,U,8),1)_"("_$$FN($PIECE(GMTSVS,U,13),1)_")"
- +5 IF GMTAB="6"
- SET $PIECE(ARRAY,U,GMTAB)=$$FN($PIECE(GMTSVS,U,8),1)_"("_$$FN($PIECE(GMTSVS,U,13),0)_")"
- +6 IF GMTAB="7"
- SET $PIECE(ARRAY,U,GMTAB)=$$FN($PIECE(GMTSVS,U,8),0)_"("_$$FN($PIECE(GMTSVS,U,13),1)_")"
- +7 IF "^2^7^"[GMTAB
- IF $PIECE(GMTSVS,U,8)?1A.E
- SET $PIECE(ARRAY,U,GMTAB)=$PIECE(GMTSVS,U,8)
- +8 IF GMTAB=6
- IF $PIECE(GMTSVS,U,8)?1A.E
- SET $PIECE(ARRAY,U,GMTAB)=$EXTRACT($PIECE(GMTSVS,U,8),1,9)
- +9 IF "^2^6^7^"'[GMTAB
- SET $PIECE(ARRAY,U,GMTAB)=$PIECE(GMTSVS,U,8)
- +10 IF GMTAB=3
- IF $PIECE(ARRAY,U,GMTAB)?1A.E
- SET $PIECE(ARRAY,U,GMTAB)=$EXTRACT($PIECE(ARRAY,U,GMTAB),1,5)
- +11 IF GMTAB=4
- IF $PIECE(ARRAY,U,GMTAB)?1A.E
- SET $PIECE(ARRAY,U,GMTAB)=$EXTRACT($PIECE(ARRAY,U,GMTAB),1,4)
- +12 ;I "^3^4^5^"[GMTAB,$P(ARRAY,U,GMTAB)?1A.E S $P(ARRAY,U,GMTAB)=$E($P(ARRAY,U,GMTAB),1,7)
- +13 IF GMTAB=7
- IF $PIECE(GMTSVS,U,14)]""
- SET $PIECE(ARRAY,U,GMTAB)=$PIECE(ARRAY,U,GMTAB)_"["_$PIECE(GMTSVS,U,14)_"]"
- +14 if GMTAB>1
- SET GMTSCTL=GMTSCTL_$PIECE(ARRAY,U,GMTAB)
- SET $PIECE(ARRAY,U,8)=GMTSCTL
- +15 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 WRITE !,?18,"CMH20(MMHG)",?32,"(L/MIN)(%)",?45,"IN(CM)",!,?18,"-----------",?32,"----------",?45,"------",!!
- +7 SET GMT=""
- FOR
- SET GMT=$ORDER(^UTILITY($JOB,"GMRVD",GMT))
- if GMT<0!(GMT="")!(END=1)
- QUIT
- DO SLOOP
- DO SWRT
- +8 if GMTSCCNT=0
- WRITE "No data",!
- +9 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 SET $PIECE(ARRAY,U,GMTAB)=$PIECE(GMTSVS,U,8)
- +5 IF GMTAB=2
- SET $PIECE(ARRAY,U,GMTAB)=$PIECE(ARRAY,U,GMTAB)_$SELECT($PIECE(ARRAY,U,GMTAB)?1A.E:"",1:"("_$PIECE(GMTSVS,U,13)_")")
- +6 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)_")")
- +7 IF GMTAB=4
- SET $PIECE(ARRAY,U,GMTAB)=$PIECE(ARRAY,U,GMTAB)_$SELECT($PIECE(ARRAY,U,GMTAB)?1A.E:"",1:"("_$$FN($PIECE(GMTSVS,U,13),0)_")"_$SELECT($PIECE(GMTSVS,U,17)]"":"["_$PIECE(GMTSVS,U,17)_"]",1:""))
- +8 if GMTAB>1
- SET GMTSCTL=$GET(GMTSCTL)_$PIECE($GET(ARRAY),U,GMTAB)
- SET $PIECE(ARRAY,U,5)=GMTSCTL
- +9 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 WRITE !,?18,"CMH20(MMHG)",?32,"(L/MIN)(%)",?45,"IN(CM)",!,?18,"-----------",?32,"----------",?45,"------",!!
- End DoDot:1
- +6 SET GMTSCCNT=$GET(GMTSCCNT)+1
- +7 WRITE $PIECE(ARRAY,U,1),?18,$PIECE(ARRAY,U,2),?32,$PIECE(ARRAY,U,3),?45,$PIECE(ARRAY,U,4),!
- +8 SET CNTR=CNTR-1
- IF CNTR=0
- SET END=1
- +9 KILL ARRAY
- +10 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")
- +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