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
