- 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 Jan 18, 2025@02:56:46 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