source: WorldVistAEHR/trunk/r/GEN_MED_REC_IO-GMRY/GMRYRP2.m@ 1361

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

initial load of WorldVistAEHR

File size: 3.5 KB
Line 
1GMRYRP2 ;HIRMFO/YH-TMP FOR PATIENT INTAKE/OUTPUT REPORTS-2 ;2/28/91
2 ;;4.0;Intake/Output;;Apr 25, 1997
3SETARRY ;
4 S DA(1)=$O(^GMR(126,"B",DFN,0)) K ^TMP($J,"GMRY")
5 I $D(^GMR(126,"B",DFN)) F II="IN","OUT" D SAVE
6 D:$D(^GMR(126,"B",DFN)) SAVEIV
7 K GLEFT,GTOTAL Q
8SAVE ;
9 I '$D(^GMR(126,DA(1),II,"TYP")) Q
10 S GINDT=0,GDAY=0 D NEXT^GMRYRP1 F JJ=0:0 S GINDT=$O(^GMR(126,DA(1),II,"TYP",GINDT)) Q:GINDT'>0 S GMRINDT=9999999-GINDT Q:GMRINDT<GMRSTRT I GMRINDT'>GMRFIN D SETSIFT D GETTYP
11 Q
12GETTYP ;
13 S GTYP=0 F KK=0:0 S GTYP=$O(^GMR(126,DA(1),II,"TYP",GINDT,GTYP)) Q:GTYP'>0 D GETDA
14 Q
15GETDA ;
16 S DA=0 F KK=0:0 S DA=$O(^GMR(126,DA(1),II,"TYP",GINDT,GTYP,DA)) Q:DA'>0 D GETAMT S ^TMP($J,"GMRY",$P(GDSHFT,"."),GSHIFT,II,GMRINDT,GTYP,GSUB)=GAMOUNT_"^"_GTEXT_"^"_GITEM_"^"_$S(II="OUT":$P(^GMR(126,DA(1),II,DA,0),"^",3),1:"")
17 Q
18GETAMT ;
19 S GSUB=+$P(^GMR(126,DA(1),II,DA,0),"^",3) S:GSUB=0 GSUB=99
20 S GITEM="" I II="IN" S GAMOUNT=$P(^GMR(126,DA(1),II,DA,0),"^",5),GTEXT=$P(^(0),"^",6)_"^"_$P(^(0),"^",7) D ITEM^GMRYRP1 Q
21 I II="OUT" D S GTEXT=GTEXT(1)_GTEXT Q
22 . S GAMOUNT=$P(^GMR(126,DA(1),II,DA,0),"^",4)
23 . I GAMOUNT'>0,GAMOUNT'?1.3N N GI S GI=$$UP^XLFSTR($E(GAMOUNT)),GAMOUNT=$S(GI="S":"Small",GI="M":"Medium",GI="L":"Large",GI="*":"*",1:"")
24 . S GTEXT="^"_$P(^GMR(126,DA(1),II,DA,0),"^",6),GTEXT(1)=$P(^(0),"^",5)
25 . Q
26 S GAMOUNT=0,GTEXT=""
27 Q
28SETSIFT ;
29 I GDAY=0 D SETDT
30CHECKD I GMRINDT<GNSHFT D SETSFTD G CHECKD
31 I GMRINDT<GDSHFT S GSHIFT="SH-1" Q
32 I GMRINDT<GESHFT S GSHIFT="SH-2" Q
33 I GMRINDT<GNXNSF S GSHIFT="SH-3" Q
34 S GSHIFT="BLANK" Q
35SETSFTD ;
36 S GDAY=GDAY+1
37 S X1=GDTSTRT,X2=-1 D C^%DTC K %DT S GDTSTRT=X
38 S X1=GDTFIN,X2=-1 D C^%DTC K %DT S GDTFIN=X
39 S X1=GLASTDT,X2=-1 D C^%DTC K %DT S GLASTDT=X
40 S X1=GNXNSF,X2=-1 D C^%DTC K %DT S GNXNSF=X
41SETDT ;
42 S GNSHFT=GDTSTRT_"."_GMRNIT,GDSHFT=GDTFIN_"."_GMRDAY,GESHFT=GDTFIN_"."_GMREVE,GNXNSF=GNXTDT_"."_GMRNIT
43 Q
44SAVEIV ;SET ^TMP($J,"GMRY" FOR IV INTAKE
45 I '$D(^GMR(126,DA(1),"IV","TYP")) Q
46 S GIVSTRT=0 F JJ=0:0 S GIVSTRT=$O(^GMR(126,DA(1),"IV","TYP",GIVSTRT)) Q:GIVSTRT'>0 D IVTYP
47 Q
48IVTYP ;
49 S GIVTYP="" F KK=0:0 S GIVTYP=$O(^GMR(126,DA(1),"IV","TYP",GIVSTRT,GIVTYP)) Q:GIVTYP="" S DA=0 F S DA=$O(^GMR(126,DA(1),"IV","TYP",GIVSTRT,GIVTYP,DA)) Q:DA'>0 Q:'$D(^GMR(126,DA(1),"IV",DA,0)) D IVDA
50 Q
51IVDA ;
52 D IVINTK^GMRYUT8 S GSITE=$P(^GMR(126,DA(1),"IV",DA,0),"^",2),GSTRT=$P(^(0),"^")
53 I GRPT>7 D STRTIV,TITR
54 Q:'$D(^GMR(126,DA(1),"IV",DA,"IN",0))
55 S (GINDT,GDAY)=0 D NEXT^GMRYRP1 F LL=0:0 S GINDT=$O(^GMR(126,DA(1),"IV",DA,"IN","C",GINDT)) Q:GINDT'>0 S GMRINDT=9999999-GINDT Q:GMRINDT<GMRSTRT I GMRINDT'>GMRFIN D SETSIFT D IVAMNT
56 Q
57IVAMNT ;
58 I GIVTYP'="L" S ^TMP($J,"GMRY",$P(GDSHFT,"."),GSHIFT,"IV",GMRINDT,GSTRT,GIVTYP,DA,2)=$P(GIN(GMRINDT),"^",2)_"^"_GIVTYP_"^"_GSITE_"^"_$P(GIN(GMRINDT),"^",3)_"^"_$P(GIN(GMRINDT),"^",4)_"^"_$P(GIN(GMRINDT),"^")_"^"_DA
59 Q
60STRTIV ;SET ^TMP($J,"GMRY") FOR IV STARTING INFORMATION
61 S GMRINDT=GSTRT,GDAY=0 D NEXT^GMRYRP1 Q:GMRINDT<GMRSTRT!(GMRINDT>GMRFIN)
62 D SETSIFT S ^TMP($J,"GMRY",$P(GMRINDT,"."),GSHIFT,"IV",GMRINDT,GSTRT,GIVTYP,DA,1)=^GMR(126,DA(1),"IV",DA,0)
63 Q
64TITR ;
65 Q:'$D(^GMR(126,DA(1),"IV",DA,"TITR",0))
66 S (GINDT,GDAY)=0 D NEXT^GMRYRP1 F LL=0:0 S GINDT=$O(^GMR(126,DA(1),"IV",DA,"TITR","C",GINDT)) Q:GINDT'>0 S GDA=$O(^(GINDT,0)),GMRINDT=9999999-GINDT Q:GMRINDT<GMRSTRT I GMRINDT'>GMRFIN D SETSIFT D
67 .S ^TMP($J,"GMRY",$P(GDSHFT,"."),GSHIFT,"IV",GMRINDT,GSTRT,GIVTYP,DA,3)=$P(^GMR(126,DA(1),"IV",DA,"TITR",GDA,0),"^",2,3)_"^"_GDA_"^"_$P(^GMR(126,DA(1),"IV",DA,0),"^",2,3)_"^"_$P(^GMR(126,DA(1),"IV",DA,"TITR",GDA,0),"^",5)
68 Q
Note: See TracBrowser for help on using the repository browser.