FHNUT ; HISC/NCA - Read in the and Calculate 100 Grams ;2/23/00 12:38
;;5.5;DIETETICS;;Jan 28, 2005
EN1 ; Enter Data
K DIC S FHX1=0,DIC="^FHNU(",DIC(0)="EMZ"
R !!,"Food Nutrient Name: ",TIT:DTIME G:'$T!("^"[TIT) KIL I TIT'?.ANP W *7," ??" G EN1
S DIC("S")="I $E($P(^(0),U,1),1)'=""*"""
S X=TIT D ^DIC K DIC G:U[X!($D(DTOUT)) EN1 I Y<1 G:TIT["?" EN1 D ADD G KIL:'FHX1,R2
S FHX1=+Y I $P($G(^FHNU(FHX1,0)),"^",6)="N" W !!," USDA Handbook Values Not Editable" Q
R2 W !!,"Portion Size: " R X:DTIME G:'$T!("^"[X) KIL
I X'?.N.1".".N!(X<0)!(X>9999) W *7,!,"Enter the gram Portion Size.",!,"Enter a number From 1-9999." G R2
S POR=X
STOR K A S ANS="" F L=1:1:66 S A(L)=""
F K=1:1:34 S Y=$T(COM+K^FHNU6),Z1=$P(Y,";",3) G:ANS="^" KIL D:Z1 CALC
F K=35:1:70 S Y=$T(COM+K^FHNU6),Z1=$P(Y,";",3) G:ANS="^" KIL D:Z1 CALC
S (Z1,Z2,Z3,Z4)="" S $P(^FHNU(FHX1,0),"^",4)=POR F K=1:1:20 S $P(Z1,"^",K)=A(K)
F K=21:1:38 S $P(Z2,"^",K-20)=A(K)
F K=39:1:56 S $P(Z3,"^",K-38)=A(K)
F K=57:1:66 S $P(Z4,"^",K-56)=A(K)
S ^FHNU(FHX1,1)=Z1,^(2)=Z2 S:Z3'="" ^FHNU(FHX1,3)=Z3 S:Z4'="" ^FHNU(FHX1,4)=Z4
G EN1
KIL G KILL^XUSCLEAN
ADD ; Add the new entry
W !!,"ADD ",TIT," as a New Entry? Y// " R X:DTIME Q:'$T!(X="^") S:X="" X="Y" D TR^FH I $P("YES",X,1)'="",$P("NO",X,1)'="" W *7," Answer YES or NO" G ADD
S X=$E(X,1) Q:X="N"
K DIC,DD,DO,X S (DIC,DIE)="^FHNU(",DIC(0)="L",DLAYGO=112
A L +^FHNU(0) S DA=$P(^FHNU(0),"^",3)+1 I $D(^FHNU(DA)) S $P(^FHNU(0),"^",3)=DA L -^FHNU(0) G A
S X=TIT D FILE^DICN L -^FHNU(0) S FHX1=+Y K DIC,DLAYGO
S DA=+Y,DR=".01;2;4:5;7;98;99" S:$D(^XUSEC("FHMGR",DUZ)) DIDEL=112 D ^DIE S:$D(DTOUT)!($D(Y))!('$D(DA)) FHX1=0 K DA,DIE,DR,Y
Q
CALC ; Read in Food Nutrient and Calculate 100 gms
W !,$P(Y,";",4)_": " R X:DTIME I '$T S ANS="^" Q
I X["^" W *7," Required Field." G CALC
I X'?.N.1".".N!(X<0)!(X>99999) W *7," Enter a number from 0-99999" G CALC
I X'="" S DEC=$S(Z1>64:2,1:3),A(Z1)=X/POR*100,A(Z1)=$S(A(Z1):+$J(A(Z1),0,DEC),1:0) W "... ",A(Z1)
Q
FHNUT ; HISC/NCA - Read in the and Calculate 100 Grams ;2/23/00 12:38
+1 ;;5.5;DIETETICS;;Jan 28, 2005
EN1 ; Enter Data
+1 KILL DIC
SET FHX1=0
SET DIC="^FHNU("
SET DIC(0)="EMZ"
+2 READ !!,"Food Nutrient Name: ",TIT:DTIME
IF '$TEST!("^"[TIT)
GOTO KIL
IF TIT'?.ANP
WRITE *7," ??"
GOTO EN1
+3 SET DIC("S")="I $E($P(^(0),U,1),1)'=""*"""
+4 SET X=TIT
DO ^DIC
KILL DIC
IF U[X!($DATA(DTOUT))
GOTO EN1
IF Y<1
IF TIT["?"
GOTO EN1
DO ADD
IF 'FHX1
GOTO KIL
GOTO R2
+5 SET FHX1=+Y
IF $PIECE($GET(^FHNU(FHX1,0)),"^",6)="N"
WRITE !!," USDA Handbook Values Not Editable"
QUIT
R2 WRITE !!,"Portion Size: "
READ X:DTIME
IF '$TEST!("^"[X)
GOTO KIL
+1 IF X'?.N.1".".N!(X<0)!(X>9999)
WRITE *7,!,"Enter the gram Portion Size.",!,"Enter a number From 1-9999."
GOTO R2
+2 SET POR=X
STOR KILL A
SET ANS=""
FOR L=1:1:66
SET A(L)=""
+1 FOR K=1:1:34
SET Y=$TEXT(COM+K^FHNU6)
SET Z1=$PIECE(Y,";",3)
IF ANS="^"
GOTO KIL
IF Z1
DO CALC
+2 FOR K=35:1:70
SET Y=$TEXT(COM+K^FHNU6)
SET Z1=$PIECE(Y,";",3)
IF ANS="^"
GOTO KIL
IF Z1
DO CALC
+3 SET (Z1,Z2,Z3,Z4)=""
SET $PIECE(^FHNU(FHX1,0),"^",4)=POR
FOR K=1:1:20
SET $PIECE(Z1,"^",K)=A(K)
+4 FOR K=21:1:38
SET $PIECE(Z2,"^",K-20)=A(K)
+5 FOR K=39:1:56
SET $PIECE(Z3,"^",K-38)=A(K)
+6 FOR K=57:1:66
SET $PIECE(Z4,"^",K-56)=A(K)
+7 SET ^FHNU(FHX1,1)=Z1
SET ^(2)=Z2
IF Z3'=""
SET ^FHNU(FHX1,3)=Z3
IF Z4'=""
SET ^FHNU(FHX1,4)=Z4
+8 GOTO EN1
KIL GOTO KILL^XUSCLEAN
ADD ; Add the new entry
+1 WRITE !!,"ADD ",TIT," as a New Entry? Y// "
READ X:DTIME
IF '$TEST!(X="^")
QUIT
IF X=""
SET X="Y"
DO TR^FH
IF $PIECE("YES",X,1)'=""
IF $PIECE("NO",X,1)'=""
WRITE *7," Answer YES or NO"
GOTO ADD
+2 SET X=$EXTRACT(X,1)
IF X="N"
QUIT
+3 KILL DIC,DD,DO,X
SET (DIC,DIE)="^FHNU("
SET DIC(0)="L"
SET DLAYGO=112
A LOCK +^FHNU(0)
SET DA=$PIECE(^FHNU(0),"^",3)+1
IF $DATA(^FHNU(DA))
SET $PIECE(^FHNU(0),"^",3)=DA
LOCK -^FHNU(0)
GOTO A
+1 SET X=TIT
DO FILE^DICN
LOCK -^FHNU(0)
SET FHX1=+Y
KILL DIC,DLAYGO
+2 SET DA=+Y
SET DR=".01;2;4:5;7;98;99"
IF $DATA(^XUSEC("FHMGR",DUZ))
SET DIDEL=112
DO ^DIE
IF $DATA(DTOUT)!($DATA(Y))!('$DATA(DA))
SET FHX1=0
KILL DA,DIE,DR,Y
+3 QUIT
CALC ; Read in Food Nutrient and Calculate 100 gms
+1 WRITE !,$PIECE(Y,";",4)_": "
READ X:DTIME
IF '$TEST
SET ANS="^"
QUIT
+2 IF X["^"
WRITE *7," Required Field."
GOTO CALC
+3 IF X'?.N.1".".N!(X<0)!(X>99999)
WRITE *7," Enter a number from 0-99999"
GOTO CALC
+4 IF X'=""
SET DEC=$SELECT(Z1>64:2,1:3)
SET A(Z1)=X/POR*100
SET A(Z1)=$SELECT(A(Z1):+$JUSTIFY(A(Z1),0,DEC),1:0)
WRITE "... ",A(Z1)
+5 QUIT
