GMRVSC1 ;HIOFO/YH,FT-CUMULATIVE V/M - CONTINUED ;9/27/07
;;5.0;GEN. MED. REC. - VITALS;**23**;Oct 31, 2002;Build 25
;
; This routine uses the following IAs:
; #4290 - ^PXRMINDX global (controlled)
; #10061 - ^VADPT calls (supported)
;
EN1 ; ENTRY TO PRINT REPORT FROM TASKMAN
N GMVCLIO
K ^TMP($J,"GMRV"),GMRVDT S GMRVHT=0 S (GMROUT,GMRDATE(0))=0
F GMRVTY="T","P","R","BP","HT","WT","CVP","CG","PO2","PN" S GMRVITY=$O(^GMRD(120.51,"C",GMRVTY,0)) I GMRVITY>0 D SETAR,SETAR1
I $O(^TMP($J,"GMRV",0))'>0 W !,"THERE IS NO DATA FOR THIS REPORT" G QT
F GMRDATE=0:0 S GMRDATE=$O(GMRVDT(GMRDATE)) Q:GMRDATE'>0!GMROUT I $D(^TMP($J,"GMRV",GMRDATE)) D PRT Q:GMROUT
QT I IOSL'<($Y+10) F X=1:1 W ! Q:IOSL<($Y+10)
I 'GMROUT W ! D FOOTER^GMRVSC0
I $E(IOST)'="P",'GMROUT W "Press return to continue or ""^"" to escape " R X:DTIME S:'$T!(X["^") GMROUT=1
K ^TMP($J,"GMRV"),^TMP($J,"OTHR"),GOTHR,GMRV,GMRVDT Q
Q ; KILL VARIBLES
S:$D(ZTQUEUED) ZTREQ="@" K GMRZZ,GMRVARY
K GMRVER,GDATA,GMRST,GERROR,GERST,^TMP($J),GBED,GWARD,DFN,GX,GMR1ST,GMRDAT,GMRDATE,GMRDSH,GMRDT,GMRLN,GMRPDT,GMRSP,GMRVDA,GMRVITY,GMRX,GMRY,GMRVTY,GMRSITE,GMRVX,POP,DIPGM,%T,GMRQUAL,GMROUT,GMRPG,GFLAG D KVAR^VADPT K VA D ^%ZISC
Q
SETAR ;get clio records
S GMRDT=GMRVSDT-.000001
F S GMRDT=$O(^PXRMINDX(120.5,"PI",DFN,GMRVITY,GMRDT)) Q:GMRDT'>0!(GMRDT>GMRVFDT) S GMRDATE=GMRDT D SETND
Q
SETAR1 ; PXRMINDX index doesn't have entered-in-error records, so use AA x-ref
N GMRVSDT1,GMRVFDT1
S GMRDT=9999999-GMRVFDT,GMRVSDT1=9999999-GMRVSDT
S GMRDT=GMRDT-.000001,GMRVSDT1=GMRVSDT1+.000001
F S GMRDT=$O(^GMR(120.5,"AA",DFN,GMRVITY,GMRDT)) Q:GMRDT'>0!(GMRDT>GMRVSDT1) D SETND1
Q
SETND ;
S GMRVDA=0
F S GMRVDA=$O(^PXRMINDX(120.5,"PI",DFN,GMRVITY,GMRDT,GMRVDA)) Q:GMRVDA="" D
.Q:GMRVDA=+GMRVDA ;already got it SETND1
.I GMRVDA'=+GMRVDA D
..D CLIO^GMVUTL(.GMVCLIO,GMRVDA)
..S GMVCLIO(0)=$G(GMVCLIO(0)),GMVCLIO(2)=$G(GMVCLIO(2)),GMVCLIO(5)=$G(GMVCLIO(5))
..I GMVCLIO(0)=""!($P(GMVCLIO(0),U,8)="") Q
..D SETUT
..Q
.Q
Q
SETND1 ;
S GMRVDA=0
F S GMRVDA=$O(^GMR(120.5,"AA",DFN,GMRVITY,GMRDT,GMRVDA)) Q:GMRVDA="" D
.D F1205^GMVUTL(.GMVCLIO,GMRVDA,1)
.S GMVCLIO(0)=$G(GMVCLIO(0)),GMVCLIO(2)=$G(GMVCLIO(2)),GMVCLIO(5)=$G(GMVCLIO(5))
.I GMVCLIO(0)=""!($P(GMVCLIO(0),U,8)="") Q
.S GMRDATE=$P(GMVCLIO(0),U,1)
.D SETUT
.Q
Q
SETUT ;
S ^TMP($J,"GMRV",GMRDATE,GMRVTY,GMRVDA)=$S($P(GMVCLIO(2),U,1)'=1:0,1:+$P(GMVCLIO(2),U,1))_"|"_GMVCLIO(0)_"|"_GMVCLIO(5)
S GMRVDT(GMRDATE)=""
Q
PRT ;PRINT V/M BY DATE/TIME
D:IOSL<($Y+9) HDR^GMRVSC2 Q:GMROUT
S Y=GMRDATE X ^DD("DD") I $P(GMRDATE,".")'=GMRDATE(0) W !,$E(GMRDATE,4,5)_"/"_$E(GMRDATE,6,7)_"/"_$E(GMRDATE,2,3) S GMRDATE(0)=$P(GMRDATE,".")
D:IOSL<($Y+9) HDR^GMRVSC2 Q:GMROUT W !,$P($P(Y,"@",2),":",1,2)
I $D(^TMP($J,"GMRV",GMRDATE)) D
.K GMRLN,GERROR F GMRVTY="T","P","R","BP","HT","WT","CVP","CG","PO2","PN" S GPRT(GMRVTY)=0 I $D(^TMP($J,"GMRV",GMRDATE,GMRVTY)) S GMRVDA="" F GMRVDA=$O(^TMP($J,"GMRV",GMRDATE,GMRVTY,GMRVDA)) Q:$L(GMRVDA)'>0!GMROUT D SETLN^GMRVSC2
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRVSC1 3074 printed Oct 16, 2024@17:58:13 Page 2
GMRVSC1 ;HIOFO/YH,FT-CUMULATIVE V/M - CONTINUED ;9/27/07
+1 ;;5.0;GEN. MED. REC. - VITALS;**23**;Oct 31, 2002;Build 25
+2 ;
+3 ; This routine uses the following IAs:
+4 ; #4290 - ^PXRMINDX global (controlled)
+5 ; #10061 - ^VADPT calls (supported)
+6 ;
EN1 ; ENTRY TO PRINT REPORT FROM TASKMAN
+1 NEW GMVCLIO
+2 KILL ^TMP($JOB,"GMRV"),GMRVDT
SET GMRVHT=0
SET (GMROUT,GMRDATE(0))=0
+3 FOR GMRVTY="T","P","R","BP","HT","WT","CVP","CG","PO2","PN"
SET GMRVITY=$ORDER(^GMRD(120.51,"C",GMRVTY,0))
IF GMRVITY>0
DO SETAR
DO SETAR1
+4 IF $ORDER(^TMP($JOB,"GMRV",0))'>0
WRITE !,"THERE IS NO DATA FOR THIS REPORT"
GOTO QT
+5 FOR GMRDATE=0:0
SET GMRDATE=$ORDER(GMRVDT(GMRDATE))
if GMRDATE'>0!GMROUT
QUIT
IF $DATA(^TMP($JOB,"GMRV",GMRDATE))
DO PRT
if GMROUT
QUIT
QT IF IOSL'<($Y+10)
FOR X=1:1
WRITE !
if IOSL<($Y+10)
QUIT
+1 IF 'GMROUT
WRITE !
DO FOOTER^GMRVSC0
+2 IF $EXTRACT(IOST)'="P"
IF 'GMROUT
WRITE "Press return to continue or ""^"" to escape "
READ X:DTIME
if '$TEST!(X["^")
SET GMROUT=1
+3 KILL ^TMP($JOB,"GMRV"),^TMP($JOB,"OTHR"),GOTHR,GMRV,GMRVDT
QUIT
Q ; KILL VARIBLES
+1 if $DATA(ZTQUEUED)
SET ZTREQ="@"
KILL GMRZZ,GMRVARY
+2 KILL GMRVER,GDATA,GMRST,GERROR,GERST,^TMP($JOB),GBED,GWARD,DFN,GX,GMR1ST,GMRDAT,GMRDATE,GMRDSH,GMRDT,GMRLN,GMRPDT,GMRSP,GMRVDA,GMRVITY,GMRX,GMRY,GMRVTY,GMRSITE,GMRVX,POP,DIPGM,%T,GMRQUAL,GMROUT,GMRPG,GFLAG
DO KVAR^VADPT
KILL VA
DO ^%ZISC
+3 QUIT
SETAR ;get clio records
+1 SET GMRDT=GMRVSDT-.000001
+2 FOR
SET GMRDT=$ORDER(^PXRMINDX(120.5,"PI",DFN,GMRVITY,GMRDT))
if GMRDT'>0!(GMRDT>GMRVFDT)
QUIT
SET GMRDATE=GMRDT
DO SETND
+3 QUIT
SETAR1 ; PXRMINDX index doesn't have entered-in-error records, so use AA x-ref
+1 NEW GMRVSDT1,GMRVFDT1
+2 SET GMRDT=9999999-GMRVFDT
SET GMRVSDT1=9999999-GMRVSDT
+3 SET GMRDT=GMRDT-.000001
SET GMRVSDT1=GMRVSDT1+.000001
+4 FOR
SET GMRDT=$ORDER(^GMR(120.5,"AA",DFN,GMRVITY,GMRDT))
if GMRDT'>0!(GMRDT>GMRVSDT1)
QUIT
DO SETND1
+5 QUIT
SETND ;
+1 SET GMRVDA=0
+2 FOR
SET GMRVDA=$ORDER(^PXRMINDX(120.5,"PI",DFN,GMRVITY,GMRDT,GMRVDA))
if GMRVDA=""
QUIT
Begin DoDot:1
+3 ;already got it SETND1
if GMRVDA=+GMRVDA
QUIT
+4 IF GMRVDA'=+GMRVDA
Begin DoDot:2
+5 DO CLIO^GMVUTL(.GMVCLIO,GMRVDA)
+6 SET GMVCLIO(0)=$GET(GMVCLIO(0))
SET GMVCLIO(2)=$GET(GMVCLIO(2))
SET GMVCLIO(5)=$GET(GMVCLIO(5))
+7 IF GMVCLIO(0)=""!($PIECE(GMVCLIO(0),U,8)="")
QUIT
+8 DO SETUT
+9 QUIT
End DoDot:2
+10 QUIT
End DoDot:1
+11 QUIT
SETND1 ;
+1 SET GMRVDA=0
+2 FOR
SET GMRVDA=$ORDER(^GMR(120.5,"AA",DFN,GMRVITY,GMRDT,GMRVDA))
if GMRVDA=""
QUIT
Begin DoDot:1
+3 DO F1205^GMVUTL(.GMVCLIO,GMRVDA,1)
+4 SET GMVCLIO(0)=$GET(GMVCLIO(0))
SET GMVCLIO(2)=$GET(GMVCLIO(2))
SET GMVCLIO(5)=$GET(GMVCLIO(5))
+5 IF GMVCLIO(0)=""!($PIECE(GMVCLIO(0),U,8)="")
QUIT
+6 SET GMRDATE=$PIECE(GMVCLIO(0),U,1)
+7 DO SETUT
+8 QUIT
End DoDot:1
+9 QUIT
SETUT ;
+1 SET ^TMP($JOB,"GMRV",GMRDATE,GMRVTY,GMRVDA)=$SELECT($PIECE(GMVCLIO(2),U,1)'=1:0,1:+$PIECE(GMVCLIO(2),U,1))_"|"_GMVCLIO(0)_"|"_GMVCLIO(5)
+2 SET GMRVDT(GMRDATE)=""
+3 QUIT
PRT ;PRINT V/M BY DATE/TIME
+1 if IOSL<($Y+9)
DO HDR^GMRVSC2
if GMROUT
QUIT
+2 SET Y=GMRDATE
XECUTE ^DD("DD")
IF $PIECE(GMRDATE,".")'=GMRDATE(0)
WRITE !,$EXTRACT(GMRDATE,4,5)_"/"_$EXTRACT(GMRDATE,6,7)_"/"_$EXTRACT(GMRDATE,2,3)
SET GMRDATE(0)=$PIECE(GMRDATE,".")
+3 if IOSL<($Y+9)
DO HDR^GMRVSC2
if GMROUT
QUIT
WRITE !,$PIECE($PIECE(Y,"@",2),":",1,2)
+4 IF $DATA(^TMP($JOB,"GMRV",GMRDATE))
Begin DoDot:1
+5 KILL GMRLN,GERROR
FOR GMRVTY="T","P","R","BP","HT","WT","CVP","CG","PO2","PN"
SET GPRT(GMRVTY)=0
IF $DATA(^TMP($JOB,"GMRV",GMRDATE,GMRVTY))
SET GMRVDA=""
FOR GMRVDA=$ORDER(^TMP($JOB,"GMRV",GMRDATE,GMRVTY,GMRVDA))
if $LENGTH(GMRVDA)'>0!GMROUT
QUIT
DO SETLN^GMRVSC2
End DoDot:1
+6 QUIT
