FHIPST1.m

FHIPST1	; HISC/REL - Post-Init (Move Tubefeeds) ;11/24/92  09:25

	;;5.0;Dietetics;;Oct 11, 1995

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

INP	W !!,"Move Tubefeedings for Inpatients ..."

	S NX="" F  S NX=$O(^DPT("CN",NX)) Q:NX=""  F DFN=0:0 S DFN=$O(^DPT("CN",NX,DFN)) Q:DFN<1  S ADM=$G(^(DFN)) I ADM,$D(^FHPT(DFN,"A",ADM,"TF")) D TF

	Q

ALL	; Move TF for all patients

	W !!,"Move Tubefeedings for all patients ..."

	S CT=0 F DFN=0:0 S DFN=$O(^FHPT(DFN)) Q:DFN<1  F ADM=0:0 S ADM=$O(^FHPT(DFN,"A",ADM)) Q:ADM<1  S CT=CT+1 W:CT#1000=0 "." I $D(^FHPT(DFN,"A",ADM,"TF")) D TF

	Q

TF	F C=0:0 S C=$O(^FHPT(DFN,"A",ADM,"TF",C)) Q:C<1  I '$D(^FHPT(DFN,"A",ADM,"TF",C,"P")) D TF1

	Q

TF1	S Y=$P($G(^FHPT(DFN,"A",ADM,"TF",C,0)),"^",2,9) Q:'Y  S $P(^(0),"^",2,4)="^^",$P(^(0),"^",8,9)="^"

	S ^FHPT(DFN,"A",ADM,"TF",C,"P",0)="^115.1P^1^1"

	S ^FHPT(DFN,"A",ADM,"TF",C,"P",1,0)=$P(Y,"^",1,3)_"^"_$P(Y,"^",7,8)_"^"_$P(Y,"^",6)

	S ^FHPT(DFN,"A",ADM,"TF",C,"P","B",+Y,1)="" Q

FHIPST1   ; HISC/REL - Post-Init (Move Tubefeeds) ;11/24/92  09:25

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

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

               QUIT 

INP        WRITE !!,"Move Tubefeedings for Inpatients ..."

 +1        SET NX=""

           FOR 

               SET NX=$ORDER(^DPT("CN",NX))

               IF NX=""

                   QUIT 

               FOR DFN=0:0

                   SET DFN=$ORDER(^DPT("CN",NX,DFN))

                   IF DFN<1

                       QUIT 

                   SET ADM=$GET(^(DFN))

                   IF ADM

                       IF $DATA(^FHPT(DFN,"A",ADM,"TF"))

                           DO TF

 +2        QUIT 

ALL       ; Move TF for all patients

 +1        WRITE !!,"Move Tubefeedings for all patients ..."

 +2        SET CT=0

           FOR DFN=0:0

               SET DFN=$ORDER(^FHPT(DFN))

               IF DFN<1

                   QUIT 

               FOR ADM=0:0

                   SET ADM=$ORDER(^FHPT(DFN,"A",ADM))

                   IF ADM<1

                       QUIT 

                   SET CT=CT+1

                   IF CT#1000=0

                       WRITE "."

                   IF $DATA(^FHPT(DFN,"A",ADM,"TF"))

                       DO TF

 +3        QUIT 

TF         FOR C=0:0

               SET C=$ORDER(^FHPT(DFN,"A",ADM,"TF",C))

               IF C<1

                   QUIT 

               IF '$DATA(^FHPT(DFN,"A",ADM,"TF",C,"P"))

                   DO TF1

 +1        QUIT 

TF1        SET Y=$PIECE($GET(^FHPT(DFN,"A",ADM,"TF",C,0)),"^",2,9)

           IF 'Y

               QUIT 

           SET $PIECE(^(0),"^",2,4)="^^"

           SET $PIECE(^(0),"^",8,9)="^"

 +1        SET ^FHPT(DFN,"A",ADM,"TF",C,"P",0)="^115.1P^1^1"

 +2        SET ^FHPT(DFN,"A",ADM,"TF",C,"P",1,0)=$PIECE(Y,"^",1,3)_"^"_$PIECE(Y,"^",7,8)_"^"_$PIECE(Y,"^",6)

 +3        SET ^FHPT(DFN,"A",ADM,"TF",C,"P","B",+Y,1)=""

           QUIT