GMRYRP4 ;HIRMFO/YH-TMP FOR SUMMING UP PATIENT I/O ;3/27/97
;;4.0;Intake/Output;**2**;Apr 25, 1997
SUM ;
S (GCURDT,GDATE)=0 F II=0:0 S GDATE=$O(^TMP($J,"GMRY",GDATE)) D:GDATE'>0 SDATE Q:GMROUT!(GDATE'>0) D:GCURDT'=GDATE SDATE Q:GMROUT S:GDATE>0 GNDATE=GDATE D SHIFT
Q
SHIFT ;
S (GCSHFT,GSHIFT)="" F II=0:0 S GSHIFT=$O(^TMP($J,"GMRY",GDATE,GSHIFT)) D:GSHIFT="" WSHIFT Q:GMROUT!(GSHIFT="") D:GCSHFT'=GSHIFT WSHIFT Q:GMROUT D IOSUM
Q
IOSUM ;
S GIO="" F II=0:0 S GIO=$O(^TMP($J,"GMRY",GDATE,GSHIFT,GIO)) Q:GIO="" D IOTIME
Q
IOTIME ;
S GHR=0 F II=0:0 S GHR=$O(^TMP($J,"GMRY",GDATE,GSHIFT,GIO,GHR)) Q:GHR'>0 S GOPT=$S(GIO="IN"!(GIO="OUT"):"IOTYPE",GIO="IV":"SUMIV",1:"") Q:GOPT="" D @GOPT
Q
IOTYPE ;
S GTYPE=0 F II=0:0 S GTYPE=$O(^TMP($J,"GMRY",GDATE,GSHIFT,GIO,GHR,GTYPE)) Q:GTYPE'>0 S GSUB=0 F S GSUB=$O(^TMP($J,"GMRY",GDATE,GSHIFT,GIO,GHR,GTYPE,GSUB)) Q:GSUB'>0 D ADD
Q
ADD ;
I GIO="IN",'$D(GTYPI(GTYPE)) Q
I GIO="OUT",'$D(GTYPO(GTYPE)) Q
I GIO="IN" D Q
. S GIN=+GTYPI(GTYPE),GAMOUNT=$P(^TMP($J,"GMRY",GDATE,GSHIFT,GIO,GHR,GTYPE,GSUB),"^"),GIN(GIN)=GIN(GIN)+GAMOUNT,GTOTIN(GIN)=GTOTIN(GIN)+GAMOUNT
. I GAMOUNT'>0,GAMOUNT'="0" S (GSIP(GIN),GDIP(GIN),GRNDIP)="+"
I GIO="OUT" D Q
. S GOUT=+GTYPO(GTYPE),GAMOUNT=$P(^TMP($J,"GMRY",GDATE,GSHIFT,GIO,GHR,GTYPE,GSUB),"^"),GOUT(GOUT)=GOUT(GOUT)+GAMOUNT,GTOTOUT(GOUT)=GTOTOUT(GOUT)+GAMOUNT
. I GAMOUNT'>0,GAMOUNT'="0" S (GSOP(GTYPE),GDOP(GTYPE),GRNDOP)="+"
I GIO="IV" D Q
. S GAMOUNT=$P(^TMP($J,"GMRY",GDATE,GSHIFT,GIO,GHR,GIVDT,GTYPE,GSUB,GDA),"^") Q:GAMOUNT>2000000!(GDA=3) S GIN(GIN)=GIN(GIN)+GAMOUNT,GTOTIN(GIN)=GTOTIN(GIN)+GAMOUNT
. I $P(^TMP($J,"GMRY",GDATE,GSHIFT,GIO,GHR,GIVDT,GTYPE,GSUB,GDA),"^",6)="*" S (GSIP(GIN),GDIP(GIN),GRNDIP)="+"
Q
SUMIV ;
S GIVDT=0 F II=0:0 S GIVDT=$O(^TMP($J,"GMRY",GDATE,GSHIFT,GIO,GHR,GIVDT)) Q:GIVDT'>0 D IVLINE
Q
IVLINE ;
S GTYPE="" F II=0:0 S GTYPE=$O(^TMP($J,"GMRY",GDATE,GSHIFT,GIO,GHR,GIVDT,GTYPE)) Q:GTYPE="" D IVSUB
Q
IVSUB S GSUB=0 F S GSUB=$O(^TMP($J,"GMRY",GDATE,GSHIFT,GIO,GHR,GIVDT,GTYPE,GSUB)) Q:GSUB'>0 S GIN=$S(GTYPE="B":2,GTYPE="A"!(GTYPE="P")!(GTYPE="L"):1,GTYPE="H"!(GTYPE="I"):3,1:0) D
.S GDA=$O(^TMP($J,"GMRY",GDATE,GSHIFT,GIO,GHR,GIVDT,GTYPE,GSUB,0)) D:GIN>0 ADD
Q
WSHIFT ;
I GCSHFT="" S GCSHFT=GSHIFT Q
I GRPT<5 D CKSH
W:GRPT<5 !,$S(GCSHFT="SH-1":"N:",GCSHFT="SH-2":"D:",GCSHFT="SH-3":"E:",1:" "),$E(GLN(4),3,$L(GLN(4))),! S GX=1
I GRPT<5 F II=1:1:GN(1) D
. S GIN(II)=GIN(II)_GSIP(II) S:GIN(II)="0+" GIN(II)="+"
. W ?GX,$E(GBLNK,1,4-$L(GIN(II)))_GIN(II)_"|" S GX=GX+6
I GRPT<5 F II=1:1:GN(2) D
. S GOUT(II)=GOUT(II)_GSOP(II) S:GOUT(II)="0+" GOUT(II)="+"
. W ?GX,$E(GBLNK,1,4-$L(GOUT(II)))_GOUT(II)_"|" S GX=GX+6
S:GSHIFT'="" GCSHFT=GSHIFT D INISHFT^GMRYRP3,SHFTP^GMRYRP3
Q
SDATE ;
S (GNSH(1),GNSH(2),GNSH(3))=0 I GCURDT=0 S GCURDT=GDATE S GY=$E(GCURDT,4,5)_"/"_$E(GCURDT,6,7)_"/"_$E(GCURDT,2,3) W:GRPT=1!(GRPT=4) GY,$E(GLN(4),9,$L(GLN(4))) Q
D DAYTOT Q:GDATE'>0!GMROUT S GCURDT=GDATE,GY=$E(GCURDT,4,5)_"/"_$E(GCURDT,6,7)_"/"_$E(GCURDT,2,3) W:GRPT<5 GY,$E(GLN(4),9,$L(GLN(4))) Q
Q
DAYTOT ;
I GRPT<5 D CKSH1
W:GRPT<5 !!,"TOTAL:",$E(GLN(4),7,$L(GLN(4))),!
S GTOTLI=0,GX=1 F II=1:1:GN(1) D
. S GTOTIN(II)=GTOTIN(II)_GDIP(II) S:GTOTIN(II)="0+" GTOTIN(II)="+"
. W:GRPT<5 ?GX,$E(GBLNK,1,4-$L(GTOTIN(II)))_GTOTIN(II)_"|" S:GRPT=5 ^TMP($J,"GMR","XI"_II,GCURDT,GTOTIN(II))="" S GX=GX+6,GTOTLI=GTOTLI+GTOTIN(II)
S:GRPT=5 II=II+1,^TMP($J,"GMR","XI"_II,GCURDT,GTOTLI)=""
S GTOTLO=0 F II=1:1:GN(2) D
. S GTOTOUT(II)=GTOTOUT(II)_GDOP(II) S:GTOTOUT(II)="0+" GTOTOUT(II)="+"
. W:GRPT<5 ?GX,$E(GBLNK,1,4-$L(GTOTOUT(II)))_GTOTOUT(II)_"|" S:GRPT=5 ^TMP($J,"GMR","XO"_II,GCURDT,GTOTOUT(II))="" S GX=GX+6,GTOTLO=GTOTLO+GTOTOUT(II)
S:GRPT=5 II=II+1,^TMP($J,"GMR","XO"_II,GCURDT,GTOTLO)=""
I GRPT<5 D
. W !!,?15,"TOTAL INTAKE MEASURED: ",$S(GTOTLI=0&(GRNDIP="+"):"+",1:GTOTLI_GRNDIP),!,?15,"TOTAL OUTPUT MEASURED: ",$S(GTOTLO=0&(GRNDOP="+"):"+",1:GTOTLO_GRNDOP),!,$E(GMRX,1,GMRCOL),!
D INITOT^GMRYRP3,DAYP^GMRYRP3 S (GRNGIP,GRNDOP)=""
D:GRPT<5&(GDATE>0)&($E(IOST)="C"!($E(IOST)="P"&(($Y+5)>IOSL))) HEADER^GMRYRP3 Q
Q
CKSH ;PRINT LINE FOR NO I/O DATA
I $P(GCSHFT,"-",2)=2&'$D(^TMP($J,"GMRY",GNDATE,"SH-1"))&(GNSH(1)=0) W !,"N:",$E(GLN(4),3,$L(GLN(4))),!,GLN(5) S GNSH(1)=1 Q
I $P(GCSHFT,"-",2)=3&'$D(^TMP($J,"GMRY",GNDATE,"SH-1"))&(GNSH(1)=0) W !,"N:",$E(GLN(4),3,$L(GLN(4))),!,GLN(5) S GNSH(1)=1
I $P(GCSHFT,"-",2)=3&'$D(^TMP($J,"GMRY",GNDATE,"SH-2"))&(GNSH(2)=0) W !,"D:",$E(GLN(4),3,$L(GLN(4))),!,GLN(5) S GNSH(2)=1
Q
CKSH1 ;PRINT LINE FOR NO I/O DATA
I $P(GCSHFT,"-",2)=1&'$D(^TMP($J,"GMRY",GNDATE,"SH-2"))&'GNSH(2) W !,"D:",$E(GLN(4),3,$L(GLN(4))),!,GLN(5) S GNSH(2)=1
I $P(GCSHFT,"-",2)=1&'$D(^TMP($J,"GMRY",GNDATE,"SH-3"))&'GNSH(3) W !,"E:",$E(GLN(4),3,$L(GLN(4))),!,GLN(5) S GNSH(3)=1
I $P(GCSHFT,"-",2)=2&'$D(^TMP($J,"GMRY",GNDATE,"SH-3"))&'GNSH(3) W !,"E:",$E(GLN(4),3,$L(GLN(4))),!,GLN(5) S GNSH(3)=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRYRP4 4952 printed Oct 16, 2024@17:56:22 Page 2
GMRYRP4 ;HIRMFO/YH-TMP FOR SUMMING UP PATIENT I/O ;3/27/97
+1 ;;4.0;Intake/Output;**2**;Apr 25, 1997
SUM ;
+1 SET (GCURDT,GDATE)=0
FOR II=0:0
SET GDATE=$ORDER(^TMP($JOB,"GMRY",GDATE))
if GDATE'>0
DO SDATE
if GMROUT!(GDATE'>0)
QUIT
if GCURDT'=GDATE
DO SDATE
if GMROUT
QUIT
if GDATE>0
SET GNDATE=GDATE
DO SHIFT
+2 QUIT
SHIFT ;
+1 SET (GCSHFT,GSHIFT)=""
FOR II=0:0
SET GSHIFT=$ORDER(^TMP($JOB,"GMRY",GDATE,GSHIFT))
if GSHIFT=""
DO WSHIFT
if GMROUT!(GSHIFT="")
QUIT
if GCSHFT'=GSHIFT
DO WSHIFT
if GMROUT
QUIT
DO IOSUM
+2 QUIT
IOSUM ;
+1 SET GIO=""
FOR II=0:0
SET GIO=$ORDER(^TMP($JOB,"GMRY",GDATE,GSHIFT,GIO))
if GIO=""
QUIT
DO IOTIME
+2 QUIT
IOTIME ;
+1 SET GHR=0
FOR II=0:0
SET GHR=$ORDER(^TMP($JOB,"GMRY",GDATE,GSHIFT,GIO,GHR))
if GHR'>0
QUIT
SET GOPT=$SELECT(GIO="IN"!(GIO="OUT"):"IOTYPE",GIO="IV":"SUMIV",1:"")
if GOPT=""
QUIT
DO @GOPT
+2 QUIT
IOTYPE ;
+1 SET GTYPE=0
FOR II=0:0
SET GTYPE=$ORDER(^TMP($JOB,"GMRY",GDATE,GSHIFT,GIO,GHR,GTYPE))
if GTYPE'>0
QUIT
SET GSUB=0
FOR
SET GSUB=$ORDER(^TMP($JOB,"GMRY",GDATE,GSHIFT,GIO,GHR,GTYPE,GSUB))
if GSUB'>0
QUIT
DO ADD
+2 QUIT
ADD ;
+1 IF GIO="IN"
IF '$DATA(GTYPI(GTYPE))
QUIT
+2 IF GIO="OUT"
IF '$DATA(GTYPO(GTYPE))
QUIT
+3 IF GIO="IN"
Begin DoDot:1
+4 SET GIN=+GTYPI(GTYPE)
SET GAMOUNT=$PIECE(^TMP($JOB,"GMRY",GDATE,GSHIFT,GIO,GHR,GTYPE,GSUB),"^")
SET GIN(GIN)=GIN(GIN)+GAMOUNT
SET GTOTIN(GIN)=GTOTIN(GIN)+GAMOUNT
+5 IF GAMOUNT'>0
IF GAMOUNT'="0"
SET (GSIP(GIN),GDIP(GIN),GRNDIP)="+"
End DoDot:1
QUIT
+6 IF GIO="OUT"
Begin DoDot:1
+7 SET GOUT=+GTYPO(GTYPE)
SET GAMOUNT=$PIECE(^TMP($JOB,"GMRY",GDATE,GSHIFT,GIO,GHR,GTYPE,GSUB),"^")
SET GOUT(GOUT)=GOUT(GOUT)+GAMOUNT
SET GTOTOUT(GOUT)=GTOTOUT(GOUT)+GAMOUNT
+8 IF GAMOUNT'>0
IF GAMOUNT'="0"
SET (GSOP(GTYPE),GDOP(GTYPE),GRNDOP)="+"
End DoDot:1
QUIT
+9 IF GIO="IV"
Begin DoDot:1
+10 SET GAMOUNT=$PIECE(^TMP($JOB,"GMRY",GDATE,GSHIFT,GIO,GHR,GIVDT,GTYPE,GSUB,GDA),"^")
if GAMOUNT>2000000!(GDA=3)
QUIT
SET GIN(GIN)=GIN(GIN)+GAMOUNT
SET GTOTIN(GIN)=GTOTIN(GIN)+GAMOUNT
+11 IF $PIECE(^TMP($JOB,"GMRY",GDATE,GSHIFT,GIO,GHR,GIVDT,GTYPE,GSUB,GDA),"^",6)="*"
SET (GSIP(GIN),GDIP(GIN),GRNDIP)="+"
End DoDot:1
QUIT
+12 QUIT
SUMIV ;
+1 SET GIVDT=0
FOR II=0:0
SET GIVDT=$ORDER(^TMP($JOB,"GMRY",GDATE,GSHIFT,GIO,GHR,GIVDT))
if GIVDT'>0
QUIT
DO IVLINE
+2 QUIT
IVLINE ;
+1 SET GTYPE=""
FOR II=0:0
SET GTYPE=$ORDER(^TMP($JOB,"GMRY",GDATE,GSHIFT,GIO,GHR,GIVDT,GTYPE))
if GTYPE=""
QUIT
DO IVSUB
+2 QUIT
IVSUB SET GSUB=0
FOR
SET GSUB=$ORDER(^TMP($JOB,"GMRY",GDATE,GSHIFT,GIO,GHR,GIVDT,GTYPE,GSUB))
if GSUB'>0
QUIT
SET GIN=$SELECT(GTYPE="B":2,GTYPE="A"!(GTYPE="P")!(GTYPE="L"):1,GTYPE="H"!(GTYPE="I"):3,1:0)
Begin DoDot:1
+1 SET GDA=$ORDER(^TMP($JOB,"GMRY",GDATE,GSHIFT,GIO,GHR,GIVDT,GTYPE,GSUB,0))
if GIN>0
DO ADD
End DoDot:1
+2 QUIT
WSHIFT ;
+1 IF GCSHFT=""
SET GCSHFT=GSHIFT
QUIT
+2 IF GRPT<5
DO CKSH
+3 if GRPT<5
WRITE !,$SELECT(GCSHFT="SH-1":"N:",GCSHFT="SH-2":"D:",GCSHFT="SH-3":"E:",1:" "),$EXTRACT(GLN(4),3,$LENGTH(GLN(4))),!
SET GX=1
+4 IF GRPT<5
FOR II=1:1:GN(1)
Begin DoDot:1
+5 SET GIN(II)=GIN(II)_GSIP(II)
if GIN(II)="0+"
SET GIN(II)="+"
+6 WRITE ?GX,$EXTRACT(GBLNK,1,4-$LENGTH(GIN(II)))_GIN(II)_"|"
SET GX=GX+6
End DoDot:1
+7 IF GRPT<5
FOR II=1:1:GN(2)
Begin DoDot:1
+8 SET GOUT(II)=GOUT(II)_GSOP(II)
if GOUT(II)="0+"
SET GOUT(II)="+"
+9 WRITE ?GX,$EXTRACT(GBLNK,1,4-$LENGTH(GOUT(II)))_GOUT(II)_"|"
SET GX=GX+6
End DoDot:1
+10 if GSHIFT'=""
SET GCSHFT=GSHIFT
DO INISHFT^GMRYRP3
DO SHFTP^GMRYRP3
+11 QUIT
SDATE ;
+1 SET (GNSH(1),GNSH(2),GNSH(3))=0
IF GCURDT=0
SET GCURDT=GDATE
SET GY=$EXTRACT(GCURDT,4,5)_"/"_$EXTRACT(GCURDT,6,7)_"/"_$EXTRACT(GCURDT,2,3)
if GRPT=1!(GRPT=4)
WRITE GY,$EXTRACT(GLN(4),9,$LENGTH(GLN(4)))
QUIT
+2 DO DAYTOT
if GDATE'>0!GMROUT
QUIT
SET GCURDT=GDATE
SET GY=$EXTRACT(GCURDT,4,5)_"/"_$EXTRACT(GCURDT,6,7)_"/"_$EXTRACT(GCURDT,2,3)
if GRPT<5
WRITE GY,$EXTRACT(GLN(4),9,$LENGTH(GLN(4)))
QUIT
+3 QUIT
DAYTOT ;
+1 IF GRPT<5
DO CKSH1
+2 if GRPT<5
WRITE !!,"TOTAL:",$EXTRACT(GLN(4),7,$LENGTH(GLN(4))),!
+3 SET GTOTLI=0
SET GX=1
FOR II=1:1:GN(1)
Begin DoDot:1
+4 SET GTOTIN(II)=GTOTIN(II)_GDIP(II)
if GTOTIN(II)="0+"
SET GTOTIN(II)="+"
+5 if GRPT<5
WRITE ?GX,$EXTRACT(GBLNK,1,4-$LENGTH(GTOTIN(II)))_GTOTIN(II)_"|"
if GRPT=5
SET ^TMP($JOB,"GMR","XI"_II,GCURDT,GTOTIN(II))=""
SET GX=GX+6
SET GTOTLI=GTOTLI+GTOTIN(II)
End DoDot:1
+6 if GRPT=5
SET II=II+1
SET ^TMP($JOB,"GMR","XI"_II,GCURDT,GTOTLI)=""
+7 SET GTOTLO=0
FOR II=1:1:GN(2)
Begin DoDot:1
+8 SET GTOTOUT(II)=GTOTOUT(II)_GDOP(II)
if GTOTOUT(II)="0+"
SET GTOTOUT(II)="+"
+9 if GRPT<5
WRITE ?GX,$EXTRACT(GBLNK,1,4-$LENGTH(GTOTOUT(II)))_GTOTOUT(II)_"|"
if GRPT=5
SET ^TMP($JOB,"GMR","XO"_II,GCURDT,GTOTOUT(II))=""
SET GX=GX+6
SET GTOTLO=GTOTLO+GTOTOUT(II)
End DoDot:1
+10 if GRPT=5
SET II=II+1
SET ^TMP($JOB,"GMR","XO"_II,GCURDT,GTOTLO)=""
+11 IF GRPT<5
Begin DoDot:1
+12 WRITE !!,?15,"TOTAL INTAKE MEASURED: ",$SELECT(GTOTLI=0&(GRNDIP="+"):"+",1:GTOTLI_GRNDIP),!,?15,"TOTAL OUTPUT MEASURED: ",$SELECT(GTOTLO=0&(GRNDOP="+"):"+",1:GTOTLO_GRNDOP),!,$EXTRACT(GMRX,1,GMRCOL),!
End DoDot:1
+13 DO INITOT^GMRYRP3
DO DAYP^GMRYRP3
SET (GRNGIP,GRNDOP)=""
+14 if GRPT<5&(GDATE>0)&($EXTRACT(IOST)="C"!($EXTRACT(IOST)="P"&(($Y+5)>IOSL)))
DO HEADER^GMRYRP3
QUIT
+15 QUIT
CKSH ;PRINT LINE FOR NO I/O DATA
+1 IF $PIECE(GCSHFT,"-",2)=2&'$DATA(^TMP($JOB,"GMRY",GNDATE,"SH-1"))&(GNSH(1)=0)
WRITE !,"N:",$EXTRACT(GLN(4),3,$LENGTH(GLN(4))),!,GLN(5)
SET GNSH(1)=1
QUIT
+2 IF $PIECE(GCSHFT,"-",2)=3&'$DATA(^TMP($JOB,"GMRY",GNDATE,"SH-1"))&(GNSH(1)=0)
WRITE !,"N:",$EXTRACT(GLN(4),3,$LENGTH(GLN(4))),!,GLN(5)
SET GNSH(1)=1
+3 IF $PIECE(GCSHFT,"-",2)=3&'$DATA(^TMP($JOB,"GMRY",GNDATE,"SH-2"))&(GNSH(2)=0)
WRITE !,"D:",$EXTRACT(GLN(4),3,$LENGTH(GLN(4))),!,GLN(5)
SET GNSH(2)=1
+4 QUIT
CKSH1 ;PRINT LINE FOR NO I/O DATA
+1 IF $PIECE(GCSHFT,"-",2)=1&'$DATA(^TMP($JOB,"GMRY",GNDATE,"SH-2"))&'GNSH(2)
WRITE !,"D:",$EXTRACT(GLN(4),3,$LENGTH(GLN(4))),!,GLN(5)
SET GNSH(2)=1
+2 IF $PIECE(GCSHFT,"-",2)=1&'$DATA(^TMP($JOB,"GMRY",GNDATE,"SH-3"))&'GNSH(3)
WRITE !,"E:",$EXTRACT(GLN(4),3,$LENGTH(GLN(4))),!,GLN(5)
SET GNSH(3)=1
+3 IF $PIECE(GCSHFT,"-",2)=2&'$DATA(^TMP($JOB,"GMRY",GNDATE,"SH-3"))&'GNSH(3)
WRITE !,"E:",$EXTRACT(GLN(4),3,$LENGTH(GLN(4))),!,GLN(5)
SET GNSH(3)=1
+4 QUIT
