- FHREC1 ; HISC/REL - Units Conversion ;2/24/92 13:33
- ;;5.5;DIETETICS;;Jan 28, 2005
- EN1 ; Units Input - UNT=Recipe Unit, X=Input - Error if X undefined
- K A1 D TYP I TYP="E" S X=+X G:X'?1N.N!(X<1) F5 G KIL
- I X["#" F K=0:0 S A1=$F(X,"#") Q:'A1 S X=$E(X,0,A1-2)_"LBS"_$E(X,A1,99)
- I X["," F K=0:0 S A1=$F(X,",") Q:'A1 S X=$E(X,0,A1-2)_$E(X,A1,99)
- I X["-" F K=0:0 S A1=$F(X,"-") Q:'A1 S X=$E(X,0,A1-2)_" "_$E(X,A1,99)
- F1 S A1=$P(X," ",1),X=$P(X," ",2,99) I A1="" G F4:X="",F1
- G:A1'?.E1U.E D1 F K=1:1:$L(A1) Q:$E(A1,K)?1U
- S A3=$E(A1,K,99),A1=$E(A1,0,K-1),A2="" G D3
- D1 G:X="" F5 S A2=$P(X," ",1),X=$P(X," ",2,99) G:A2'?.E1U.E D2
- F K=1:1:$L(A2) Q:$E(A2,K)?1U
- S A3=$E(A2,K,99),A2=$E(A2,0,K-1) G D3
- D2 G:X="" F5 S A3=$P(X," ",1),X=$P(X," ",2,99) G:A3'?1U.E F5
- D3 S:A1?1N1"/"1N&(A2="") A2=A1,A1=0 I A1'?1N.N,A1'?.N1".".N G F5
- I A2'="" G:A2'?1N1"/"1N F5 S Y1=+A2,Y2=$E(A2,3) G:Y1=0!(Y1'<Y2) F5 S A1=A1+(Y1/Y2)
- S:A3["." A3=$P(A3,".",1) S A2=A3
- I TYP="W" S S1=$F("LBS OZ TBSP TSP",A2) G:'S1 F5 S S1=$S(S1<5:1,S1<8:2,S1<13:3,1:4) G F3
- S S1=$F("GALS QTS QUARTS PINTS PTS CUPS FLOZ TBSP TSP",A2) G:'S1 F5 S S1=$S(S1<6:1,S1<17:2,S1<27:3,S1<32:4,S1<37:5,S1<42:6,1:7)
- F3 S:'$D(A1(S1)) A1(S1)=0 S A1(S1)=A1(S1)+A1 G F1
- F4 D DIV S X=0 F K=1:1 S P1=$P(P0,",",K) Q:P1="" S:$D(A1(K)) X=X+(A1(K)/P1)
- S X=$J(X,0,5),X=+X G KIL
- F5 K X G KIL
- TYP S TYP=$S(UNT="EACH":"E",UNT="LB":"W",1:"V") Q
- DIV I TYP="W" S P0="1,16,32,96"
- E S P0="1,4,8,16,128,256,768"
- Q
- EN2 ; Units Output - UNT=Recipe Unit, Y=Amount - return Y
- D TYP I TYP="E" S Y=$J(Y,0,0)_" "_UNT G KIL
- S A2=$S(TYP="W":"LB OZ TBSP TSP",1:"GAL QTS PTS CUPS FLOZ TBSP TSP")
- D DIV F K=1:1 S P1=$P(P0,",",K) Q:P1=""!((Y*P1)'<1)
- S (Y1,Y2)="" S:P1="" K=K-1,P1=$P(P0,",",K) S P2=$P(P0,",",K+1)
- S U1=$P(A2," ",K),U2=$P(A2," ",K+1) I P2="" S P2=P1,P1="",U2=U1,U1="" G N1
- S A1=Y*P1 I A1\1 S Y1=A1\1,Y=Y-(A1\1/P1)
- N1 S A1=Y*P2 S:A1#1>.875 A1=(A1+1)\1 I A1\1 S Y2=(A1\1),A1=A1#1
- I P1,Y2'<(P2/P1) S Y1=Y1+1,Y2=Y2-(P2/P1) S:'Y2 Y2=""
- N2 S S1=$S(A1<.125:"",A1<.375:"1/4",A1<.625:"1/2",1:"3/4") I Y2'=""!(S1="") G N3
- G:'$P(P0,",",K+2) N3 S A1=A1*$P(P0,",",K+2)/P2+.5\1 G:'A1 N3
- I A1'<($P(P0,",",K+2)/P2) S Y2=Y2+1,S1="" G N3
- S Y2=A1,U2=$P(A2," ",K+2),S1=""
- N3 I S1'="" S:Y2'="" Y2=Y2_"-" S Y2=Y2_S1
- I Y1'="" S Y1=Y1_" "_U1 S:Y2'="" Y1=Y1_", "
- S:Y2'="" Y2=Y2_" "_U2 S Y=Y1_Y2 S:Y="" Y="1/8 TSP" G KIL
- EN3 ; Portion size input
- F K=1:1 S A1=$E(X,K) I A1'?1N,A1'?1"." Q
- S A1=+$E(X,1,K-1),A2=$E(X,K,99) I 'A1 K X G KIL
- S:$E(A2,1)'?1U A2=$E(A2,2,99) S A3=$P(A2," ",2,99),A2=$P(A2," ",1) I A2="" K X G KIL
- I $P("OZ",A2,1)'="",$P("EACH",A2,1)'="",$P("FLOZ",A2,1)'="" K X G KIL
- S X=A1_"-"_$S(A2?1"O".E:"OZ",A2?1"E".E:"EACH",1:"FLOZ") S:A3'="" X=X_" "_A3 G KIL
- KIL K A1,A2,A3,P1,P2,P0,K,S1,TYP,U1,U2,Y1,Y2 Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHREC1 2796 printed Feb 18, 2025@23:21:13 Page 2
- FHREC1 ; HISC/REL - Units Conversion ;2/24/92 13:33
- +1 ;;5.5;DIETETICS;;Jan 28, 2005
- EN1 ; Units Input - UNT=Recipe Unit, X=Input - Error if X undefined
- +1 KILL A1
- DO TYP
- IF TYP="E"
- SET X=+X
- if X'?1N.N!(X<1)
- GOTO F5
- GOTO KIL
- +2 IF X["#"
- FOR K=0:0
- SET A1=$FIND(X,"#")
- if 'A1
- QUIT
- SET X=$EXTRACT(X,0,A1-2)_"LBS"_$EXTRACT(X,A1,99)
- +3 IF X[","
- FOR K=0:0
- SET A1=$FIND(X,",")
- if 'A1
- QUIT
- SET X=$EXTRACT(X,0,A1-2)_$EXTRACT(X,A1,99)
- +4 IF X["-"
- FOR K=0:0
- SET A1=$FIND(X,"-")
- if 'A1
- QUIT
- SET X=$EXTRACT(X,0,A1-2)_" "_$EXTRACT(X,A1,99)
- F1 SET A1=$PIECE(X," ",1)
- SET X=$PIECE(X," ",2,99)
- IF A1=""
- if X=""
- GOTO F4
- GOTO F1
- +1 if A1'?.E1U.E
- GOTO D1
- FOR K=1:1:$LENGTH(A1)
- if $EXTRACT(A1,K)?1U
- QUIT
- +2 SET A3=$EXTRACT(A1,K,99)
- SET A1=$EXTRACT(A1,0,K-1)
- SET A2=""
- GOTO D3
- D1 if X=""
- GOTO F5
- SET A2=$PIECE(X," ",1)
- SET X=$PIECE(X," ",2,99)
- if A2'?.E1U.E
- GOTO D2
- +1 FOR K=1:1:$LENGTH(A2)
- if $EXTRACT(A2,K)?1U
- QUIT
- +2 SET A3=$EXTRACT(A2,K,99)
- SET A2=$EXTRACT(A2,0,K-1)
- GOTO D3
- D2 if X=""
- GOTO F5
- SET A3=$PIECE(X," ",1)
- SET X=$PIECE(X," ",2,99)
- if A3'?1U.E
- GOTO F5
- D3 if A1?1N1"/"1N&(A2="")
- SET A2=A1
- SET A1=0
- IF A1'?1N.N
- IF A1'?.N1".".N
- GOTO F5
- +1 IF A2'=""
- if A2'?1N1"/"1N
- GOTO F5
- SET Y1=+A2
- SET Y2=$EXTRACT(A2,3)
- if Y1=0!(Y1'<Y2)
- GOTO F5
- SET A1=A1+(Y1/Y2)
- +2 if A3["."
- SET A3=$PIECE(A3,".",1)
- SET A2=A3
- +3 IF TYP="W"
- SET S1=$FIND("LBS OZ TBSP TSP",A2)
- if 'S1
- GOTO F5
- SET S1=$SELECT(S1<5:1,S1<8:2,S1<13:3,1:4)
- GOTO F3
- +4 SET S1=$FIND("GALS QTS QUARTS PINTS PTS CUPS FLOZ TBSP TSP",A2)
- if 'S1
- GOTO F5
- SET S1=$SELECT(S1<6:1,S1<17:2,S1<27:3,S1<32:4,S1<37:5,S1<42:6,1:7)
- F3 if '$DATA(A1(S1))
- SET A1(S1)=0
- SET A1(S1)=A1(S1)+A1
- GOTO F1
- F4 DO DIV
- SET X=0
- FOR K=1:1
- SET P1=$PIECE(P0,",",K)
- if P1=""
- QUIT
- if $DATA(A1(K))
- SET X=X+(A1(K)/P1)
- +1 SET X=$JUSTIFY(X,0,5)
- SET X=+X
- GOTO KIL
- F5 KILL X
- GOTO KIL
- TYP SET TYP=$SELECT(UNT="EACH":"E",UNT="LB":"W",1:"V")
- QUIT
- DIV IF TYP="W"
- SET P0="1,16,32,96"
- +1 IF '$TEST
- SET P0="1,4,8,16,128,256,768"
- +2 QUIT
- EN2 ; Units Output - UNT=Recipe Unit, Y=Amount - return Y
- +1 DO TYP
- IF TYP="E"
- SET Y=$JUSTIFY(Y,0,0)_" "_UNT
- GOTO KIL
- +2 SET A2=$SELECT(TYP="W":"LB OZ TBSP TSP",1:"GAL QTS PTS CUPS FLOZ TBSP TSP")
- +3 DO DIV
- FOR K=1:1
- SET P1=$PIECE(P0,",",K)
- if P1=""!((Y*P1)'<1)
- QUIT
- +4 SET (Y1,Y2)=""
- if P1=""
- SET K=K-1
- SET P1=$PIECE(P0,",",K)
- SET P2=$PIECE(P0,",",K+1)
- +5 SET U1=$PIECE(A2," ",K)
- SET U2=$PIECE(A2," ",K+1)
- IF P2=""
- SET P2=P1
- SET P1=""
- SET U2=U1
- SET U1=""
- GOTO N1
- +6 SET A1=Y*P1
- IF A1\1
- SET Y1=A1\1
- SET Y=Y-(A1\1/P1)
- N1 SET A1=Y*P2
- if A1#1>.875
- SET A1=(A1+1)\1
- IF A1\1
- SET Y2=(A1\1)
- SET A1=A1#1
- +1 IF P1
- IF Y2'<(P2/P1)
- SET Y1=Y1+1
- SET Y2=Y2-(P2/P1)
- if 'Y2
- SET Y2=""
- N2 SET S1=$SELECT(A1<.125:"",A1<.375:"1/4",A1<.625:"1/2",1:"3/4")
- IF Y2'=""!(S1="")
- GOTO N3
- +1 if '$PIECE(P0,",",K+2)
- GOTO N3
- SET A1=A1*$PIECE(P0,",",K+2)/P2+.5\1
- if 'A1
- GOTO N3
- +2 IF A1'<($PIECE(P0,",",K+2)/P2)
- SET Y2=Y2+1
- SET S1=""
- GOTO N3
- +3 SET Y2=A1
- SET U2=$PIECE(A2," ",K+2)
- SET S1=""
- N3 IF S1'=""
- if Y2'=""
- SET Y2=Y2_"-"
- SET Y2=Y2_S1
- +1 IF Y1'=""
- SET Y1=Y1_" "_U1
- if Y2'=""
- SET Y1=Y1_", "
- +2 if Y2'=""
- SET Y2=Y2_" "_U2
- SET Y=Y1_Y2
- if Y=""
- SET Y="1/8 TSP"
- GOTO KIL
- EN3 ; Portion size input
- +1 FOR K=1:1
- SET A1=$EXTRACT(X,K)
- IF A1'?1N
- IF A1'?1"."
- QUIT
- +2 SET A1=+$EXTRACT(X,1,K-1)
- SET A2=$EXTRACT(X,K,99)
- IF 'A1
- KILL X
- GOTO KIL
- +3 if $EXTRACT(A2,1)'?1U
- SET A2=$EXTRACT(A2,2,99)
- SET A3=$PIECE(A2," ",2,99)
- SET A2=$PIECE(A2," ",1)
- IF A2=""
- KILL X
- GOTO KIL
- +4 IF $PIECE("OZ",A2,1)'=""
- IF $PIECE("EACH",A2,1)'=""
- IF $PIECE("FLOZ",A2,1)'=""
- KILL X
- GOTO KIL
- +5 SET X=A1_"-"_$SELECT(A2?1"O".E:"OZ",A2?1"E".E:"EACH",1:"FLOZ")
- if A3'=""
- SET X=X_" "_A3
- GOTO KIL
- KIL KILL A1,A2,A3,P1,P2,P0,K,S1,TYP,U1,U2,Y1,Y2
- QUIT