source: WorldVistAEHR/trunk/r/DIETETICS-FH/FHOMAPI.m@ 1211

Last change on this file since 1211 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 937 bytes
RevLine 
[613]1FHOMAPI ;Hines OIFO/RTK OUTPATIENT MEALS/CPRS API's ;8/26/03 10:15
2 ;;5.5;DIETETICS;**2**;Jan 28, 2005
3 ;
4AUTH(DUZ) ;Check whether USER (DUZ) has FHAUTH key: 1=YES, 0=NO
5 N FHAU S FHAU=0
6 I $D(^XUSEC("FHAUTH",DUZ)) S FHAU=1
7 Q FHAU
8DIETLST ;Build list of allowable outpatient diets from site parameters
9 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)
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
11 Q
12MAXDAYS(FHLOC) ;Returns max number of days a recurring meal may be ordered
13 N FHMAXD S FHMAXD=365 I FHLOC="" Q FHMAXD
14 S FHLOC=$O(^FH(119.6,"AL",FHLOC,""))
15 I 'FHLOC Q FHMAXD
16 S FHMAXD=$P($G(^FH(119.6,FHLOC,1)),U,2) I FHMAXD="" S FHMAXD=365
17 Q FHMAXD
18NFSLOC(FHLOC) ;Returns NFS location name given HOSP LOCATION pointer
19 I FHLOC="" Q ""
20 S FHLOC=$O(^FH(119.6,"AL",FHLOC,""))
21 I 'FHLOC Q ""
22 S FHLNAME=$P($G(^FH(119.6,FHLOC,0)),U,1)
23 Q FHLNAME
Note: See TracBrowser for help on using the repository browser.