APSKAMN5.m

APSKAMN5 ;IHS/ANMC/SFB/MRS - CALC MIN & MAX SERUM CONC.,DOSING INTERVALS & RATE; [ 09/28/94  1:03 PM ]

 ;;1.0;Aminoglycoside Kinetics;;OCT 31,1994

 ;

LOOP ;EP

 ;===>DETERMINS THE MAXIMUM AND MINIMUM SERUM CONCENTRATIONS BASED ON

 ;===>THE USERS INPUTS OF ACCEPTABLE INFUSION RATE AND DOSING INTERVAL.

 ;===>THE USER HAS THE OPPORTUNITY REPEAT THE MAX AND MIN SERUM

 ;===>CONCENTRATIONS.

 I APSKPTIN=0 D NOINFO^APSKAMN Q

 S APSKXX=-APSKK1*APSKT0 D EXP^APSKAMN6

 S APSKC4A=APSKK3*(1-APSKEE)

 S APSKXX=(-APSKK1*APSKT3) D EXP^APSKAMN6

 S APSKC4B=(APSKK1*APSKV1*(1-APSKEE))

 S APSKC4=(APSKC4A/APSKC4B)

 S APSKXX=(-APSKK1*(APSKT3-APSKT0)) D EXP^APSKAMN6

 S APSKC5=APSKC4*APSKEE

 S APSKC4=$P(100*APSKC4+.5,".",1)/100

 S APSKC4=$E(APSKC4,1,6)

 S APSKC5=$P(100*APSKC5+.5,".",1)/100

 I APSKFIN=1 D SB,FINALR Q

 W !,APSKK3," mg/hr given over ",APSKT0," hour every ",APSKT3," hours will produce:"

 W !,"    ",$J(APSKC4,3,2)," mcg per ml MAXIMUM serum concentrations"

 W !,"    ",$J(APSKC5,3,2)," mcg per ml MINIMUM serum concentrations"

 W !!

 K DIR S DIR(0)="Y",DIR("B")="YES"

 S DIR("A")="Do you want this option printed on the final worksheet "

 D ^DIR G END:$D(DIRUT)

 I Y=1 D SB

SKIP2 K DIR S DIR(0)="Y",DIR("B")="YES"

 S DIR("A")="Do you wish to change the dose or the dosing interval"

 D ^DIR G END:$D(DIRUT) S APSKQ=Y

 ;===>IF USER WISHES TO CHANGE DOSE AND INTERVAL GO TO REPEAT

 I APSKQ=1 G REPEAT

 K DIR S DIR(0)="Y" W !!

 S DIR("A")="Is the current choice your FINAL recommendation"

 D ^DIR G END:$D(DIRUT) S APSKCC=Y

 ;===>IF IT IS THE FINAL RECOMMENDATION QUIT. OTHEWISE,

 ;===>GO TO REPEAT2 AND ENTER THE RECOMMENDED DOSE AND INTERVAL

 I APSKCC=1 G FINALR

REPEAT2 ;===>USER ENTERS RECOMMENDED DOSE AND INTERVAL

 ;===>THE MAXIMUM AND MINIMUM SERUM CONCENTRATIONS ARE CALCULATED

 ;===>AND PRINTED IN THE FINAL PRINTOUT

 W !! K DIR S DIR(0)="N"

 S DIR("A")="Enter the Recommended DOSE"

 D ^DIR G END:$D(DIRUT) S APSKK3=Y W !

 K DIR S DIR(0)="N"

 S DIR("A")="Enter the Recommended INTERVAL"

 D ^DIR G END:$D(DIRUT) S APSKT3=Y

 S APSKFIN=1

 G LOOP

REPEAT ;EP

 I APSKPTIN=0 D NOINFO^APSKAMN Q

 K DIR S DIR(0)="N"

 S DIR("A")="Enter the new DOSE"

 D ^DIR G END:$D(DIRUT) S APSKK3=Y W !

 K DIR S DIR(0)="N"

 S DIR("A")="Enter the new INTERVAL"

 D ^DIR G END:$D(DIRUT) S APSKT3=Y

 ;===>CALCULATES NEW MAX AND MIN SERUM CONCENTRATIONS BASED ON USER'S

 ;===>    NEW DOSE AND INTERVAL VALUES.

 G LOOP

 ;

