FHWOR7.m

FHWOR7 ; HISC/NCA - OE/RR Procedure Call ;2/17/95  10:28

 ;;5.5;DIETETICS;;Jan 28, 2005

EN1 ; OE/RR passes the Patient DFN and the information is stored in ^TMP

 K ^TMP($J,"FHTF"),^TMP($J,"FHSF"),^TMP($J,"FHPF")

 S FHZ115="P"_DFN D CHECK^FHOMDPA I FHDFN="" Q

 S FHWRD=$G(^DPT(DFN,.1)) G:FHWRD="" KIL

 S FHADM=$G(^DPT("CN",FHWRD,DFN)) G:FHADM<1 KIL

 I '$D(^FHPT(FHDFN,"A",FHADM,0)) G KIL

SF ; Get Current Supplemental Feeding order and store in ^TMP($J,"FHSF",1).

 ; The information is stored in the following:

 ;

 ; ^TMP($J,"FHSF",1)=DATE ORDERED_"^"_10am fdg_"^"_2pm fdg_"^"_8pm fdg

 ; Under each feeding it is stored as Quantity_" "_fdg name 1_";"_

 ; Quantity_" "_fdg name 2... up to 4.

 S FHNO=$P($G(^FHPT(FHDFN,"A",FHADM,0)),"^",7) G:'FHNO TF

 S FHX=$G(^FHPT(FHDFN,"A",FHADM,"SF",FHNO,0)),FHX1=$P(FHX,"^",2)

 S FHL=4 F FHK1=1:1:3 S FHN(FHK1)="" F FHK2=1:1:4 S FHX2=$P(FHX,"^",FHL+1),FHX3=$P(FHX,"^",FHL+2),FHL=FHL+2 I FHX2 S:FHN(FHK1)'="" FHN(FHK1)=FHN(FHK1)_";" S FHN(FHK1)=FHN(FHK1)_$S(FHX3:FHX3,1:1)_" "_$P($G(^FH(118,FHX2,0)),"^",1)

 S FHX=FHX1_"^"_FHN(1)_"^"_FHN(2)_"^"_FHN(3)

 S ^TMP($J,"FHSF",1)=FHX

TF ; Get Tubefeeding total Kcal/Day and store in ^TMP($J,"FHTF",1).

 S FHNO=$P($G(^FHPT(FHDFN,"A",FHADM,0)),"^",4) G:'FHNO FP

 S FHX=$G(^FHPT(FHDFN,"A",FHADM,"TF",FHNO,0)) S FHX=$P(FHX,"^",7)

 S ^TMP($J,"FHTF",1)=FHX

FP ; Get Food Preferences and store all Likes in ^TMP($J,"FHFP","L")

 ; and all Dislikes in ^TMP($J,"FHFP","D").  The information is store

 ; in the following:

 ;

 ; ^TMP($J,"FHFP","L",1)=Quantity_" "_Food Preference name_"^"_Meal

 ; ^TMP($J,"FHFP","D",1)=Food Preference name_"^"_Meals.

 S (FHD,FHL)=0 F FHNO=0:0 S FHNO=$O(^FHPT(FHDFN,"P",FHNO)) Q:FHNO<1  S FHX=$G(^(FHNO,0)) D SP

 G KIL

SP S FHZ=$G(^FH(115.2,+FHX,0))

 I $P(FHZ,"^",2)="L" S FHL=FHL+1,^TMP($J,"FHFP","L",FHL)=$S($P(FHX,"^",3):$P(FHX,"^",3),1:1)_" "_$P(FHZ,"^",1)_"^"_$P(FHX,"^",2) Q

 E  S FHD=FHD+1,^TMP($J,"FHFP","D",FHD)=$P(FHZ,"^",1)_"^"_$P(FHX,"^",2)

 Q

KIL K FHADM,FHD,FHK1,FHK2,FHL,FHN,FHNO,FHX,FHX1,FHX2,FHX3,FHWRD,FHZ Q

FHWOR7    ; HISC/NCA - OE/RR Procedure Call ;2/17/95  10:28

 +1       ;;5.5;DIETETICS;;Jan 28, 2005

