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)
Q
;
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)
Q
LOOP3 S APSKXX=APSKC(APSKX1) D LN^APSKAMN6
S APSKS(4)=APSKS(4)+APSKLNN
Q
LOOP4 S APSKXX=APSKH(APSKX1),APSKYY=2 D PWR^APSKAMN6
S APSKS(5)=APSKS(5)+APSKPP
Q
LOOP5 S APSKXX=APSKC(APSKX1) D LN^APSKAMN6
S APSKXX=APSKLNN,APSKYY=2 D PWR^APSKAMN6
S APSKS(6)=(APSKS(6)+APSKPP)
Q
;
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=""
Q
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
