- 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 Feb 18, 2025@23:22:32 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