| [613] | 1 | FHWOR8 ; HISC/NCA - Dietetics Order Parameter ;2/24/95 07:56 ;
|
|---|
| 2 | ;;5.5;DIETETICS;;Jan 28, 2005;
|
|---|
| 3 | EN(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)
|
|---|
| 12 | EXIT Q
|
|---|
| 13 | ;
|
|---|
| 14 | EN1(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
|
|---|
| 27 | EN2(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
|
|---|
| 41 | EN3(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
|
|---|
