source: FOIAVistA/trunk/r/HEALTH_SUMMARY-GMTS/GMTSVS.m@ 802

Last change on this file since 802 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 6.8 KB
Line 
1GMTSVS ; SLC/KER - Vital Signs Component ; 02/27/2002
2 ;;2.7;Health Summary;**8,20,28,35,49,78**;Oct 20, 1995
3 ;
4 ; External References
5 ; DBIA 4791 EN1^GMVHS
6 ; DBIA 10141 $$VERSION^XPDUTL
7 ;
8 ; Health Summary patch GMTS*2.7*35 will require
9 ; Vitals version 4.0, patch GMRV*4.0*7
10 ;
11OUTPAT ; Outpatient Vital Signs Main Control
12 N GMRVSTR
13 S CNTR=$S(+($G(GMTSNDM))>0:+($G(GMTSNDM)),1:100)
14 K ^UTILITY($J,"GMRVD"),ARRAY
15 S T1=GMTSEND,T2=GMTSBEG,END=0,TN=0,LF=0
16 S GMRVSTR="T"_";"_"P"_";"_"R"_";"_"BP"_";"_"HT"_";"_"WT"_";"_"CVP"_";"_"PO2"_";"_"CG"_";"_"PN"
17 S GMRVSTR(0)=T2_"^"_T1_"^"_CNTR_"^"_1
18 S GMRVSTR("LT")="^C^" ;Set to only get Vital Sign for Clinics
19 ;D EN1^GMRVUT0
20 D EN1^GMVHS
21 ; If no data, display message and get
22 ; most recent inpatient measurements
23 I '$D(^UTILITY($J,"GMRVD")) D Q
24 . D CKP^GMTSUP Q:$D(GMTSQIT) W "*** No Outpatient measurements ***",!!
25 . S CNTR=1 D ENVS
26 D FIRST,SECOND:GMTSVMVR>3,KILLVS Q
27 ;
28ENVS ; Set up for Vitals Extraction Routine
29 S CNTR=$S(+($G(CNTR))>0:+($G(CNTR)),+($G(CNTR))'>0&(+($G(GMTSNDM))>0):+($G(GMTSNDM)),1:100)
30 K ^UTILITY($J,"GMRVD"),ARRAY,GMRVSTR("LT")
31 S T1=GMTSEND,T2=GMTSBEG,END=0,TN=0,LF=0
32 S GMRVSTR="T"_";"_"P"_";"_"R"_";"_"BP"_";"_"HT"_";"_"WT"_";"_"CVP"_";"_"PO2"_";"_"CG"_";"_"PN"
33 S GMRVSTR(0)=T2_"^"_T1_"^"_CNTR_"^"_1
34 ;D EN1^GMRVUT0 I '$D(^UTILITY($J,"GMRVD")) D KILLVS Q
35 D EN1^GMVHS I '$D(^UTILITY($J,"GMRVD")) D KILLVS Q
36 D FIRST,SECOND:GMTSVMVR>3,KILLVS Q
37 ;
38FIRST ; First Set of Vitals
39 ; 1 2 3 4 5 6 7 8
40 ; Date^Temp()^Pulse^Respt^BP^Height()^Weight()^Control
41 N GMW,GMTSCCNT,GMTSCTL S CNTR("HOLDER")=CNTR S GMTSVMVR=$$VERSION^XPDUTL("GMRV")
42 I GMTSVMVR'>3 D Q:$D(GMTSQIT)
43 . D CKP^GMTSUP Q:$D(GMTSQIT) W "Measurement DT",?20,"TEMP",?29,"PULSE",?36,"RESP",?45,"BP",?55,"HT",?68,"WT",!
44 . D CKP^GMTSUP Q:$D(GMTSQIT) W ?20,"F(C)",?55,"IN(CM)",?68,"LB(KG)",!
45 . D CKP^GMTSUP Q:$D(GMTSQIT) W ?20,"----",?29,"-----",?36,"----",?45,"--",?55,"------",?68,"------",!!
46 I GMTSVMVR>3 D Q:$D(GMTSQIT)
47 . D CKP^GMTSUP Q:$D(GMTSQIT) W "Measurement DT",?18,"TEMP",?30,"PULSE",?36,"RESP",?41,"BP",?53,"HT",?63,"WT",!
48 . D CKP^GMTSUP Q:$D(GMTSQIT) W ?18,"F(C)",?53,"IN(CM)",?63,"LB(KG)[BMI]",!
49 . D CKP^GMTSUP Q:$D(GMTSQIT) W ?18,"----",?30,"-----",?36,"----",?41,"--",?53,"------",?63,"-----------",!!
50 S GMTSCCNT=0,GMT="" F S GMT=$O(^UTILITY($J,"GMRVD",GMT)) Q:GMT<0!(GMT="")!(END=1) D FLOOP,FWRT
51 W:GMTSCCNT=0 "No data",!
52 Q
53FLOOP ; Loop through first set of vitals by date
54 S (GMTSCTL,GMTSVT)=""
55 F S GMTSVT=$O(^UTILITY($J,"GMRVD",GMT,GMTSVT)) Q:GMTSVT="" S IEN=$O(^UTILITY($J,"GMRVD",GMT,GMTSVT,0)) D FFMT
56 Q
57FFMT ; Extract and format first set of vitals
58 S GMTSVS=^UTILITY($J,"GMRVD",GMT,GMTSVT,IEN),X=$P(GMTSVS,U,1) D REGDT4^GMTSU S TDT=X
59 S X=$P(GMTSVS,U,1) D MTIM^GMTSU S TI=X S TDT=TDT_" "_TI,$P(ARRAY,U,1)=TDT
60 S GMTAB=$S(GMTSVT="T":2,GMTSVT="P":3,GMTSVT="R":4,GMTSVT="BP":5,GMTSVT="HT":6,GMTSVT="WT":7,1:0)
61 I GMTAB="2" S $P(ARRAY,U,GMTAB)=$$FN($P(GMTSVS,U,8),1)_"("_$$FN($P(GMTSVS,U,13),1)_")"
62 I GMTAB="6" S $P(ARRAY,U,GMTAB)=$$FN($P(GMTSVS,U,8),1)_"("_$$FN($P(GMTSVS,U,13),0)_")"
63 I GMTAB="7" S $P(ARRAY,U,GMTAB)=$$FN($P(GMTSVS,U,8),0)_"("_$$FN($P(GMTSVS,U,13),1)_")"
64 I "^2^7^"[GMTAB,$P(GMTSVS,U,8)?1A.E S $P(ARRAY,U,GMTAB)=$P(GMTSVS,U,8)
65 I GMTAB=6,$P(GMTSVS,U,8)?1A.E S $P(ARRAY,U,GMTAB)=$E($P(GMTSVS,U,8),1,9)
66 I "^2^6^7^"'[GMTAB S $P(ARRAY,U,GMTAB)=$P(GMTSVS,U,8)
67 I GMTAB=3,$P(ARRAY,U,GMTAB)?1A.E S $P(ARRAY,U,GMTAB)=$E($P(ARRAY,U,GMTAB),1,5)
68 I GMTAB=4,$P(ARRAY,U,GMTAB)?1A.E S $P(ARRAY,U,GMTAB)=$E($P(ARRAY,U,GMTAB),1,4)
69 ;I "^3^4^5^"[GMTAB,$P(ARRAY,U,GMTAB)?1A.E S $P(ARRAY,U,GMTAB)=$E($P(ARRAY,U,GMTAB),1,7)
70 I GMTAB=7,$P(GMTSVS,U,14)]"" S $P(ARRAY,U,GMTAB)=$P(ARRAY,U,GMTAB)_"["_$P(GMTSVS,U,14)_"]"
71 S:GMTAB>1 GMTSCTL=GMTSCTL_$P(ARRAY,U,GMTAB),$P(ARRAY,U,8)=GMTSCTL
72 Q
73FWRT ; Write first set of vitals by date
74 Q:$P($G(ARRAY),U,8)="" S GMTSCCNT=$G(GMTSCCNT)+1
75 D CKP^GMTSUP Q:$D(GMTSQIT)
76 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),!
77 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),!
78 S CNTR=CNTR-1 I CNTR=0 S END=1
79 K ARRAY
80 Q
81 ;
82SECOND ; Second Set of Vitals
83 ; 1 2 3 4 5 6
84 ; Date^CVP^POx^Cir/Gir^Pain^Control
85 N GMW,GMTSCCNT,GMTSCTL S (GMTSCCNT,END)=0,CNTR=CNTR("HOLDER")
86 D CKP^GMTSUP Q:$D(GMTSQIT)
87 W !,"Measurement DT",?18,"CVP",?32,"POx",?45,"CG"
88 W !,?18,"CMH20(MMHG)",?32,"(L/MIN)(%)",?45,"IN(CM)",?73,"Pain",!,?18,"-----------",?32,"----------",?45,"------",?73,"----",!!
89 S GMT="" F S GMT=$O(^UTILITY($J,"GMRVD",GMT)) Q:GMT<0!(GMT="")!(END=1) D SLOOP,SWRT
90 W:GMTSCCNT=0 "No data",!
91 Q
92SLOOP ; Loop through second set of vitals by date
93 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
94 Q
95SFMT ; Extract and format second set of vitals
96 S GMTSVS=^UTILITY($J,"GMRVD",GMT,GMTSVT,IEN)
97 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
98 S GMTAB=$S(GMTSVT="CVP":2,GMTSVT="PO2":3,GMTSVT="CG":4,GMTSVT="PN":5,1:0)
99 S $P(ARRAY,U,GMTAB)=$P(GMTSVS,U,8)
100 I GMTAB=2 S $P(ARRAY,U,GMTAB)=$P(ARRAY,U,GMTAB)_$S($P(ARRAY,U,GMTAB)?1A.E:"",1:"("_$P(GMTSVS,U,13)_")")
101 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)_")")
102 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:""))
103 I GMTAB=5 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):"No Response",1:"")
104 S:GMTAB>1 GMTSCTL=$G(GMTSCTL)_$P($G(ARRAY),U,GMTAB),$P(ARRAY,U,6)=GMTSCTL
105 Q
106SWRT ; Write second set of vitals by date
107 Q:$P($G(ARRAY),U,6)=""
108 D CKP^GMTSUP Q:$D(GMTSQIT)
109 I GMTSNPG=1 D
110 . W !,"Measurement DT",?18,"CVP",?34,"POx",?46,"CG"
111 . W !,?18,"CMH20(MMHG)",?32,"(L/MIN)(%)",?45,"IN(CM)",?73,"Pain",!,?18,"-----------",?32,"----------",?45,"------",?73,"----",!!
112 S GMTSCCNT=$G(GMTSCCNT)+1
113 W $P(ARRAY,U,1),?18,$P(ARRAY,U,2),?32,$P(ARRAY,U,3),?45,$P(ARRAY,U,4),?73,$S($P(ARRAY,U,5)?1A.E:$E($P(ARRAY,U,5),1,7),1:$P(ARRAY,U,5)),!
114 S CNTR=CNTR-1 I CNTR=0 S END=1
115 K ARRAY
116 Q
117 ;
118KILLVS ; Kill Variables
119 K CNTR,T1,T2,TDT,TI,END,TN,IEN,LF,GMTSVMVR,GMTSVS,GMTSVT,GMT,ARRAY,GMTAB,X
120 K ^UTILITY($J,"GMRVD")
121 Q
122FN(X,Y) ; Format Number
123 N VAL S VAL=+($G(X)),Y=$G(Y) Q:+Y'=Y X
124 S X=$FN(VAL,"",Y) Q X
Note: See TracBrowser for help on using the repository browser.