GMRYRP2 ;HIRMFO/YH-TMP FOR PATIENT INTAKE/OUTPUT REPORTS-2 ;2/28/91
;;4.0;Intake/Output;;Apr 25, 1997
SETARRY ;
S DA(1)=$O(^GMR(126,"B",DFN,0)) K ^TMP($J,"GMRY")
I $D(^GMR(126,"B",DFN)) F II="IN","OUT" D SAVE
D:$D(^GMR(126,"B",DFN)) SAVEIV
K GLEFT,GTOTAL Q
SAVE ;
I '$D(^GMR(126,DA(1),II,"TYP")) Q
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
Q
GETTYP ;
S GTYP=0 F KK=0:0 S GTYP=$O(^GMR(126,DA(1),II,"TYP",GINDT,GTYP)) Q:GTYP'>0 D GETDA
Q
GETDA ;
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:"")
Q
GETAMT ;
S GSUB=+$P(^GMR(126,DA(1),II,DA,0),"^",3) S:GSUB=0 GSUB=99
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
I II="OUT" D S GTEXT=GTEXT(1)_GTEXT Q
. S GAMOUNT=$P(^GMR(126,DA(1),II,DA,0),"^",4)
. 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:"")
. S GTEXT="^"_$P(^GMR(126,DA(1),II,DA,0),"^",6),GTEXT(1)=$P(^(0),"^",5)
. Q
S GAMOUNT=0,GTEXT=""
Q
SETSIFT ;
I GDAY=0 D SETDT
CHECKD I GMRINDT<GNSHFT D SETSFTD G CHECKD
I GMRINDT<GDSHFT S GSHIFT="SH-1" Q
I GMRINDT<GESHFT S GSHIFT="SH-2" Q
I GMRINDT<GNXNSF S GSHIFT="SH-3" Q
S GSHIFT="BLANK" Q
SETSFTD ;
S GDAY=GDAY+1
S X1=GDTSTRT,X2=-1 D C^%DTC K %DT S GDTSTRT=X
S X1=GDTFIN,X2=-1 D C^%DTC K %DT S GDTFIN=X
S X1=GLASTDT,X2=-1 D C^%DTC K %DT S GLASTDT=X
S X1=GNXNSF,X2=-1 D C^%DTC K %DT S GNXNSF=X
SETDT ;
S GNSHFT=GDTSTRT_"."_GMRNIT,GDSHFT=GDTFIN_"."_GMRDAY,GESHFT=GDTFIN_"."_GMREVE,GNXNSF=GNXTDT_"."_GMRNIT
Q
SAVEIV ;SET ^TMP($J,"GMRY" FOR IV INTAKE
I '$D(^GMR(126,DA(1),"IV","TYP")) Q
S GIVSTRT=0 F JJ=0:0 S GIVSTRT=$O(^GMR(126,DA(1),"IV","TYP",GIVSTRT)) Q:GIVSTRT'>0 D IVTYP
Q
IVTYP ;
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
Q
IVDA ;
D IVINTK^GMRYUT8 S GSITE=$P(^GMR(126,DA(1),"IV",DA,0),"^",2),GSTRT=$P(^(0),"^")
I GRPT>7 D STRTIV,TITR
Q:'$D(^GMR(126,DA(1),"IV",DA,"IN",0))
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
Q
IVAMNT ;
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
Q
STRTIV ;SET ^TMP($J,"GMRY") FOR IV STARTING INFORMATION
S GMRINDT=GSTRT,GDAY=0 D NEXT^GMRYRP1 Q:GMRINDT<GMRSTRT!(GMRINDT>GMRFIN)
D SETSIFT S ^TMP($J,"GMRY",$P(GMRINDT,"."),GSHIFT,"IV",GMRINDT,GSTRT,GIVTYP,DA,1)=^GMR(126,DA(1),"IV",DA,0)
Q
TITR ;
Q:'$D(^GMR(126,DA(1),"IV",DA,"TITR",0))
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
.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)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRYRP2 3604 printed Dec 13, 2024@01:55:33 Page 2
GMRYRP2 ;HIRMFO/YH-TMP FOR PATIENT INTAKE/OUTPUT REPORTS-2 ;2/28/91
+1 ;;4.0;Intake/Output;;Apr 25, 1997
SETARRY ;
+1 SET DA(1)=$ORDER(^GMR(126,"B",DFN,0))
KILL ^TMP($JOB,"GMRY")
+2 IF $DATA(^GMR(126,"B",DFN))
FOR II="IN","OUT"
DO SAVE
+3 if $DATA(^GMR(126,"B",DFN))
DO SAVEIV
+4 KILL GLEFT,GTOTAL
QUIT
SAVE ;
+1 IF '$DATA(^GMR(126,DA(1),II,"TYP"))
QUIT
+2 SET GINDT=0
SET GDAY=0
DO NEXT^GMRYRP1
FOR JJ=0:0
SET GINDT=$ORDER(^GMR(126,DA(1),II,"TYP",GINDT))
if GINDT'>0
QUIT
SET GMRINDT=9999999-GINDT
if GMRINDT<GMRSTRT
QUIT
IF GMRINDT'>GMRFIN
DO SETSIFT
DO GETTYP
+3 QUIT
GETTYP ;
+1 SET GTYP=0
FOR KK=0:0
SET GTYP=$ORDER(^GMR(126,DA(1),II,"TYP",GINDT,GTYP))
if GTYP'>0
QUIT
DO GETDA
+2 QUIT
GETDA ;
+1 SET DA=0
FOR KK=0:0
SET DA=$ORDER(^GMR(126,DA(1),II,"TYP",GINDT,GTYP,DA))
if DA'>0
QUIT
DO GETAMT
SET ^TMP($JOB,"GMRY",$PIECE(GDSHFT,"."),GSHIFT,II,GMRINDT,GTYP,GSUB)=GAMOUNT_"^"_GTEXT_"^"_GITEM_"^"_$SELECT(II="OUT":$PIECE(^GMR(126,DA(1),II,DA,0),"^",3),1:"")
+2 QUIT
GETAMT ;
+1 SET GSUB=+$PIECE(^GMR(126,DA(1),II,DA,0),"^",3)
if GSUB=0
SET GSUB=99
+2 SET GITEM=""
IF II="IN"
SET GAMOUNT=$PIECE(^GMR(126,DA(1),II,DA,0),"^",5)
SET GTEXT=$PIECE(^(0),"^",6)_"^"_$PIECE(^(0),"^",7)
DO ITEM^GMRYRP1
QUIT
+3 IF II="OUT"
Begin DoDot:1
+4 SET GAMOUNT=$PIECE(^GMR(126,DA(1),II,DA,0),"^",4)
+5 IF GAMOUNT'>0
IF GAMOUNT'?1.3N
NEW GI
SET GI=$$UP^XLFSTR($EXTRACT(GAMOUNT))
SET GAMOUNT=$SELECT(GI="S":"Small",GI="M":"Medium",GI="L":"Large",GI="*":"*",1:"")
+6 SET GTEXT="^"_$PIECE(^GMR(126,DA(1),II,DA,0),"^",6)
SET GTEXT(1)=$PIECE(^(0),"^",5)
+7 QUIT
End DoDot:1
SET GTEXT=GTEXT(1)_GTEXT
QUIT
+8 SET GAMOUNT=0
SET GTEXT=""
+9 QUIT
SETSIFT ;
+1 IF GDAY=0
DO SETDT
CHECKD IF GMRINDT<GNSHFT
DO SETSFTD
GOTO CHECKD
+1 IF GMRINDT<GDSHFT
SET GSHIFT="SH-1"
QUIT
+2 IF GMRINDT<GESHFT
SET GSHIFT="SH-2"
QUIT
+3 IF GMRINDT<GNXNSF
SET GSHIFT="SH-3"
QUIT
+4 SET GSHIFT="BLANK"
QUIT
SETSFTD ;
+1 SET GDAY=GDAY+1
+2 SET X1=GDTSTRT
SET X2=-1
DO C^%DTC
KILL %DT
SET GDTSTRT=X
+3 SET X1=GDTFIN
SET X2=-1
DO C^%DTC
KILL %DT
SET GDTFIN=X
+4 SET X1=GLASTDT
SET X2=-1
DO C^%DTC
KILL %DT
SET GLASTDT=X
+5 SET X1=GNXNSF
SET X2=-1
DO C^%DTC
KILL %DT
SET GNXNSF=X
SETDT ;
+1 SET GNSHFT=GDTSTRT_"."_GMRNIT
SET GDSHFT=GDTFIN_"."_GMRDAY
SET GESHFT=GDTFIN_"."_GMREVE
SET GNXNSF=GNXTDT_"."_GMRNIT
+2 QUIT
SAVEIV ;SET ^TMP($J,"GMRY" FOR IV INTAKE
+1 IF '$DATA(^GMR(126,DA(1),"IV","TYP"))
QUIT
+2 SET GIVSTRT=0
FOR JJ=0:0
SET GIVSTRT=$ORDER(^GMR(126,DA(1),"IV","TYP",GIVSTRT))
if GIVSTRT'>0
QUIT
DO IVTYP
+3 QUIT
IVTYP ;
+1 SET GIVTYP=""
FOR KK=0:0
SET GIVTYP=$ORDER(^GMR(126,DA(1),"IV","TYP",GIVSTRT,GIVTYP))
if GIVTYP=""
QUIT
SET DA=0
FOR
SET DA=$ORDER(^GMR(126,DA(1),"IV","TYP",GIVSTRT,GIVTYP,DA))
if DA'>0
QUIT
if '$DATA(^GMR(126,DA(1),"IV",DA,0))
QUIT
DO IVDA
+2 QUIT
IVDA ;
+1 DO IVINTK^GMRYUT8
SET GSITE=$PIECE(^GMR(126,DA(1),"IV",DA,0),"^",2)
SET GSTRT=$PIECE(^(0),"^")
+2 IF GRPT>7
DO STRTIV
DO TITR
+3 if '$DATA(^GMR(126,DA(1),"IV",DA,"IN",0))
QUIT
+4 SET (GINDT,GDAY)=0
DO NEXT^GMRYRP1
FOR LL=0:0
SET GINDT=$ORDER(^GMR(126,DA(1),"IV",DA,"IN","C",GINDT))
if GINDT'>0
QUIT
SET GMRINDT=9999999-GINDT
if GMRINDT<GMRSTRT
QUIT
IF GMRINDT'>GMRFIN
DO SETSIFT
DO IVAMNT
+5 QUIT
IVAMNT ;
+1 IF GIVTYP'="L"
SET ^TMP($JOB,"GMRY",$PIECE(GDSHFT,"."),GSHIFT,"IV",GMRINDT,GSTRT,GIVTYP,DA,2)=$PIECE(GIN(GMRINDT),"^",2)_"^"_GIVTYP_"^"_GSITE_"^"_$PIECE(GIN(GMRINDT),"^",3)_"^"_$PIECE(GIN(GMRINDT),"^",4)_"^"_$PIECE(GIN(GMRINDT),"^")_"^"_DA
+2 QUIT
STRTIV ;SET ^TMP($J,"GMRY") FOR IV STARTING INFORMATION
+1 SET GMRINDT=GSTRT
SET GDAY=0
DO NEXT^GMRYRP1
if GMRINDT<GMRSTRT!(GMRINDT>GMRFIN)
QUIT
+2 DO SETSIFT
SET ^TMP($JOB,"GMRY",$PIECE(GMRINDT,"."),GSHIFT,"IV",GMRINDT,GSTRT,GIVTYP,DA,1)=^GMR(126,DA(1),"IV",DA,0)
+3 QUIT
TITR ;
+1 if '$DATA(^GMR(126,DA(1),"IV",DA,"TITR",0))
QUIT
+2 SET (GINDT,GDAY)=0
DO NEXT^GMRYRP1
FOR LL=0:0
SET GINDT=$ORDER(^GMR(126,DA(1),"IV",DA,"TITR","C",GINDT))
if GINDT'>0
QUIT
SET GDA=$ORDER(^(GINDT,0))
SET GMRINDT=9999999-GINDT
if GMRINDT<GMRSTRT
QUIT
IF GMRINDT'>GMRFIN
DO SETSIFT
Begin DoDot:1
+3 SET ^TMP($JOB,"GMRY",$PIECE(GDSHFT,"."),GSHIFT,"IV",GMRINDT,GSTRT,GIVTYP,DA,3)=$PIECE(^GMR(126,DA(1),"IV",DA,"TITR",GDA,0),"^",2,3)_"^"_GDA_"^"_$PIECE(^GMR(126,DA(1),"IV",DA,0),"^",2,3)_"^"_$PIECE(^GMR(126,DA(1),"IV",DA,"TITR",GDA,0
),"^",5)
End DoDot:1
+4 QUIT
