source: WorldVistAEHR/trunk/r/HEALTH_SUMMARY-GMTS/GMTSVSD.m@ 1578

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

initial load of WorldVistAEHR
File size: 8.3 KB
RevLine 
[613]1GMTSVSD ; SLC/KER - Vital Signs (Detailed) ; 01/06/2003
2 ;;2.7;Health Summary;**35,49,58,78**;Oct 20, 1995
3 ;
4 ; External References
5 ; DBIA 4791 EN1^GMVHS
6 ; DBIA 10141 $$VERSION^XPDUTL
7 ; DBIA 10103 $$NOW^XLFDT
8 ;
9 ; Health Summary patch GMTS*2.7*35 will require
10 ; Vitals version 4.0, patch GMRV*4.0*7
11 ;
12 Q
13EN ; Detailed Vital Signs main control
14 N GMRVSTR,GMTSC1,GMTSC2,GMTSC3,GMTSC4,GMTSCNT,GMTSCD,GMTSCHR,GMTSCI
15 N GMTSCW1,GMTSCW2,GMTSCW3,GMTSCW4,GMTSCW5,GMTSLN,GMTSMEAS,GMTSMAX
16 N GMTSN,GMTSOK,GMTSP,GMTSPSN,GMTSQ,GMTSREM,GMTSROV,GMTST,GMTSTO,GMTSV
17 N GMTSVCT,GMTSVD,GMTSVI,GMTSVSD,GMTSVSDT,GMTSVT,X,Y,GMTSLM,GMTSLML
18 S GMTSLM=0 S:$D(VALM("BM"))&($G(VALM("LINES"))>0) GMTSLM=1
19 S GMTSLML=9999999009 S:GMTSLM GMTSLML=+($G(VALM("LINES")))
20 S GMTSLO=+($G(GMTSLO)) S:GMTSLO=0 GMTSLO=3 S GMTSLPG=+($G(GMTSLPG)),GMTSDTM=$G(GMTSDTM) S:'$L(GMTSDTM) GMTSDTM=$$DTM
21 S:'$D(GMTSTITL)!('$L($G(GMTSTITL))) GMTSTITL="VITALS DETAILED DISPLAY" K ^TMP("GMTSVSD",$J),^UTILITY($J,"GMRVD")
22 S (GMTSVCT,GMTSMAX)=$S(+($G(GMTSNDM))>0:+($G(GMTSNDM)),1:1)
23 S GMRVSTR("LT")="^C^"
24 D GET D:$D(^UTILITY($J,"GMRVD")) ST K GMRVSTR("LT")
25 D GET D:$D(^UTILITY($J,"GMRVD")) ST K ^UTILITY($J,"GMRVD")
26 S GMTSCW1=0,GMTSCW2=18,GMTSCW3=36,GMTSCW4=53,GMTSCW5=+($G(IOM))-2
27 S:GMTSCW5'>49 GMTSCW5=78
28 I '$D(^TMP("GMTSVSD",$J)) Q
29 D REM,OUT
30 Q
31 ;
32GET ; Get Data
33 K ^UTILITY($J,"GMRVD") N GMTSMAX
34 S GMTSMAX=$S(+($G(GMTSVCT))>0:+($G(GMTSVCT)),1:1) S GMTSMAX=GMTSMAX*100
35 S GMRVSTR="T"_";"_"P"_";"_"R"_";"_"BP"_";"_"HT"_";"_"WT"_";"_"CVP"_";"_"PO2"_";"_"CG"_";"_"PN"
36 S GMRVSTR(0)=$G(GMTSBEG)_"^"_$G(GMTSEND)_"^"_$G(GMTSMAX)_"^"_1
37 ;D EN1^GMRVUT0 S GMTSMAX=+($G(GMTSVCT))
38 D EN1^GMVHS S GMTSMAX=+($G(GMTSVCT))
39 Q
40NOD ; No Data Found
41 D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG=1 HDR
42 W "*** No vital measurements ***",! S GMTSMAX=1 Q
43REM ; Remove Excess Data
44 N GMTSMAX S GMTSMAX=$S(+($G(GMTSNDM))>0:+($G(GMTSNDM)),1:1)
45 N GMTSVD,GMTSVT,GMTSVI,GMTST
46 S GMTSVD=0 F S GMTSVD=$O(^TMP("GMTSVSD",$J,GMTSVD)) Q:+GMTSVD=0 D
47 . S GMTSVT="" F S GMTSVT=$O(^TMP("GMTSVSD",$J,GMTSVD,GMTSVT)) Q:GMTSVT="" D
48 . . S GMTSVI=0 F S GMTSVI=$O(^TMP("GMTSVSD",$J,GMTSVD,GMTSVT,GMTSVI)) Q:+GMTSVI=0 D
49 . . . I +($G(GMTST(GMTSVT)))>(GMTSMAX-1) K ^TMP("GMTSVSD",$J,GMTSVD,GMTSVT,GMTSVI) Q
50 . . . S GMTST(GMTSVT)=+($G(GMTST(GMTSVT)))+1
51 Q
52 ;
53OUT ; Output Data
54 D HDR Q:$D(GMTSQIT) N GMTSVD,GMTSVT,GMTSVSDT,GMTSVSD,GMTSVI,GMTSCNT S GMTSCNT=0
55 S GMTSVD=0 F S GMTSVD=$O(^TMP("GMTSVSD",$J,GMTSVD)) Q:GMTSVD<1!(GMTSVD="") D
56 . S GMTSVT="" F S GMTSVT=$O(^TMP("GMTSVSD",$J,GMTSVD,GMTSVT)) Q:GMTSVT="" D
57 . . S GMTSVI=0 F S GMTSVI=$O(^TMP("GMTSVSD",$J,GMTSVD,GMTSVT,GMTSVI)) Q:+GMTSVI=0 D
58 . . . 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
59 . I +($O(^TMP("GMTSVSD",$J,GMTSVD)))'=GMTSVD D WRL
60 I GMTSCNT=0 D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG=1 HDR W "No data",!
61 Q
62ADD ; Add to Output Array
63 N GMTST,GMTSTO,GMTSV,GMTSQ S GMTST=$G(GMTSVT) Q:'$L(GMTST)
64 S GMTSTO=$$VO(GMTST) Q:GMTSTO'>0 S GMTST=$$VT(GMTST) Q:'$L(GMTST)
65 S GMTSV=$$VM(GMTSVT,GMTSVSD)
66 S GMTSQ=$$VQ(GMTSVSD),GMTSROV(GMTSTO)=GMTST_"^"_GMTSV_"^"_GMTSQ,GMTSCNT=+($G(GMTSCNT))+1,GMTSROV("DT")=$$EDT^GMTSU(GMTSVSDT)
67 Q
68WRL ; Write Line from Array
69 N GMTSCI,GMTSCD,GMTSC1,GMTSC2,GMTSC3,GMTSC4
70 S (GMTSCD,GMTSC1)=$G(GMTSROV("DT")) I '$L(GMTSC1) K GMTSROV Q
71 S GMTSCI=0 F S GMTSCI=$O(GMTSROV(GMTSCI)) Q:+GMTSCI=0 Q:$D(GMTSQIT) D Q:$D(GMTSQIT)
72 . S GMTSC2=$G(GMTSROV(GMTSCI)),GMTSC3=$P(GMTSC2,"^",2),GMTSC4=$P(GMTSC2,"^",3),GMTSC2=$P(GMTSC2,"^",1)
73 . D CKP^GMTSUP Q:$D(GMTSQIT)
74 . I +($G(GMTSLM))>0 S:+($$LMP)>0 GMTSC1=GMTSCD
75 . I GMTSNPG'=1 W GMTSC1,?GMTSCW2,GMTSC2,?GMTSCW3,GMTSC3 D QUAL
76 . I GMTSNPG=1 S GMTSC1=GMTSCD D HDR W GMTSC1,?GMTSCW2,GMTSC2,?GMTSCW3,GMTSC3 D QUAL
77 . S GMTSC1=" "" "" "
78 . Q:$D(GMTSQIT)
79 K GMTSROV
80 Q
81LMP(X) ;
82 Q:+($G(GMTSLML))'>0 0
83 N GMTSP,GMTSD S GMTSP=$Y,GMTSD=0 S:GMTSP#GMTSLML=0 GMTSD=1 S X=GMTSD Q X
84QUAL ; Write Vital Qualifiers
85 N GMTSOK,GMTSLN,GMTSTO,GMTSREM,GMTSPSN,GMTSCHR S GMTSLN=GMTSCW5-GMTSCW4
86 I $L(GMTSC4)'>(GMTSLN-1) D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG=1 HDR W ?GMTSCW4,GMTSC4,! Q
87 S GMTSREM=GMTSC4 F Q:$D(GMTSQIT) D QPARSE Q:$D(GMTSQIT) Q:'$L(GMTSREM)
88 Q
89QPARSE ; Parse Qualifier (wrap)
90 I $L(GMTSREM)'>(GMTSLN-1) D CKP^GMTSUP Q:$D(GMTSQIT) D:GMTSNPG=1 HDR W ?GMTSCW4,GMTSREM,! S GMTSREM="" Q
91 S GMTSOK=0 F GMTSPSN=GMTSLN:-1:0 Q:+GMTSOK=1 D Q:+GMTSOK=1
92 . I $E(GMTSREM,GMTSPSN)=" " S GMTSCHR=" ",GMTSOK=1 Q
93 . I $E(GMTSREM,GMTSPSN)="," S GMTSCHR=",",GMTSOK=1 Q
94 . I $E(GMTSREM,GMTSPSN)="/"!($E(GMTSREM,GMTSPSN)="-")!($E(GMTSREM,GMTSPSN)=")") S GMTSCHR=$E(GMTSREM,GMTSPSN),GMTSOK=1 Q
95 I GMTSCHR=" " D Q:$D(GMTSQIT)
96 . 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),!
97 I GMTSCHR="/"!(GMTSCHR=",")!(GMTSCHR="-")!(GMTSCHR=")") D Q:$D(GMTSQIT)
98 . 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),!
99 Q
100 ;
101 ; Miscellaneous
102FM(X) ; Format Vitals Measurement
103 S X=$$TRIM($G(X)) Q:+X'=X X
104 S:X["." X=$FN(X,"",2) Q X
105TRIM(X) ; Trim Blank Spaces
106 F Q:$E(X,1)'=" " S X=$E(X,2,$L(X))
107 F Q:$E(X,$L(X))'=" " S X=$E(X,1,($L(X)-1))
108 Q X
109VO(X) ; Vital Array Order
110 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 ""
111VT(X) ; Vital Type
112 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)"
113 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 ""
114VM(X,Y) ; Vital Type Measurement
115 N GMTSMEAS,GMTSID S GMTSMEAS="",(GMTSID,X)=$G(X) Q:"^BP^T^R^P^HT^WT^CVP^PO2^CG^PN^"'[("^"_X_"^") ""
116 S Y=$G(Y) Q:'$L(Y) ""
117 ; If data for T, Ht or Wt piece 8 and 13 else piece 8
118 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)_")")
119 E S GMTSMEAS=$P(Y,"^",8)
120 ; WT - Weight and BMI (piece 14)
121 I X="WT",$L($P(Y,"^",14)) S GMTSMEAS=GMTSMEAS_"["_$P(Y,"^",14)_"]"
122 ; CVP - Central Venous Pressure/CG - Circum/Girth
123 I X="CVP"!(X="CG") S GMTSMEAS=$P(Y,"^",8) S:$L($P(Y,"^",13)) GMTSMEAS=GMTSMEAS_" ("_$P(Y,"^",13)_")"
124 ; POx - Pulse Oximetry
125 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)_")"
126 ; PN - Pain
127 S:X="PN" GMTSMEAS=$P(Y,"^",8) S:X="PN"&(GMTSMEAS=99) GMTSMEAS="No Response"
128 S X=GMTSMEAS Q X
129VQ(X) ; Vital Qualifiers
130 S X=$G(X),X=$P(X,"^",17) S:$L(X) X=$$AQ(X) Q X
131HDR ; Header
132 N GMTSLN D CKP^GMTSUP Q:$D(GMTSQIT) G:GMTSNPG=1 HDR
133 W "Date",?GMTSCW2,"Vital",?GMTSCW3,"Measurement",?GMTSCW4,"Qualifiers"
134 W:'$D(GMTSOBJ)!($D(GMTSOBJ)&($D(GMTSOBJ("UNDERLINE")))) !
135 D CKP^GMTSUP Q:$D(GMTSQIT) G:GMTSNPG=1 HDR
136 W:'$D(GMTSOBJ)!($D(GMTSOBJ)&($D(GMTSOBJ("UNDERLINE")))) $$LN((GMTSCW2-2)) W ?GMTSCW2
137 W:'$D(GMTSOBJ)!($D(GMTSOBJ)&($D(GMTSOBJ("UNDERLINE")))) $$LN((GMTSCW3-(GMTSCW2+2))) W ?GMTSCW3
138 W:'$D(GMTSOBJ)!($D(GMTSOBJ)&($D(GMTSOBJ("UNDERLINE")))) $$LN((GMTSCW4-(GMTSCW3+2))) W ?GMTSCW4
139 W:'$D(GMTSOBJ)!($D(GMTSOBJ)&($D(GMTSOBJ("UNDERLINE")))) $$LN((GMTSCW5-(GMTSCW4+2)))
140 D CKP^GMTSUP Q:$D(GMTSQIT) G:GMTSNPG=1 HDR W !
141 ;
142 S GMTSNPG=0 Q
143ST ; Save in ^TMP Global
144 Q:'$D(^UTILITY($J,"GMRVD")) M ^TMP("GMTSVSD",$J)=^UTILITY($J,"GMRVD") Q
145AQ(X) ; All Qualifiers Field
146 S X=$G(X) F Q:X'[";" S X=$P(X,";",1)_", "_$P(X,";",2,299)
147 S X=$$MC(X) Q X
148MC(X) ; Mix Case for Qualifiers
149 N GMTSP S X=$TR($G(X),"ABCDEFGHIJKLMNOPQRSTUVWXYZ","abcdefghijklmnopqrstuvwxyz") F GMTSP=1:1:$L(X) D
150 . S:GMTSP=1 X=$TR($E(X,GMTSP),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")_$E(X,(GMTSP+1),$L(X)) Q:GMTSP=1
151 . S:" /-,"[$E(X,(GMTSP-1)) X=$E(X,1,(GMTSP-1))_$TR($E(X,GMTSP),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")_$E(X,(GMTSP+1),$L(X))
152 Q X
153DTM(X) ; Current Date and Time
154 S X=$$NOW^XLFDT D REGDTM4^GMTSU Q X
155FN(X,Y) ; Format Number
156 N GMTSV S X=$G(X),GMTSV=+($G(X)),Y=$G(Y) S:+Y=Y X=$FN(GMTSV,"",+Y) Q X
157LN(X) ; Dashed Line
158 S X=+($G(X)) Q:X=0 "" N GMTSLN S GMTSLN="",$P(GMTSLN,"-",X)="-" S X=GMTSLN Q X
159EDT(X) ; External Date and Time
160 S X=$G(X) Q:'$L(X) ""
161 D REGDTM4^GMTSU Q X
Note: See TracBrowser for help on using the repository browser.