FHIPST4.m

FHIPST4	; HISC/REL - Convert Meals ;12/3/91  14:56

	;;5.0;Dietetics;;Oct 11, 1995

	Q:'$D(^FH(119.7))

	W !!,"Converting Meals ..."

	K DP F P0=0:0 S P0=$O(^FH(119.7,P0)) Q:P0<1  S DP(P0)=$G(^(P0,4))

	F KK=.9:0 S KK=$O(^FH(116.1,KK)) Q:KK<1  F M=0:0 S M=$O(^FH(116.1,KK,"RE",M)) Q:M<1  I $O(^FH(116.1,KK,"RE",M,"D",0))>0 D P1

	S DIU="^FH(119.7,",DIU(0)="DS" D EN^DIU2 Q

P1	K D,P F P0=0:0 S P0=$O(^FH(116.1,KK,"RE",M,"D",P0)) Q:P0<1  S D(P0)=$G(^(P0,0)) D P2

	K ^FH(116.1,KK,"RE",M,"D") S Z1=0,ZT=0

	F P0=0:0 S P0=$O(P(P0)) Q:P0=""  S ^FH(116.1,KK,"RE",M,"D",P0,0)=P(P0),^FH(116.1,KK,"RE",M,"D","B",P0,P0)="",Z1=Z1+1,ZT=P0

	S ^FH(116.1,KK,"RE",M,"D",0)="^116.112PA^"_ZT_"^"_Z1

	Q

P2	S ZT=$P(D(P0),"^",2) I ZT'="" S Z1=$P(DP(P0),"^",1) S:Z1 P(Z1)=Z1_"^"_ZT

	S ZC=$P(D(P0),"^",3) I ZC'="" S Z1=$P(DP(P0),"^",2) S:Z1 P(Z1)=Z1_"^"_ZC

	S Z1=$P(DP(P0),"^",3) I Z1 S ZT=$S($P(DP(P0),"^",4)="T":ZT,1:ZC) S:ZT'="" P(Z1)=Z1_"^"_ZT

	Q

FHIPST4   ; HISC/REL - Convert Meals ;12/3/91  14:56

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

 +2        IF '$DATA(^FH(119.7))

               QUIT 

 +3        WRITE !!,"Converting Meals ..."

 +4        KILL DP

           FOR P0=0:0

               SET P0=$ORDER(^FH(119.7,P0))

               IF P0<1

                   QUIT 

               SET DP(P0)=$GET(^(P0,4))

 +5        FOR KK=.9:0

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

               IF KK<1

                   QUIT 

               FOR M=0:0

                   SET M=$ORDER(^FH(116.1,KK,"RE",M))

                   IF M<1

                       QUIT 

                   IF $ORDER(^FH(116.1,KK,"RE",M,"D",0))>0

                       DO P1

 +6        SET DIU="^FH(119.7,"

           SET DIU(0)="DS"

           DO EN^DIU2

           QUIT 

P1         KILL D,P

           FOR P0=0:0

               SET P0=$ORDER(^FH(116.1,KK,"RE",M,"D",P0))

               IF P0<1

                   QUIT 

               SET D(P0)=$GET(^(P0,0))

               DO P2

 +1        KILL ^FH(116.1,KK,"RE",M,"D")

           SET Z1=0

           SET ZT=0

 +2        FOR P0=0:0

               SET P0=$ORDER(P(P0))

               IF P0=""

                   QUIT 

               SET ^FH(116.1,KK,"RE",M,"D",P0,0)=P(P0)

               SET ^FH(116.1,KK,"RE",M,"D","B",P0,P0)=""

               SET Z1=Z1+1

               SET ZT=P0

 +3        SET ^FH(116.1,KK,"RE",M,"D",0)="^116.112PA^"_ZT_"^"_Z1

 +4        QUIT 

P2         SET ZT=$PIECE(D(P0),"^",2)

           IF ZT'=""

               SET Z1=$PIECE(DP(P0),"^",1)

               IF Z1

                   SET P(Z1)=Z1_"^"_ZT

 +1        SET ZC=$PIECE(D(P0),"^",3)

           IF ZC'=""

               SET Z1=$PIECE(DP(P0),"^",2)

               IF Z1

                   SET P(Z1)=Z1_"^"_ZC

 +2        SET Z1=$PIECE(DP(P0),"^",3)

           IF Z1

               SET ZT=$SELECT($PIECE(DP(P0),"^",4)="T":ZT,1:ZC)

               IF ZT'=""

                   SET P(Z1)=Z1_"^"_ZT

 +3        QUIT