EN1       ; OE/RR passes the Patient DFN and the information is stored in ^TMP

 +1        KILL ^TMP($JOB,"FHTF"),^TMP($JOB,"FHSF"),^TMP($JOB,"FHPF")

 +2        SET FHZ115="P"_DFN

           DO CHECK^FHOMDPA

           IF FHDFN=""

               QUIT 

 +3        SET FHWRD=$GET(^DPT(DFN,.1))

           IF FHWRD=""

               GOTO KIL

 +4        SET FHADM=$GET(^DPT("CN",FHWRD,DFN))

           IF FHADM<1

               GOTO KIL

 +5        IF '$DATA(^FHPT(FHDFN,"A",FHADM,0))

               GOTO KIL

SF        ; Get Current Supplemental Feeding order and store in ^TMP($J,"FHSF",1).

 +1       ; The information is stored in the following:

 +2       ;

 +3       ; ^TMP($J,"FHSF",1)=DATE ORDERED_"^"_10am fdg_"^"_2pm fdg_"^"_8pm fdg

 +4       ; Under each feeding it is stored as Quantity_" "_fdg name 1_";"_

 +5       ; Quantity_" "_fdg name 2... up to 4.

 +6        SET FHNO=$PIECE($GET(^FHPT(FHDFN,"A",FHADM,0)),"^",7)

           IF 'FHNO

               GOTO TF

 +7        SET FHX=$GET(^FHPT(FHDFN,"A",FHADM,"SF",FHNO,0))

           SET FHX1=$PIECE(FHX,"^",2)

 +8        SET FHL=4

           FOR FHK1=1:1:3

               SET FHN(FHK1)=""

               FOR FHK2=1:1:4

                   SET FHX2=$PIECE(FHX,"^",FHL+1)

                   SET FHX3=$PIECE(FHX,"^",FHL+2)

                   SET FHL=FHL+2

                   IF FHX2

                       IF FHN(FHK1)'=""

                           SET FHN(FHK1)=FHN(FHK1)_";"

                       SET FHN(FHK1)=FHN(FHK1)_$SELECT(FHX3:FHX3,1:1)_" "_$PIECE($GET(^FH(118,FHX2,0)),"^",1)

 +9        SET FHX=FHX1_"^"_FHN(1)_"^"_FHN(2)_"^"_FHN(3)

 +10       SET ^TMP($JOB,"FHSF",1)=FHX

TF        ; Get Tubefeeding total Kcal/Day and store in ^TMP($J,"FHTF",1).

 +1        SET FHNO=$PIECE($GET(^FHPT(FHDFN,"A",FHADM,0)),"^",4)

           IF 'FHNO

               GOTO FP

 +2        SET FHX=$GET(^FHPT(FHDFN,"A",FHADM,"TF",FHNO,0))

           SET FHX=$PIECE(FHX,"^",7)

 +3        SET ^TMP($JOB,"FHTF",1)=FHX

FP        ; Get Food Preferences and store all Likes in ^TMP($J,"FHFP","L")

 +1       ; and all Dislikes in ^TMP($J,"FHFP","D").  The information is store

 +2       ; in the following:

 +3       ;

 +4       ; ^TMP($J,"FHFP","L",1)=Quantity_" "_Food Preference name_"^"_Meal

 +5       ; ^TMP($J,"FHFP","D",1)=Food Preference name_"^"_Meals.

 +6        SET (FHD,FHL)=0

           FOR FHNO=0:0

               SET FHNO=$ORDER(^FHPT(FHDFN,"P",FHNO))

               IF FHNO<1

                   QUIT 

               SET FHX=$GET(^(FHNO,0))

               DO SP

 +7        GOTO KIL

SP         SET FHZ=$GET(^FH(115.2,+FHX,0))

 +1        IF $PIECE(FHZ,"^",2)="L"

               SET FHL=FHL+1

               SET ^TMP($JOB,"FHFP","L",FHL)=$SELECT($PIECE(FHX,"^",3):$PIECE(FHX,"^",3),1:1)_" "_$PIECE(FHZ,"^",1)_"^"_$PIECE(FHX,"^",2)

               QUIT 

 +2       IF '$TEST

               SET FHD=FHD+1

               SET ^TMP($JOB,"FHFP","D",FHD)=$PIECE(FHZ,"^",1)_"^"_$PIECE(FHX,"^",2)

 +3        QUIT 

KIL        KILL FHADM,FHD,FHK1,FHK2,FHL,FHN,FHNO,FHX,FHX1,FHX2,FHX3,FHWRD,FHZ

           QUIT