FHWOR8 ; HISC/NCA - Dietetics Order Parameter ;2/24/95  07:56 ;
 ;;5.5;DIETETICS;;Jan 28, 2005;
EN(DFN,FHPAR) ; Get the Order Parameter by passing the DFN and Variable
 ; array FHPAR(1)-FHPAR(3) is returned.
 N WARD,ADM,DP,FHWRD
 S FHPAR="",WARD=$G(^DPT(DFN,.1)) G:WARD="" EXIT
 S ADM=$G(^DPT("CN",WARD,DFN)) G:ADM<1 EXIT
 S FHZ115="P"_DFN D CHECK^FHOMDPA I FHDFN="" Q
 S FHWRD=$P($G(^FHPT(FHDFN,"A",ADM,0)),"^",8),DP=$P($G(^FH(119.6,+FHWRD,0)),"^",8)
 S FHPAR(1)=$G(^FH(119.73,+DP,1)),FHPAR(2)=$G(^FH(119.73,+DP,2))
 S FHPAR(3)=$P($G(^FH(119.6,+FHWRD,0)),"^",10)
EXIT Q
 ;
EN1(LOC,FHPAR) ; Get the Order Parameters by passing the WARD/HOSP LOCATION
 ; array FHPAR(1)-FHPAR(3) is returned.
 K FHPAR N DP,FHVPTR,FHLOC
 S FHVPTR=$P(LOC,";",1)
 I LOC["SC" S FHLOC=$O(^FH(119.6,"AL",FHVPTR,"")) I FHLOC="" D
 .S FHVPTR=$G(^SC(FHVPTR,42)) Q:FHVPTR=""  S FHLOC=$O(^FH(119.6,"AW",FHVPTR,""))
 I LOC'["SC" S FHLOC=$O(^FH(119.6,"AW",FHVPTR,"")) I FHLOC="" D
 .S FHVPTR=$G(^DIC(42,FHVPTR,44)) Q:FHVPTR=""  S FHLOC=$O(^FH(119.6,"AL",FHVPTR,""))
 I FHLOC="" Q
 S DP=$P($G(^FH(119.6,+FHLOC,0)),"^",8) I DP="" Q
 S FHPAR(1)=$G(^FH(119.73,+DP,1)),FHPAR(2)=$G(^FH(119.73,+DP,2))
 S FHPAR(3)=$P($G(^FH(119.6,+FHLOC,0)),"^",10)
 Q
EN2(DFN,FHM,FHPAR) ; Get the list of meal dates by passing the DFN/MEAL
 ; array FHPAR() is returned.
 S FHZ115="P"_DFN D CHECK^FHOMDPA I FHDFN="" Q
 K FHPAR S FHINDX=0
 D NOW^%DTC S FHNOW=X,X1=FHNOW,X2=-1 D C^%DTC S FHNOW=X
 I '$O(^FHPT(FHDFN,"OP","B",FHNOW)) Q
 F FHRM=FHNOW:0 S FHRM=$O(^FHPT(FHDFN,"OP","B",FHRM)) Q:FHRM'>0  D
 .F FHRNUM=0:0 S FHRNUM=$O(^FHPT(FHDFN,"OP","B",FHRM,FHRNUM)) Q:FHRNUM'>0  D
 ..I $P($G(^FHPT(FHDFN,"OP",FHRNUM,0)),U,15)="C" Q
 ..S FHMEAL1=$P($G(^FHPT(FHDFN,"OP",FHRNUM,0)),U,4)
 ..I FHM'="",FHM'=FHMEAL1 Q
 ..S FHINDX=FHINDX+1
 ..S FHPAR(FHINDX)=FHRM_"^"_FHMEAL1 Q
 Q
EN3(DFN,FHPAR) ; Get the list of recurring meal dates by passing the DFN
 ; array FHPAR() is returned.
 S FHZ115="P"_DFN D CHECK^FHOMDPA I FHDFN="" Q
 K FHPAR S FHINDX=0
 D NOW^%DTC S FHNOW=X,X1=FHNOW,X2=-1 D C^%DTC S FHNOW=X
 I '$O(^FHPT(FHDFN,"OP","B",FHNOW)) Q
 F FHRM=FHNOW:0 S FHRM=$O(^FHPT(FHDFN,"OP","B",FHRM)) Q:FHRM'>0  D
 .F FHRNUM=0:0 S FHRNUM=$O(^FHPT(FHDFN,"OP","B",FHRM,FHRNUM)) Q:FHRNUM'>0  D
 ..I $P($G(^FHPT(FHDFN,"OP",FHRNUM,0)),U,15)="C" Q
 ..S FHMEAL1=$P($G(^FHPT(FHDFN,"OP",FHRNUM,0)),U,4)
 ..S FHINDX=FHINDX+1
 ..S FHPAR(FHINDX)=FHRM_"^"_FHMEAL1 Q
 Q