source: WorldVistAEHR/trunk/r/DIETETICS-FH/FHWOR8.m@ 701

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

initial load of WorldVistAEHR

File size: 2.3 KB
Line 
1FHWOR8 ; HISC/NCA - Dietetics Order Parameter ;2/24/95 07:56 ;
2 ;;5.5;DIETETICS;;Jan 28, 2005;
3EN(DFN,FHPAR) ; Get the Order Parameter by passing the DFN and Variable
4 ; array FHPAR(1)-FHPAR(3) is returned.
5 N WARD,ADM,DP,FHWRD
6 S FHPAR="",WARD=$G(^DPT(DFN,.1)) G:WARD="" EXIT
7 S ADM=$G(^DPT("CN",WARD,DFN)) G:ADM<1 EXIT
8 S FHZ115="P"_DFN D CHECK^FHOMDPA I FHDFN="" Q
9 S FHWRD=$P($G(^FHPT(FHDFN,"A",ADM,0)),"^",8),DP=$P($G(^FH(119.6,+FHWRD,0)),"^",8)
10 S FHPAR(1)=$G(^FH(119.73,+DP,1)),FHPAR(2)=$G(^FH(119.73,+DP,2))
11 S FHPAR(3)=$P($G(^FH(119.6,+FHWRD,0)),"^",10)
12EXIT Q
13 ;
14EN1(LOC,FHPAR) ; Get the Order Parameters by passing the WARD/HOSP LOCATION
15 ; array FHPAR(1)-FHPAR(3) is returned.
16 K FHPAR N DP,FHVPTR,FHLOC
17 S FHVPTR=$P(LOC,";",1)
18 I LOC["SC" S FHLOC=$O(^FH(119.6,"AL",FHVPTR,"")) I FHLOC="" D
19 .S FHVPTR=$G(^SC(FHVPTR,42)) Q:FHVPTR="" S FHLOC=$O(^FH(119.6,"AW",FHVPTR,""))
20 I LOC'["SC" S FHLOC=$O(^FH(119.6,"AW",FHVPTR,"")) I FHLOC="" D
21 .S FHVPTR=$G(^DIC(42,FHVPTR,44)) Q:FHVPTR="" S FHLOC=$O(^FH(119.6,"AL",FHVPTR,""))
22 I FHLOC="" Q
23 S DP=$P($G(^FH(119.6,+FHLOC,0)),"^",8) I DP="" Q
24 S FHPAR(1)=$G(^FH(119.73,+DP,1)),FHPAR(2)=$G(^FH(119.73,+DP,2))
25 S FHPAR(3)=$P($G(^FH(119.6,+FHLOC,0)),"^",10)
26 Q
27EN2(DFN,FHM,FHPAR) ; Get the list of meal dates by passing the DFN/MEAL
28 ; array FHPAR() is returned.
29 S FHZ115="P"_DFN D CHECK^FHOMDPA I FHDFN="" Q
30 K FHPAR S FHINDX=0
31 D NOW^%DTC S FHNOW=X,X1=FHNOW,X2=-1 D C^%DTC S FHNOW=X
32 I '$O(^FHPT(FHDFN,"OP","B",FHNOW)) Q
33 F FHRM=FHNOW:0 S FHRM=$O(^FHPT(FHDFN,"OP","B",FHRM)) Q:FHRM'>0 D
34 .F FHRNUM=0:0 S FHRNUM=$O(^FHPT(FHDFN,"OP","B",FHRM,FHRNUM)) Q:FHRNUM'>0 D
35 ..I $P($G(^FHPT(FHDFN,"OP",FHRNUM,0)),U,15)="C" Q
36 ..S FHMEAL1=$P($G(^FHPT(FHDFN,"OP",FHRNUM,0)),U,4)
37 ..I FHM'="",FHM'=FHMEAL1 Q
38 ..S FHINDX=FHINDX+1
39 ..S FHPAR(FHINDX)=FHRM_"^"_FHMEAL1 Q
40 Q
41EN3(DFN,FHPAR) ; Get the list of recurring meal dates by passing the DFN
42 ; array FHPAR() is returned.
43 S FHZ115="P"_DFN D CHECK^FHOMDPA I FHDFN="" Q
44 K FHPAR S FHINDX=0
45 D NOW^%DTC S FHNOW=X,X1=FHNOW,X2=-1 D C^%DTC S FHNOW=X
46 I '$O(^FHPT(FHDFN,"OP","B",FHNOW)) Q
47 F FHRM=FHNOW:0 S FHRM=$O(^FHPT(FHDFN,"OP","B",FHRM)) Q:FHRM'>0 D
48 .F FHRNUM=0:0 S FHRNUM=$O(^FHPT(FHDFN,"OP","B",FHRM,FHRNUM)) Q:FHRNUM'>0 D
49 ..I $P($G(^FHPT(FHDFN,"OP",FHRNUM,0)),U,15)="C" Q
50 ..S FHMEAL1=$P($G(^FHPT(FHDFN,"OP",FHRNUM,0)),U,4)
51 ..S FHINDX=FHINDX+1
52 ..S FHPAR(FHINDX)=FHRM_"^"_FHMEAL1 Q
53 Q
Note: See TracBrowser for help on using the repository browser.