source: FOIAVistA/tag/r/HEALTH_SUMMARY-GMTS/GMTSVSD.m@ 628

GMTSVSD ; SLC/KER - Vital Signs (Detailed)           ; 01/06/2003
 ;;2.7;Health Summary;**35,49,58,78**;Oct 20, 1995
 ;                          
 ; 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="No Response"
 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