FINALR S %ZIS="PQ" D ^%ZIS G END:POP,QUE2:$D(IO("Q"))

 D EN2

 D ^%ZISC

 Q

QUE2 K IO("Q"),ZTSAVE

 F %="APSK*" S ZTSAVE(%)=""

 S ZTRTN="EN2^APSKAMN5",ZTDESC="POSSIBLE OPTIONS"

 D ^%ZTLOAD K ZTSK

 D ^%ZISC

 Q

EN2 S (APSKN0,APSKCNT,APSKPAGE)=0

 U IO D @("HDR"_(2-($E(IOST,1,2)="C-")))

 F  S APSKN0=$O(APSK(APSKN0)) Q:'APSKN0  D

 .S APSKND=APSK(APSKN0)

 .S APSKK3=$P(APSKND,"^",1),APSKT0=$P(APSKND,"^",2)

 .S APSKT3=$P(APSKND,"^",3),APSKC4=$P(APSKND,"^",4)

 .S APSKC5=$P(APSKND,"^",5)

 .D HDR1:$Y+5>IOSL

 .W !,APSKK3," mg/hr given over ",APSKT0," hour every ",APSKT3," hours will produce:"

 .W !,"    ",$J(APSKC4,3,2)," mcg per ml MAXIMUM serum concentrations"

 .W !,"    ",$J(APSKC5,3,2)," mcg per ml MINIMUM serum concentrations"

 .W !!

 .S APSKCNT=APSKCNT+1

 .I APSKNP=1 D APSKREM

 .D HDR:($Y+5>IOSL)&(APSKCNT>0) Q

 D ^%ZISC

 Q

HDR I $E(IOST,1,2)="C-" K DIR S DIR(0)="EO" D ^DIR G END:$D(DIRUT)

 Q:APSKCNT=APSKSS

HDR1 W @IOF

HDR2 S APSKPAGE=APSKPAGE+1

 I $D(IOST),$E(IOST,1,2)="C-",$Y+5>IOSL D HDR

 W ! F APSK=1:1:22 W "*"

 W " CONFIDENTIAL PATIENT INFORMATION "

 F APSK=1:1:22 W "*"

 W !,"Printed by: ",$P(^VA(200,DUZ,0),U),?(IOM-10),"PAGE: ",$J(APSKPAGE,3)

 W !!!,"THIS IS INTENDED TO BE ONLY A WORKSHEET. IT SHOULD BE SHREDDED WHEN YOU ARE"

 W !,"FINISHED."

 W !!!,"NAME:",?6,APSKNAME,?34,"DOSING WT:",APSKWT," KG"

 W !,"DATE OF ANALYSIS: ",APSKDATE,?34,"CHART NUMBER: ",APSKCHRT

 W !!?15,"AMINOGLYCOSIDE KINETICS WORKSHEET"

 W !?15,"---------------------------------"

 W !!,"POSSIBLE OPTIONS"

 W !,"----------------",!

 Q

SB S APSKSS=APSKSS+1

 S APSK(APSKSS)=APSKK3_"^"_APSKT0_"^"_APSKT3_"^"_APSKC4_"^"_APSKC5

 Q

APSKREM F APSKCLR=1:1:APSKCNT K APSK(APSKCLR)

END Q

APSKAMN5  ;IHS/ANMC/SFB/MRS - CALC MIN & MAX SERUM CONC.,DOSING INTERVALS & RATE; [ 09/28/94  1:03 PM ]

 +1       ;;1.0;Aminoglycoside Kinetics;;OCT 31,1994

 +2       ;

