FHOMAPI ;Hines OIFO/RTK OUTPATIENT MEALS/CPRS API's ;8/26/03 10:15
;;5.5;DIETETICS;**2**;Jan 28, 2005
;
AUTH(DUZ) ;Check whether USER (DUZ) has FHAUTH key: 1=YES, 0=NO
N FHAU S FHAU=0
I $D(^XUSEC("FHAUTH",DUZ)) S FHAU=1
Q FHAU
DIETLST ;Build list of allowable outpatient diets from site parameters
K FHDIET,SPDIETS S SPDIETS=$P($G(^FH(119.9,1,0)),U,2,6)_"^"_$P($G(^FH(119.9,1,1)),U,1,10)
F A=1:1:15 S AB=$P(SPDIETS,U,A) I AB'="" S FHN=$P($G(^FH(111,AB,0)),U,1),FHDIET(A)=AB_"^"_FHN
Q
MAXDAYS(FHLOC) ;Returns max number of days a recurring meal may be ordered
N FHMAXD S FHMAXD=365 I FHLOC="" Q FHMAXD
S FHLOC=$O(^FH(119.6,"AL",FHLOC,""))
I 'FHLOC Q FHMAXD
S FHMAXD=$P($G(^FH(119.6,FHLOC,1)),U,2) I FHMAXD="" S FHMAXD=365
Q FHMAXD
NFSLOC(FHLOC) ;Returns NFS location name given HOSP LOCATION pointer
I FHLOC="" Q ""
S FHLOC=$O(^FH(119.6,"AL",FHLOC,""))
I 'FHLOC Q ""
S FHLNAME=$P($G(^FH(119.6,FHLOC,0)),U,1)
Q FHLNAME
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HFHOMAPI 960 printed Nov 22, 2024@17:02:51 Page 2
FHOMAPI ;Hines OIFO/RTK OUTPATIENT MEALS/CPRS API's ;8/26/03 10:15
+1 ;;5.5;DIETETICS;**2**;Jan 28, 2005
+2 ;
AUTH(DUZ) ;Check whether USER (DUZ) has FHAUTH key: 1=YES, 0=NO
+1 NEW FHAU
SET FHAU=0
+2 IF $DATA(^XUSEC("FHAUTH",DUZ))
SET FHAU=1
+3 QUIT FHAU
DIETLST ;Build list of allowable outpatient diets from site parameters
+1 KILL FHDIET,SPDIETS
SET SPDIETS=$PIECE($GET(^FH(119.9,1,0)),U,2,6)_"^"_$PIECE($GET(^FH(119.9,1,1)),U,1,10)
+2 FOR A=1:1:15
SET AB=$PIECE(SPDIETS,U,A)
IF AB'=""
SET FHN=$PIECE($GET(^FH(111,AB,0)),U,1)
SET FHDIET(A)=AB_"^"_FHN
+3 QUIT
MAXDAYS(FHLOC) ;Returns max number of days a recurring meal may be ordered
+1 NEW FHMAXD
SET FHMAXD=365
IF FHLOC=""
QUIT FHMAXD
+2 SET FHLOC=$ORDER(^FH(119.6,"AL",FHLOC,""))
+3 IF 'FHLOC
QUIT FHMAXD
+4 SET FHMAXD=$PIECE($GET(^FH(119.6,FHLOC,1)),U,2)
IF FHMAXD=""
SET FHMAXD=365
+5 QUIT FHMAXD
NFSLOC(FHLOC) ;Returns NFS location name given HOSP LOCATION pointer
+1 IF FHLOC=""
QUIT ""
+2 SET FHLOC=$ORDER(^FH(119.6,"AL",FHLOC,""))
+3 IF 'FHLOC
QUIT ""
+4 SET FHLNAME=$PIECE($GET(^FH(119.6,FHLOC,0)),U,1)
+5 QUIT FHLNAME
