source: WorldVistAEHR/trunk/r/GEN_MED_REC_VITALS-GMRV/GMRVUT2.m@ 1093

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

initial load of WorldVistAEHR

File size: 3.7 KB
Line 
1GMRVUT2 ;HIRMFO/YH,RM,FT-ENTRY TO GATHER PATIENT VITAL/MEASURMENT DATA ;6/26/01 11:14
2 ;;4.0;Vitals/Measurements;**1,10,13**;Apr 25, 1997
3 ;
4 ; This routine uses the following IAs:
5 ; #1246 - WIN^DGPMDDCF (supported)
6 ;
7BP ;ENTRY TO GATHER PATIENT BLOOD PRESSURE/PULSE DATA
8 K ^UTILITY($J,GMRVSTR("T")) S (GDT,GMRVSTR("TMO"))=0,GMRVSTR("R")=GMRVSTR("B") F S GMRVSTR("R")=$O(^GMR(120.5,"AA",DFN,GMRVSTR("TDA"),GMRVSTR("R"))) Q:GMRVSTR("R")>GMRVSTR("E")!(GMRVSTR("R")'>0) D Q:GMRVSTR("TMO")
9 . S GMRVSTR("IEN")=0 F S GMRVSTR("IEN")=$O(^GMR(120.5,"AA",DFN,GMRVSTR("TDA"),GMRVSTR("R"),GMRVSTR("IEN"))) Q:GMRVSTR("IEN")'>0 I '$P($G(^GMR(120.5,+GMRVSTR("IEN"),2)),"^"),$P($G(^GMR(120.5,+GMRVSTR("IEN"),0)),"^",8)>0 D
10 . . S GDT(1)=9999999-$$STRIP100(9999999-GMRVSTR("R")) I GDT'=GDT(1) S GDT=GDT(1),GMRVSTR("O")=$G(GMRVSTR("O"))+1
11 . . I GMRVSTR("O")>$P(GMRVSTR(0),"^",3) S GMRVSTR("TMO")=1 Q
12 . . S ^UTILITY($J,GMRVSTR("T"),GDT,GMRVSTR("IEN"))=""
13 S GMRVSTR("R")=0 F S GMRVSTR("R")=$O(^UTILITY($J,GMRVSTR("T"),GMRVSTR("R"))) Q:GMRVSTR("R")'>0 F GMRVSTR("IEN")=0:0 S GMRVSTR("IEN")=$O(^UTILITY($J,GMRVSTR("T"),GMRVSTR("R"),GMRVSTR("IEN"))) Q:GMRVSTR("IEN")'>0 D SETU2
14 K ^UTILITY($J,GMRVSTR("T")),GDT
15 Q
16STRIP100(DATE) ; This procedure takes DATE and returns that date with
17 ; any fractional seconds stripped off.
18 Q +($P(DATE,".")_+$E("."_$P(DATE,".",2),1,7))
19SETU2 ; Given the IEN of entry GMRVSTR("IEN") this procedure will set the
20 ; extract global.
21 S GDATA=$P($G(^GMR(120.5,+GMRVSTR("IEN"),0))_"^^^^^^^^^^^^^","^",1,17)
22 I GMRVSTR("T")'="CVP",$P(GDATA,"^",8)="" Q
23 I GMRVSTR("T")="CVP",+$P(GDATA,"^",8)=0,$E($P(GDATA,"^",8))'="0" Q
24 S (GMRINF(1),GMRINF(2))="",GMRINF=$P(GDATA,"^",10)
25 I GMRINF'="" D PO2^GMRVLGQU(.GMRINF) S $P(GDATA,"^",15)=GMRINF(1),$P(GDATA,"^",16)=GMRINF(2)
26 I $L($G(GMRVSTR("LT"))) Q:$P(GDATA,"^",5)'>0 Q:GMRVSTR("LT")'[("^"_$$GET1^DIQ(44,$P(GDATA,"^",5)_",",2,"I")_"^")
27 I GMRVSTR("T")'="BP",GMRVSTR("T")'="P" S GMRVSTR("O")=$G(GMRVSTR("O"))+1,GMRVSTR("TMO")=$S('$P(GMRVSTR(0),"^",3):0,GMRVSTR("O")<$P(GMRVSTR(0),"^",3):0,1:1)
28 S GMRVX=GMRVSTR("T"),GMRVX(0)=$P(GDATA,"^",8) D:GMRVX(0)>0 EN1^GMRVSAS0 S $P(GDATA,"^",12)=$S($G(GMRVX(1))>0:"*",1:"")
29 S X=GMRVX(0) I X>0 D EN1^GMRVUTL:GMRVSTR("T")="T",EN2^GMRVUTL:GMRVSTR("T")="HT",EN3^GMRVUTL:GMRVSTR("T")="WT" S:GMRVSTR("T")="T"!(GMRVSTR("T")="HT")!(GMRVSTR("T")="WT") $P(GDATA,"^",13)=$S($D(Y):Y,1:"")
30 I GMRVSTR("T")="CG" S $P(GDATA,"^",13)=$J(GMRVX(0)/.3937,0,2)
31 I GMRVSTR("T")="CVP" S $P(GDATA,"^",13)=$J(GMRVX(0)/1.36,0,1)
32 I GMRVSTR("T")="WT",$G(Y)>0 S GMRBMI="",GMRBMI(1)=$P(GDATA,"^"),GMRBMI(2)=+$P(GDATA,"^",8) D CALBMI^GMRVBMI(.GMRBMI) S $P(GDATA,"^",14)=GMRBMI K GMRBMI
33 S (GMRSITE,GMRQUAL)="" D QUALIFY
34 S $P(GDATA,"^",10)=GMRSITE,$P(GDATA,"^",11)=GMRQUAL,$P(GDATA,"^",17)=$G(GG)
35 S ^UTILITY($J,"GMRVD",$S('$P(GMRVSTR(0),"^",4):GMRVSTR("T"),1:GMRVSTR("R")),$S('$P(GMRVSTR(0),"^",4):GMRVSTR("R"),1:GMRVSTR("T")),GMRVSTR("IEN"))=$$STRIP100($P(GDATA,"^"))_"^"_$P(GDATA,"^",2,99)
36 Q
37INACT42(GMWLOC) ; THIS PROCEDURE WILL CALL SUPPORTED ENTRY POINT WIN^DGPMDDCF
38 ; TO DETERMINE IF WARD LOCATION (GMWLOC) IS INACTIVE.
39 N X,D0,DGPMOS
40 S D0=GMWLOC D WIN^DGPMDDCF
41 Q X
42QUALIFY ;OBTAIN QUALIFIERS FOR VITAL MEASUREMENT
43 K GMRVARY S GMRVARY=""
44 I $P($G(^GMR(120.5,+GMRVSTR("IEN"),5,0)),"^",4)>0 D CHAR^GMRVCHAR(+GMRVSTR("IEN"),.GMRVARY,GMRVSTR("TDA")) S GMRSITE=$O(GMRVARY(+GMRVSTR("IEN"),1,"")),GMRQUAL=$O(GMRVARY(+GMRVSTR("IEN"),2,""))
45 K GG S GG="" I $O(GMRVARY(0)) D
46 . S GG(1)=0 F S GG(1)=$O(GMRVARY(GG(1))) Q:GG(1)'>0 S GG(2)=0 F S GG(2)=$O(GMRVARY(GG(1),GG(2))) Q:GG(2)'>0 S GG(3)="" F S GG(3)=$O(GMRVARY(GG(1),GG(2),GG(3))) Q:GG(3)="" S GG=GG_$S(GG="":"",1:";")_GG(3)
47 I GMRVSTR("T")'="P" Q
48 I GMRSITE="" S GMRSITE=GMRQUAL,GMRQUAL="" Q
49 I GMRQUAL="" Q
50 S GMRSITE=GMRSITE_" "_GMRQUAL,GMRQUAL=""
51 Q
Note: See TracBrowser for help on using the repository browser.