GMRYUT8 ;HIRMFO/YH - IV/LOCK/PORT ENTER/EDIT ;2/12/91
;;4.0;Intake/Output;**6**;Apr 25, 1997
IV ;EDIT OR DELETE IV RECORD
S GX(1)=+GX,GX(2)="",GDCREAS=$P(^GMR(126,DA(2),"IV",DA(1),0),"^",11)
REASK S GREC(1)=0 I GMRDEL="@" S %=1 W !!,"Are you sure you want to delete" D YN^DICN S:%<0 GMROUT=1 W:%=0 !!,"Enter N(o) if you do not want to delete this record or '^' to quit.",! G:%=0 REASK D:%=1 KILLRC K % Q
REDIT S Y=+GX X ^DD("DD")
W:GMRVTYP'="L" !!,"Enter "_$S(GLABEL'="":GLABEL_" intake dated ",1:"solution left in the container on ")_$P(Y,":",1,2),!,?5,"Enter * for AMOUNT LEFT if amount of solution absorbed is unknown.",!,?10,"Unit mls is not required.",!
S DIE="^GMR(126,"_DA(2)_",""IV"","_DA(1)_",""IN"","
S DR="S GMRZZZ="""" S:GMRVTYP=""P""!(GMRVTYP=""L""!(GDCREAS[""INFUSED"")) GMRZZZ=0;"_$S(GMRVTYP="L":"1///",1:"1//")_"^S X=GMRZZZ;3///^S X=""`""_DUZ;4///^S X=""`""_GHLOC;" D WAIT^GMRYUT0 I GMROUT K DIE,DR Q
;; GMRY*4*6 - RJS ADDED THE DA SETS
D ^DIE L -^GMR(126,DFN) K DIE,DR S GMRDA=$P(^GMR(126,DA(2),"IV",DA(1),"IN",DA,0),"^",2),GREC(1)=DA I GMRDA="" D KILLRC S GMROUT=1,DA=DA(1),DA(1)=DA(2) K GIN Q
K GIN S DA=DA(1),DA(1)=DA(2) Q:GMRVTYP="L"
I $D(^GMR(126,DA(1),"IV",DA,0)) D IVINTK W !!,"Intake for this period: "_$S($P(^GMR(126,DFN,"IV",DA,"IN",GREC(1),0),"^",2)="*":"unknown",1:$P(GIN(+GX),"^",2)_" mls ")
I $D(GIN(+GX)),$P(GIN(+GX),"^",2)<0 W !!,"ERROR ENTRY!!!" S $P(^GMR(126,DFN,"IV",DA,"IN",GREC(1),0),"^",2)="",DA(2)=DA(1),DA(1)=DA,DA=GREC(1) G REDIT
;; GMRY*4*6 - RJS ADDED THE DA SETS
S %=1 D YN^DICN I %<0 S DA(2)=DA(1),DA(1)=DA,DA=GREC(1) D KILLRC S GMROUT=1,DA=DA(1),DA(1)=DA(2) K DA(2) Q
I %'=1 S $P(^GMR(126,DFN,"IV",DA,"IN",GREC(1),0),"^",2)="",DA(2)=DA(1),DA(1)=DA,DA=GREC(1) G REDIT
Q
KILLRC S DIK="^GMR(126,"_DA(2)_",""IV"","_DA(1)_",""IN""," D ^DIK K DIK S Y=GX(1) X ^DD("DD") W !!,GLABEL_" Entered on "_$P(Y,":",1,2)_" has been deleted!!!",! S GREC(1)=0,$P(^GMR(126,DFN,"IV",DA(1),0),"^",9)="" Q
IVINTK ;CALCULATE IV INTAKE FOR EACH IV INTAKE RECORD
S:'$D(^GMR(126,DA(1),"IV",DA,0)) GMROUT=1 Q:GMROUT K GIN S (GTOTAL(1),GTOTAL)=+$P(^GMR(126,DA(1),"IV",DA,0),"^",5),GSOL=$P(^(0),"^",3)
S GDT=0,GSTAR="" F S GDT=$O(^GMR(126,DA(1),"IV",DA,"IN","B",GDT)) Q:GDT'>0 S GDA=$O(^GMR(126,DA(1),"IV",DA,"IN","B",GDT,0)) Q:GDA'>0 D SETGIN
K GINTAKE,GDT,GDA Q
Q
SETGIN S GLEFT=$P(^GMR(126,DA(1),"IV",DA,"IN",GDA,0),"^",2),GXX=^(0)
S GINTAKE=$S($E(GLEFT)=".":GTOTAL-GLEFT,$A($E(GLEFT))<48!($A($E(GLEFT))>57):0,1:GTOTAL-GLEFT),GTOTAL=GTOTAL-GINTAKE,(GIN(GDT),GIN(GDA))=GLEFT_"^"_GINTAKE_"^"_$P(GXX,"^",4)_"^"_GSOL S:GLEFT["*" GSTAR="unknown" K GXX Q
LOCK ;CONVERT TO LOCK/PORT
S GHLOC=GMRHLOC K DD S X=+GX,DLAYGO=126.03,DA(1)=DFN,DIC="^GMR(126,"_DA(1)_",""IV"",",DIC(0)="ML" D WAIT^GMRYUT0 Q:GMROUT D FILE^DICN L -^GMR(126,DFN) K DIC,DLAYGO,DD S DA=+Y Q:Y'>0!GMROUT
S DIE="^GMR(126,"_DA(1)_",""IV"",",DR="2///^S X=GMRZ;3///^S X=GMRZ(1);4///^S X=GMRZ(2);11///^S X=GMRZ(3);6///^S X=""`""_DUZ;7///^S X=""`""_GHLOC;1///^S X=GSITE;17///^S X=GCATH(1)"
D WAIT^GMRYUT0 D:'GMROUT ^DIE K DIE,DR L:'GMROUT -^GMR(126,DFN) Q
MOREDRN ;ENTER MORE THAN ONE DRAINAGE DATA
K DD S DLAYGO=126.02,X=+GX,DA(1)=DFN,DIC="^GMR(126,"_DA(1)_","""_GNANS_""",",DIC(0)="ML" D WAIT^GMRYUT0 Q:GMROUT D FILE^DICN L -^GMR(126,DFN) K DIC,DLAYGO,DD S DA=+Y S:Y'>0 GMROUT=1 Q
DC ;DC IV FROM IV INTAKE
S GDATA=^GMR(126,DFN,"IV",DA,0),GDT=$P(GDATA,"^"),GTYPE=$P(GDATA,"^",4) W !!,"Discontinue ",?5,$P(GDATA,"^",3)_" "_$S(GTYPE'["L":$P(GDATA,"^",5)_" mls ("_GTYPE_") ",1:"")_$P(GDATA,"^",2)
S Y=GDT X ^DD("DD") W " started on "_$P(Y,":",1,2),!
S GDCDT=+GX,DIE="^GMR(126,"_DA(1)_",""IV"",",DR="8///^S X=+GX;9///^S X=""`""_DUZ;10///^D DCREASON^GMRYUT11" D WAIT^GMRYUT0 I 'GMROUT D ^DIE L -^GMR(126,DFN)
K DIE,DR Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRYUT8 3768 printed Dec 13, 2024@01:55:53 Page 2
GMRYUT8 ;HIRMFO/YH - IV/LOCK/PORT ENTER/EDIT ;2/12/91
+1 ;;4.0;Intake/Output;**6**;Apr 25, 1997
IV ;EDIT OR DELETE IV RECORD
+1 SET GX(1)=+GX
SET GX(2)=""
SET GDCREAS=$PIECE(^GMR(126,DA(2),"IV",DA(1),0),"^",11)
REASK SET GREC(1)=0
IF GMRDEL="@"
SET %=1
WRITE !!,"Are you sure you want to delete"
DO YN^DICN
if %<0
SET GMROUT=1
if %=0
WRITE !!,"Enter N(o) if you do not want to delete this record or '^' to quit.",!
if %=0
GOTO REASK
if %=1
DO KILLRC
KILL %
QUIT
REDIT SET Y=+GX
XECUTE ^DD("DD")
+1 if GMRVTYP'="L"
WRITE !!,"Enter "_$SELECT(GLABEL'="":GLABEL_" intake dated ",1:"solution left in the container on ")_$PIECE(Y,":",1,2),!,?5,"Enter * for AMOUNT LEFT if amount of solution absorbed is unknown.",!,?10,"Unit mls is not required.",!
+2 SET DIE="^GMR(126,"_DA(2)_",""IV"","_DA(1)_",""IN"","
+3 SET DR="S GMRZZZ="""" S:GMRVTYP=""P""!(GMRVTYP=""L""!(GDCREAS[""INFUSED"")) GMRZZZ=0;"_$SELECT(GMRVTYP="L":"1///",1:"1//")_"^S X=GMRZZZ;3///^S X=""`""_DUZ;4///^S X=""`""_GHLOC;"
DO WAIT^GMRYUT0
IF GMROUT
KILL DIE,DR
QUIT
+4 ;; GMRY*4*6 - RJS ADDED THE DA SETS
+5 DO ^DIE
LOCK -^GMR(126,DFN)
KILL DIE,DR
SET GMRDA=$PIECE(^GMR(126,DA(2),"IV",DA(1),"IN",DA,0),"^",2)
SET GREC(1)=DA
IF GMRDA=""
DO KILLRC
SET GMROUT=1
SET DA=DA(1)
SET DA(1)=DA(2)
KILL GIN
QUIT
+6 KILL GIN
SET DA=DA(1)
SET DA(1)=DA(2)
if GMRVTYP="L"
QUIT
+7 IF $DATA(^GMR(126,DA(1),"IV",DA,0))
DO IVINTK
WRITE !!,"Intake for this period: "_$SELECT($PIECE(^GMR(126,DFN,"IV",DA,"IN",GREC(1),0),"^",2)="*":"unknown",1:$PIECE(GIN(+GX),"^",2)_" mls ")
+8 IF $DATA(GIN(+GX))
IF $PIECE(GIN(+GX),"^",2)<0
WRITE !!,"ERROR ENTRY!!!"
SET $PIECE(^GMR(126,DFN,"IV",DA,"IN",GREC(1),0),"^",2)=""
SET DA(2)=DA(1)
SET DA(1)=DA
SET DA=GREC(1)
GOTO REDIT
+9 ;; GMRY*4*6 - RJS ADDED THE DA SETS
+10 SET %=1
DO YN^DICN
IF %<0
SET DA(2)=DA(1)
SET DA(1)=DA
SET DA=GREC(1)
DO KILLRC
SET GMROUT=1
SET DA=DA(1)
SET DA(1)=DA(2)
KILL DA(2)
QUIT
+11 IF %'=1
SET $PIECE(^GMR(126,DFN,"IV",DA,"IN",GREC(1),0),"^",2)=""
SET DA(2)=DA(1)
SET DA(1)=DA
SET DA=GREC(1)
GOTO REDIT
+12 QUIT
KILLRC SET DIK="^GMR(126,"_DA(2)_",""IV"","_DA(1)_",""IN"","
DO ^DIK
KILL DIK
SET Y=GX(1)
XECUTE ^DD("DD")
WRITE !!,GLABEL_" Entered on "_$PIECE(Y,":",1,2)_" has been deleted!!!",!
SET GREC(1)=0
SET $PIECE(^GMR(126,DFN,"IV",DA(1),0),"^",9)=""
QUIT
IVINTK ;CALCULATE IV INTAKE FOR EACH IV INTAKE RECORD
+1 if '$DATA(^GMR(126,DA(1),"IV",DA,0))
SET GMROUT=1
if GMROUT
QUIT
KILL GIN
SET (GTOTAL(1),GTOTAL)=+$PIECE(^GMR(126,DA(1),"IV",DA,0),"^",5)
SET GSOL=$PIECE(^(0),"^",3)
+2 SET GDT=0
SET GSTAR=""
FOR
SET GDT=$ORDER(^GMR(126,DA(1),"IV",DA,"IN","B",GDT))
if GDT'>0
QUIT
SET GDA=$ORDER(^GMR(126,DA(1),"IV",DA,"IN","B",GDT,0))
if GDA'>0
QUIT
DO SETGIN
+3 KILL GINTAKE,GDT,GDA
QUIT
+4 QUIT
SETGIN SET GLEFT=$PIECE(^GMR(126,DA(1),"IV",DA,"IN",GDA,0),"^",2)
SET GXX=^(0)
+1 SET GINTAKE=$SELECT($EXTRACT(GLEFT)=".":GTOTAL-GLEFT,$ASCII($EXTRACT(GLEFT))<48!($ASCII($EXTRACT(GLEFT))>57):0,1:GTOTAL-GLEFT)
SET GTOTAL=GTOTAL-GINTAKE
SET (GIN(GDT),GIN(GDA))=GLEFT_"^"_GINTAKE_"^"_$PIECE(GXX,"^",4)_"^"_GSOL
if GLEFT["*"
SET GSTAR="unknown"
KILL GXX
QUIT
LOCK ;CONVERT TO LOCK/PORT
+1 SET GHLOC=GMRHLOC
KILL DD
SET X=+GX
SET DLAYGO=126.03
SET DA(1)=DFN
SET DIC="^GMR(126,"_DA(1)_",""IV"","
SET DIC(0)="ML"
DO WAIT^GMRYUT0
if GMROUT
QUIT
DO FILE^DICN
LOCK -^GMR(126,DFN)
KILL DIC,DLAYGO,DD
SET DA=+Y
if Y'>0!GMROUT
QUIT
+2 SET DIE="^GMR(126,"_DA(1)_",""IV"","
SET DR="2///^S X=GMRZ;3///^S X=GMRZ(1);4///^S X=GMRZ(2);11///^S X=GMRZ(3);6///^S X=""`""_DUZ;7///^S X=""`""_GHLOC;1///^S X=GSITE;17///^S X=GCATH(1)"
+3 DO WAIT^GMRYUT0
if 'GMROUT
DO ^DIE
KILL DIE,DR
if 'GMROUT
LOCK -^GMR(126,DFN)
QUIT
MOREDRN ;ENTER MORE THAN ONE DRAINAGE DATA
+1 KILL DD
SET DLAYGO=126.02
SET X=+GX
SET DA(1)=DFN
SET DIC="^GMR(126,"_DA(1)_","""_GNANS_""","
SET DIC(0)="ML"
DO WAIT^GMRYUT0
if GMROUT
QUIT
DO FILE^DICN
LOCK -^GMR(126,DFN)
KILL DIC,DLAYGO,DD
SET DA=+Y
if Y'>0
SET GMROUT=1
QUIT
DC ;DC IV FROM IV INTAKE
+1 SET GDATA=^GMR(126,DFN,"IV",DA,0)
SET GDT=$PIECE(GDATA,"^")
SET GTYPE=$PIECE(GDATA,"^",4)
WRITE !!,"Discontinue ",?5,$PIECE(GDATA,"^",3)_" "_$SELECT(GTYPE'["L":$PIECE(GDATA,"^",5)_" mls ("_GTYPE_") ",1:"")_$PIECE(GDATA,"^",2)
+2 SET Y=GDT
XECUTE ^DD("DD")
WRITE " started on "_$PIECE(Y,":",1,2),!
+3 SET GDCDT=+GX
SET DIE="^GMR(126,"_DA(1)_",""IV"","
SET DR="8///^S X=+GX;9///^S X=""`""_DUZ;10///^D DCREASON^GMRYUT11"
DO WAIT^GMRYUT0
IF 'GMROUT
DO ^DIE
LOCK -^GMR(126,DFN)
+4 KILL DIE,DR
QUIT
