Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: GMRYRP2

GMRYRP2.m

Go to the documentation of this file.
  1. GMRYRP2 ;HIRMFO/YH-TMP FOR PATIENT INTAKE/OUTPUT REPORTS-2 ;2/28/91
  1. ;;4.0;Intake/Output;;Apr 25, 1997
  1. SETARRY ;
  1. S DA(1)=$O(^GMR(126,"B",DFN,0)) K ^TMP($J,"GMRY")
  1. I $D(^GMR(126,"B",DFN)) F II="IN","OUT" D SAVE
  1. D:$D(^GMR(126,"B",DFN)) SAVEIV
  1. K GLEFT,GTOTAL Q
  1. SAVE ;
  1. I '$D(^GMR(126,DA(1),II,"TYP")) Q
  1. 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
  1. Q
  1. GETTYP ;
  1. S GTYP=0 F KK=0:0 S GTYP=$O(^GMR(126,DA(1),II,"TYP",GINDT,GTYP)) Q:GTYP'>0 D GETDA
  1. Q
  1. GETDA ;
  1. 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:"")
  1. Q
  1. GETAMT ;
  1. S GSUB=+$P(^GMR(126,DA(1),II,DA,0),"^",3) S:GSUB=0 GSUB=99
  1. 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
  1. I II="OUT" D S GTEXT=GTEXT(1)_GTEXT Q
  1. . S GAMOUNT=$P(^GMR(126,DA(1),II,DA,0),"^",4)
  1. . 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:"")
  1. . S GTEXT="^"_$P(^GMR(126,DA(1),II,DA,0),"^",6),GTEXT(1)=$P(^(0),"^",5)
  1. . Q
  1. S GAMOUNT=0,GTEXT=""
  1. Q
  1. SETSIFT ;
  1. I GDAY=0 D SETDT
  1. CHECKD I GMRINDT<GNSHFT D SETSFTD G CHECKD
  1. I GMRINDT<GDSHFT S GSHIFT="SH-1" Q
  1. I GMRINDT<GESHFT S GSHIFT="SH-2" Q
  1. I GMRINDT<GNXNSF S GSHIFT="SH-3" Q
  1. S GSHIFT="BLANK" Q
  1. SETSFTD ;
  1. S GDAY=GDAY+1
  1. S X1=GDTSTRT,X2=-1 D C^%DTC K %DT S GDTSTRT=X
  1. S X1=GDTFIN,X2=-1 D C^%DTC K %DT S GDTFIN=X
  1. S X1=GLASTDT,X2=-1 D C^%DTC K %DT S GLASTDT=X
  1. S X1=GNXNSF,X2=-1 D C^%DTC K %DT S GNXNSF=X
  1. SETDT ;
  1. S GNSHFT=GDTSTRT_"."_GMRNIT,GDSHFT=GDTFIN_"."_GMRDAY,GESHFT=GDTFIN_"."_GMREVE,GNXNSF=GNXTDT_"."_GMRNIT
  1. Q
  1. SAVEIV ;SET ^TMP($J,"GMRY" FOR IV INTAKE
  1. I '$D(^GMR(126,DA(1),"IV","TYP")) Q
  1. S GIVSTRT=0 F JJ=0:0 S GIVSTRT=$O(^GMR(126,DA(1),"IV","TYP",GIVSTRT)) Q:GIVSTRT'>0 D IVTYP
  1. Q
  1. IVTYP ;
  1. 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
  1. Q
  1. IVDA ;
  1. D IVINTK^GMRYUT8 S GSITE=$P(^GMR(126,DA(1),"IV",DA,0),"^",2),GSTRT=$P(^(0),"^")
  1. I GRPT>7 D STRTIV,TITR
  1. Q:'$D(^GMR(126,DA(1),"IV",DA,"IN",0))
  1. 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
  1. Q
  1. IVAMNT ;
  1. 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
  1. Q
  1. STRTIV ;SET ^TMP($J,"GMRY") FOR IV STARTING INFORMATION
  1. S GMRINDT=GSTRT,GDAY=0 D NEXT^GMRYRP1 Q:GMRINDT<GMRSTRT!(GMRINDT>GMRFIN)
  1. D SETSIFT S ^TMP($J,"GMRY",$P(GMRINDT,"."),GSHIFT,"IV",GMRINDT,GSTRT,GIVTYP,DA,1)=^GMR(126,DA(1),"IV",DA,0)
  1. Q
  1. TITR ;
  1. Q:'$D(^GMR(126,DA(1),"IV",DA,"TITR",0))
  1. 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
  1. .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)
  1. Q