- GMRVUT2 ;HIOFO/YH,RM,FT-ENTRY TO GATHER PATIENT VITAL/MEASURMENT DATA ;10/3/07
- ;;5.0;GEN. MED. REC. - VITALS;**23**;Oct 31, 2002;Build 25
- ;
- ; This routine uses the following IAs:
- ; #1246 - WIN^DGPMDDCF (supported)
- ; #4290 - ^PXRMINDX global (controlled)
- ; #10040 - FILE 44 references (supported)
- ;
- BP ;ENTRY TO GATHER PATIENT BLOOD PRESSURE/PULSE DATA
- N GMVCLIO
- K ^UTILITY($J,GMRVSTR("T"))
- S (GDT,GMRVSTR("TMO"))=0,GMRVSTR("R")=GMRVSTR("E")
- F S GMRVSTR("R")=$O(^PXRMINDX(120.5,"PI",DFN,GMRVSTR("TDA"),GMRVSTR("R")),-1) Q:GMRVSTR("R")<GMRVSTR("B")!(GMRVSTR("R")'>0) D Q:GMRVSTR("TMO")
- .S GMRVSTR("IEN")=0
- .F S GMRVSTR("IEN")=$O(^PXRMINDX(120.5,"PI",DFN,GMRVSTR("TDA"),GMRVSTR("R"),GMRVSTR("IEN"))) Q:$L(GMRVSTR("IEN"))'>0 D
- ..S GDT(1)=9999999-$$STRIP100(9999999-GMRVSTR("R")) I GDT'=GDT(1) S GDT=GDT(1),GMRVSTR("O")=$G(GMRVSTR("O"))+1
- ..I GMRVSTR("O")>$P(GMRVSTR(0),"^",3) S GMRVSTR("TMO")=1 Q
- ..S ^UTILITY($J,GMRVSTR("T"),GDT,GMRVSTR("IEN"))=""
- ..Q
- .Q
- S GMRVSTR("R")=0
- F S GMRVSTR("R")=$O(^UTILITY($J,GMRVSTR("T"),GMRVSTR("R"))) Q:GMRVSTR("R")'>0 S GMRVSTR("IEN")=0 F S GMRVSTR("IEN")=$O(^UTILITY($J,GMRVSTR("T"),GMRVSTR("R"),GMRVSTR("IEN"))) Q:$L(GMRVSTR("IEN"))'>0 D
- .I GMRVSTR("IEN")=+GMRVSTR("IEN") D
- ..D F1205^GMVUTL(.GMVCLIO,GMRVSTR("IEN"))
- ..Q
- .I GMRVSTR("IEN")'=+GMRVSTR("IEN") D
- ..D CLIO^GMVUTL(.GMVCLIO,GMRVSTR("IEN"))
- ..Q
- .S GMVCLIO(0)=$G(GMVCLIO(0)),GMVCLIO(5)=$G(GMVCLIO(5))
- .I GMVCLIO(0)=""!($P(GMVCLIO(0),U,8)="") Q
- .D SETU2
- .Q
- K ^UTILITY($J,GMRVSTR("T")),GDT
- Q
- STRIP100(DATE) ; This procedure takes DATE and returns that date with
- ; any fractional seconds stripped off.
- Q +($P(DATE,".")_+$E("."_$P(DATE,".",2),1,7))
- ;
- SETU2 ; Given the IEN of entry GMRVSTR("IEN") this procedure will set the
- ; extract global. <<< IA 1447 - NURSING >>>
- N GG,GMVLOOP,GMVQNAME,GMVRECORDID
- S GDATA=$P($G(GMVCLIO(0))_"^^^^^^^^^^^^^","^",1,17)
- S GMRVX(1)=0 ; fix for Remedy 116911
- I GMRVSTR("T")'="CVP",$P(GDATA,"^",8)="" Q
- I GMRVSTR("T")="CVP",+$P(GDATA,"^",8)=0,$E($P(GDATA,"^",8))'="0" Q
- S (GMRINF(1),GMRINF(2))="",GMRINF=$P(GDATA,"^",10)
- I GMRINF'="" D PO2^GMRVLGQU(.GMRINF) S $P(GDATA,"^",15)=GMRINF(1),$P(GDATA,"^",16)=GMRINF(2)
- I $L($G(GMRVSTR("LT"))) Q:$P(GDATA,"^",5)'>0 Q:GMRVSTR("LT")'[("^"_$$GET1^DIQ(44,$P(GDATA,"^",5)_",",2,"I")_"^")
- 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)
- 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:"")
- 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:"")
- I GMRVSTR("T")="CG" S $P(GDATA,"^",13)=$J(GMRVX(0)/.3937,0,2)
- I GMRVSTR("T")="CVP" S $P(GDATA,"^",13)=$J(GMRVX(0)/1.36,0,1)
- 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
- S (GG,GMRSITE,GMRQUAL)=""
- F GMVLOOP=1:1 Q:$P(GMVCLIO(5),U,GMVLOOP)="" D
- .S GMVQNAME=$$FIELD^GMVGETQL($P(GMVCLIO(5),U,GMVLOOP),1,"E")
- .I GMVQNAME=""!(GMVQNAME=-1) Q
- .S GG=GG_$S(GG="":"",1:";")_GMVQNAME
- .Q
- S GMRSITE=$P(GG,";",1),GMRQUAL=$P(GG,";",2)
- S $P(GDATA,"^",10)=GMRSITE,$P(GDATA,"^",11)=GMRQUAL,$P(GDATA,"^",17)=$G(GG)
- S GMVRECORDID=GMRVSTR("IEN")
- I GMRVSTR("IEN")'=+GMRVSTR("IEN") D
- .S GMVIENGUID=GMVIENGUID+1
- .S GMVRECORDID=GMVIENGUID
- S ^UTILITY($J,"GMRVD",$S('$P(GMRVSTR(0),"^",4):GMRVSTR("T"),1:9999999-GMRVSTR("R")),$S('$P(GMRVSTR(0),"^",4):9999999-GMRVSTR("R"),1:GMRVSTR("T")),GMVRECORDID)=$$STRIP100($P(GDATA,"^"))_"^"_$P(GDATA,"^",2,99)
- Q
- INACT42(GMWLOC) ; THIS PROCEDURE WILL CALL SUPPORTED ENTRY POINT WIN^DGPMDDCF
- ; TO DETERMINE IF WARD LOCATION (GMWLOC) IS INACTIVE.
- N X,D0,DGPMOS
- S D0=GMWLOC D WIN^DGPMDDCF
- Q X
- ;QUALIFY ;OBTAIN QUALIFIERS FOR VITAL MEASUREMENT <<< CALLED FROM SETU2 ABOVE>>
- ;K GMRVARY S GMRVARY=""
- ;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,""))
- ;K GG S GG="" I $O(GMRVARY(0)) D
- ;. 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)
- ;I GMRVSTR("T")'="P" Q
- ;I GMRSITE="" S GMRSITE=GMRQUAL,GMRQUAL="" Q
- ;I GMRQUAL="" Q
- ;S GMRSITE=GMRSITE_" "_GMRQUAL,GMRQUAL=""
- ;Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRVUT2 4686 printed Feb 18, 2025@23:24:01 Page 2
- GMRVUT2 ;HIOFO/YH,RM,FT-ENTRY TO GATHER PATIENT VITAL/MEASURMENT DATA ;10/3/07
- +1 ;;5.0;GEN. MED. REC. - VITALS;**23**;Oct 31, 2002;Build 25
- +2 ;
- +3 ; This routine uses the following IAs:
- +4 ; #1246 - WIN^DGPMDDCF (supported)
- +5 ; #4290 - ^PXRMINDX global (controlled)
- +6 ; #10040 - FILE 44 references (supported)
- +7 ;
- BP ;ENTRY TO GATHER PATIENT BLOOD PRESSURE/PULSE DATA
- +1 NEW GMVCLIO
- +2 KILL ^UTILITY($JOB,GMRVSTR("T"))
- +3 SET (GDT,GMRVSTR("TMO"))=0
- SET GMRVSTR("R")=GMRVSTR("E")
- +4 FOR
- SET GMRVSTR("R")=$ORDER(^PXRMINDX(120.5,"PI",DFN,GMRVSTR("TDA"),GMRVSTR("R")),-1)
- if GMRVSTR("R")<GMRVSTR("B")!(GMRVSTR("R")'>0)
- QUIT
- Begin DoDot:1
- +5 SET GMRVSTR("IEN")=0
- +6 FOR
- SET GMRVSTR("IEN")=$ORDER(^PXRMINDX(120.5,"PI",DFN,GMRVSTR("TDA"),GMRVSTR("R"),GMRVSTR("IEN")))
- if $LENGTH(GMRVSTR("IEN"))'>0
- QUIT
- Begin DoDot:2
- +7 SET GDT(1)=9999999-$$STRIP100(9999999-GMRVSTR("R"))
- IF GDT'=GDT(1)
- SET GDT=GDT(1)
- SET GMRVSTR("O")=$GET(GMRVSTR("O"))+1
- +8 IF GMRVSTR("O")>$PIECE(GMRVSTR(0),"^",3)
- SET GMRVSTR("TMO")=1
- QUIT
- +9 SET ^UTILITY($JOB,GMRVSTR("T"),GDT,GMRVSTR("IEN"))=""
- +10 QUIT
- End DoDot:2
- +11 QUIT
- End DoDot:1
- if GMRVSTR("TMO")
- QUIT
- +12 SET GMRVSTR("R")=0
- +13 FOR
- SET GMRVSTR("R")=$ORDER(^UTILITY($JOB,GMRVSTR("T"),GMRVSTR("R")))
- if GMRVSTR("R")'>0
- QUIT
- SET GMRVSTR("IEN")=0
- FOR
- SET GMRVSTR("IEN")=$ORDER(^UTILITY($JOB,GMRVSTR("T"),GMRVSTR("R"),GMRVSTR("IEN")))
- if $LENGTH(GMRVSTR("IEN"))'>0
- QUIT
- Begin DoDot:1
- +14 IF GMRVSTR("IEN")=+GMRVSTR("IEN")
- Begin DoDot:2
- +15 DO F1205^GMVUTL(.GMVCLIO,GMRVSTR("IEN"))
- +16 QUIT
- End DoDot:2
- +17 IF GMRVSTR("IEN")'=+GMRVSTR("IEN")
- Begin DoDot:2
- +18 DO CLIO^GMVUTL(.GMVCLIO,GMRVSTR("IEN"))
- +19 QUIT
- End DoDot:2
- +20 SET GMVCLIO(0)=$GET(GMVCLIO(0))
- SET GMVCLIO(5)=$GET(GMVCLIO(5))
- +21 IF GMVCLIO(0)=""!($PIECE(GMVCLIO(0),U,8)="")
- QUIT
- +22 DO SETU2
- +23 QUIT
- End DoDot:1
- +24 KILL ^UTILITY($JOB,GMRVSTR("T")),GDT
- +25 QUIT
- STRIP100(DATE) ; This procedure takes DATE and returns that date with
- +1 ; any fractional seconds stripped off.
- +2 QUIT +($PIECE(DATE,".")_+$EXTRACT("."_$PIECE(DATE,".",2),1,7))
- +3 ;
- SETU2 ; Given the IEN of entry GMRVSTR("IEN") this procedure will set the
- +1 ; extract global. <<< IA 1447 - NURSING >>>
- +2 NEW GG,GMVLOOP,GMVQNAME,GMVRECORDID
- +3 SET GDATA=$PIECE($GET(GMVCLIO(0))_"^^^^^^^^^^^^^","^",1,17)
- +4 ; fix for Remedy 116911
- SET GMRVX(1)=0
- +5 IF GMRVSTR("T")'="CVP"
- IF $PIECE(GDATA,"^",8)=""
- QUIT
- +6 IF GMRVSTR("T")="CVP"
- IF +$PIECE(GDATA,"^",8)=0
- IF $EXTRACT($PIECE(GDATA,"^",8))'="0"
- QUIT
- +7 SET (GMRINF(1),GMRINF(2))=""
- SET GMRINF=$PIECE(GDATA,"^",10)
- +8 IF GMRINF'=""
- DO PO2^GMRVLGQU(.GMRINF)
- SET $PIECE(GDATA,"^",15)=GMRINF(1)
- SET $PIECE(GDATA,"^",16)=GMRINF(2)
- +9 IF $LENGTH($GET(GMRVSTR("LT")))
- if $PIECE(GDATA,"^",5)'>0
- QUIT
- if GMRVSTR("LT")'[("^"_$$GET1^DIQ(44,$PIECE(GDATA,"^",5)_",",2,"I")_"^")
- QUIT
- +10 IF GMRVSTR("T")'="BP"
- IF GMRVSTR("T")'="P"
- SET GMRVSTR("O")=$GET(GMRVSTR("O"))+1
- SET GMRVSTR("TMO")=$SELECT('$PIECE(GMRVSTR(0),"^",3):0,GMRVSTR("O")<$PIECE(GMRVSTR(0),"^",3):0,1:1)
- +11 SET GMRVX=GMRVSTR("T")
- SET GMRVX(0)=$PIECE(GDATA,"^",8)
- if GMRVX(0)>0
- DO EN1^GMRVSAS0
- SET $PIECE(GDATA,"^",12)=$SELECT($GET(GMRVX(1))>0:"*",1:"")
- +12 SET X=GMRVX(0)
- IF X>0
- if GMRVSTR("T")="T"
- DO EN1^GMRVUTL
- if GMRVSTR("T")="HT"
- DO EN2^GMRVUTL
- if GMRVSTR("T")="WT"
- DO EN3^GMRVUTL
- if GMRVSTR("T")="T"!(GMRVSTR("T")="HT")!(GMRVSTR("T")="WT")
- SET $PIECE(GDATA,"^",13)=$SELECT($DATA(Y):Y,1:"")
- +13 IF GMRVSTR("T")="CG"
- SET $PIECE(GDATA,"^",13)=$JUSTIFY(GMRVX(0)/.3937,0,2)
- +14 IF GMRVSTR("T")="CVP"
- SET $PIECE(GDATA,"^",13)=$JUSTIFY(GMRVX(0)/1.36,0,1)
- +15 IF GMRVSTR("T")="WT"
- IF $GET(Y)>0
- SET GMRBMI=""
- SET GMRBMI(1)=$PIECE(GDATA,"^")
- SET GMRBMI(2)=+$PIECE(GDATA,"^",8)
- DO CALBMI^GMRVBMI(.GMRBMI)
- SET $PIECE(GDATA,"^",14)=GMRBMI
- KILL GMRBMI
- +16 SET (GG,GMRSITE,GMRQUAL)=""
- +17 FOR GMVLOOP=1:1
- if $PIECE(GMVCLIO(5),U,GMVLOOP)=""
- QUIT
- Begin DoDot:1
- +18 SET GMVQNAME=$$FIELD^GMVGETQL($PIECE(GMVCLIO(5),U,GMVLOOP),1,"E")
- +19 IF GMVQNAME=""!(GMVQNAME=-1)
- QUIT
- +20 SET GG=GG_$SELECT(GG="":"",1:";")_GMVQNAME
- +21 QUIT
- End DoDot:1
- +22 SET GMRSITE=$PIECE(GG,";",1)
- SET GMRQUAL=$PIECE(GG,";",2)
- +23 SET $PIECE(GDATA,"^",10)=GMRSITE
- SET $PIECE(GDATA,"^",11)=GMRQUAL
- SET $PIECE(GDATA,"^",17)=$GET(GG)
- +24 SET GMVRECORDID=GMRVSTR("IEN")
- +25 IF GMRVSTR("IEN")'=+GMRVSTR("IEN")
- Begin DoDot:1
- +26 SET GMVIENGUID=GMVIENGUID+1
- +27 SET GMVRECORDID=GMVIENGUID
- End DoDot:1
- +28 SET ^UTILITY($JOB,"GMRVD",$SELECT('$PIECE(GMRVSTR(0),"^",4):GMRVSTR("T"),1:9999999-GMRVSTR("R")),$SELECT('$PIECE(GMRVSTR(0),"^",4):9999999-GMRVSTR("R"),1:GMRVSTR("T")),GMVRECORDID)=$$STRIP100($PIECE(GDATA,"^"))_"^"_$PIECE(GDATA,"^",2,99)
- +29 QUIT
- INACT42(GMWLOC) ; THIS PROCEDURE WILL CALL SUPPORTED ENTRY POINT WIN^DGPMDDCF
- +1 ; TO DETERMINE IF WARD LOCATION (GMWLOC) IS INACTIVE.
- +2 NEW X,D0,DGPMOS
- +3 SET D0=GMWLOC
- DO WIN^DGPMDDCF
- +4 QUIT X
- +5 ;QUALIFY ;OBTAIN QUALIFIERS FOR VITAL MEASUREMENT <<< CALLED FROM SETU2 ABOVE>>
- +6 ;K GMRVARY S GMRVARY=""
- +7 ;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,""))
- +8 ;K GG S GG="" I $O(GMRVARY(0)) D
- +9 ;. 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)
- +10 ;I GMRVSTR("T")'="P" Q
- +11 ;I GMRSITE="" S GMRSITE=GMRQUAL,GMRQUAL="" Q
- +12 ;I GMRQUAL="" Q
- +13 ;S GMRSITE=GMRSITE_" "_GMRQUAL,GMRQUAL=""
- +14 ;Q