source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SDHPIB.m@ 1608

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

initial load of FOIAVistA 6/30/08 version
File size: 7.8 KB
Line 
1SDHPIB ;PKE/ALB - Health Services R&D Caregiver Study Main Routine;
2 ;;5.3;Scheduling;**141**;March 12, 1996
3 ;
4 I $D(DUZ)'=11 DO Q
5 .W !!,"Please set DUZ variables, D ^XUP"
6 ;
7 S SDTATION=+$$SITE^VASITE()
8 I 'SDTATION DO Q
9 . W !!,"Could not find station number from VASITE" Q
10 ;
11 W !?3,">>> VA HSR&D Caregivers Survey <<< ",!
12 W !," Please queue to run at a none peak time."
13 W !," This extract will generate 2 mail messages to you"
14 W !," and to G.SD HPI EXTRACT@ISC-ALBANY.VA.GOV",!
15 ;
16 S ZTIO="",ZTRTN="START^SDHPIB"
17 S ZTDESC="SD*5.3*141 - VA HSR&D Caregivers Survey"
18 D ^%ZTLOAD,HOME^%ZIS
19 I $G(ZTSK) W !?30,"Task Number = ",ZTSK,!
20 Q
21START I $D(DUZ)'=11 W !!,"Please set DUZ variables, D ^XUP" Q
22 ;
23 S SDTATION=+$$SITE^VASITE()
24 I '$D(^XTMP("SDHPI","S",SDTATION)) W:'$D(ZTQUEUED) !,"No STATION data" Q
25 ;
26 S SDSTART=$$FMTE^XLFDT($$NOW^XLFDT)
27 ;
28 K ^XTMP("SDHPI",$J,"DATA")
29 K ^XTMP("SDHPI",$J,"ERROR")
30 K ^XTMP("SDHPI","S",SDTATION,"DFN")
31 ;
32 I $D(^XTMP("SDHPI","S",SDTATION,"ERROR","NO DATA REQUESTED")) DO QUIT
33 .;
34 . D FMAIL(0)
35 . I '$D(ZTQUEUED) W !!?3,">>>... all done"
36 ;
37 I '$D(ZTQUEUED) DO
38 .W !?3,">>> Looking up patients DFNs from SSNs "
39 D GETDFN(SDTATION)
40 ;
41 I '$D(ZTQUEUED) DO
42 .W !!?3,">>> Looking up patients data from DFNs "
43 D DIQLOOK(SDTATION)
44 ;
45 I '$D(ZTQUEUED) DO
46 .W !!?3,">>> Creating Mail message of patients data "
47 D SENDATA(SDTATION)
48 ;
49 I '$D(ZTQUEUED) DO
50 .W !!?3,">>> ....all done"
51 ;
52 ;mail summary
53 D FMAIL(1)
54 ;
55 K SDFIELD,SDN,SDP,SDPECE,SDSTART
56 K SDZ,SDFLDS,SDDFN,SDTATION,SDSSN,SDLINE
57 Q
58GETDFN(SDTATION) ;
59 ;From strings of SSNs get DFN's from DPT
60 ; go down station array
61 S SDN=0
62 F S SDN=$O(^XTMP("SDHPI","S",SDTATION,SDN)) Q:'SDN DO
63 .;;piece out ssn
64 .F SDP=1:1 S SDSSN=$P(^XTMP("SDHPI","S",SDTATION,SDN),"^",SDP) Q:'SDSSN DO
65 . . S SDDFN=$$DFN(SDSSN)
66 . . I SDDFN S ^XTMP("SDHPI","S",SDTATION,"DFN",SDDFN)=SDSSN
67 . . E S ^XTMP("SDHPI",$J,"ERROR","SSN",SDSSN)=SDDFN
68 . .;
69 . . I (($P($H,",",2))#20) Q
70 . . I '$D(ZTQUEUED) W "."
71 Q
72DIQLOOK(SDTATION) ;
73 ;
74 ; get array of fields to lookup
75 D INIFLDS
76 ; for each dfn call gets^diq
77 S SDDFN=0
78 F S SDDFN=$O(^XTMP("SDHPI","S",SDTATION,"DFN",SDDFN)) Q:'SDDFN DO
79 . D GETSDIQ(SDDFN)
80 .;
81 . I (($P($H,",",2))#3) Q
82 . I '$D(ZTQUEUED) W "."
83 .;
84 Q
85SENDATA(SDTATION) ;
86 ; sdline is the message line
87 S SDLINE=0
88 S SDDFN=""
89 ; (2,dfn, field set up from fileman data merge, dfn is dfn_","
90 F S SDDFN=$O(^XTMP("SDHPI",$J,"DATA",2,SDDFN)) Q:'SDDFN DO
91 . D SETMAIL(SDTATION,SDDFN)
92 .;
93 . I (($P($H,",",2))#10) Q
94 . I '$D(ZTQUEUED) W " ."
95 .;
96 ;final mailman set
97 Q:'SDLINE
98 D SMAIL(SDLINE)
99 ;
100 Q
101SETMAIL(SDTATION,SDDFN) ;
102 I SDLINE=0 D INITMAIL(1)
103 ;
104 S SDLINE=SDLINE+1
105 S SDPECE=1
106 ;
107 ; set first line of each record to station^ssn
108 S ^XMB(3.9,XMZ,2,SDLINE,0)=SDTATION_"^"_$P($G(^DPT(+SDDFN,0)),"^",9)_"^"
109 S SDLINE=SDLINE+1
110 ;
111 S SDFIELD=0
112 F S SDFIELD=$O(^XTMP("SDHPI",$J,"DATA",2,SDDFN,SDFIELD)) Q:'SDFIELD DO
113 . ;set mailmsg for 1 dfn
114 . I $$LINECALC(SDFIELD,SDLINE)>80 DO
115 . . ; make sure end piece has last ^
116 . . S $P(^XMB(3.9,XMZ,2,SDLINE,0),"^",SDPECE)=""
117 . . S SDLINE=SDLINE+1
118 . . S SDPECE=1
119 . D SETLINE
120 . S SDPECE=SDPECE+1
121 ;
122 ; make sure end piece has last ^
123 S $P(^XMB(3.9,XMZ,2,SDLINE,0),"^",SDPECE)=""
124 S SDLINE=SDLINE+1
125 ; set record delimiter
126 S ^XMB(3.9,XMZ,2,SDLINE,0)=">>>"
127 ;
128 Q
129LINECALC(SDFIELD,SDLINE) ;
130 ; return length that would be set
131 Q $L($G(^XTMP("SDHPI",$J,"DATA",2,SDDFN,SDFIELD,"E")))+$L($G(^XMB(3.9,XMZ,2,SDLINE,0)))
132 ;
133 ;
134SETLINE ;set mailmsg from xtmp array
135 ; $g will preserve piece position if field returned error
136 S $P(^XMB(3.9,XMZ,2,SDLINE,0),"^",SDPECE)=$G(^XTMP("SDHPI",$J,"DATA",2,SDDFN,SDFIELD,"E")) Q
137 ;
138 ;
139GETSDIQ(SDDFN) ;
140 K SDDATA,SDERR
141 ;
142 F SDFLDS=1:1:5 DO
143 . D GETS^DIQ(2,SDDFN,SDFLDS(SDFLDS),"E","SDDATA","SDERR")
144 .;
145 .; merge will set ,2,dfn_",",field,"E")=external value
146 .;
147 . M ^XTMP("SDHPI",$J,"DATA")=SDDATA
148 . K SDDATA
149 . I $D(SDERR) DO K SDERR
150 . .;if a field has err whatodo
151 . .;
152 . .; check to see if each field was set in returned array
153 . . F SDP=1:1 S SDFIELD=$P(SDFLDS(SDFLDS),";",SDP) Q:'SDFIELD DO
154 . . .;
155 . . .; indicates fileman returned error
156 . . . I '$D(^XTMP("SDHPI",$J,"DATA",2,SDDFN_",",SDFIELD,"E")) DO
157 . . . .;
158 . . . .; set it to null to keep the piece position in mail
159 . . . . S ^XTMP("SDHPI",$J,"DATA",2,SDDFN_",",SDFIELD,"E")=""
160 . . . .;
161 . . . .;the sderr array is set by fm in order of missing fields
162 . . . . S SDERR=$O(SDERR("DIERR",0)) I 'SDERR K SDERR Q
163 . . . . M ^XTMP("SDHPI",$J,"ERROR",SDDFN,SDFIELD)=SDERR("DIERR",SDERR)
164 . . . . S ^XTMP("SDHPI",$J,"ERROR",SDDFN,"SSN")=$P($G(^DPT(SDDFN,0)),"^",9)
165 . . . .;pop the array
166 . . . . K SDERR("DIERR",SDERR)
167 . . .;
168 ;
169 Q
170 ;
171 Q
172INITMAIL(FLAG) ;-- This function will initialize mail variables
173 ;
174 S XMSUB="SD*5.3*141 "_(+$$SITE^VASITE())_"VA HSR&D CAREGIVERS SURVEY"
175 S XMDUZ=.5,XMY(DUZ)="",XMY(XMDUZ)=""
176 I $G(FLAG) DO
177 . S XMY("G.SD HPI EXTRACT@ISC-ALBANY.VA.GOV")=""
178 . S XMY("S.SD HPI EXTRACT@ISC-ALBANY.VA.GOV")=""
179 D GET^XMA2
180 Q
181SMAIL(SDLINE) ;-- Send Mail Message containing records so far
182 ;
183 ; INPUT TOTAL- Total Lines in Message
184 ;
185 S ^XMB(3.9,XMZ,2,0)="^3.92A^"_SDLINE_U_SDLINE_U_DT
186 D ENT1^XMD
187 D KILL^XM
188 Q
189 ;
190FMAIL(DATA) ;- This function will generate a summary mail message.
191 ;
192 S XMSUB="SD*5.3*141 "_(+$$SITE^VASITE())_"VA HSR&D Error Summary"
193 S XMDUZ=.5,XMY(DUZ)="",XMY(XMDUZ)=""
194 S XMY("G.SD HPI EXTRACT@ISC-ALBANY.VA.GOV")=""
195 S XMY("S.SD HPI EXTRACT@ISC-ALBANY.VA.GOV")=""
196 ;
197 D GET^XMA2
198 S ^XMB(3.9,XMZ,2,1,0)="VA Health Services R&D Caregivers Survey completed."
199 S ^XMB(3.9,XMZ,2,2,0)=""
200 S ^XMB(3.9,XMZ,2,3,0)="Start Time: "_SDSTART
201 S ^XMB(3.9,XMZ,2,4,0)=" Stop Time: "_$$FMTE^XLFDT($$NOW^XLFDT)
202 S ^XMB(3.9,XMZ,2,5,0)=""
203 ;
204 S SDLINE=6
205 I 'DATA DO QUIT
206 . S ^XMB(3.9,XMZ,2,SDLINE,0)="No data requested"
207 . D SMAIL(SDLINE)
208 ;
209 S SDZ=$Q(^XTMP("SDHPI",$J,"ERROR"))
210 I SDZ]"",SDZ[("""SDHPI"""_","_$J_","_"""ERROR""")
211 E DO QUIT
212 . S ^XMB(3.9,XMZ,2,SDLINE,0)=" Error Summary: No errors Found "
213 . D SMAIL(SDLINE)
214 ;
215 S ^XMB(3.9,XMZ,2,SDLINE,0)=" Error Summary: "
216 S SDLINE=SDLINE+1
217 S ^XMB(3.9,XMZ,2,SDLINE,0)="""ERR"_$P(SDZ,"ERROR",2)_" = "_@SDZ
218 ;
219 F S SDZ=$Q(@SDZ) Q:SDZ']"" Q:SDZ'[("""SDHPI"""_","_$J_","_"""ERROR""") DO
220 . S SDLINE=SDLINE+1
221 . S ^XMB(3.9,XMZ,2,SDLINE,0)="""ERR"_$P(SDZ,"ERROR",2)_" = "_@SDZ
222 .;
223 .;quit if this gets to be too much
224 . I SDLINE>500 S SDZ="ZZZEND"
225 D SMAIL(SDLINE)
226 Q
227 ;
228DFN(SSN) ;function to lookup DFN from SSN x-ref
229 ; input SSN
230 ; output DFN or error code
231 N DFN
232 ; make sure dfn is numeric and not null
233 I $O(^DPT("SSN",SSN,0))
234 E Q "No SSN Index for "_SSN
235 ;
236 I $O(^DPT("SSN",SSN,0))=$O(^DPT("SSN",SSN,""),-1)
237 E Q "Ambiguous SSN cross-ref "_SSN
238 ;
239 S DFN=$O(^DPT("SSN",SSN,0))
240 ;
241 I $G(^DPT(DFN,0))]""
242 E Q "No Zero node in DPT for SSN "_SSN
243 ;
244 I $P($G(^DPT(DFN,0)),"^",9)=SSN
245 E Q "Bad SSN cross-ref "_SSN
246 Q DFN
247 ;
248INIFLDS ; set up array of fields to be used in fm getsdiq call
249 S SDFLDS(1)=$P($T(FLDS1),";;",2)
250 S SDFLDS(2)=$P($T(FLDS2),";;",2)
251 S SDFLDS(3)=$P($T(FLDS3),";;",2)
252 S SDFLDS(4)=$P($T(FLDS4),";;",2)
253 S SDFLDS(5)=$P($T(FLDS5),";;",2)
254 Q
255FLDS1 ;;.01;.02;.03;.033;.05;.06;.07;.08;.09;.103;.104;.1041;.105;.111;.1112;.112;.113;.114;.115;.116;.117;.12105;.1211;.12111;.12112;.1212;.1213;.1214;.1215;.1216;.1217;.1218;.1219
256FLDS2 ;;.131;.132;.14;.21011;.211;.211011;.212;.2125;.213;.214;.215;.216;.217;.218;.219;.2191;.2192;.21925;.2193;.2194;.2195;.2196;.2197;.2198;.2199
257FLDS3 ;;.2401;.2402;.2403;.251;.2514;.2515;.252;.253;.254;.255;.256;.257;.258;.291;.2911;.2912;.2913;.2914;.2915;.2916;.2917;.2918;.2919;.292;.2921;.2922;.2923;.2924;.2925;.2926;.2927;.2928;.2929;.293
258FLDS4 ;;.301;.3192;.323;.33011;.3305;.331;.331011;.3311;.3312;.3313;.3314;.3315;.3316;.3317;.3318;.3319;.332;.333;.334;.335;.336;.337;.338;.339;.34011;.3405;.341;.342;.343;.344;.345;.346;.347;.348;.349;.351
259FLDS5 ;;.3601;.36205;.3621;.36215;.3622;.36225;.3623;.36235;.3624;.3625;.36255;.3626;.36265;.3627;.36275;.3628;.36285;.3629;.36295;.525;.5291;57.4;148;1901
260 Q
Note: See TracBrowser for help on using the repository browser.