source: FOIAVistA/trunk/r/DIETETICS-FH/FHOMTK1.m@ 1607

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

initial load of FOIAVistA 6/30/08 version

File size: 3.3 KB
Line 
1FHOMTK1 ;Hines OIFO/RTK OUTPATIENT MEALS TRAY TICKETS ;7/02/03 14:05
2 ;;5.5;DIETETICS;**5**;Jan 28, 2005;Build 53
3 ;
4START S RM="",FHBY=$E($G(FHBY),1) I FHBY="" Q
5 S FHDTE=D1
6 S X1=D1,X2=-1 D C^%DTC S FHRMDTE=X
7 S X1=D1,X2=1 D C^%DTC S FHDTQ=X
8 ;NEW CODE FOR SORTING
9BLDTMP ; First build data in ^TMP global
10 K ^TMP($J,"OPTX")
11 ; Recurring Meals
12 F FHOMDT=FHRMDTE:0 S FHOMDT=$O(^FHPT("RM",FHOMDT)) Q:FHOMDT=""!(FHOMDT'<FHDTQ) D
13 .F FHDFN=0:0 S FHDFN=$O(^FHPT("RM",FHOMDT,FHDFN)) Q:FHDFN="" D
14 ..D PATNAME^FHOMUTL I DFN'="" I $G(^DPT(DFN,.1))'="" Q
15 ..F FHRNUM=0:0 S FHRNUM=$O(^FHPT("RM",FHOMDT,FHDFN,FHRNUM)) Q:FHRNUM="" D
16 ...S FHZN=$G(^FHPT(FHDFN,"OP",FHRNUM,0)),FHLOC=$P(FHZN,U,3) Q:FHLOC=""
17 ...S FHSTAT=$P(FHZN,U,15) Q:FHSTAT="C"
18 ...S FHMEAL=$P(FHZN,U,4)
19 ...I FHOMEAL'="A",FHOMEAL'[FHMEAL Q
20 ...I FHBY="P",FHDFN'=FHTTDFN Q
21 ...I FHBY="L",W1'=FHLOC Q
22 ...I FHBY="C" S FHCOMM=$P($G(^FH(119.6,FHLOC,0)),U,8) I FHP'=FHCOMM Q
23 ...S FHLOCNM=$P($G(^FH(119.6,FHLOC,0)),U,1) I FHMEAL="E" S FHMEAL="Z"
24 ...I SRT="R" S ^TMP($J,"OPTX",FHLOCNM,FHMEAL_"~"_FHPTNM_"~"_FHDFN_"~R~"_FHRNUM)=FHZN
25 ...I SRT'="R" S ^TMP($J,"OPTX",FHPTNM,FHMEAL_"~"_FHLOCNM_"~"_FHDFN_"~R~"_FHRNUM)=FHZN
26 ...Q
27 ..Q
28 .Q
29 ; Special Meals
30 F FHOMDT=FHDTE:0 S FHOMDT=$O(^FHPT("SM",FHOMDT)) Q:FHOMDT=""!(FHOMDT>FHDTQ) D
31 .F FHDFN=0:0 S FHDFN=$O(^FHPT("SM",FHOMDT,FHDFN)) Q:FHDFN="" D
32 ..D PATNAME^FHOMUTL I DFN'="" I $G(^DPT(DFN,.1))'="" Q
33 ..S FHZN=$G(^FHPT(FHDFN,"SM",FHOMDT,0)),FHLOC=$P(FHZN,U,3) Q:FHLOC=""
34 ..S FHSTAT=$P(FHZN,U,2) Q:FHSTAT'="A"
35 ..S FHMEAL=$P(FHZN,U,9)
36 ..I FHOMEAL'="A",FHOMEAL'[FHMEAL Q
37 ..I FHBY="P",FHDFN'=FHTTDFN Q
38 ..I FHBY="L",W1'=FHLOC Q
39 ..I FHBY="C" S FHCOMM=$P($G(^FH(119.6,FHLOC,0)),U,8) I FHP'=FHCOMM Q
40 ..S FHLOCNM=$P($G(^FH(119.6,FHLOC,0)),U,1) I FHMEAL="E" S FHMEAL="Z"
41 ..I SRT="R" S ^TMP($J,"OPTX",FHLOCNM,FHMEAL_"~"_FHPTNM_"~"_FHDFN_"~S")=FHZN
42 ..I SRT'="R" S ^TMP($J,"OPTX",FHPTNM,FHMEAL_"~"_FHLOCNM_"~"_FHDFN_"~S")=FHZN
43 ..Q
44 .Q
45 ; Guest Meals
46 F FHOMDT=FHDTE:0 S FHOMDT=$O(^FHPT("GM",FHOMDT)) Q:FHOMDT=""!(FHOMDT>FHDTQ) D
47 .F FHDFN=0:0 S FHDFN=$O(^FHPT("GM",FHOMDT,FHDFN)) Q:FHDFN="" D
48 ..D PATNAME^FHOMUTL I DFN'="" I $G(^DPT(DFN,.1))'="" Q
49 ..S FHZN=$G(^FHPT(FHDFN,"GM",FHOMDT,0)),FHLOC=$P(FHZN,U,5) Q:FHLOC=""
50 ..S FHSTAT=$P(FHZN,U,9) Q:FHSTAT="C"
51 ..S FHMEAL=$P(FHZN,U,3)
52 ..I FHOMEAL'="A",FHOMEAL'[FHMEAL Q
53 ..I FHBY="P",FHDFN'=FHTTDFN Q
54 ..I FHBY="L",W1'=FHLOC Q
55 ..I FHBY="C" S FHCOMM=$P($G(^FH(119.6,FHLOC,0)),U,8) I FHP'=FHCOMM Q
56 ..S FHLOCNM=$P($G(^FH(119.6,FHLOC,0)),U,1) I FHMEAL="E" S FHMEAL="Z"
57 ..I SRT="R" S ^TMP($J,"OPTX",FHLOCNM,FHMEAL_"~"_FHPTNM_"~"_FHDFN_"~G")=FHZN
58 ..I SRT'="R" S ^TMP($J,"OPTX",FHPTNM,FHMEAL_"~"_FHLOCNM_"~"_FHDFN_"~G")=FHZN
59 ..Q
60 .Q
61 ;
62 ;Now process sorted OM tray tickets
63 I '$D(^TMP($J,"OPTX")) Q
64 S FHINDX="" F S FHINDX=$O(^TMP($J,"OPTX",FHINDX)) Q:FHINDX="" D
65 .S FHINDX2="" F S FHINDX2=$O(^TMP($J,"OPTX",FHINDX,FHINDX2)) Q:FHINDX2="" D
66 ..S FHZN=$G(^TMP($J,"OPTX",FHINDX,FHINDX2)),FHOMDT=$P(FHZN,U,1)
67 ..S FHMEAL=$P(FHINDX2,"~",1) I FHMEAL="Z" S FHMEAL="E" ;for sorting
68 ..S FHDFN=$P(FHINDX2,"~",3),FHOMTYP=$P(FHINDX2,"~",4)
69 ..S FHLOC=$P(FHZN,U,3) I FHOMTYP="G" S FHLOC=$P(FHZN,U,5)
70 ..I FHOMTYP="R" S FHRNUM=$P(FHINDX2,"~",5)
71 ..I UPD,FHOMTYP="R",$P(FHZN,U,16)<$P(FHZN,U,13) Q
72 ..I UPD,FHOMTYP="S",$P(FHZN,U,10)'="" Q
73 ..I FHOMEAL'="A" D BLD^FHOMTK2 Q
74 ..S MEAL=FHMEAL D BLD^FHOMTK2
75 ..Q
76 .Q
77 I $G(NBR) D PRT^FHMTK1C Q
78 K FHTTDFN Q
Note: See TracBrowser for help on using the repository browser.