APSKAMN0.m

APSKAMN0 ;IHS/ANMC/SFB/MRS - GET VITAL STATS & CALC LBW;[ 09/28/94  10:23 AM ]

 ;;1.0;Aminoglycoside Kinetics;;AUG 1,1993

 ;===>INITIALIZE VARIABLES TO 0

START ;EP

 F APSKX1=1:1:16 S (APSKT(APSKX1),APSKH(APSKX1),APSKC(APSKX1),APSKZ(APSKX1),APSKS(APSKX1))=0

 S (APSKWT,APSKHT,APSKSE,APSKLBWC,APSKC,APSKD,APSKE,APSKM,APSKQ)=0

 S (APSKPL,APSKQQ,APSKXX,APSKPTIN,APSKSS,APSKCC,APSKFIN,APSKN0,APSKNP)=0

 S (APSKZ1T,APSKZ2T,APSKZ3T,APSKZ4T,APSKZ5T,APSKZ6T,APSKZ7T,APSKZ8T)=0

 S (APSKZ9T,APSKZ10T,APSKZ11T,APSKZ12T,APSKZ13T)=0

 ;

INPUT ;===>USES PATIENT LOOKUP ROUTINE

 ;===>OBTAINS THE PATIENT FULL NAME,CHART NUMBER,SSN,AND SEX

 W @IOF

 K DIC S DIC="^DPT(",DIC(0)="AEQMN"

 S DIC("A")="Select Patient Name: "

 D ^DIC

 G END:$D(DTOUT),END:$D(DUOUT),INPUT:Y=-1

 S APSKDFN=+Y

 S APSKCHRT=$P($G(^AUPNPAT(+$G(APSKDFN),41,+$G(DUZ(2)),0)),"^",2)

 S APSKSEX=AUPNSEX

 S APSKNAME=$P(Y,"^",2)

 S APSKPTIN=1,APSKNP=1

 ;

DATE ;===>USES VA FILEMAN'S DATE AND TIME CONVERSION ROUTINE

 ;===>VALIDATES IN INPUT AS BEING A CORRECT DATE

 W !!

 S %DT="AEX" S %DT("A")="Enter date of analysis: "

 D ^%DT G END:$D(DTOUT),END:X="^" X ^DD("DD")

 I (Y=-1)!(X="") D RR G DATE

 S APSKDATE=Y

 ;

WEIGHT K DIR S DIR(0)="N^1:500" W !

 S DIR("A")="Enter ACTUAL weight in KILOGRAMS "

 S DIR("?")="Enter a number from 1 to 500.  Enter '^' to exit. "

 D ^DIR G END:$D(DTOUT),END:$D(DUOUT) G WEIGHT:Y="" K DIR

 S APSKWT=Y

 W !!!,"   Lean Body Weight formula will now be calculated.  However,"

 W !,"the formula is undefined for patients under 60 inches (152 centimeters)."

 W !,"Recommend you skip Lean Body Weight calculation if your patient"

 W !,"does not meet the criteron."

 ;

 ;===>USERS HAVE THE OPTION FOR LEAN BODY WEIGHT TO BE CALCULATED

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

 S DIR("A")="Do you wish to procede with Lean Body Weight Calculation "

 D ^DIR G END:$D(DIRUT) K DIR

 S APSKLBWC=Y

 I APSKLBWC="0" G CHOICE2^APSKAMN1

 ;

 ;===>ASKS IF USERS HAS HEIGHT IN INCHES OR CENTIMETERS

 ;===>IF USERS HAS HEIGHT IN CENTIMETERS, GOTO HEIGHT2

HEIGHT K DIR S DIR(0)="S^1:INCHES;2:CENTIMETERS" W !

 S DIR("A")="ENTER '1'or '2' "

 D ^DIR G END:$D(DIRUT) K DIR

 S APSKHT=Y I APSKHT=2 G HEIGHT2

 ;

HEIGHT1 K DIR S DIR(0)="N^60:150"

 S DIR("A")="Enter height in INCHES "

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

 G GENDER

 ;

HEIGHT2 ;===>CONVERTS CENTIMETERS TO INCHES

 K DIR S DIR(0)="N^152:350"

 S DIR("A")="Enter height in CENTIMETERS "

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

 S APSKHT=$P((10*(APSKHT/2.54))+0.5,".",1)/10

 ;

GENDER ;===>CALCULATES MALE LBW

 ;===>IF PATIENT IS FEMALE, GOTO GENDER1

 I AUPNSEX="F" G GENDER1

 S APSKL=50+(2.3*(APSKHT-60)) S APSKLBW=$P((10*APSKL+0.50),".",1)/10

 G DWT1

 ;

GENDER1 ;===>CALCULATES FEMALE LBW

 S APSKL=45+(2.3*(APSKHT-60))

 S APSKLBW=$P((10*APSKL+0.50),".",1)/10

 ;

