GMRYUT7.m

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

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