GMRVDS1 ;HIRMFO/YH-CURRENT VITAL SIGNS BY LOCATION ;2/3/99
;;4.0;Vitals/Measurements;**7**;Apr 25, 1997
EN1 ; ENTRY FROM OPTION GMRV V/M BY LOCATION
S GMROUT=0,GMREDB="A" D WARDSEL^GMRVED0 G:GMROUT Q1
PAT ;ENTRY POINT FOR REPORT BY PATIENT
DEV S %ZIS="Q" D ^%ZIS G:POP Q1 I $E(IOST)="P",'$D(IO("Q")),'$D(IO("S")) D ^%ZISC W !,?3,$C(7),"PRINTED REPORTS MUST QUEUED" G DEV
I $D(IO("Q")) S ZTIO=ION,ZTRTN="EN2^GMRVDS1",(ZTSAVE("DFN"),ZTSAVE("GMRWARD("),ZTSAVE("GMROUT"),ZTSAVE("GMREDB"),ZTSAVE("GMRVHLOC"))="",ZTDESC="Latest Vital/Measurements Report" D ^%ZTLOAD K ZTSK,IO("Q"),ZTIO Q
EN2 ;ENTRY TO REPORT FROM TASKMAN
K ^TMP($J) S GMROUT=0
I $G(GMREDB)="P" D
. D DEM^VADPT,INP^VADPT S GMRRMBD=$S(VAIN(5)'="":VAIN(5),1:" BLANK"),GMRNAM=$S(VADM(1)'="":VADM(1),1:" BLANK"),GMRWARD=$P(VAIN(4),"^"),GMRWARD(1)=$P(VAIN(4),"^",2) D KVAR^VADPT K VA
. S ^TMP($J,GMRRMBD,GMRNAM,DFN)=""
E D EN1^GMRVED2
AE D NOW^%DTC S Y=% X ^DD("DD") S $P(GMRDSH,"-",81)="",GMRPDT=$P(Y,"@")_" ("_$P($P(Y,"@",2),":",1,2)_")",GMRPG=0,GMR1ST=1,GMRSTR="T;P;R;BP;WT;HT;CVP;CG;PO2;PN",GLOC=1
U IO I $O(^TMP($J,""))="" D HDR W !,"THERE IS NO DATA FOR THIS REPORT" G Q1
S GMRRMBD="" F S GMRRMBD=$O(^TMP($J,GMRRMBD)) Q:GMRRMBD=""!GMROUT S GMRNAM="" F S GMRNAM=$O(^TMP($J,GMRRMBD,GMRNAM)) Q:GMRNAM=""!GMROUT F DFN=0:0 S DFN=$O(^TMP($J,GMRRMBD,GMRNAM,DFN)) Q:DFN'>0 D PRT Q:GMROUT
Q1 I $D(GMROUT),$E(IOST)'="P",'GMROUT R !,"Press return to continue ",X:DTIME W @IOF
S:$D(ZTQUEUED) ZTREQ="@" K ^TMP($J),DFN,GMR1ST,GMRADM,GMRDA,GMRDSH,GMREDB,GMRNAM,GMRNAME,GMRNM,GMROUT,GMRPDT,GMRPG,GMRRMBD,GMRPR,GMRVDT,GMRVTDA,GMRWARD,GMRX,GMRSITE,GMRSP,GMRVX,GMRVHLOC,POP,GMRDT,%T,GDT D KVAR^VADPT K VA W:$E(IOST)'="C" @IOF
K GSTRIN,GMRSTR,GMROUT,GMRVOERR,GMRVSTOP,GMRVSTRT,GLOC,GDATA D ^%ZISC,Q^GMRVDS0 Q
HDR ;
I $E(IOST)'="P",'GMR1ST W !!,"Press return to continue or ""^"" to quit " R X:DTIME I X=U!'$T S GMROUT=1 Q
W:'($E(IOST)'="C"&'GMRPG) @IOF S GMR1ST=0,GMRPG=GMRPG+1
I GMREDB="A" W !,GMRPDT,?20,"VITALS REPORT FOR UNIT: "_GMRWARD(1) W:GMRVHLOC>0 " - "_$$GET1^DIQ(4,+$$GET1^DIQ(44,+GMRVHLOC,3,"I"),.01,"I")
I GMREDB="P" W !,GMRPDT,?28,"LATEST VITALS REPORT"
W ?72,"PAGE ",GMRPG,!,GMRDSH,!
Q
PRT ;
D:IOSL<($Y+6)!($E(IOST)'="P")!(GMRPG=0) HDR Q:GMROUT
D DEM^VADPT K GMRDT
W !,$S(GMRRMBD'=" BLANK":$E(GMRRMBD,1,10),1:""),?12,$E(GMRNAM,1,20),?34,$P(VADM(2),U,2),!
D EN1^GMRVDS0 D Q2 Q
EN3 ; ENTRY TO PRINT VITALS FOR LOCATION GROUP
; INPUT : ^TMP($J,ROOM-BED,PATIENT NAME,DFN)=""
; ARRAY OF PATIENTS TO BE PRINTED WHERE
; ROOM-BED: PATIENT ROOM-BED
; PATIENT NAME: PATIENT NAME
; DFN: POINTER ^DPT
; GMRVWLO=NAME OF LOCATION GROUP
Q:'$D(GMRVWLO) S GMREDB="A"
S GMROUT=0,GMRWARD(1)=GMRVWLO D AE
K GMRVWLO
Q
WRT I $D(GLOC)&(IOSL<($Y+6)) D WRT2
W !,?GMRSP,$P(GMRL,"^",2) D:GSITE'=0!(GQUAL'=0) PRTSITE Q
WRT2 D HDR^GMRVDS1 W !,$S(GMRRMBD'=" BLANK":$E(GMRRMBD,1,10),1:""),?12,$E(GMRNAM,1,20),?34,$P(VADM(2),U,2)_" (cont.)" Q
PRTSITE W " ("_$S($D(^GMRD(120.52,GSITE,0)):$P(^(0),"^"),1:"")_$S(GSITE>0&(GQUAL>0):"/",1:"")_$S($D(^GMRD(120.53,GQUAL,0)):$P(^(0),"^"),1:"")_")" Q
Q2 ;
K GMRLIN,GMRJ,GBP,GMR,GMRL,GMRDT,GMRDAT,GMRDATS,GMRI,GMRX,GMRY,GMRVX,GSITE,GQUAL Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRVDS1 3330 printed Dec 13, 2024@01:56:10 Page 2
GMRVDS1 ;HIRMFO/YH-CURRENT VITAL SIGNS BY LOCATION ;2/3/99
+1 ;;4.0;Vitals/Measurements;**7**;Apr 25, 1997
EN1 ; ENTRY FROM OPTION GMRV V/M BY LOCATION
+1 SET GMROUT=0
SET GMREDB="A"
DO WARDSEL^GMRVED0
if GMROUT
GOTO Q1
PAT ;ENTRY POINT FOR REPORT BY PATIENT
DEV SET %ZIS="Q"
DO ^%ZIS
if POP
GOTO Q1
IF $EXTRACT(IOST)="P"
IF '$DATA(IO("Q"))
IF '$DATA(IO("S"))
DO ^%ZISC
WRITE !,?3,$CHAR(7),"PRINTED REPORTS MUST QUEUED"
GOTO DEV
+1 IF $DATA(IO("Q"))
SET ZTIO=ION
SET ZTRTN="EN2^GMRVDS1"
SET (ZTSAVE("DFN"),ZTSAVE("GMRWARD("),ZTSAVE("GMROUT"),ZTSAVE("GMREDB"),ZTSAVE("GMRVHLOC"))=""
SET ZTDESC="Latest Vital/Measurements Report"
DO ^%ZTLOAD
KILL ZTSK,IO("Q"),ZTIO
QUIT
EN2 ;ENTRY TO REPORT FROM TASKMAN
+1 KILL ^TMP($JOB)
SET GMROUT=0
+2 IF $GET(GMREDB)="P"
Begin DoDot:1
+3 DO DEM^VADPT
DO INP^VADPT
SET GMRRMBD=$SELECT(VAIN(5)'="":VAIN(5),1:" BLANK")
SET GMRNAM=$SELECT(VADM(1)'="":VADM(1),1:" BLANK")
SET GMRWARD=$PIECE(VAIN(4),"^")
SET GMRWARD(1)=$PIECE(VAIN(4),"^",2)
DO KVAR^VADPT
KILL VA
+4 SET ^TMP($JOB,GMRRMBD,GMRNAM,DFN)=""
End DoDot:1
+5 IF '$TEST
DO EN1^GMRVED2
AE DO NOW^%DTC
SET Y=%
XECUTE ^DD("DD")
SET $PIECE(GMRDSH,"-",81)=""
SET GMRPDT=$PIECE(Y,"@")_" ("_$PIECE($PIECE(Y,"@",2),":",1,2)_")"
SET GMRPG=0
SET GMR1ST=1
SET GMRSTR="T;P;R;BP;WT;HT;CVP;CG;PO2;PN"
SET GLOC=1
+1 USE IO
IF $ORDER(^TMP($JOB,""))=""
DO HDR
WRITE !,"THERE IS NO DATA FOR THIS REPORT"
GOTO Q1
+2 SET GMRRMBD=""
FOR
SET GMRRMBD=$ORDER(^TMP($JOB,GMRRMBD))
if GMRRMBD=""!GMROUT
QUIT
SET GMRNAM=""
FOR
SET GMRNAM=$ORDER(^TMP($JOB,GMRRMBD,GMRNAM))
if GMRNAM=""!GMROUT
QUIT
FOR DFN=0:0
SET DFN=$ORDER(^TMP($JOB,GMRRMBD,GMRNAM,DFN))
if DFN'>0
QUIT
DO PRT
if GMROUT
QUIT
Q1 IF $DATA(GMROUT)
IF $EXTRACT(IOST)'="P"
IF 'GMROUT
READ !,"Press return to continue ",X:DTIME
WRITE @IOF
+1 if $DATA(ZTQUEUED)
SET ZTREQ="@"
KILL ^TMP($JOB),DFN,GMR1ST,GMRADM,GMRDA,GMRDSH,GMREDB,GMRNAM,GMRNAME,GMRNM,GMROUT,GMRPDT,GMRPG,GMRRMBD,GMRPR,GMRVDT,GMRVTDA,GMRWARD,GMRX,GMRSITE,GMRSP,GMRVX,GMRVHLOC,POP,GMRDT,%T,GDT
DO KVAR^VADPT
KILL VA
if $EXTRACT(IOST)'="C"
WRITE @IOF
+2 KILL GSTRIN,GMRSTR,GMROUT,GMRVOERR,GMRVSTOP,GMRVSTRT,GLOC,GDATA
DO ^%ZISC
DO Q^GMRVDS0
QUIT
HDR ;
+1 IF $EXTRACT(IOST)'="P"
IF 'GMR1ST
WRITE !!,"Press return to continue or ""^"" to quit "
READ X:DTIME
IF X=U!'$TEST
SET GMROUT=1
QUIT
+2 if '($EXTRACT(IOST)'="C"&'GMRPG)
WRITE @IOF
SET GMR1ST=0
SET GMRPG=GMRPG+1
+3 IF GMREDB="A"
WRITE !,GMRPDT,?20,"VITALS REPORT FOR UNIT: "_GMRWARD(1)
if GMRVHLOC>0
WRITE " - "_$$GET1^DIQ(4,+$$GET1^DIQ(44,+GMRVHLOC,3,"I"),.01,"I")
+4 IF GMREDB="P"
WRITE !,GMRPDT,?28,"LATEST VITALS REPORT"
+5 WRITE ?72,"PAGE ",GMRPG,!,GMRDSH,!
+6 QUIT
PRT ;
+1 if IOSL<($Y+6)!($EXTRACT(IOST)'="P")!(GMRPG=0)
DO HDR
if GMROUT
QUIT
+2 DO DEM^VADPT
KILL GMRDT
+3 WRITE !,$SELECT(GMRRMBD'=" BLANK":$EXTRACT(GMRRMBD,1,10),1:""),?12,$EXTRACT(GMRNAM,1,20),?34,$PIECE(VADM(2),U,2),!
+4 DO EN1^GMRVDS0
DO Q2
QUIT
EN3 ; ENTRY TO PRINT VITALS FOR LOCATION GROUP
+1 ; INPUT : ^TMP($J,ROOM-BED,PATIENT NAME,DFN)=""
+2 ; ARRAY OF PATIENTS TO BE PRINTED WHERE
+3 ; ROOM-BED: PATIENT ROOM-BED
+4 ; PATIENT NAME: PATIENT NAME
+5 ; DFN: POINTER ^DPT
+6 ; GMRVWLO=NAME OF LOCATION GROUP
+7 if '$DATA(GMRVWLO)
QUIT
SET GMREDB="A"
+8 SET GMROUT=0
SET GMRWARD(1)=GMRVWLO
DO AE
+9 KILL GMRVWLO
+10 QUIT
WRT IF $DATA(GLOC)&(IOSL<($Y+6))
DO WRT2
+1 WRITE !,?GMRSP,$PIECE(GMRL,"^",2)
if GSITE'=0!(GQUAL'=0)
DO PRTSITE
QUIT
WRT2 DO HDR^GMRVDS1
WRITE !,$SELECT(GMRRMBD'=" BLANK":$EXTRACT(GMRRMBD,1,10),1:""),?12,$EXTRACT(GMRNAM,1,20),?34,$PIECE(VADM(2),U,2)_" (cont.)"
QUIT
PRTSITE WRITE " ("_$SELECT($DATA(^GMRD(120.52,GSITE,0)):$PIECE(^(0),"^"),1:"")_$SELECT(GSITE>0&(GQUAL>0):"/",1:"")_$SELECT($DATA(^GMRD(120.53,GQUAL,0)):$PIECE(^(0),"^"),1:"")_")"
QUIT
Q2 ;
+1 KILL GMRLIN,GMRJ,GBP,GMR,GMRL,GMRDT,GMRDAT,GMRDATS,GMRI,GMRX,GMRY,GMRVX,GSITE,GQUAL
QUIT