DWT1 ;===>DETERMINES IF LBW IS 10% GREATER THAN ACTUAL WEIGHT

 ;===>IF NOT DOSING WEIGHT EQUAL ACTUAL WEIGHT

 S APSKDWT=APSKWT-APSKLBW

 I APSKDWT>(0.10*APSKLBW) G DWT2

 W @IOF

 W !,"The Total Body weight - Lean Body weight was LESS than 10% "

 W !,"Lean Body weight.  Therefore, the DOSING WEIGHT IS: ",APSKWT," KG, "

 W !,"which is the same as the Total Body weight"

 ;===>APSKAMN1 ROUTINE GAINS CONTROL

 G CHOICE2^APSKAMN1

 ;

DWT2 ;===>CALCULATES THE DOSING WEIGHT

 S APSKDWTT=APSKLBW+(0.4*(APSKWT-APSKLBW))

 S APSKWT=$J(APSKDWTT,3,1)

 W @IOF

 W !,"The Total Body weight - the Lean Body weight was GREATER than 10%"

 W !,"Lean Body weight.  Therefore, the calculated DOSING WEIGHT IS: ",APSKWT," KG"

 W !,"weight. Therefore, the DOSING WEIGHT IS: ",APSKWT

 ;===>APSKAMN1 ROUTINE GAINS CONTROL

 G CHOICE2^APSKAMN1

 ;

RR ;EP

 W $C(7),!!,"THIS IS A REQUIRED RESPONSE.  ENTER '^' TO EXIT"

 Q

END ;===>CONTROL IS PASSED TO APSKEND

 ;===>IF PROGRAM TIMES OUT,USER ENTERS "^", OR USER ENTERS ""

 Q

APSKAMN0  ;IHS/ANMC/SFB/MRS - GET VITAL STATS & CALC LBW;[ 09/28/94  10:23 AM ]

 +1       ;;1.0;Aminoglycoside Kinetics;;AUG 1,1993

 +2       ;===>INITIALIZE VARIABLES TO 0

START     ;EP

 +1        FOR APSKX1=1:1:16

               SET (APSKT(APSKX1),APSKH(APSKX1),APSKC(APSKX1),APSKZ(APSKX1),APSKS(APSKX1))=0

 +2        SET (APSKWT,APSKHT,APSKSE,APSKLBWC,APSKC,APSKD,APSKE,APSKM,APSKQ)=0

 +3        SET (APSKPL,APSKQQ,APSKXX,APSKPTIN,APSKSS,APSKCC,APSKFIN,APSKN0,APSKNP)=0

 +4        SET (APSKZ1T,APSKZ2T,APSKZ3T,APSKZ4T,APSKZ5T,APSKZ6T,APSKZ7T,APSKZ8T)=0

 +5        SET (APSKZ9T,APSKZ10T,APSKZ11T,APSKZ12T,APSKZ13T)=0

 +6       ;

INPUT     ;===>USES PATIENT LOOKUP ROUTINE

 +1       ;===>OBTAINS THE PATIENT FULL NAME,CHART NUMBER,SSN,AND SEX

 +2        WRITE @IOF

 +3        KILL DIC

           SET DIC="^DPT("

           SET DIC(0)="AEQMN"

 +4        SET DIC("A")="Select Patient Name: "

 +5        DO ^DIC

 +6        IF $DATA(DTOUT)

               GOTO END

           IF $DATA(DUOUT)

               GOTO END

           IF Y=-1

               GOTO INPUT

 +7        SET APSKDFN=+Y

 +8        SET APSKCHRT=$PIECE($GET(^AUPNPAT(+$GET(APSKDFN),41,+$GET(DUZ(2)),0)),"^",2)

 +9        SET APSKSEX=AUPNSEX

 +10       SET APSKNAME=$PIECE(Y,"^",2)

 +11       SET APSKPTIN=1

           SET APSKNP=1

 +12      ;

DATE      ;===>USES VA FILEMAN'S DATE AND TIME CONVERSION ROUTINE

 +1       ;===>VALIDATES IN INPUT AS BEING A CORRECT DATE

 +2        WRITE !!

 +3        SET %DT="AEX"

           SET %DT("A")="Enter date of analysis: "

 +4        DO ^%DT

           IF $DATA(DTOUT)

               GOTO END

           IF X="^"

               GOTO END

           XECUTE ^DD("DD")

 +5        IF (Y=-1)!(X="")

               DO RR

               GOTO DATE

 +6        SET APSKDATE=Y

 +7       ;

