- 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
- 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