Routine: APSKAMN2

APSKAMN2 ;IHS/ANMC/SFB/MRS - TIME CONVERSION [ 09/28/94  10:50 AM ]

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

 S IOP=ION S %ZIS("B")=""

 D ^%ZIS

CVTIME ;EP - CONVERTS ALL TIME INPUTS INTO DECIMAL HOURS

 S APSKS(1)=2 S APSKX1=13 D TIME^APSKAMN6

 S APSKX1=14 D TIME^APSKAMN6 S APSKX1=2 D TIME^APSKAMN6

 S APSKT(15)=(APSKT(13)-APSKT(14))

 I APSKT(15)'>0 S APSKT(15)=(APSKT(15)+24)

 S APSKT(16)=(APSKT(15)+APSKT(2))

 I APSKT(16)>24 S APSKT(16)=(APSKT(16)-24)

 S APSKZ1=$P(APSKT(16),".",1)

 S APSKZ2=(((APSKT(16)-APSKZ1)*60)/100)+APSKZ1

 S APSKZ3=$P(100*(APSKZ2)+0.5,".",1)

 S APSKZ4=APSKZ3/100

 S APSKZ5=$P(APSKZ4,".",1)

 I APSKZ4-APSKZ5'<0.595 S APSKZ4=($P(APSKZ5,".",1)+1)

 S APSKZ4A=$P(APSKZ4,".",1),APSKZ4B=$P(APSKZ4,".",2)

 I APSKZ4A=$L(APSKZ4A)=1 S APSKZ4A="0"_APSKZ4A

 I APSKZ4B="" S APSKZ4B="00"_APSKZ4B

 S APSKZ4=APSKZ4A_":"_APSKZ4B

 S APSKZ(4)=APSKZ4

 S APSKC(4)=APSKC(13)

CALC ;ENTRY POINT

 F APSKX1=1:1:APSKS(1)+2 D TIME^APSKAMN6

 F APSKX1=3:1:APSKS(1)+2 D LOOP1

 G CALCKO

LOOP1 S APSKH(APSKX1)=(APSKT(APSKX1)-APSKT(2))

 I APSKH(APSKX1)<0 S APSKH(APSKX1)=(APSKH(APSKX1)+24)

CALCKO S APSKX1=13 D TIME^APSKAMN6

 S APSKH(13)=(APSKT(1)-APSKT(13))

 I APSKH(13)<0 S APSKH(13)=(APSKH(13)+24)

 I APSKPL="0" S APSKH(13)=0

 S APSKT0=(APSKT(2)-APSKT(1))

 I APSKT0<0 S APSKT0=(APSKT0+24)

 S APSKK0=(APSKD/APSKT0) S APSKT0=$J(APSKT0,2,2)

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

 F APSKX1=3:1:(APSKS(1)+2) D LOOP2

 F APSKX1=3:1:(APSKS(1)+2) S APSKS(3)=APSKS(3)+APSKH(APSKX1)

 F APSKX1=3:1:(APSKS(1)+2) D LOOP3

 F APSKX1=3:1:(APSKS(1)+2) D LOOP4

 F APSKX1=3:1:(APSKS(1)+2) D LOOP5

 G R2

LOOP2 S APSKXX=APSKC(APSKX1)

 D LN^APSKAMN6

 S APSKS(2)=APSKS(2)+(APSKH(APSKX1)*APSKLNN)

LOOP3 S APSKXX=APSKC(APSKX1) D LN^APSKAMN6

 S APSKS(4)=APSKS(4)+APSKLNN

LOOP4 S APSKXX=APSKH(APSKX1),APSKYY=2 D PWR^APSKAMN6

 S APSKS(5)=APSKS(5)+APSKPP

LOOP5 S APSKXX=APSKC(APSKX1) D LN^APSKAMN6

 S APSKXX=APSKLNN,APSKYY=2 D PWR^APSKAMN6

 S APSKS(6)=(APSKS(6)+APSKPP)

