GMRYUT7 ;HIRMFO/YH-IV SOLUTION SELECT TO START ;10/16/96
;;4.0;Intake/Output;;Apr 25, 1997
SOLTYPE ;SELECT SOLUTION TYPE
S GMRVTYP=""
W !,"Select one of the IV types listed below",!,?5,"A - admixture",!,?5,"B - blood/blood product",!,?5,"H - hyperal",!,?5,"I - intralipid",!,?5,"P - piggyback",!,?5,"L - locks/ports",!,?5,"Please enter a character: " S X="" R X:DTIME
I '$T!(X["^") S GMROUT=1 Q
S GMRVTYP=$S("Aa"[X:"A","Hh"[X:"H","Ii"[X:"I","Bb"[X:"B","Pp"[X:"P","Ll"[X:"L",1:"") I GMRVTYP'=""&(X'="") D Q
. W " "_$S(GMRVTYP="A":"admixture",GMRVTYP="B":"blood/blood product",GMRVTYP="H":"hyperal",GMRVTYP="I":"intralipid",GMRVTYP="P":"piggyback",GMRVTYP="L":"locks/ports",1:"")
. Q
W !,"Select type of IV solution you want to hang by entering",!,"the first character of the solution category",! G SOLTYPE
Q
NURSOL ;SELECT IV SOLUTION FROM NUR SOLUTION FILE 126.9 TO HUNG
K GMRY,GMRB S (GMRY,GMRX)=0 F S GMRX=$O(^GMRD(126.9,"C",GMRVTYP,GMRX)) Q:GMRX'>0 I $D(^GMRD(126.9,GMRX,0)) S GMRY=GMRY+1,GMRB($P(^(0),"^"))=^(0)
S GMRB(" OTHER")="OTHER^"_GMRVTYP_"^0",GMRY=0,GMRB="" F S GMRB=$O(GMRB(GMRB)) Q:GMRB="" S GMRY=GMRY+1,GMRY(GMRY)=GMRB(GMRB)
SEL0 I GMRY=0 W !,"No solutions found in the NURS SOLUTION FILE 126.9",! S GMROUT=1 Q
S GMRN=(GMRY\2)+(GMRY#2) F I=1:1:GMRN S $P(GTXT(I)," ",80)="" I $D(GMRY(I)) S X="",X=I_". "_$P(GMRY(I),"^")_" "_+$P(GMRY(I),"^",3)_" mls",GTXT(I)=X_$E(GTXT(I),$L(X),80)
F I=GMRN+1:1:GMRY I $D(GMRY(I)) S GTXT(I-GMRN)=$E(GTXT(I-GMRN),1,40)_I_". "_$P(GMRY(I),"^")_" "_+$P(GMRY(I),"^",3)_" mls"
SEL W !!,"Select a(n) "_$S(GMRVTYP="A":"admixture",GMRVTYP="B":"blood/blood product",GMRVTYP="H":"hyperal",GMRVTYP="I":"intralipid",GMRVTYP="P":"piggyback",1:"")_" from the following Nursing Solution file listing ",! F I=1:1:GMRN W !,GTXT(I)
W !!,"Enter a number/name for your selection,",!,"Enter additional vitamins/electrolytes using a ; to separate,",!,"for example, 4;multivits): " S X="" R X:DTIME I '$T!(X["^") S GMROUT=1 K GMRB,GTXT,GMRN Q
I X=""!(X["?")!(X>GMRY) W !,"Enter the number or the first couple of letters of",!,"the solution you want to start",! G SEL
I X>0,$D(GMRY(+X)) S Y(0)=GMRY(+X),$P(Y(0),"^")=$P(Y(0),"^")_$P(X,+X,2) D:$P(Y(0),"^")["OTHER" OTHRSOL^GMRYUT10 K GMRB,GTXT,GMRN Q
Q:GMROUT S X=$$UP^XLFSTR(X) K GMRB,GTXT,GMRW,GMRX S (GMRW,GMRX)=0 F S GMRX=$O(GMRY(GMRX)) Q:GMRX'>0 I $E($P(GMRY(GMRX),"^"),1,$L(X))=X S GMRW=GMRW+1,GMRW(GMRW)=GMRY(GMRX)
I GMRW=0 W !,"No solution selected",! G SEL0
K GMRY S GMRY=GMRW F I=1:1:GMRY S GMRY(I)=GMRW(I)
G SEL0
SITEDC ;SCREEN THE SELECTED IV SITE WAS D/C'D
Q:GMROUT N GDA S GSTDC=0,GDA=+$P(^GMR(126,DA(2),"IVM",DA(1),1,0),"^",3) Q:GDA'>0 S:$P(^GMR(126,DA(2),"IVM",DA(1),1,GDA,0),"^",6)["Y" GSTDC=1 Q
DRAIN ;SELECT SUBTYPE OF OUTPUT DRAINAGE
K GMRY,GTXT S GMRZ="",(GMRY,GMRX)=0 F S GMRX=$O(^GMRD(126.6,"C",GTP,GMRX)) Q:GMRX'>0 I $D(^GMRD(126.6,GMRX,0)) S GMRY=GMRY+1,GMRY(GMRY)=$P(^(0),"^")_"^"_GMRX
I GMRY=0 W !,"No OUTPUT SUBTYPE set!!!",! K GMRY,GMRX Q
S GMRN=(GMRY\2)+(GMRY#2) F I=1:1:GMRN S $P(GTXT(I)," ",80)="" I $D(GMRY(I)) S X="",X=I_". "_$P(GMRY(I),"^"),GTXT(I)=X_$E(GTXT(I),$L(X),80)
F I=GMRN+1:1:GMRY I $D(GMRY(I)) S GTXT(I-GMRN)=$E(GTXT(I-GMRN),1,30)_I_". "_$P(GMRY(I),"^")
F I=1:1:GMRN W !,GTXT(I)
W !,"Select a number for the "_GLABEL_" SUBTYPE(optional): " S X="" R X:DTIME S:'$T GMROUT=1 S:X["^" (GMROUT,GMROUT(1))=1 I GMROUT!(X="")!GMROUT(1) K GMRY,GMRX,GMRN,GTXT Q
I X>0,$D(GMRY(+X)) S GMRZ=+$P(GMRY(+X),"^",2) W !,$P(GMRY(+X),"^") Q
W !,"Subtype for "_GLABEL_" is optional. However if you to wish",!,"to identify the subtype of "_GLABEL_", then enter the number of your selection",! G DRAIN
SELSITE ;
N GMRZ,I S (GMRZ,I)=0 F S I=$O(GMRY(I)) Q:I'>0 I $E($P(GMRY(I),"^",2))=GMRX S GMRZ=GMRZ+1,GMRZ(GMRZ)=$P(GMRY(I),"^",2)
Q:GMRZ=0 I GMRZ=1 S X=GMRZ(1) Q
S I=0 F S I=$O(GMRZ(I)) Q:I'>0 W !,I_". "_GMRZ(I)
W !,"Select a number from the above list: " S I=0 R I:DTIME I '$T!(I["^") S GMROUT=1 Q
I $D(GMRZ(+I)) S X=GMRZ(+I) Q
G SELSITE
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HGMRYUT7 4030 printed Dec 13, 2024@01:55:52 Page 2
GMRYUT7 ;HIRMFO/YH-IV SOLUTION SELECT TO START ;10/16/96
+1 ;;4.0;Intake/Output;;Apr 25, 1997
SOLTYPE ;SELECT SOLUTION TYPE
+1 SET GMRVTYP=""
+2 WRITE !,"Select one of the IV types listed below",!,?5,"A - admixture",!,?5,"B - blood/blood product",!,?5,"H - hyperal",!,?5,"I - intralipid",!,?5,"P - piggyback",!,?5,"L - locks/ports",!,?5,"Please enter a character: "
SET X=""
READ X:DTIME
+3 IF '$TEST!(X["^")
SET GMROUT=1
QUIT
+4 SET GMRVTYP=$SELECT("Aa"[X:"A","Hh"[X:"H","Ii"[X:"I","Bb"[X:"B","Pp"[X:"P","Ll"[X:"L",1:"")
IF GMRVTYP'=""&(X'="")
Begin DoDot:1
+5 WRITE " "_$SELECT(GMRVTYP="A":"admixture",GMRVTYP="B":"blood/blood product",GMRVTYP="H":"hyperal",GMRVTYP="I":"intralipid",GMRVTYP="P":"piggyback",GMRVTYP="L":"locks/ports",1:"")
+6 QUIT
End DoDot:1
QUIT
+7 WRITE !,"Select type of IV solution you want to hang by entering",!,"the first character of the solution category",!
GOTO SOLTYPE
+8 QUIT
NURSOL ;SELECT IV SOLUTION FROM NUR SOLUTION FILE 126.9 TO HUNG
+1 KILL GMRY,GMRB
SET (GMRY,GMRX)=0
FOR
SET GMRX=$ORDER(^GMRD(126.9,"C",GMRVTYP,GMRX))
if GMRX'>0
QUIT
IF $DATA(^GMRD(126.9,GMRX,0))
SET GMRY=GMRY+1
SET GMRB($PIECE(^(0),"^"))=^(0)
+2 SET GMRB(" OTHER")="OTHER^"_GMRVTYP_"^0"
SET GMRY=0
SET GMRB=""
FOR
SET GMRB=$ORDER(GMRB(GMRB))
if GMRB=""
QUIT
SET GMRY=GMRY+1
SET GMRY(GMRY)=GMRB(GMRB)
SEL0 IF GMRY=0
WRITE !,"No solutions found in the NURS SOLUTION FILE 126.9",!
SET GMROUT=1
QUIT
+1 SET GMRN=(GMRY\2)+(GMRY#2)
FOR I=1:1:GMRN
SET $PIECE(GTXT(I)," ",80)=""
IF $DATA(GMRY(I))
SET X=""
SET X=I_". "_$PIECE(GMRY(I),"^")_" "_+$PIECE(GMRY(I),"^",3)_" mls"
SET GTXT(I)=X_$EXTRACT(GTXT(I),$LENGTH(X),80)
+2 FOR I=GMRN+1:1:GMRY
IF $DATA(GMRY(I))
SET GTXT(I-GMRN)=$EXTRACT(GTXT(I-GMRN),1,40)_I_". "_$PIECE(GMRY(I),"^")_" "_+$PIECE(GMRY(I),"^",3)_" mls"
SEL WRITE !!,"Select a(n) "_$SELECT(GMRVTYP="A":"admixture",GMRVTYP="B":"blood/blood product",GMRVTYP="H":"hyperal",GMRVTYP="I":"intralipid",GMRVTYP="P":"piggyback",1:"")_" from the following Nursing Solution file listing ",!
FOR I=1:1:GMRN
WRITE !,GTXT(I)
+1 WRITE !!,"Enter a number/name for your selection,",!,"Enter additional vitamins/electrolytes using a ; to separate,",!,"for example, 4;multivits): "
SET X=""
READ X:DTIME
IF '$TEST!(X["^")
SET GMROUT=1
KILL GMRB,GTXT,GMRN
QUIT
+2 IF X=""!(X["?")!(X>GMRY)
WRITE !,"Enter the number or the first couple of letters of",!,"the solution you want to start",!
GOTO SEL
+3 IF X>0
IF $DATA(GMRY(+X))
SET Y(0)=GMRY(+X)
SET $PIECE(Y(0),"^")=$PIECE(Y(0),"^")_$PIECE(X,+X,2)
if $PIECE(Y(0),"^")["OTHER"
DO OTHRSOL^GMRYUT10
KILL GMRB,GTXT,GMRN
QUIT
+4 if GMROUT
QUIT
SET X=$$UP^XLFSTR(X)
KILL GMRB,GTXT,GMRW,GMRX
SET (GMRW,GMRX)=0
FOR
SET GMRX=$ORDER(GMRY(GMRX))
if GMRX'>0
QUIT
IF $EXTRACT($PIECE(GMRY(GMRX),"^"),1,$LENGTH(X))=X
SET GMRW=GMRW+1
SET GMRW(GMRW)=GMRY(GMRX)
+5 IF GMRW=0
WRITE !,"No solution selected",!
GOTO SEL0
+6 KILL GMRY
SET GMRY=GMRW
FOR I=1:1:GMRY
SET GMRY(I)=GMRW(I)
+7 GOTO SEL0
SITEDC ;SCREEN THE SELECTED IV SITE WAS D/C'D
+1 if GMROUT
QUIT
NEW GDA
SET GSTDC=0
SET GDA=+$PIECE(^GMR(126,DA(2),"IVM",DA(1),1,0),"^",3)
if GDA'>0
QUIT
if $PIECE(^GMR(126,DA(2),"IVM",DA(1),1,GDA,0),"^",6)["Y"
SET GSTDC=1
QUIT
DRAIN ;SELECT SUBTYPE OF OUTPUT DRAINAGE
+1 KILL GMRY,GTXT
SET GMRZ=""
SET (GMRY,GMRX)=0
FOR
SET GMRX=$ORDER(^GMRD(126.6,"C",GTP,GMRX))
if GMRX'>0
QUIT
IF $DATA(^GMRD(126.6,GMRX,0))
SET GMRY=GMRY+1
SET GMRY(GMRY)=$PIECE(^(0),"^")_"^"_GMRX
+2 IF GMRY=0
WRITE !,"No OUTPUT SUBTYPE set!!!",!
KILL GMRY,GMRX
QUIT
+3 SET GMRN=(GMRY\2)+(GMRY#2)
FOR I=1:1:GMRN
SET $PIECE(GTXT(I)," ",80)=""
IF $DATA(GMRY(I))
SET X=""
SET X=I_". "_$PIECE(GMRY(I),"^")
SET GTXT(I)=X_$EXTRACT(GTXT(I),$LENGTH(X),80)
+4 FOR I=GMRN+1:1:GMRY
IF $DATA(GMRY(I))
SET GTXT(I-GMRN)=$EXTRACT(GTXT(I-GMRN),1,30)_I_". "_$PIECE(GMRY(I),"^")
+5 FOR I=1:1:GMRN
WRITE !,GTXT(I)
+6 WRITE !,"Select a number for the "_GLABEL_" SUBTYPE(optional): "
SET X=""
READ X:DTIME
if '$TEST
SET GMROUT=1
if X["^"
SET (GMROUT,GMROUT(1))=1
IF GMROUT!(X="")!GMROUT(1)
KILL GMRY,GMRX,GMRN,GTXT
QUIT
+7 IF X>0
IF $DATA(GMRY(+X))
SET GMRZ=+$PIECE(GMRY(+X),"^",2)
WRITE !,$PIECE(GMRY(+X),"^")
QUIT
+8 WRITE !,"Subtype for "_GLABEL_" is optional. However if you to wish",!,"to identify the subtype of "_GLABEL_", then enter the number of your selection",!
GOTO DRAIN
SELSITE ;
+1 NEW GMRZ,I
SET (GMRZ,I)=0
FOR
SET I=$ORDER(GMRY(I))
if I'>0
QUIT
IF $EXTRACT($PIECE(GMRY(I),"^",2))=GMRX
SET GMRZ=GMRZ+1
SET GMRZ(GMRZ)=$PIECE(GMRY(I),"^",2)
+2 if GMRZ=0
QUIT
IF GMRZ=1
SET X=GMRZ(1)
QUIT
+3 SET I=0
FOR
SET I=$ORDER(GMRZ(I))
if I'>0
QUIT
WRITE !,I_". "_GMRZ(I)
+4 WRITE !,"Select a number from the above list: "
SET I=0
READ I:DTIME
IF '$TEST!(I["^")
SET GMROUT=1
QUIT
+5 IF $DATA(GMRZ(+I))
SET X=GMRZ(+I)
QUIT
+6 GOTO SELSITE
