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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHWOR7 2061 printed Dec 13, 2024@01:55:31 Page 2
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
