GMRYED6 ;HIRMFO/YH-D/C IV AND IV SITE MAINTENANCE ;9/10/92
;;4.0;Intake/Output;;Apr 25, 1997
ADDSOL1 S DA=DFN,(GMROUT,GMRDC)=0 D LISTIV^GMRYUT0,SEL^GMRYUT13 I GMROUT D Q4 Q
Q:$G(GMRZ(1))="" S GCATH(2)=$S($D(^GMRD(126.74,"B",GCATH)):$O(^GMRD(126.74,"B",GCATH,0)),1:"")
REMOVE S GMRVTYP=GMRZ(1) D DC I GMROUT D Q4 Q
S GREC=DA,GMRDEL="",(GX,GDCDT)=$P(^GMR(126,DA(1),"IV",DA,0),"^",9),GDCREAS=$P(^(0),"^",11),GLOC=$P(^(0),"^",2) G:GDCDT="" Q4 G:$P(^(0),"^",2)="" Q4 I '$D(^GMR(126,DA(1),"IV",DA,"IN",0)) S GLABEL="",GHLOC=GMRHLOC D DC^GMRYUT0 G ADD
I '$D(^GMR(126,DA(1),"IV",DA,"IN","C")) S GLABEL="",GHLOC=GMRHLOC D DC^GMRYUT0 G ADD
S GDT=$O(^GMR(126,DA(1),"IV",DA,"IN","C",0)) I GDT'>0 S GLABEL="",GHLOC=GMRHLOC D DC^GMRYUT0 G ADD
S GGDA=$O(^GMR(126,DA(1),"IV",DA,"IN","C",GDT,0)) G:GGDA'>0 ADD W !,"Last reading for AMOUNT LEFT is "_$P(^GMR(126,DA(1),"IV",DA,"IN",GGDA,0),"^",2)_" mls"
I $P(^GMR(126,DA(1),"IV",DA,"IN",GGDA,0),"^",2)'>0 D IVINTK^GMRYUT8 G:GMROUT ADD W !,"Total amount absorbed for this solution: "_$S($P(^GMR(126,DA(1),"IV",DA,"IN",GGDA,0),"^",2)["*":"UNKNOWN",1:($P(GDATA,"^",5)-GTOTAL)_" mls"),! G ADD
NEXT ;
K DD S DA(2)=DA(1),DA(1)=DA,(GX,X)=GDCDT,GMRDEL="",DIC="^GMR(126,"_DA(2)_",""IV"","_DA(1)_",""IN"",",DIC(0)="ML",DLAYGO=126.313 D WAIT^GMRYUT0 G:GMROUT Q4 D FILE^DICN L -^GMR(126,DFN) K DR,DIC,DLAYGO,DD S DA=+Y I Y'>0 G Q4
S GHLOC=GMRHLOC,GLABEL="" D IV^GMRYUT8 G:'$D(GTOTAL) ADD W !,"Total amount absorbed for this solution: ",($P(GDATA,"^",5)-GTOTAL)_" mls",!
ADD I GMROUT D CANCEL G Q4
I GOPT["DCIV",$D(^GMR(126,DFN,"IV",G(1),"IN",0)) S I=+$P(^(0),"^",3) S GST(GSITE,G,G(1))=GMRVTYP_"^"_$S($D(^GMR(126,DFN,"IV",G(1),"IN",I,0)):$P(^(0),"^",2),1:"")
ASK Q:GOPT["DCIV" S GADD="",GMROUT=0 W !,"Do you wish to ",!,?5,"Convert to lock/port",!,?5,"Hang a new solution",!,"Please enter the FIRST character for your selection or press return to continue: "
R GADD:DTIME I '$T!(GADD["^") D CANCEL S GMROUT=1 G Q4
I GADD["?" W !,"The current solution has been discontinued.",!,"Do you want to hang a new bottle or convert the line to a lock/port",! G ASK
I GADD="" S GSAVE=GSITE D SELSITE^GMRYMNT S GSITE=GSAVE
I GADD="",+$G(GCT(GLOC))>0 W !,"The solution has been DC'ed" G Q4
I GADD="",+$G(GCT(GLOC))=0 S %=1 W !,"The IV site has no more solutions hanging. Do you want to DC IV SITE" D YN^DICN G:%'=1 ASK S GSAVE=GOPT,GOPT="DCIV",GX=GDCDT,DA(1)=DFN,DA=$O(^GMR(126,DFN,"IVM","B",GSITE,0)) D EN4^GMRYUT5 S GOPT=GSAVE Q
S GADD=$E(GADD),GADD=$S("Cc"[GADD:"C","Hh"[GADD:"H",1:"") G:GADD="" ASK
W !,$S(GADD["C":"Convert to lock/port",GADD["D":"DC the IV",GADD["H":"Hang new solution",1:"") ;S %=1 D YN^DICN G:%'=1 ASK
ASK1 I GADD["H" S DA=DFN,GADD="Y",GX=GDCDT,GMRDEL="",GDR=0 D SOLTYPE^GMRYUT7 G:GMROUT ASK D ADDIV^GMRYED2
I GADD["C" S DA=DFN,GADD="Y",GX=GDCDT,GMRDEL="",GDR=0,GMRVTYP="L",GMRZ(1)="L",GMRZ(2)="*",GMRZ(3)="" D LOCK^GMRYED5 G:GMROUT ASK S GMRZ="LOCK/PORT" D LOCK^GMRYUT8
D:GMROUT CANCEL D ASK1^GMRYED5 G Q4
STCARE G:GSITE="" Q4 S GX=$S(GDCIV=6:GX,1:GDCDT),DA(1)=DFN,DA=$O(^GMR(126,DA(1),"IVM","B",GSITE,0)) D EN4^GMRYUT5
Q4 Q:GDCIV>1&(GDCIV<5)
D KILLV^GMRYUT0 K GLOC,GSTAR,GCATH,GMRX,GMRY,GADD,GDATA,GHLOC,GMRZ,GTEYPE,GTOTAL,GMRDEL,GNN,GTXT,X,Y,GDC,GMRDC,GMRAMT,GMRQUAL,GX,GLABEL,GTYPE Q
;
DC Q:$G(GMRZ(1))="" S:$D(GDCDA) GDCDA=DA S GDATA=^GMR(126,DA(1),"IV",DA,0),GDT=$P(GDATA,"^"),GTYPE=$P(GDATA,"^",4) W !!,"Discontinued ",?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 GSITE=$P(GDATA,"^",2) D:+$G(GDCIV)'=1 DCREASON^GMRYUT11 Q:GMROUT
S DIE="^GMR(126,"_DA(1)_",""IV"",",DR=$S(GDCIV=1:"8///^S X=GDCDT;",1:"8//NOW;")_"9///^S X=""`""_DUZ;10///^S X=GDCREAS" D WAIT^GMRYUT0 I GMROUT K DIE,DR Q
D ^DIE L -^GMR(126,DFN) K DIE,DR S GREC=DA
I $P(^GMR(126,DA(1),"IV",DA,0),"^",9)="" S GMROUT=1,$P(^(0),"^",10)="",$P(^(0),"^",11)=""
Q
CANCEL ;
S $P(^GMR(126,DFN,"IV",GREC,0),"^",9)="",$P(^(0),"^",10)="",$P(^(0),"^",11)="",GMROUT=1 W !,"DC cancelled!!!",! Q:'$D(GREC(1)) Q:GREC(1)=0
S DA(2)=DFN,DA(1)=GREC,DA=GREC(1),DIK="^GMR(126,"_DA(2)_",""IV"","_DA(1)_",""IN"",",(X,GX)=GDCDT D ^DIK K DIK W !,"The IV intake record has been deleted",!! Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRYED6 4242 printed Dec 13, 2024@01:55:21 Page 2
GMRYED6 ;HIRMFO/YH-D/C IV AND IV SITE MAINTENANCE ;9/10/92
+1 ;;4.0;Intake/Output;;Apr 25, 1997
ADDSOL1 SET DA=DFN
SET (GMROUT,GMRDC)=0
DO LISTIV^GMRYUT0
DO SEL^GMRYUT13
IF GMROUT
DO Q4
QUIT
+1 if $GET(GMRZ(1))=""
QUIT
SET GCATH(2)=$SELECT($DATA(^GMRD(126.74,"B",GCATH)):$ORDER(^GMRD(126.74,"B",GCATH,0)),1:"")
REMOVE SET GMRVTYP=GMRZ(1)
DO DC
IF GMROUT
DO Q4
QUIT
+1 SET GREC=DA
SET GMRDEL=""
SET (GX,GDCDT)=$PIECE(^GMR(126,DA(1),"IV",DA,0),"^",9)
SET GDCREAS=$PIECE(^(0),"^",11)
SET GLOC=$PIECE(^(0),"^",2)
if GDCDT=""
GOTO Q4
if $PIECE(^(0),"^",2)=""
GOTO Q4
IF '$DATA(^GMR(126,DA(1),"IV",DA,"IN",0))
SET GLABEL=""
SET GHLOC=GMRHLOC
DO DC^GMRYUT0
GOTO ADD
+2 IF '$DATA(^GMR(126,DA(1),"IV",DA,"IN","C"))
SET GLABEL=""
SET GHLOC=GMRHLOC
DO DC^GMRYUT0
GOTO ADD
+3 SET GDT=$ORDER(^GMR(126,DA(1),"IV",DA,"IN","C",0))
IF GDT'>0
SET GLABEL=""
SET GHLOC=GMRHLOC
DO DC^GMRYUT0
GOTO ADD
+4 SET GGDA=$ORDER(^GMR(126,DA(1),"IV",DA,"IN","C",GDT,0))
if GGDA'>0
GOTO ADD
WRITE !,"Last reading for AMOUNT LEFT is "_$PIECE(^GMR(126,DA(1),"IV",DA,"IN",GGDA,0),"^",2)_" mls"
+5 IF $PIECE(^GMR(126,DA(1),"IV",DA,"IN",GGDA,0),"^",2)'>0
DO IVINTK^GMRYUT8
if GMROUT
GOTO ADD
WRITE !,"Total amount absorbed for this solution: "_$SELECT($PIECE(^GMR(126,DA(1),"IV",DA,"IN",GGDA,0),"^",2)["*":"UNKNOWN",1:($PIECE(GDATA,"^",5)-GTOTAL)_" mls"),!
GOTO ADD
NEXT ;
+1 KILL DD
SET DA(2)=DA(1)
SET DA(1)=DA
SET (GX,X)=GDCDT
SET GMRDEL=""
SET DIC="^GMR(126,"_DA(2)_",""IV"","_DA(1)_",""IN"","
SET DIC(0)="ML"
SET DLAYGO=126.313
DO WAIT^GMRYUT0
if GMROUT
GOTO Q4
DO FILE^DICN
LOCK -^GMR(126,DFN)
KILL DR,DIC,DLAYGO,DD
SET DA=+Y
IF Y'>0
GOTO Q4
+2 SET GHLOC=GMRHLOC
SET GLABEL=""
DO IV^GMRYUT8
if '$DATA(GTOTAL)
GOTO ADD
WRITE !,"Total amount absorbed for this solution: ",($PIECE(GDATA,"^",5)-GTOTAL)_" mls",!
ADD IF GMROUT
DO CANCEL
GOTO Q4
+1 IF GOPT["DCIV"
IF $DATA(^GMR(126,DFN,"IV",G(1),"IN",0))
SET I=+$PIECE(^(0),"^",3)
SET GST(GSITE,G,G(1))=GMRVTYP_"^"_$SELECT($DATA(^GMR(126,DFN,"IV",G(1),"IN",I,0)):$PIECE(^(0),"^",2),1:"")
ASK if GOPT["DCIV"
QUIT
SET GADD=""
SET GMROUT=0
WRITE !,"Do you wish to ",!,?5,"Convert to lock/port",!,?5,"Hang a new solution",!,"Please enter the FIRST character for your selection or press return to continue: "
+1 READ GADD:DTIME
IF '$TEST!(GADD["^")
DO CANCEL
SET GMROUT=1
GOTO Q4
+2 IF GADD["?"
WRITE !,"The current solution has been discontinued.",!,"Do you want to hang a new bottle or convert the line to a lock/port",!
GOTO ASK
+3 IF GADD=""
SET GSAVE=GSITE
DO SELSITE^GMRYMNT
SET GSITE=GSAVE
+4 IF GADD=""
IF +$GET(GCT(GLOC))>0
WRITE !,"The solution has been DC'ed"
GOTO Q4
+5 IF GADD=""
IF +$GET(GCT(GLOC))=0
SET %=1
WRITE !,"The IV site has no more solutions hanging. Do you want to DC IV SITE"
DO YN^DICN
if %'=1
GOTO ASK
SET GSAVE=GOPT
SET GOPT="DCIV"
SET GX=GDCDT
SET DA(1)=DFN
SET DA=$ORDER(^GMR(126,DFN,"IVM","B",GSITE,0))
DO EN4^GMRYUT5
SET GOPT=GSAVE
QUIT
+6 SET GADD=$EXTRACT(GADD)
SET GADD=$SELECT("Cc"[GADD:"C","Hh"[GADD:"H",1:"")
if GADD=""
GOTO ASK
+7 ;S %=1 D YN^DICN G:%'=1 ASK
WRITE !,$SELECT(GADD["C":"Convert to lock/port",GADD["D":"DC the IV",GADD["H":"Hang new solution",1:"")
ASK1 IF GADD["H"
SET DA=DFN
SET GADD="Y"
SET GX=GDCDT
SET GMRDEL=""
SET GDR=0
DO SOLTYPE^GMRYUT7
if GMROUT
GOTO ASK
DO ADDIV^GMRYED2
+1 IF GADD["C"
SET DA=DFN
SET GADD="Y"
SET GX=GDCDT
SET GMRDEL=""
SET GDR=0
SET GMRVTYP="L"
SET GMRZ(1)="L"
SET GMRZ(2)="*"
SET GMRZ(3)=""
DO LOCK^GMRYED5
if GMROUT
GOTO ASK
SET GMRZ="LOCK/PORT"
DO LOCK^GMRYUT8
+2 if GMROUT
DO CANCEL
DO ASK1^GMRYED5
GOTO Q4
STCARE if GSITE=""
GOTO Q4
SET GX=$SELECT(GDCIV=6:GX,1:GDCDT)
SET DA(1)=DFN
SET DA=$ORDER(^GMR(126,DA(1),"IVM","B",GSITE,0))
DO EN4^GMRYUT5
Q4 if GDCIV>1&(GDCIV<5)
QUIT
+1 DO KILLV^GMRYUT0
KILL GLOC,GSTAR,GCATH,GMRX,GMRY,GADD,GDATA,GHLOC,GMRZ,GTEYPE,GTOTAL,GMRDEL,GNN,GTXT,X,Y,GDC,GMRDC,GMRAMT,GMRQUAL,GX,GLABEL,GTYPE
QUIT
+2 ;
DC if $GET(GMRZ(1))=""
QUIT
if $DATA(GDCDA)
SET GDCDA=DA
SET GDATA=^GMR(126,DA(1),"IV",DA,0)
SET GDT=$PIECE(GDATA,"^")
SET GTYPE=$PIECE(GDATA,"^",4)
WRITE !!,"Discontinued ",?5,$PIECE(GDATA,"^",3)_" "_$SELECT(GTYPE'["L":$PIECE(GDATA,"^",5)_" mls ("_GTYPE_") ",1:"")_$PIECE(GDATA,"^",2)
+1 SET Y=GDT
XECUTE ^DD("DD")
WRITE " started on "_$PIECE(Y,":",1,2),!
SET GSITE=$PIECE(GDATA,"^",2)
if +$GET(GDCIV)'=1
DO DCREASON^GMRYUT11
if GMROUT
QUIT
+2 SET DIE="^GMR(126,"_DA(1)_",""IV"","
SET DR=$SELECT(GDCIV=1:"8///^S X=GDCDT;",1:"8//NOW;")_"9///^S X=""`""_DUZ;10///^S X=GDCREAS"
DO WAIT^GMRYUT0
IF GMROUT
KILL DIE,DR
QUIT
+3 DO ^DIE
LOCK -^GMR(126,DFN)
KILL DIE,DR
SET GREC=DA
+4 IF $PIECE(^GMR(126,DA(1),"IV",DA,0),"^",9)=""
SET GMROUT=1
SET $PIECE(^(0),"^",10)=""
SET $PIECE(^(0),"^",11)=""
+5 QUIT
CANCEL ;
+1 SET $PIECE(^GMR(126,DFN,"IV",GREC,0),"^",9)=""
SET $PIECE(^(0),"^",10)=""
SET $PIECE(^(0),"^",11)=""
SET GMROUT=1
WRITE !,"DC cancelled!!!",!
if '$DATA(GREC(1))
QUIT
if GREC(1)=0
QUIT
+2 SET DA(2)=DFN
SET DA(1)=GREC
SET DA=GREC(1)
SET DIK="^GMR(126,"_DA(2)_",""IV"","_DA(1)_",""IN"","
SET (X,GX)=GDCDT
DO ^DIK
KILL DIK
WRITE !,"The IV intake record has been deleted",!!
QUIT
