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