FHOMAPI.m

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