R2 ;===>CALC COEFFICIENT OF DETERMINATION

 S APSKXX=(APSKS(2)-(((1/APSKS(1)))*APSKS(3)*APSKS(4))),APSKYY=2

 D PWR^APSKAMN6

 S APSKR2A=APSKPP

 S APSKXX=APSKS(3),APSKY=2

 D PWR^APSKAMN6

 S APSKRS3=((APSKPP/APSKS(1))-APSKS(5))

 S APSKXX=APSKS(4),APSKSY=2 D PWR^APSKAMN6

 S APSKRS4=(APSKPP/APSKS(1)-APSKS(6))

 S APSKR2B=APSKRS3*APSKRS4

 S APSKR2=$E(APSKR2A/APSKR2B,1,4)

K1 ;===>CALC ELIMINATION RATE

 S APSKK1A=(APSKS(2)-((1/APSKS(1))*APSKS(3)*APSKS(4)))

 S APSKXX=APSKS(3),APSKYY=2 D PWR^APSKAMN6

 S APSKK1B=-(APSKS(5)-((1/APSKS(1)*APSKPP)))

 S APSKK1=(APSKK1A/APSKK1B)

CO ;===>PART OF VOL OF DISTR. CALC

 S APSKCO1=(-APSKK1*APSKH(13))

 S APSKXX=APSKCO1 D EXP^APSKAMN6

 S APSKCO=(APSKC(13)*APSKEE)

 ;===>CALC EXTRAPOLATED PEAK SERUM

 S APSKXX=(APSKS(3)*APSKK1+APSKS(4))/(APSKS(1)) D EXP^APSKAMN6 S APSKC1=$E(APSKEE,1,6)

V1 ;===>CALC VOL OF DISTRIBUTION

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

 S APSKV1A=(APSKK0*(1-APSKEE))

 I APSKV1A=0 G ERROR

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

 S APSKV1B=(APSKC1-(APSKCO*APSKEE))*APSKK1

 I APSKV1B=0 G ERROR

 S APSKV1=(APSKV1A/APSKV1B)

 S APSKV2=(APSKV1/APSKWT) ;===>VOL OF DISTRIB. PER KG

 S APSKT1=(0.693/APSKK1) ;===>HALF-LIFE

 G OUTPUT^APSKAMN3

SAMTIME ;EP

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

 S DIR("A",1)="The time you entered is the same as the end of infusion."

 S DIR("A",2)="Press return if you wish to enter a different time or"

 S DIR("A")="enter '^' to quit. "

 D ^DIR G END:$D(DIRUT),END:$D(DUOUT),SAMTIME:Y=""

ERROR ;EP

 W !!,"AN ERROR HAS OCCURED IN YOUR DATA COLLECTION.  PLEASE REVIEW"

 W !,"YOUR DATA CAREFULLY!"

 K DIR S DIR(0)="S^1:ENTER NEW DATA;2:QUIT"

 S DIR("A")="CHOICE" D ^DIR

 G END:$D(DIRUT),END:$D(DUOUT),END:Y=2

 W @IOF

 G START1^APSKAMN1

END Q

APSKAMN2  ;IHS/ANMC/SFB/MRS - TIME CONVERSION [ 09/28/94  10:50 AM ]

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

 +2        SET IOP=ION

           SET %ZIS("B")=""

 +3        DO ^%ZIS

