Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: FHWOR8

FHWOR8.m

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