FHASS2 ; GLRISC/REL - Extended Assessment ; 24-Jul-85 2:26 pm [ 06/07/90 12:32 PM ]
;;3.16;NUTRITION & DIETETICS;;*;;1NOV90
S SXC=SEX?1"F",AGC=$S(AGE<25:1,AGE<35:2,AGE<45:3,AGE<55:4,AGE<65:5,1:6)
F J=1:1:9 S Y(J)=""
F1 R !!,"Albumin (g/dl): ",X(1):DTIME G KIL:'$T!(X(1)["^"),F2:X(1)=""
I X(1)'?.N.1".".N!(X(1)<0)!(X(1)>5) W !?5,"Normal = 3.0-3.5; Values must be 0-5.0" G F1
S Y(1)=$S(X(1)<2.5:4,X(1)<3.0:3,X(1)<3.5:2,1:1)
F2 R !,"Pre-albumin (mg/dl): ",X(10):DTIME G KIL:'$T!(X(10)["^"),F31:X(10)=""
I X(10)'?1N.N!(X(10)<0)!(X(10)>25) W !?5,"Enter a whole number between 0 and 25; see User Manual" G F2
F31 R !,"Total Lymphocyte Count: ",X(2):DTIME G KIL:'$T!(X(2)["^"),F3:X(2)=""
I X(2)'?1N.N!(X(2)<200)!(X(2)>2500) W !?5,"Enter a number 200-2500; see User Manual" G F31
G F41
F3 R !,"Lymphs (%): ",X(2):DTIME G KIL:'$T!(X(2)["^"),F49:X(2)=""
I X(2)'?.N.1".".N!(X(2)<0)!(X(2)>100) W !?5,"Enter a percentage between 0 and 100; total will be calculated" G F3
F4 R !,"WBC (cmm): ",X(3):DTIME G KIL:'$T!(X(3)["^") I X(3)="" S X(2)="" G F49
I X(3)'?1N.N!(X(3)<500)!(X(3)>15000) W !?5,"Enter number between 500-15000; normal = 4800-10800;",!?5,"values outside this range should not be used." G F4
S X(2)=X(2)*X(3)/100
F41 S Y(2)=$S(X(2)<900:4,X(2)<1500:3,X(2)<1800:2,1:1)
F49 R !,"Transferrin (mg/dl): ",X(4):DTIME G KIL:'$T!(X(4)["^"),F5:X(4)=""
I X(4)'?.N.1".".N!(X(4)<50)!(X(4)>450) W !?5,"Enter 50-450; see User Manual" G F49
G F55
F5 R !,"TIBC (mcg/dl): ",X(4):DTIME G KIL:'$T!(X(4)["^"),F6:X(4)=""
I X(4)'?.N.1".".N!(X(4)<50)!(X(4)>550) W !?5,"Enter 50-550; Normal = 250-410; Transferrin will be evaluated." G F5
S X(4)=X(4)*0.76+18
F55 S Y(4)=$S(X(4)<160:4,X(4)<180:3,X(4)<200:2,1:1)
F6 R !,"TSF (mm): ",X(5):DTIME G KIL:'$T!(X(5)["^"),F7:X(5)=""
I X(5)'?.N.1".".N!(X(5)<1)!(X(5)>35) W !?5,"Enter value between 1 and 35; outside values should be assessed manually" G F6
S K=5,TAB="T1" D GET
F7 R !,"Arm Circumference (cm): ",X(6):DTIME G KIL:'$T!(X(6)["^"),F8:X(6)=""
I X(6)'?.N.1".".N!(X(6)<15)!(X(6)>35) W !?5,"Enter number between 15 and 35; outside values should be assessed manually" G F7
S K=6,TAB="T2" D GET
F8 R !,"S. Creatinine (mg/dl) for Creat. Clr.: ",X(11):DTIME G KIL:'$T!(X(11)["^"),F9:X(11)=""
I X(11)'?.N.1".".N!(X(11)<0)!(X(11)>2.5) W !?5,"Enter 0-2.5; Normal = .7-1.4; creatine clearance will be calculated" G F8
F9 R !,"Protein Intake (g) for Nit. Bal.: ",X(7):DTIME G KIL:'$T!(X(7)["^"),F11:X(7)=""
I X(7)'?.N.1".".N!(X(7)<0)!(X(7)>200) W !?5,"Enter 0-200 grams of protein intake" G F9
F10 R !,"24 Hour UUN: ",X(8):DTIME G KIL:'$T!(X(8)["^"),F11:X(8)=""
I X(8)'?.N.1".".N!(X(8)<0)!(X(8)>20) W !?5,"Enter 0-20; nitrogen balance will be calculated" G F10
S Y(7)=X(7)/6.25-(X(8)+3)
F11 S X(9)="" I X(6)'="",X(5)'="" S X(9)=X(6)-(.314*X(5))
S K=9,TAB="T3" D GET W ! Q
KIL S EXT="K" Q
GET S Y(K)="" Q:X(K)="" S Q=$P($T(@TAB+SXC),";",AGC*3,AGC*3+2)
S A1=$P(Q,";",1),A2=$P(Q,";",2),A3=$P(Q,";",3)
S Y(K)=$S(X(K)<A1:4,X(K)<A2:3,X(K)<A3:2,1:1) Q
T1 ;;4.0;5.1;7.1;4.5;5.6;8.1;5.0;6.1;8.6;5.0;6.1;8.1;5.0;6.1;8.1;4.5;5.6;8.1
;;9.4;11.1;14.1;10.5;12.1;16.1;12.0;14.1;18.1;13.0;15.1;20.1;11.0;14.1;19.1;11.5;14.1;18.1
T2 ;;25.7;27.2;28.8;27.0;28.3;30.1;27.8;28.8;30.8;26.7;27.9;30.1;25.6;27.4;29.7;25.3;26.6;28.6
;;22.1;23.1;24.6;23.3;24.3;25.8;24.1;25.3;26.9;24.3;25.8;27.6;23.9;25.2;27.8;23.8;25.3;27.5
T3 ;;23.5;24.5;25.6;24.2;25.4;26.6;25.0;25.7;27.2;24.0;25.0;26.6;22.8;24.5;26.3;22.5;23.8;25.4
;;17.7;18.6;19.5;18.3;19.0;20.1;18.5;19.3;20.7;18.8;19.6;20.8;18.6;19.6;20.9;18.6;19.6;20.9
FHASS2 ; GLRISC/REL - Extended Assessment ; 24-Jul-85 2:26 pm [ 06/07/90 12:32 PM ]
+1 ;;3.16;NUTRITION & DIETETICS;;*;;1NOV90
+2 SET SXC=SEX?1"F"
SET AGC=$SELECT(AGE<25:1,AGE<35:2,AGE<45:3,AGE<55:4,AGE<65:5,1:6)
+3 FOR J=1:1:9
SET Y(J)=""
F1 READ !!,"Albumin (g/dl): ",X(1):DTIME
IF '$TEST!(X(1)["^")
GOTO KIL
IF X(1)=""
GOTO F2
+1 IF X(1)'?.N.1".".N!(X(1)<0)!(X(1)>5)
WRITE !?5,"Normal = 3.0-3.5; Values must be 0-5.0"
GOTO F1
+2 SET Y(1)=$SELECT(X(1)<2.5:4,X(1)<3.0:3,X(1)<3.5:2,1:1)
F2 READ !,"Pre-albumin (mg/dl): ",X(10):DTIME
IF '$TEST!(X(10)["^")
GOTO KIL
IF X(10)=""
GOTO F31
+1 IF X(10)'?1N.N!(X(10)<0)!(X(10)>25)
WRITE !?5,"Enter a whole number between 0 and 25; see User Manual"
GOTO F2
F31 READ !,"Total Lymphocyte Count: ",X(2):DTIME
IF '$TEST!(X(2)["^")
GOTO KIL
IF X(2)=""
GOTO F3
+1 IF X(2)'?1N.N!(X(2)<200)!(X(2)>2500)
WRITE !?5,"Enter a number 200-2500; see User Manual"
GOTO F31
+2 GOTO F41
F3 READ !,"Lymphs (%): ",X(2):DTIME
IF '$TEST!(X(2)["^")
GOTO KIL
IF X(2)=""
GOTO F49
+1 IF X(2)'?.N.1".".N!(X(2)<0)!(X(2)>100)
WRITE !?5,"Enter a percentage between 0 and 100; total will be calculated"
GOTO F3
F4 READ !,"WBC (cmm): ",X(3):DTIME
IF '$TEST!(X(3)["^")
GOTO KIL
IF X(3)=""
SET X(2)=""
GOTO F49
+1 IF X(3)'?1N.N!(X(3)<500)!(X(3)>15000)
WRITE !?5,"Enter number between 500-15000; normal = 4800-10800;",!?5,"values outside this range should not be used."
GOTO F4
+2 SET X(2)=X(2)*X(3)/100
F41 SET Y(2)=$SELECT(X(2)<900:4,X(2)<1500:3,X(2)<1800:2,1:1)
F49 READ !,"Transferrin (mg/dl): ",X(4):DTIME
IF '$TEST!(X(4)["^")
GOTO KIL
IF X(4)=""
GOTO F5
+1 IF X(4)'?.N.1".".N!(X(4)<50)!(X(4)>450)
WRITE !?5,"Enter 50-450; see User Manual"
GOTO F49
+2 GOTO F55
F5 READ !,"TIBC (mcg/dl): ",X(4):DTIME
IF '$TEST!(X(4)["^")
GOTO KIL
IF X(4)=""
GOTO F6
+1 IF X(4)'?.N.1".".N!(X(4)<50)!(X(4)>550)
WRITE !?5,"Enter 50-550; Normal = 250-410; Transferrin will be evaluated."
GOTO F5
+2 SET X(4)=X(4)*0.76+18
F55 SET Y(4)=$SELECT(X(4)<160:4,X(4)<180:3,X(4)<200:2,1:1)
F6 READ !,"TSF (mm): ",X(5):DTIME
IF '$TEST!(X(5)["^")
GOTO KIL
IF X(5)=""
GOTO F7
+1 IF X(5)'?.N.1".".N!(X(5)<1)!(X(5)>35)
WRITE !?5,"Enter value between 1 and 35; outside values should be assessed manually"
GOTO F6
+2 SET K=5
SET TAB="T1"
DO GET
F7 READ !,"Arm Circumference (cm): ",X(6):DTIME
IF '$TEST!(X(6)["^")
GOTO KIL
IF X(6)=""
GOTO F8
+1 IF X(6)'?.N.1".".N!(X(6)<15)!(X(6)>35)
WRITE !?5,"Enter number between 15 and 35; outside values should be assessed manually"
GOTO F7
+2 SET K=6
SET TAB="T2"
DO GET
F8 READ !,"S. Creatinine (mg/dl) for Creat. Clr.: ",X(11):DTIME
IF '$TEST!(X(11)["^")
GOTO KIL
IF X(11)=""
GOTO F9
+1 IF X(11)'?.N.1".".N!(X(11)<0)!(X(11)>2.5)
WRITE !?5,"Enter 0-2.5; Normal = .7-1.4; creatine clearance will be calculated"
GOTO F8
F9 READ !,"Protein Intake (g) for Nit. Bal.: ",X(7):DTIME
IF '$TEST!(X(7)["^")
GOTO KIL
IF X(7)=""
GOTO F11
+1 IF X(7)'?.N.1".".N!(X(7)<0)!(X(7)>200)
WRITE !?5,"Enter 0-200 grams of protein intake"
GOTO F9
F10 READ !,"24 Hour UUN: ",X(8):DTIME
IF '$TEST!(X(8)["^")
GOTO KIL
IF X(8)=""
GOTO F11
+1 IF X(8)'?.N.1".".N!(X(8)<0)!(X(8)>20)
WRITE !?5,"Enter 0-20; nitrogen balance will be calculated"
GOTO F10
+2 SET Y(7)=X(7)/6.25-(X(8)+3)
F11 SET X(9)=""
IF X(6)'=""
IF X(5)'=""
SET X(9)=X(6)-(.314*X(5))
+1 SET K=9
SET TAB="T3"
DO GET
WRITE !
QUIT
KIL SET EXT="K"
QUIT
GET SET Y(K)=""
IF X(K)=""
QUIT
SET Q=$PIECE($TEXT(@TAB+SXC),";",AGC*3,AGC*3+2)
+1 SET A1=$PIECE(Q,";",1)
SET A2=$PIECE(Q,";",2)
SET A3=$PIECE(Q,";",3)
+2 SET Y(K)=$SELECT(X(K)<A1:4,X(K)<A2:3,X(K)<A3:2,1:1)
QUIT
T1 ;;4.0;5.1;7.1;4.5;5.6;8.1;5.0;6.1;8.6;5.0;6.1;8.1;5.0;6.1;8.1;4.5;5.6;8.1
+1 ;;9.4;11.1;14.1;10.5;12.1;16.1;12.0;14.1;18.1;13.0;15.1;20.1;11.0;14.1;19.1;11.5;14.1;18.1
T2 ;;25.7;27.2;28.8;27.0;28.3;30.1;27.8;28.8;30.8;26.7;27.9;30.1;25.6;27.4;29.7;25.3;26.6;28.6
+1 ;;22.1;23.1;24.6;23.3;24.3;25.8;24.1;25.3;26.9;24.3;25.8;27.6;23.9;25.2;27.8;23.8;25.3;27.5
T3 ;;23.5;24.5;25.6;24.2;25.4;26.6;25.0;25.7;27.2;24.0;25.0;26.6;22.8;24.5;26.3;22.5;23.8;25.4
+1 ;;17.7;18.6;19.5;18.3;19.0;20.1;18.5;19.3;20.7;18.8;19.6;20.8;18.6;19.6;20.9;18.6;19.6;20.9
