source: FOIAVistA/trunk/r/DIETETICS-FH/FHOMRBL1.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: 5.2 KB
Line 
1FHOMRBL1 ;Hines OIFO/RVD-OUTPATIENT REPORT UTILITY2 ;2/03/04 10:05
2 ;;5.5;DIETETICS;**5**;Jan 28, 2005;Build 53
3 ;
4 ;PATCH #5 - added the cancelled guest meal status and a screen for cancelled meals.
5 ;
6GETGM(FHGDT,FHGCOM,FHGLOC,FHGDFN) ;get guest meals data
7 ;ENTRY POINTS:
8 ; GETGM - get outpatient guest meals data from starting dt.
9 ;input variable:
10 ; FHGDT = starting date
11 ; FHGCOM = IEN of communication office, 'ALL' for all.
12 ; = if NULL, considered 'ALL'
13 ; FHGLOC = IEN of location, 'ALL' for all.
14 ; = if NULL, considered 'ALL'
15 ; FHGDFN = IEN of file #115, 'ALL' for all.
16 ; = if NULL, considered 'ALL'
17 ;
18 ;output variable:
19 ; ^TMP($J,"OP","G",COMM OFF,PATIENT NAME,DTE)
20 ;
21 ;error:
22 ; ^TMP($J,"OP","ER")
23 K ^TMP($J,"OP","G")
24 D NEWVAR
25 S:FHGDFN="" FHGDFN="ALL"
26 S:FHGCOM="" FHGCOM="ALL"
27 S:FHGLOC="" FHGLOC="ALL"
28 S FHGDT=FHGDT-.000001
29 I '$O(^FHPT("GM",FHGDT)) S ^TMP($J,"OP","ER")="NO GUEST MEALS FOR THIS DATE RANGE" Q
30 ;
31 F FHGMDT=FHGDT:0 S FHGMDT=$O(^FHPT("GM",FHGMDT)) Q:FHGMDT'>0 D
32 .F FHDFN=0:0 S FHDFN=$O(^FHPT("GM",FHGMDT,FHDFN)) Q:FHDFN'>0 D
33 ..I $G(FHGDFN),(FHGDFN'=FHDFN) Q
34 ..S (FHGCOMN,FHPTNM,FHLOCN)=""
35 ..S FHNODE=$G(^FHPT(FHDFN,"GM",FHGMDT,0))
36 ..S FHCL=$P(FHNODE,U,2)
37 ..S FHML=$P(FHNODE,U,3)
38 ..S FHCH=$P(FHNODE,U,4)
39 ..S FHLPT=$P(FHNODE,U,5)
40 ..S FHDIET=$P(FHNODE,U,6)
41 ..S FHSTAT=$P(FHNODE,U,9)
42 ..I $G(FHGLOC),FHGLOC'=FHLPT Q ;quit if location is not the same
43 ..S:$G(FHLPT) FHLCOM=$P($G(^FH(119.6,FHLPT,0)),U,8)
44 ..I $G(FHGCOM),FHGCOM'=FHLCOM Q ;quit if d same communication office
45 ..S:$G(FHLCOM) FHGCOMN=$P($G(^FH(119.73,FHLCOM,0)),U,1)
46 ..S:FHGCOMN="" FHGCOMN="***"
47 ..I $G(FHLPT) D
48 ...S FHLOCN=$P($G(^FH(119.6,FHLPT,0)),U,1)
49 ..S:FHLOCN="" FHLOCN="***"
50 ..;
51 ..S FHCL=$S(FHCL="E":"EMPLOYEE",FHCL="G":"GRATUITOUS",FHCL="O":"OOD",FHCL="P":"PAID",1:"VOLUNTEER")
52 ..S FHD=$$FMTE^XLFDT(FHGMDT,"P")
53 ..S FHD=$E(FHD,1,12)
54 ..D PATNAME^FHOMUTL S FHPTNM=$E(FHPTNM,1,24)
55 ..S:FHPTNM="" FHPTNM="***"
56 ..S ^TMP($J,"OP","G",FHGCOMN,FHLOCN,FHPTNM,FHGMDT)=FHDFN_"^"_FHD_"^"_FHML_"^"_FHCL_"^"_FHCH_"^"_FHDIET_"^"_FHSTAT
57 Q
58 ;
59NEWVAR ;new all variables.
60 N FHPTNM,FHD,FHDIET,FHMEAL,FHELTT,FHELBG,FHDAT,FHSTAT,FHLPT
61 N FHAGE,FHCH,FHCL,FHDOB,FHGMDT,FHML,FHNODE,FHPCZN,FHSEX,FHSSN,FILE
62 N FHDAT,FHDPT,FHEL,FHLPT,FHS,FHSMDT,FHSTAT,FHNN,FH
63 Q
64 ;
65GETOUT ;get outpatient data for TODAY.
66 ;output variables:
67 ; ^TMP($J,"FH",##LOCATION,PATIENT NAME,DATE)=OP or SM or GM^IEN OF 115^MEAL^
68 ;
69 K ^TMP($J)
70 N FHMEAL,FHDT,DT3,FHI,I,J,FHRMD,FHRMLNM,FHSMD,FHSMSTA,DFN,FHDFN
71 N DTTST,FHSMLNM,FHGMLNM
72 ;recurring meals
73 S FHDT=DT-.00001,DT3=DT+.999999
74 F FHI=FHDT:0 S FHI=$O(^FHPT("RM",FHI)) Q:(FHI>DT3)!(FHI="") F I=0:0 S I=$O(^FHPT("RM",FHI,I)) Q:I'>0 D
75 .F J=0:0 S J=$O(^FHPT("RM",FHI,I,J)) Q:J'>0 D
76 ..S (FHRMD,FHMEAL)=""
77 ..S FHRMLNM="***"
78 ..I $D(^FHPT(I,"OP",J,0)) S FHRMD=$G(^FHPT(I,"OP",J,0))
79 ..Q:$P(FHRMD,U,15)="C"
80 ..I $D(FHRMD) S FHMEAL=$P(FHRMD,U,2)
81 ..S FHDFN=I D PATNAME^FHOMUTL Q:DFN=""
82 ..S:FHMEAL="" FHMEAL=$P(FHRMD,U,7)
83 ..S:FHMEAL="" FHMEAL=$P(FHRMD,U,8)
84 ..S:FHMEAL="" FHMEAL=$P(FHRMD,U,9)
85 ..S:FHMEAL="" FHMEAL=$P(FHRMD,U,10)
86 ..S:FHMEAL="" FHMEAL=$P(FHRMD,U,11)
87 ..S FHRMLOC=$P(FHRMD,U,3) Q:FHRMLOC=""
88 ..S FHML=$P(FHRMD,U,4)
89 ..I $G(FHRMLOC),$D(^FH(119.6,FHRMLOC,0)) D
90 ...S FHRMLNM=$P(^FH(119.6,FHRMLOC,0),U,1)
91 ...S FHRMPR=$P(^FH(119.6,FHRMLOC,0),U,4)
92 ...S FHRMSTA=$P(^FH(119.6,FHRMLOC,0),U,8)
93 ...S:FHRMPR<10 FHRMPR=0_FHRMPR
94 ...S:FHRMPR="" FHRMPR=99
95 ..S ^TMP($J,"FH",FHRMPR_FHRMLNM,FHPTNM,FHI,J)="OP"_"^"_I_"^"_FHMEAL_"^"_FHRMSTA_"^"_FHML_"^"_FHRMLOC_"^"_J
96SM ;special meals
97 S FHDT=DT-.00001,DTTST=$P(DT,".",1),DT3=DTTST+1
98 F FHI=FHDT:0 S FHI=$O(^FHPT("SM",FHI)) Q:(FHI>DT3)!(FHI="") F I=0:0 S I=$O(^FHPT("SM",FHI,I)) Q:I'>0 D
99 .F J=0:0 S J=$O(^FHPT("SM",FHI,I,J)) Q:J'>0 D
100 ..S (FHSMD,FHMEAL)=""
101 ..S FHSMSTA=""
102 ..I $D(^FHPT(I,"SM",J,0)) S FHSMD=$G(^FHPT(I,"SM",J,0))
103 ..Q:$P(FHSMD,U,2)'="A"
104 ..I $D(FHSMD) S FHMEAL=$P(FHSMD,U,4)
105 ..S FHDFN=I D PATNAME^FHOMUTL Q:DFN=""
106 ..S FHSMLOC=$P(FHSMD,U,3) Q:FHSMLOC=""
107 ..S FHSMSTA=$P(FHSMD,U,2)
108 ..S FHML=$P(FHSMD,U,9)
109 ..I $G(FHSMLOC),$D(^FH(119.6,FHSMLOC,0)) D
110 ...S FHSMLNM=$P(^FH(119.6,FHSMLOC,0),U,1)
111 ...S FHSMPR=$P(^FH(119.6,FHSMLOC,0),U,4)
112 ...S FHSMSTA=$P(^FH(119.6,FHSMLOC,0),U,8)
113 ...S:FHSMPR<10 FHSMPR=0_FHSMPR
114 ...S:FHSMPR="" FHSMPR=99
115 ..S ^TMP($J,"FH",FHSMPR_FHSMLNM,FHPTNM,J)="SM"_"^"_I_"^"_FHMEAL_"^"_FHSMSTA_"^"_FHML_"^"_FHSMLOC_"^"_J
116 ;guest meals
117 S FHDT=DT-.00001,DTTST=$P(DT,".",1),DT3=DTTST+1
118 F FHI=FHDT:0 S FHI=$O(^FHPT("GM",FHI)) Q:(FHI>DT3)!(FHI="") F I=0:0 S I=$O(^FHPT("GM",FHI,I)) Q:I'>0 D
119 .F J=0:0 S J=$O(^FHPT("GM",FHI,I,J)) Q:J'>0 D
120 ..S (FHSMD,FHMEAL)=""
121 ..S FHSMSTA=""
122 ..S FHSMLNM="***"
123 ..I $D(^FHPT(I,"GM",J,0)) S FHSMD=$G(^FHPT(I,"GM",J,0))
124 ..Q:$P(FHSMD,U,9)="C"
125 ..I $D(FHSMD) S FHMEAL=$P(FHSMD,U,6)
126 ..S FHDFN=I D PATNAME^FHOMUTL Q:DFN=""
127 ..S FHSMLOC=$P(FHSMD,U,5) Q:FHSMLOC=""
128 ..S FHML=$P(FHSMD,U,3)
129 ..I $G(FHSMLOC),$D(^FH(119.6,FHSMLOC,0)) D
130 ...S FHSMLNM=$P(^FH(119.6,FHSMLOC,0),U,1)
131 ...S FHSMSTA=$P(^FH(119.6,FHSMLOC,0),U,8)
132 ...S FHSMPR=$P(^FH(119.6,FHSMLOC,0),U,4)
133 ...S:FHSMPR<10 FHSMPR=0_FHSMPR
134 ...S:FHSMPR="" FHSMPR=99
135 ..S ^TMP($J,"FH",FHSMPR_FHSMLNM,FHPTNM,J)="GM"_"^"_I_"^"_FHMEAL_"^"_FHSMSTA_"^"_FHML_"^"_FHSMLOC_"^"_J
136 Q
Note: See TracBrowser for help on using the repository browser.