LOOP      ;EP

 +1       ;===>DETERMINS THE MAXIMUM AND MINIMUM SERUM CONCENTRATIONS BASED ON

 +2       ;===>THE USERS INPUTS OF ACCEPTABLE INFUSION RATE AND DOSING INTERVAL.

 +3       ;===>THE USER HAS THE OPPORTUNITY REPEAT THE MAX AND MIN SERUM

 +4       ;===>CONCENTRATIONS.

 +5        IF APSKPTIN=0

               DO NOINFO^APSKAMN

               QUIT 

 +6        SET APSKXX=-APSKK1*APSKT0

           DO EXP^APSKAMN6

 +7        SET APSKC4A=APSKK3*(1-APSKEE)

 +8        SET APSKXX=(-APSKK1*APSKT3)

           DO EXP^APSKAMN6

 +9        SET APSKC4B=(APSKK1*APSKV1*(1-APSKEE))

 +10       SET APSKC4=(APSKC4A/APSKC4B)

 +11       SET APSKXX=(-APSKK1*(APSKT3-APSKT0))

           DO EXP^APSKAMN6

 +12       SET APSKC5=APSKC4*APSKEE

 +13       SET APSKC4=$PIECE(100*APSKC4+.5,".",1)/100

 +14       SET APSKC4=$EXTRACT(APSKC4,1,6)

 +15       SET APSKC5=$PIECE(100*APSKC5+.5,".",1)/100

 +16       IF APSKFIN=1

               DO SB

               DO FINALR

               QUIT 

 +17       WRITE !,APSKK3," mg/hr given over ",APSKT0," hour every ",APSKT3," hours will produce:"

 +18       WRITE !,"    ",$JUSTIFY(APSKC4,3,2)," mcg per ml MAXIMUM serum concentrations"

 +19       WRITE !,"    ",$JUSTIFY(APSKC5,3,2)," mcg per ml MINIMUM serum concentrations"

 +20       WRITE !!

 +21       KILL DIR

           SET DIR(0)="Y"

           SET DIR("B")="YES"

 +22       SET DIR("A")="Do you want this option printed on the final worksheet "

 +23       DO ^DIR

           IF $DATA(DIRUT)

               GOTO END

 +24       IF Y=1

               DO SB

SKIP2      KILL DIR

           SET DIR(0)="Y"

           SET DIR("B")="YES"

 +1        SET DIR("A")="Do you wish to change the dose or the dosing interval"

 +2        DO ^DIR

           IF $DATA(DIRUT)

               GOTO END

           SET APSKQ=Y

 +3       ;===>IF USER WISHES TO CHANGE DOSE AND INTERVAL GO TO REPEAT

 +4        IF APSKQ=1

               GOTO REPEAT

 +5        KILL DIR

           SET DIR(0)="Y"

           WRITE !!

 +6        SET DIR("A")="Is the current choice your FINAL recommendation"

 +7        DO ^DIR

           IF $DATA(DIRUT)

               GOTO END

           SET APSKCC=Y

 +8       ;===>IF IT IS THE FINAL RECOMMENDATION QUIT. OTHEWISE,

 +9       ;===>GO TO REPEAT2 AND ENTER THE RECOMMENDED DOSE AND INTERVAL

 +10       IF APSKCC=1

               GOTO FINALR

REPEAT2   ;===>USER ENTERS RECOMMENDED DOSE AND INTERVAL

 +1       ;===>THE MAXIMUM AND MINIMUM SERUM CONCENTRATIONS ARE CALCULATED

 +2       ;===>AND PRINTED IN THE FINAL PRINTOUT

 +3        WRITE !!

           KILL DIR

           SET DIR(0)="N"

 +4        SET DIR("A")="Enter the Recommended DOSE"

 +5        DO ^DIR

           IF $DATA(DIRUT)

               GOTO END

           SET APSKK3=Y

           WRITE !

 +6        KILL DIR

           SET DIR(0)="N"

 +7        SET DIR("A")="Enter the Recommended INTERVAL"

 +8        DO ^DIR

           IF $DATA(DIRUT)

               GOTO END

           SET APSKT3=Y

 +9        SET APSKFIN=1

 +10       GOTO LOOP

REPEAT    ;EP

 +1        IF APSKPTIN=0

               DO NOINFO^APSKAMN

               QUIT 

 +2        KILL DIR

           SET DIR(0)="N"

 +3        SET DIR("A")="Enter the new DOSE"

 +4        DO ^DIR

           IF $DATA(DIRUT)

               GOTO END

           SET APSKK3=Y

           WRITE !

 +5        KILL DIR

           SET DIR(0)="N"

 +6        SET DIR("A")="Enter the new INTERVAL"

 +7        DO ^DIR

           IF $DATA(DIRUT)

               GOTO END

           SET APSKT3=Y

 +8       ;===>CALCULATES NEW MAX AND MIN SERUM CONCENTRATIONS BASED ON USER'S

 +9       ;===>    NEW DOSE AND INTERVAL VALUES.

 +10       GOTO LOOP

 +11      ;

