- 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
- 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