CVTIME    ;EP - CONVERTS ALL TIME INPUTS INTO DECIMAL HOURS

 +1        SET APSKS(1)=2

           SET APSKX1=13

           DO TIME^APSKAMN6

 +2        SET APSKX1=14

           DO TIME^APSKAMN6

           SET APSKX1=2

           DO TIME^APSKAMN6

 +3        SET APSKT(15)=(APSKT(13)-APSKT(14))

 +4        IF APSKT(15)'>0

               SET APSKT(15)=(APSKT(15)+24)

 +5        SET APSKT(16)=(APSKT(15)+APSKT(2))

 +6        IF APSKT(16)>24

               SET APSKT(16)=(APSKT(16)-24)

 +7        SET APSKZ1=$PIECE(APSKT(16),".",1)

 +8        SET APSKZ2=(((APSKT(16)-APSKZ1)*60)/100)+APSKZ1

 +9        SET APSKZ3=$PIECE(100*(APSKZ2)+0.5,".",1)

 +10       SET APSKZ4=APSKZ3/100

 +11       SET APSKZ5=$PIECE(APSKZ4,".",1)

 +12       IF APSKZ4-APSKZ5'<0.595

               SET APSKZ4=($PIECE(APSKZ5,".",1)+1)

 +13       SET APSKZ4A=$PIECE(APSKZ4,".",1)

           SET APSKZ4B=$PIECE(APSKZ4,".",2)

 +14       IF APSKZ4A=$LENGTH(APSKZ4A)=1

               SET APSKZ4A="0"_APSKZ4A

 +15       IF APSKZ4B=""

               SET APSKZ4B="00"_APSKZ4B

 +16       SET APSKZ4=APSKZ4A_":"_APSKZ4B

 +17       SET APSKZ(4)=APSKZ4

 +18       SET APSKC(4)=APSKC(13)

 +19      ;

CALC      ;ENTRY POINT

 +1        FOR APSKX1=1:1:APSKS(1)+2

               DO TIME^APSKAMN6

 +2        FOR APSKX1=3:1:APSKS(1)+2

               DO LOOP1

 +3        GOTO CALCKO

 +4       ;

LOOP1      SET APSKH(APSKX1)=(APSKT(APSKX1)-APSKT(2))

 +1        IF APSKH(APSKX1)<0

               SET APSKH(APSKX1)=(APSKH(APSKX1)+24)

 +2        QUIT

 +3       ;

CALCKO     SET APSKX1=13

           DO TIME^APSKAMN6

 +1        SET APSKH(13)=(APSKT(1)-APSKT(13))

 +2        IF APSKH(13)<0

               SET APSKH(13)=(APSKH(13)+24)

 +3        IF APSKPL="0"

               SET APSKH(13)=0

 +4        SET APSKT0=(APSKT(2)-APSKT(1))

 +5        IF APSKT0<0

               SET APSKT0=(APSKT0+24)

 +6        SET APSKK0=(APSKD/APSKT0)

           SET APSKT0=$JUSTIFY(APSKT0,2,2)

 +7        SET APSKK0=($PIECE(100*APSKK0+.5,".",1))/100

 +8        FOR APSKX1=3:1:(APSKS(1)+2)

               DO LOOP2

 +9        FOR APSKX1=3:1:(APSKS(1)+2)

               SET APSKS(3)=APSKS(3)+APSKH(APSKX1)

 +10       FOR APSKX1=3:1:(APSKS(1)+2)

               DO LOOP3

 +11       FOR APSKX1=3:1:(APSKS(1)+2)

               DO LOOP4

 +12       FOR APSKX1=3:1:(APSKS(1)+2)

               DO LOOP5

 +13       GOTO R2

 +14      ;

LOOP2      SET APSKXX=APSKC(APSKX1)

 +1        DO LN^APSKAMN6

 +2        SET APSKS(2)=APSKS(2)+(APSKH(APSKX1)*APSKLNN)

 +3        QUIT

LOOP3      SET APSKXX=APSKC(APSKX1)

           DO LN^APSKAMN6

 +1        SET APSKS(4)=APSKS(4)+APSKLNN

 +2        QUIT

LOOP4      SET APSKXX=APSKH(APSKX1)

           SET APSKYY=2

           DO PWR^APSKAMN6

 +1        SET APSKS(5)=APSKS(5)+APSKPP

 +2        QUIT

LOOP5      SET APSKXX=APSKC(APSKX1)

           DO LN^APSKAMN6

 +1        SET APSKXX=APSKLNN

           SET APSKYY=2

           DO PWR^APSKAMN6

 +2        SET APSKS(6)=(APSKS(6)+APSKPP)

 +3        QUIT

 +4       ;