FINALR     SET %ZIS="PQ"

           DO ^%ZIS

           IF POP

               GOTO END

           IF $DATA(IO("Q"))

               GOTO QUE2

 +1        DO EN2

 +2        DO ^%ZISC

 +3        QUIT 

QUE2       KILL IO("Q"),ZTSAVE

 +1        FOR %="APSK*"

               SET ZTSAVE(%)=""

 +2        SET ZTRTN="EN2^APSKAMN5"

           SET ZTDESC="POSSIBLE OPTIONS"

 +3        DO ^%ZTLOAD

           KILL ZTSK

 +4        DO ^%ZISC

 +5        QUIT 

EN2        SET (APSKN0,APSKCNT,APSKPAGE)=0

 +1        USE IO

           DO @("HDR"_(2-($EXTRACT(IOST,1,2)="C-")))

 +2        FOR 

               SET APSKN0=$ORDER(APSK(APSKN0))

               IF 'APSKN0

                   QUIT 

               Begin DoDot:1

 +3                SET APSKND=APSK(APSKN0)

 +4                SET APSKK3=$PIECE(APSKND,"^",1)

                   SET APSKT0=$PIECE(APSKND,"^",2)

 +5                SET APSKT3=$PIECE(APSKND,"^",3)

                   SET APSKC4=$PIECE(APSKND,"^",4)

 +6                SET APSKC5=$PIECE(APSKND,"^",5)

 +7                IF $Y+5>IOSL

                       DO HDR1

 +8                WRITE !,APSKK3," mg/hr given over ",APSKT0," hour every ",APSKT3," hours will produce:"

 +9                WRITE !,"    ",$JUSTIFY(APSKC4,3,2)," mcg per ml MAXIMUM serum concentrations"

 +10               WRITE !,"    ",$JUSTIFY(APSKC5,3,2)," mcg per ml MINIMUM serum concentrations"

 +11               WRITE !!

 +12               SET APSKCNT=APSKCNT+1

 +13               IF APSKNP=1

                       DO APSKREM

 +14               IF ($Y+5>IOSL)&(APSKCNT>0)

                       DO HDR

                   QUIT 

               End DoDot:1

 +15       DO ^%ZISC

 +16       QUIT 

HDR        IF $EXTRACT(IOST,1,2)="C-"

               KILL DIR

               SET DIR(0)="EO"

               DO ^DIR

               IF $DATA(DIRUT)

                   GOTO END

 +1        IF APSKCNT=APSKSS

               QUIT 

HDR1       WRITE @IOF

HDR2       SET APSKPAGE=APSKPAGE+1

 +1        IF $DATA(IOST)

               IF $EXTRACT(IOST,1,2)="C-"

                   IF $Y+5>IOSL

                       DO HDR

 +2        WRITE !

           FOR APSK=1:1:22

               WRITE "*"

 +3        WRITE " CONFIDENTIAL PATIENT INFORMATION "

 +4        FOR APSK=1:1:22

               WRITE "*"

 +5        WRITE !,"Printed by: ",$PIECE(^VA(200,DUZ,0),U),?(IOM-10),"PAGE: ",$JUSTIFY(APSKPAGE,3)

 +6        WRITE !!!,"THIS IS INTENDED TO BE ONLY A WORKSHEET. IT SHOULD BE SHREDDED WHEN YOU ARE"

 +7        WRITE !,"FINISHED."

 +8        WRITE !!!,"NAME:",?6,APSKNAME,?34,"DOSING WT:",APSKWT," KG"

 +9        WRITE !,"DATE OF ANALYSIS: ",APSKDATE,?34,"CHART NUMBER: ",APSKCHRT

 +10       WRITE !!?15,"AMINOGLYCOSIDE KINETICS WORKSHEET"

 +11       WRITE !?15,"---------------------------------"

 +12       WRITE !!,"POSSIBLE OPTIONS"

 +13       WRITE !,"----------------",!

 +14       QUIT 

SB         SET APSKSS=APSKSS+1

 +1        SET APSK(APSKSS)=APSKK3_"^"_APSKT0_"^"_APSKT3_"^"_APSKC4_"^"_APSKC5

 +2        QUIT 

APSKREM    FOR APSKCLR=1:1:APSKCNT

               KILL APSK(APSKCLR)

END        QUIT