source: FOIAVistA/trunk/r/GEN_MED_REC_IO-GMRY/GMRYRP4.m@ 1203

Last change on this file since 1203 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 4.8 KB
Line 
1GMRYRP4 ;HIRMFO/YH-TMP FOR SUMMING UP PATIENT I/O ;3/27/97
2 ;;4.0;Intake/Output;**2**;Apr 25, 1997
3SUM ;
4 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
5 Q
6SHIFT ;
7 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
8 Q
9IOSUM ;
10 S GIO="" F II=0:0 S GIO=$O(^TMP($J,"GMRY",GDATE,GSHIFT,GIO)) Q:GIO="" D IOTIME
11 Q
12IOTIME ;
13 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
14 Q
15IOTYPE ;
16 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
17 Q
18ADD ;
19 I GIO="IN",'$D(GTYPI(GTYPE)) Q
20 I GIO="OUT",'$D(GTYPO(GTYPE)) Q
21 I GIO="IN" D Q
22 . 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
23 . I GAMOUNT'>0,GAMOUNT'="0" S (GSIP(GIN),GDIP(GIN),GRNDIP)="+"
24 I GIO="OUT" D Q
25 . 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
26 . I GAMOUNT'>0,GAMOUNT'="0" S (GSOP(GTYPE),GDOP(GTYPE),GRNDOP)="+"
27 I GIO="IV" D Q
28 . 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
29 . I $P(^TMP($J,"GMRY",GDATE,GSHIFT,GIO,GHR,GIVDT,GTYPE,GSUB,GDA),"^",6)="*" S (GSIP(GIN),GDIP(GIN),GRNDIP)="+"
30 Q
31SUMIV ;
32 S GIVDT=0 F II=0:0 S GIVDT=$O(^TMP($J,"GMRY",GDATE,GSHIFT,GIO,GHR,GIVDT)) Q:GIVDT'>0 D IVLINE
33 Q
34IVLINE ;
35 S GTYPE="" F II=0:0 S GTYPE=$O(^TMP($J,"GMRY",GDATE,GSHIFT,GIO,GHR,GIVDT,GTYPE)) Q:GTYPE="" D IVSUB
36 Q
37IVSUB 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
38 .S GDA=$O(^TMP($J,"GMRY",GDATE,GSHIFT,GIO,GHR,GIVDT,GTYPE,GSUB,0)) D:GIN>0 ADD
39 Q
40WSHIFT ;
41 I GCSHFT="" S GCSHFT=GSHIFT Q
42 I GRPT<5 D CKSH
43 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
44 I GRPT<5 F II=1:1:GN(1) D
45 . S GIN(II)=GIN(II)_GSIP(II) S:GIN(II)="0+" GIN(II)="+"
46 . W ?GX,$E(GBLNK,1,4-$L(GIN(II)))_GIN(II)_"|" S GX=GX+6
47 I GRPT<5 F II=1:1:GN(2) D
48 . S GOUT(II)=GOUT(II)_GSOP(II) S:GOUT(II)="0+" GOUT(II)="+"
49 . W ?GX,$E(GBLNK,1,4-$L(GOUT(II)))_GOUT(II)_"|" S GX=GX+6
50 S:GSHIFT'="" GCSHFT=GSHIFT D INISHFT^GMRYRP3,SHFTP^GMRYRP3
51 Q
52SDATE ;
53 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
54 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
55 Q
56DAYTOT ;
57 I GRPT<5 D CKSH1
58 W:GRPT<5 !!,"TOTAL:",$E(GLN(4),7,$L(GLN(4))),!
59 S GTOTLI=0,GX=1 F II=1:1:GN(1) D
60 . S GTOTIN(II)=GTOTIN(II)_GDIP(II) S:GTOTIN(II)="0+" GTOTIN(II)="+"
61 . 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)
62 S:GRPT=5 II=II+1,^TMP($J,"GMR","XI"_II,GCURDT,GTOTLI)=""
63 S GTOTLO=0 F II=1:1:GN(2) D
64 . S GTOTOUT(II)=GTOTOUT(II)_GDOP(II) S:GTOTOUT(II)="0+" GTOTOUT(II)="+"
65 . 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)
66 S:GRPT=5 II=II+1,^TMP($J,"GMR","XO"_II,GCURDT,GTOTLO)=""
67 I GRPT<5 D
68 . 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),!
69 D INITOT^GMRYRP3,DAYP^GMRYRP3 S (GRNGIP,GRNDOP)=""
70 D:GRPT<5&(GDATE>0)&($E(IOST)="C"!($E(IOST)="P"&(($Y+5)>IOSL))) HEADER^GMRYRP3 Q
71 Q
72CKSH ;PRINT LINE FOR NO I/O DATA
73 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
74 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
75 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
76 Q
77CKSH1 ;PRINT LINE FOR NO I/O DATA
78 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
79 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
80 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
81 Q
Note: See TracBrowser for help on using the repository browser.