R2        ;===>CALC COEFFICIENT OF DETERMINATION

 +1        SET APSKXX=(APSKS(2)-(((1/APSKS(1)))*APSKS(3)*APSKS(4)))

           SET APSKYY=2

 +2        DO PWR^APSKAMN6

 +3        SET APSKR2A=APSKPP

 +4        SET APSKXX=APSKS(3)

           SET APSKY=2

 +5        DO PWR^APSKAMN6

 +6        SET APSKRS3=((APSKPP/APSKS(1))-APSKS(5))

 +7        SET APSKXX=APSKS(4)

           SET APSKSY=2

           DO PWR^APSKAMN6

 +8        SET APSKRS4=(APSKPP/APSKS(1)-APSKS(6))

 +9        SET APSKR2B=APSKRS3*APSKRS4

 +10       SET APSKR2=$EXTRACT(APSKR2A/APSKR2B,1,4)

 +11      ;

K1        ;===>CALC ELIMINATION RATE

 +1        SET APSKK1A=(APSKS(2)-((1/APSKS(1))*APSKS(3)*APSKS(4)))

 +2        SET APSKXX=APSKS(3)

           SET APSKYY=2

           DO PWR^APSKAMN6

 +3        SET APSKK1B=-(APSKS(5)-((1/APSKS(1)*APSKPP)))

 +4        SET APSKK1=(APSKK1A/APSKK1B)

 +5       ;

CO        ;===>PART OF VOL OF DISTR. CALC

 +1        SET APSKCO1=(-APSKK1*APSKH(13))

 +2        SET APSKXX=APSKCO1

           DO EXP^APSKAMN6

 +3        SET APSKCO=(APSKC(13)*APSKEE)

 +4       ;

 +5       ;===>CALC EXTRAPOLATED PEAK SERUM

 +6        SET APSKXX=(APSKS(3)*APSKK1+APSKS(4))/(APSKS(1))

           DO EXP^APSKAMN6

           SET APSKC1=$EXTRACT(APSKEE,1,6)

 +7       ;

V1        ;===>CALC VOL OF DISTRIBUTION

 +1        SET APSKXX=(-APSKK1*APSKT0)

           DO EXP^APSKAMN6

 +2        SET APSKV1A=(APSKK0*(1-APSKEE))

 +3        IF APSKV1A=0

               GOTO ERROR

 +4        SET APSKXX=(-APSKK1*APSKT0)

           DO EXP^APSKAMN6

 +5        SET APSKV1B=(APSKC1-(APSKCO*APSKEE))*APSKK1

 +6        IF APSKV1B=0

               GOTO ERROR

 +7        SET APSKV1=(APSKV1A/APSKV1B)

 +8       ;===>VOL OF DISTRIB. PER KG

           SET APSKV2=(APSKV1/APSKWT)

 +9       ;===>HALF-LIFE

           SET APSKT1=(0.693/APSKK1)

 +10       GOTO OUTPUT^APSKAMN3

SAMTIME   ;EP

 +1        KILL DIR

           SET DIR(0)="Y"

           SET DIR("B")="YES"

 +2        SET DIR("A",1)="The time you entered is the same as the end of infusion."

 +3        SET DIR("A",2)="Press return if you wish to enter a different time or"

 +4        SET DIR("A")="enter '^' to quit. "

 +5        DO ^DIR

           IF $DATA(DIRUT)

               GOTO END

           IF $DATA(DUOUT)

               GOTO END

           IF Y=""

               GOTO SAMTIME

 +6        QUIT

ERROR     ;EP

 +1        WRITE !!,"AN ERROR HAS OCCURED IN YOUR DATA COLLECTION.  PLEASE REVIEW"

 +2        WRITE !,"YOUR DATA CAREFULLY!"

 +3        KILL DIR

           SET DIR(0)="S^1:ENTER NEW DATA;2:QUIT"

 +4        SET DIR("A")="CHOICE"

           DO ^DIR

 +5        IF $DATA(DIRUT)

               GOTO END

           IF $DATA(DUOUT)

               GOTO END

           IF Y=2

               GOTO END

 +6        WRITE @IOF

 +7        GOTO START1^APSKAMN1

END        QUIT

APSKAMN2.m