WEIGHT     KILL DIR

           SET DIR(0)="N^1:500"

           WRITE !

 +1        SET DIR("A")="Enter ACTUAL weight in KILOGRAMS "

 +2        SET DIR("?")="Enter a number from 1 to 500.  Enter '^' to exit. "

 +3        DO ^DIR

           IF $DATA(DTOUT)

               GOTO END

           IF $DATA(DUOUT)

               GOTO END

           IF Y=""

               GOTO WEIGHT

           KILL DIR

 +4        SET APSKWT=Y

 +5        WRITE !!!,"   Lean Body Weight formula will now be calculated.  However,"

 +6        WRITE !,"the formula is undefined for patients under 60 inches (152 centimeters)."

 +7        WRITE !,"Recommend you skip Lean Body Weight calculation if your patient"

 +8        WRITE !,"does not meet the criteron."

 +9       ;

 +10      ;===>USERS HAVE THE OPTION FOR LEAN BODY WEIGHT TO BE CALCULATED

 +11       KILL DIR

           SET DIR(0)="Y"

           WRITE !!

 +12       SET DIR("A")="Do you wish to procede with Lean Body Weight Calculation "

 +13       DO ^DIR

           IF $DATA(DIRUT)

               GOTO END

           KILL DIR

 +14       SET APSKLBWC=Y

 +15       IF APSKLBWC="0"

               GOTO CHOICE2^APSKAMN1

 +16      ;

 +17      ;===>ASKS IF USERS HAS HEIGHT IN INCHES OR CENTIMETERS

 +18      ;===>IF USERS HAS HEIGHT IN CENTIMETERS, GOTO HEIGHT2

HEIGHT     KILL DIR

           SET DIR(0)="S^1:INCHES;2:CENTIMETERS"

           WRITE !

 +1        SET DIR("A")="ENTER '1'or '2' "

 +2        DO ^DIR

           IF $DATA(DIRUT)

               GOTO END

           KILL DIR

 +3        SET APSKHT=Y

           IF APSKHT=2

               GOTO HEIGHT2

 +4       ;

HEIGHT1    KILL DIR

           SET DIR(0)="N^60:150"

 +1        SET DIR("A")="Enter height in INCHES "

 +2        DO ^DIR

           IF $DATA(DIRUT)

               GOTO END

           KILL DIR

           SET APSKHT=Y

 +3        GOTO GENDER

 +4       ;

HEIGHT2   ;===>CONVERTS CENTIMETERS TO INCHES

 +1        KILL DIR

           SET DIR(0)="N^152:350"

 +2        SET DIR("A")="Enter height in CENTIMETERS "

 +3        DO ^DIR

           IF $DATA(DIRUT)

               GOTO END

           KILL DIR

           SET APSKHT=Y

 +4        SET APSKHT=$PIECE((10*(APSKHT/2.54))+0.5,".",1)/10

 +5       ;

GENDER    ;===>CALCULATES MALE LBW

 +1       ;===>IF PATIENT IS FEMALE, GOTO GENDER1

 +2        IF AUPNSEX="F"

               GOTO GENDER1

 +3        SET APSKL=50+(2.3*(APSKHT-60))

           SET APSKLBW=$PIECE((10*APSKL+0.50),".",1)/10

 +4        GOTO DWT1

 +5       ;

GENDER1   ;===>CALCULATES FEMALE LBW

 +1        SET APSKL=45+(2.3*(APSKHT-60))

 +2        SET APSKLBW=$PIECE((10*APSKL+0.50),".",1)/10

 +3       ;

DWT1      ;===>DETERMINES IF LBW IS 10% GREATER THAN ACTUAL WEIGHT

 +1       ;===>IF NOT DOSING WEIGHT EQUAL ACTUAL WEIGHT

 +2        SET APSKDWT=APSKWT-APSKLBW

 +3        IF APSKDWT>(0.10*APSKLBW)

               GOTO DWT2

 +4        WRITE @IOF

 +5        WRITE !,"The Total Body weight - Lean Body weight was LESS than 10% "

 +6        WRITE !,"Lean Body weight.  Therefore, the DOSING WEIGHT IS: ",APSKWT," KG, "

 +7        WRITE !,"which is the same as the Total Body weight"

 +8       ;===>APSKAMN1 ROUTINE GAINS CONTROL

 +9        GOTO CHOICE2^APSKAMN1

 +10      ;

DWT2      ;===>CALCULATES THE DOSING WEIGHT

 +1        SET APSKDWTT=APSKLBW+(0.4*(APSKWT-APSKLBW))

 +2        SET APSKWT=$JUSTIFY(APSKDWTT,3,1)

 +3        WRITE @IOF

 +4        WRITE !,"The Total Body weight - the Lean Body weight was GREATER than 10%"

 +5        WRITE !,"Lean Body weight.  Therefore, the calculated DOSING WEIGHT IS: ",APSKWT," KG"

 +6        WRITE !,"weight. Therefore, the DOSING WEIGHT IS: ",APSKWT

 +7       ;===>APSKAMN1 ROUTINE GAINS CONTROL

 +8        GOTO CHOICE2^APSKAMN1

 +9       ;

RR        ;EP

 +1        WRITE $CHAR(7),!!,"THIS IS A REQUIRED RESPONSE.  ENTER '^' TO EXIT"

 +2        QUIT 

END       ;===>CONTROL IS PASSED TO APSKEND

 +1       ;===>IF PROGRAM TIMES OUT,USER ENTERS "^", OR USER ENTERS ""

 +2        QUIT