FHIPST17.m

FHIPST17	; HISC/REL - Add Recipe Categories to Meals ;5/2/95  09:53

	;;5.0;Dietetics;;Oct 11, 1995

	F K=0:0 S K=$O(^FH(116.1,K)) Q:K<1  F L=0:0 S L=$O(^FH(116.1,K,"RE",L)) Q:L<1  D

	.S R1=+$G(^FH(116.1,K,"RE",L,0)) Q:'R1

	.S ZZ=$P($G(^FH(116.1,K,"RE",L,0)),"^",3) Q:ZZ

	.S CAT=$P($G(^FH(114,R1,0)),"^",7) Q:'CAT

	.S $P(^FH(116.1,K,"RE",L,0),"^",3)=CAT Q

	K CAT,K,L,R1,ZZ

EN1	; Loop through the Meals and populate the category and pd fields

	F M1=0:0 S M1=$O(^FH(116.1,M1)) Q:M1<1  F REC=0:0 S REC=$O(^FH(116.1,M1,"RE",REC)) Q:REC<1  S X1=$G(^(REC,0)) D:X1'="" GET

	K FHX1,FHX2,M1,REC,STR,X1 Q

GET	S STR=""

	I $P(X1,"^",3),$P(X1,"^",2)'="" S STR=$P(X1,"^",3)_"^"_$P(X1,"^",2)

	I STR'=""  D

	.Q:$D(^FH(116.1,M1,"RE",REC,"R",0))

	.S ^FH(116.1,M1,"RE",REC,"R",0)="^116.12PA^^"

	.S FHX1=$G(^FH(116.1,M1,"RE",REC,"R",0)),FHX2=$P(FHX1,"^",3)+1

	.S $P(^FH(116.1,M1,"RE",REC,"R",0),"^",3,4)=FHX2_"^"_($P(FHX1,"^",4)+1)

	.I '$D(^FH(116.1,M1,"RE",REC,"R",FHX2,0)) S ^FH(116.1,M1,"RE",REC,"R",FHX2,0)=STR,^FH(116.1,M1,"RE",REC,"R","B",+STR,FHX2)=""

	.Q

	Q

FHIPST17  ; HISC/REL - Add Recipe Categories to Meals ;5/2/95  09:53

 +1       ;;5.0;Dietetics;;Oct 11, 1995

 +2        FOR K=0:0

               SET K=$ORDER(^FH(116.1,K))

               IF K<1

                   QUIT 

               FOR L=0:0

                   SET L=$ORDER(^FH(116.1,K,"RE",L))

                   IF L<1

                       QUIT 

                   Begin DoDot:1

 +3                    SET R1=+$GET(^FH(116.1,K,"RE",L,0))

                       IF 'R1

                           QUIT 

 +4                    SET ZZ=$PIECE($GET(^FH(116.1,K,"RE",L,0)),"^",3)

                       IF ZZ

                           QUIT 

 +5                    SET CAT=$PIECE($GET(^FH(114,R1,0)),"^",7)

                       IF 'CAT

                           QUIT 

 +6                    SET $PIECE(^FH(116.1,K,"RE",L,0),"^",3)=CAT

                       QUIT 

                   End DoDot:1

 +7        KILL CAT,K,L,R1,ZZ

EN1       ; Loop through the Meals and populate the category and pd fields

 +1        FOR M1=0:0

               SET M1=$ORDER(^FH(116.1,M1))

               IF M1<1

                   QUIT 

               FOR REC=0:0

                   SET REC=$ORDER(^FH(116.1,M1,"RE",REC))

                   IF REC<1

                       QUIT 

                   SET X1=$GET(^(REC,0))

                   IF X1'=""

                       DO GET

 +2        KILL FHX1,FHX2,M1,REC,STR,X1

           QUIT 

GET        SET STR=""

 +1        IF $PIECE(X1,"^",3)

               IF $PIECE(X1,"^",2)'=""

                   SET STR=$PIECE(X1,"^",3)_"^"_$PIECE(X1,"^",2)

 +2        IF STR'=""

               Begin DoDot:1

 +3                IF $DATA(^FH(116.1,M1,"RE",REC,"R",0))

                       QUIT 

 +4                SET ^FH(116.1,M1,"RE",REC,"R",0)="^116.12PA^^"

 +5                SET FHX1=$GET(^FH(116.1,M1,"RE",REC,"R",0))

                   SET FHX2=$PIECE(FHX1,"^",3)+1

 +6                SET $PIECE(^FH(116.1,M1,"RE",REC,"R",0),"^",3,4)=FHX2_"^"_($PIECE(FHX1,"^",4)+1)

 +7                IF '$DATA(^FH(116.1,M1,"RE",REC,"R",FHX2,0))

                       SET ^FH(116.1,M1,"RE",REC,"R",FHX2,0)=STR

                       SET ^FH(116.1,M1,"RE",REC,"R","B",+STR,FHX2)=""

 +8                QUIT 

               End DoDot:1

 +9        QUIT