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
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHNUT   2008     printed  Sep 23, 2025@19:28:39                                                                                                                                                                                                       Page 2
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