- GMRVED4 ;HIRMFO/RM,YH-VITAL SIGNS SHORT FORM ;3/15/99 14:24
- ;;4.0;Vitals/Measurements;**1,7,11**;Apr 25, 1997
- DSPOV ; DISPLAY OLD VITALS ALREADY ENTERED FOR PATIENT AND SET GMRSTR(0)
- ; TO THE SUBSET OF GMRSTR THAT HASN'T BEEN ENTERED.
- K GMROV S (GLAST,GLAST(1))=0,GDT=GMRVIDT,GMRSTR(0)=";"_GMRSTR I $E(GMRSTR(0),$L(GMRSTR(0)))'=";" S GMRSTR(0)=GMRSTR(0)_";"
- S Y=0 F S Y=$O(^GMR(120.5,"AA",DFN,Y)) Q:Y'>0 I $D(^GMR(120.5,"AA",DFN,Y,9999999-GDT)) S X=0 F S X=$O(^GMR(120.5,"AA",DFN,Y,9999999-GDT,X)) Q:X'>0 I $S('$D(^GMR(120.5,X,2)):1,'$P(^(2),"^"):1,1:0) S GCT=0 D STOV
- I GMRSTR["BP",'$D(GMROV("BP")) S GTYPE="BP",GCT=0 D MULTIBP S:$D(GMROV(GTYPE)) GMRP=";"_GTYPE_";",GMRSTR(0)=$P(GMRSTR(0),GMRP)_";"_$P(GMRSTR(0),GMRP,2)
- I GMRSTR["P",'$D(GMROV("P")),GMRENTY=6 S GTYPE="P",GCT=0,GMRTYPE=$O(^GMRD(120.51,"C",GTYPE,0)) D MULTIBP S:$D(GMROV(GTYPE)) GMRP=";"_GTYPE_";",GMRSTR(0)=$P(GMRSTR(0),GMRP)_";"_$P(GMRSTR(0),GMRP,2)
- G:$O(GMROV(""))="" Q
- W !!,"The patient has data for this date/time for the following vital/measurements.",!,"To change this data, please use the Entered in Error Module.",!!
- F GMRX=1:1:$L(GMRSTR,";") S X=$P(GMRSTR,";",GMRX) Q:X="" I $D(GMROV(X)) S X(1)=0 F Y=0:0 S X(1)=$O(GMROV(X,X(1))) Q:X(1)'>0 D PROV
- Q S GMRVIDT=GDT W ! K X Q
- STOV ; STORE OLD VITALS FOR A PATIENT
- S GFLAG=0,GMROV=$S($D(^GMR(120.5,X,0)):^(0),1:""),GMRTYPE=+$P(GMROV,"^",3) I $D(^GMRD(120.51,GMRTYPE,0)) S GTYPE=$P(^(0),"^",2),GMRP=";"_GTYPE_";"
- I $S('$D(^GMRD(120.51,GMRTYPE,0)):0,";"_GMRSTR[GMRP:1,1:0) S GCT=GCT+1,GFLAG=1 S:GCT=1 GMRSTR(0)=$P(GMRSTR(0),GMRP)_";"_$P(GMRSTR(0),GMRP,2) D
- . K GMRVARY S GMRVARY="" D CHAR^GMRVCHAR(X,.GMRVARY,GMRTYPE) S GMRINF=$$WRITECH^GMRVCHAR(X,.GMRVARY,9) Q
- I GFLAG S GMROV(GTYPE,GCT)=$P(GMROV,"^",8) D
- .S GMROV(GTYPE,GCT)=GMROV(GTYPE,GCT)_"^"_$S(GMRINF'="":" "_GMRINF,1:"")_"^"_GMRVIDT
- .S:GTYPE="BP"!(GTYPE="P") GLAST(1)=1,GLAST=GMRVIDT D:GTYPE="BP"!(GTYPE="P") MULTIBP S GMRVIDT=GDT
- S GCT=0 K GFLAG Q
- PROV ; PRINT OUT OLD VITAL
- K GDATA S GMRVX=X,GMRVX(0)=$P(GMROV(X,X(1)),"^") G:GMRVX(0)'>0 PRT
- I GMRVX(0)>0 D EN1^GMRVSAS0 S X(2)=GMRVX(0)
- I X="T" S GMRVX(0)=GMRVX(0)_$S(GMRVX(0)>0:"F"_" ("_$J(X(2)-32*5/9,0,1)_"C)",1:"")
- I X="PN" D
- . I "UNAVAILABLEPASSREFUSED"[$$UP^XLFSTR(GMRVX(0)) Q
- . I GMRVX(0)=0 S GMRVX(0)="No pain " Q
- . I GMRVX(0)=99 S GMRVX(0)="Unable to respond "
- . I GMRVX(0)=10 S GMRVX(0)=GMRVX(0)_" - Worst imaginable pain " Q
- . Q
- I X="WT" S GMRVX(0)=GMRVX(0)_$S(GMRVX(0)>0:" lb"_" ("_$J(X(2)/2.2,0,2)_" kg)",1:"")
- I X="HT" S GMRVX(0)=(GMRVX(0)\12)_$S(GMRVX(0)>0:" ft "_$S(X(2)#12:X(2)#12_" in",1:"")_" ("_$J(X(2)*2.54,0,2)_" cm)",1:"")
- I X="CG" S GMRVX(0)=GMRVX(0)_$S(GMRVX(0)>0:" in ("_$J(X(2)/.3937,0,2)_" cm)",1:"")
- I X="CVP" S GMRVX(0)=GMRVX(0)_$S(GMRVX(0)>0:" cmH2O ("_$J(X(2)/1.36,0,0)_" mmHg)",1:"")
- I X="PO2" D
- .N GMRVPO S GMRVPO=$P(GMROV,"^",10)
- .S GMRVX(0)=$S(GMRVX(0)>0:"O2 sat. via oximetry "_GMRVX(0)_"%",1:"")_$S(GMRVPO'="":" with O2 "_$S(GMRVPO["l/min":$P(GMRVPO," l/min")_"L/min",1:"")_$S(GMRVPO["l/min":$P(GMRVPO," l/min",2),1:GMRVPO),1:"")_$S(GMRINF'="":" via",1:"")
- .Q
- PRT W:X(1)=1 !,?$X+2,$S(X="T":"Temp.",X="P":"Pulse",X="R":"Resp.",X="BP":"B/P",X="HT":"Ht.",X="WT":"Wt.",X="CG":"Circumference/Girth",X="PO2":"Pulse Oximetry",X="PN":"Pain",1:X),": "
- W:X(1)>1 !
- I X="P" D
- . I GMRINF'="",GMRVX(0)=1 S:$F(GMRINF,"DORSALIS PEDIS")>0 GMRVX(1)=""
- . I GMRINF'="",GMRVX(0)=0 S:$F(GMRINF,"DORSALIS PEDIS")>0 GMRVX(1)=1
- . Q
- S GDATA(1)=$P(GMROV(X,X(1)),"^",2),GDATA(2)=$P(GMROV(X,X(1)),"^",3)
- W:X="BP" ?8," " W:X="P" ?8,$S(X(1)>1:" ",1:"") W GMRVX(0),$S('$D(GMRVX(1)):"",'GMRVX(1):"",1:"*"),GDATA(1)
- K GDATA,GMRVX Q
- EXITACT ; VITAL OPTIONS EXIT ACTION
- K:'$L(GMRVFLAG) GMRVFLAG,GMRVDBA
- K G,GBLNK,GCAT,GCHA,GCHART,GCOL,GCOUNT,GCT,GDA,GDT,GENTR,GLAST,GLN,GMAX,GMRDAT,GMRENTR,GMRHELP,GMRINF,GMRINPTR,GMRLAST,GMRO2,GMRPRMT,GMRRET,GMRSCR,GMRSITE,GMRSTAR,GMRSTR
- K GMRV,GMRVDFLT,GMRVHLOC,GMRVIDT,GMRVIT,GMRVITY,GMRVLST,GMRVODR,GMRVWLOC,GMRW,GMRWARD,GMRX,GMRY,GORDER,GQUAL,GREASON,GSIDE,GTXT,GTYPE
- Q
- ENTACT ; NURSING VITAL OPTIONS ENTRY ACTION
- S:'$D(GMRVFLAG) GMRVFLAG=2 I GMRVFLAG S GMRVFLAG=$S(GMRVFLAG=1:0,1:""),GMROUT=0 D DATE^GMRVED0 S:'GMROUT GMRVDBA=GMROUT_"^"_GMRVIDT S:GMROUT XQUIT=1 K GMROUT,GMRVIDT
- Q
- MULTIBP ;DISPLAY MULTIPLE B/P
- Q:'$D(GMRTYPE) S GDATE=GDT S:'$D(GLAST) GLAST=0 S GDT(3)=9999999-(GDT+.00000001),GDT(2)=9999999-(GDT+.00000014) K GDATE
- F S GDT(2)=$O(^GMR(120.5,"AA",DFN,GMRTYPE,GDT(2))) Q:GDT(2)>GDT(3)!(GDT(2)="") S GDA=0 F S GDA=$O(^GMR(120.5,"AA",DFN,GMRTYPE,GDT(2),GDA)) Q:GDA'>0 I $D(^GMR(120.5,GDA,0)),'$D(^GMR(120.5,GDA,2)) S GMRVIDT=9999999-GDT(2) D
- .S GDATA=^GMR(120.5,GDA,0),(GLAST(1),GCT)=GCT+1
- .K GMRVARY S GMRVARY="" D CHAR^GMRVCHAR(GDA,.GMRVARY,GMRTYPE) S GMRINF=$$WRITECH^GMRVCHAR(GDA,.GMRVARY,9)
- .S GMROV(GTYPE,GCT)=$P(GDATA,"^",8)_"^"_$S(GMRINF'="":" "_GMRINF,1:"")_"^"_GMRVIDT
- .S:GMRVIDT>GLAST GLAST=GMRVIDT
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRVED4 4922 printed Jan 18, 2025@02:57:28 Page 2
- GMRVED4 ;HIRMFO/RM,YH-VITAL SIGNS SHORT FORM ;3/15/99 14:24
- +1 ;;4.0;Vitals/Measurements;**1,7,11**;Apr 25, 1997
- DSPOV ; DISPLAY OLD VITALS ALREADY ENTERED FOR PATIENT AND SET GMRSTR(0)
- +1 ; TO THE SUBSET OF GMRSTR THAT HASN'T BEEN ENTERED.
- +2 KILL GMROV
- SET (GLAST,GLAST(1))=0
- SET GDT=GMRVIDT
- SET GMRSTR(0)=";"_GMRSTR
- IF $EXTRACT(GMRSTR(0),$LENGTH(GMRSTR(0)))'=";"
- SET GMRSTR(0)=GMRSTR(0)_";"
- +3 SET Y=0
- FOR
- SET Y=$ORDER(^GMR(120.5,"AA",DFN,Y))
- if Y'>0
- QUIT
- IF $DATA(^GMR(120.5,"AA",DFN,Y,9999999-GDT))
- SET X=0
- FOR
- SET X=$ORDER(^GMR(120.5,"AA",DFN,Y,9999999-GDT,X))
- if X'>0
- QUIT
- IF $SELECT('$DATA(^GMR(120.5,X,2)):1,'$PIECE(^(2),"^"):1,1:0)
- SET GCT=0
- DO STOV
- +4 IF GMRSTR["BP"
- IF '$DATA(GMROV("BP"))
- SET GTYPE="BP"
- SET GCT=0
- DO MULTIBP
- if $DATA(GMROV(GTYPE))
- SET GMRP=";"_GTYPE_";"
- SET GMRSTR(0)=$PIECE(GMRSTR(0),GMRP)_";"_$PIECE(GMRSTR(0),GMRP,2)
- +5 IF GMRSTR["P"
- IF '$DATA(GMROV("P"))
- IF GMRENTY=6
- SET GTYPE="P"
- SET GCT=0
- SET GMRTYPE=$ORDER(^GMRD(120.51,"C",GTYPE,0))
- DO MULTIBP
- if $DATA(GMROV(GTYPE))
- SET GMRP=";"_GTYPE_";"
- SET GMRSTR(0)=$PIECE(GMRSTR(0),GMRP)_";"_$PIECE(GMRSTR(0),GMRP,2)
- +6 if $ORDER(GMROV(""))=""
- GOTO Q
- +7 WRITE !!,"The patient has data for this date/time for the following vital/measurements.",!,"To change this data, please use the Entered in Error Module.",!!
- +8 FOR GMRX=1:1:$LENGTH(GMRSTR,";")
- SET X=$PIECE(GMRSTR,";",GMRX)
- if X=""
- QUIT
- IF $DATA(GMROV(X))
- SET X(1)=0
- FOR Y=0:0
- SET X(1)=$ORDER(GMROV(X,X(1)))
- if X(1)'>0
- QUIT
- DO PROV
- Q SET GMRVIDT=GDT
- WRITE !
- KILL X
- QUIT
- STOV ; STORE OLD VITALS FOR A PATIENT
- +1 SET GFLAG=0
- SET GMROV=$SELECT($DATA(^GMR(120.5,X,0)):^(0),1:"")
- SET GMRTYPE=+$PIECE(GMROV,"^",3)
- IF $DATA(^GMRD(120.51,GMRTYPE,0))
- SET GTYPE=$PIECE(^(0),"^",2)
- SET GMRP=";"_GTYPE_";"
- +2 IF $SELECT('$DATA(^GMRD(120.51,GMRTYPE,0)):0,";"_GMRSTR[GMRP:1,1:0)
- SET GCT=GCT+1
- SET GFLAG=1
- if GCT=1
- SET GMRSTR(0)=$PIECE(GMRSTR(0),GMRP)_";"_$PIECE(GMRSTR(0),GMRP,2)
- Begin DoDot:1
- +3 KILL GMRVARY
- SET GMRVARY=""
- DO CHAR^GMRVCHAR(X,.GMRVARY,GMRTYPE)
- SET GMRINF=$$WRITECH^GMRVCHAR(X,.GMRVARY,9)
- QUIT
- End DoDot:1
- +4 IF GFLAG
- SET GMROV(GTYPE,GCT)=$PIECE(GMROV,"^",8)
- Begin DoDot:1
- +5 SET GMROV(GTYPE,GCT)=GMROV(GTYPE,GCT)_"^"_$SELECT(GMRINF'="":" "_GMRINF,1:"")_"^"_GMRVIDT
- +6 if GTYPE="BP"!(GTYPE="P")
- SET GLAST(1)=1
- SET GLAST=GMRVIDT
- if GTYPE="BP"!(GTYPE="P")
- DO MULTIBP
- SET GMRVIDT=GDT
- End DoDot:1
- +7 SET GCT=0
- KILL GFLAG
- QUIT
- PROV ; PRINT OUT OLD VITAL
- +1 KILL GDATA
- SET GMRVX=X
- SET GMRVX(0)=$PIECE(GMROV(X,X(1)),"^")
- if GMRVX(0)'>0
- GOTO PRT
- +2 IF GMRVX(0)>0
- DO EN1^GMRVSAS0
- SET X(2)=GMRVX(0)
- +3 IF X="T"
- SET GMRVX(0)=GMRVX(0)_$SELECT(GMRVX(0)>0:"F"_" ("_$JUSTIFY(X(2)-32*5/9,0,1)_"C)",1:"")
- +4 IF X="PN"
- Begin DoDot:1
- +5 IF "UNAVAILABLEPASSREFUSED"[$$UP^XLFSTR(GMRVX(0))
- QUIT
- +6 IF GMRVX(0)=0
- SET GMRVX(0)="No pain "
- QUIT
- +7 IF GMRVX(0)=99
- SET GMRVX(0)="Unable to respond "
- +8 IF GMRVX(0)=10
- SET GMRVX(0)=GMRVX(0)_" - Worst imaginable pain "
- QUIT
- +9 QUIT
- End DoDot:1
- +10 IF X="WT"
- SET GMRVX(0)=GMRVX(0)_$SELECT(GMRVX(0)>0:" lb"_" ("_$JUSTIFY(X(2)/2.2,0,2)_" kg)",1:"")
- +11 IF X="HT"
- SET GMRVX(0)=(GMRVX(0)\12)_$SELECT(GMRVX(0)>0:" ft "_$SELECT(X(2)#12:X(2)#12_" in",1:"")_" ("_$JUSTIFY(X(2)*2.54,0,2)_" cm)",1:"")
- +12 IF X="CG"
- SET GMRVX(0)=GMRVX(0)_$SELECT(GMRVX(0)>0:" in ("_$JUSTIFY(X(2)/.3937,0,2)_" cm)",1:"")
- +13 IF X="CVP"
- SET GMRVX(0)=GMRVX(0)_$SELECT(GMRVX(0)>0:" cmH2O ("_$JUSTIFY(X(2)/1.36,0,0)_" mmHg)",1:"")
- +14 IF X="PO2"
- Begin DoDot:1
- +15 NEW GMRVPO
- SET GMRVPO=$PIECE(GMROV,"^",10)
- +16 SET GMRVX(0)=$SELECT(GMRVX(0)>0:"O2 sat. via oximetry "_GMRVX(0)_"%",1:"")_$SELECT(GMRVPO'="":" with O2 "_$SELECT(GMRVPO["l/min":$PIECE(GMRVPO," l/min")_"L/min",1:"")_$SELECT(GMRVPO["l/min":...
- ... $PIECE(GMRVPO," l/min",2),1:GMRVPO),1:"")_$SELECT(GMRINF'="":" via",1:"")
- +17 QUIT
- End DoDot:1
- PRT if X(1)=1
- WRITE !,?$X+2,$SELECT(X="T":"Temp.",X="P":"Pulse",X="R":"Resp.",X="BP":"B/P",X="HT":"Ht.",X="WT":"Wt.",X="CG":"Circumference/Girth",X="PO2":"Pulse Oximetry",X="PN":"Pain",1:X),": "
- +1 if X(1)>1
- WRITE !
- +2 IF X="P"
- Begin DoDot:1
- +3 IF GMRINF'=""
- IF GMRVX(0)=1
- if $FIND(GMRINF,"DORSALIS PEDIS")>0
- SET GMRVX(1)=""
- +4 IF GMRINF'=""
- IF GMRVX(0)=0
- if $FIND(GMRINF,"DORSALIS PEDIS")>0
- SET GMRVX(1)=1
- +5 QUIT
- End DoDot:1
- +6 SET GDATA(1)=$PIECE(GMROV(X,X(1)),"^",2)
- SET GDATA(2)=$PIECE(GMROV(X,X(1)),"^",3)
- +7 if X="BP"
- WRITE ?8," "
- if X="P"
- WRITE ?8,$SELECT(X(1)>1:" ",1:"")
- WRITE GMRVX(0),$SELECT('$DATA(GMRVX(1)):"",'GMRVX(1):"",1:"*"),GDATA(1)
- +8 KILL GDATA,GMRVX
- QUIT
- EXITACT ; VITAL OPTIONS EXIT ACTION
- +1 if '$LENGTH(GMRVFLAG)
- KILL GMRVFLAG,GMRVDBA
- +2 KILL G,GBLNK,GCAT,GCHA,GCHART,GCOL,GCOUNT,GCT,GDA,GDT,GENTR,GLAST,GLN,GMAX,GMRDAT,GMRENTR,GMRHELP,GMRINF,GMRINPTR,GMRLAST,GMRO2,GMRPRMT,GMRRET,GMRSCR,GMRSITE,GMRSTAR,GMRSTR
- +3 KILL GMRV,GMRVDFLT,GMRVHLOC,GMRVIDT,GMRVIT,GMRVITY,GMRVLST,GMRVODR,GMRVWLOC,GMRW,GMRWARD,GMRX,GMRY,GORDER,GQUAL,GREASON,GSIDE,GTXT,GTYPE
- +4 QUIT
- ENTACT ; NURSING VITAL OPTIONS ENTRY ACTION
- +1 if '$DATA(GMRVFLAG)
- SET GMRVFLAG=2
- IF GMRVFLAG
- SET GMRVFLAG=$SELECT(GMRVFLAG=1:0,1:"")
- SET GMROUT=0
- DO DATE^GMRVED0
- if 'GMROUT
- SET GMRVDBA=GMROUT_"^"_GMRVIDT
- if GMROUT
- SET XQUIT=1
- KILL GMROUT,GMRVIDT
- +2 QUIT
- MULTIBP ;DISPLAY MULTIPLE B/P
- +1 if '$DATA(GMRTYPE)
- QUIT
- SET GDATE=GDT
- if '$DATA(GLAST)
- SET GLAST=0
- SET GDT(3)=9999999-(GDT+.00000001)
- SET GDT(2)=9999999-(GDT+.00000014)
- KILL GDATE
- +2 FOR
- SET GDT(2)=$ORDER(^GMR(120.5,"AA",DFN,GMRTYPE,GDT(2)))
- if GDT(2)>GDT(3)!(GDT(2)="")
- QUIT
- SET GDA=0
- FOR
- SET GDA=$ORDER(^GMR(120.5,"AA",DFN,GMRTYPE,GDT(2),GDA))
- if GDA'>0
- QUIT
- IF $DATA(^GMR(120.5,GDA,0))
- IF '$DATA(^GMR(120.5,GDA,2))
- SET GMRVIDT=9999999-GDT(2)
- Begin DoDot:1
- +3 SET GDATA=^GMR(120.5,GDA,0)
- SET (GLAST(1),GCT)=GCT+1
- +4 KILL GMRVARY
- SET GMRVARY=""
- DO CHAR^GMRVCHAR(GDA,.GMRVARY,GMRTYPE)
- SET GMRINF=$$WRITECH^GMRVCHAR(GDA,.GMRVARY,9)
- +5 SET GMROV(GTYPE,GCT)=$PIECE(GDATA,"^",8)_"^"_$SELECT(GMRINF'="":" "_GMRINF,1:"")_"^"_GMRVIDT
- +6 if GMRVIDT>GLAST
- SET GLAST=GMRVIDT
- End DoDot:1
- +7 QUIT