source: FOIAVistA/tag/r/INCOME_VERIFICATION_MATCH-IVM/IVMADDRP.m@ 628

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

initial load of FOIAVistA 6/30/08 version
File size: 6.5 KB
Line 
1IVMADDRP ;ALB/PHH,EG - IVM ADDRESS UPLOAD LOG REPORT ; 03/29/2006
2 ;;2.0;INCOME VERIFICATION MATCH;**108,106**; 21-OCT-94
3 ;
4 ; This routine list veterans who have had more than one address
5 ; change in the past 90 days.
6 ;
7 N SDATE,EDATE,HDR,MSG,%ZIS,ZTRTN,ZTDESC,ZTSAVE,PAGE,ZTSK,ZTREQ,POP,X
8 N BDT,U,DFN,SO
9 S U="^",DFN="",SO=""
10 S DOS=$$DOS
11 I DOS="^" Q
12 S X=$$ENDDATE
13 I X="" Q
14 S BDT=$P(X,"^",1)
15 I DOS="D" D I DFN="" Q
16 . S DFN=$$GETPAT
17 . Q
18 I DOS="S" S SO=$$SORTORD I SO="^" Q
19 S (SDATE,EDATE,HDR)=""
20 S EDATE=$$FMADD^XLFDT(BDT) I EDATE="" Q
21 S SDATE=$$FMADD^XLFDT(EDATE,-90)
22 ;
23 ; Get report device. Queue report if requested
24 S MSG(1)=""
25 S MSG(2)="This report may take a long time to generate. It is recommended that the report"
26 S MSG(3)="be queued to print."
27 S MSG(4)=""
28 D BMES^XPDUTL(.MSG)
29 K IOP,%ZIS
30 S %ZIS="MQ"
31 D ^%ZIS I POP W !!,"Report Cancelled!" Q
32 I $D(IO("Q")) D Q
33 . S ZTRTN="START^IVMADDRP"
34 . S ZTDESC="IVM Address Change Log Report"
35 . S (ZTSAVE("PAGE"),ZTSAVE("SDATE"),ZTSAVE("EDATE"))=""
36 . S (ZTSAVE("DOS"),ZTSAVE("DFN"),ZTSAVE("SO"))=""
37 . D ^%ZTLOAD
38 . W !!,"Report "_$S($D(ZTSK):"Queued!",1:"Cancelled!")
39 . D HOME^%ZIS
40 . Q
41 D START,^%ZISC
42 Q
43DOS() ;detail or summary
44 N DIR,Y,X
45 S DIR(0)="SA^D:Detail;S:Summary"
46 S DIR("A")="Select Type of Report to Run: "
47 D ^DIR
48 Q Y
49 ;
50GETPAT() ;get a patient
51 N DIC,Y,X,U
52 S DIC="^DPT(",DIC(0)="AEQZM" D ^DIC
53 Q $S($P(Y,U,1)>0:$P(Y,U,1),1:"")
54 ;
55ENDDATE() ;get an end date, default to TODAY
56 N DIR,Y,X
57 S DIR(0)="D^::EX",DIR("?")="^D HELP^%DTC",DIR("B")=$$FMTE^XLFDT(DT)
58 S DIR("A")="Enter End Date of 90 Day Window: "
59 D ^DIR
60 Q $S('Y:"",1:Y)
61 ;
62SORTORD() ;get sort order for summary
63 N DIR,Y,X
64 S DIR(0)="SA^S:Social Security Number;N:Name then SSN"
65 S DIR("A")="What Order Do You Want to See Output: "
66 D ^DIR
67 Q Y
68 ;
69START ; Generate Report
70 N CRT,X
71 K ^XTMP("IVMADDRP",$J)
72 S CRT=$S($E(IOST,1,2)="C-":1,1:0)
73 S X=$$BUILD(SDATE,EDATE,DOS,DFN,SO)
74 U IO W ! D REPORT W ! U 0
75 K ^XTMP("IVMADDRP",$J)
76 I $G(ZTSK) S ZTREQ="@"
77 Q
78BUILD(SDATE,EDATE,DOS,DFN,SO) ; Build the Report
79 ;use C index if you are only looking for one DFN
80 I $L(DFN) D C Q 1
81 N CHDTTM
82 S CHDTTM=SDATE
83 F S CHDTTM=$O(^IVM(301.7,"B",CHDTTM)) Q:CHDTTM=""!(CHDTTM>(EDATE+1)) D ADDIEN
84 Q 1
85ADDIEN ;
86 N ADDIEN
87 S ADDIEN=0
88 F S ADDIEN=$O(^IVM(301.7,"B",CHDTTM,ADDIEN)) Q:ADDIEN="" D GETINF
89 Q
90C N ADDIEN,CHDTTM
91 S ADDIEN=""
92 F S ADDIEN=$O(^IVM(301.7,"C",DFN,ADDIEN)) Q:ADDIEN="" D
93 . S CHDTTM=$P($G(^IVM(301.7,ADDIEN,0)),"^",1)
94 . I (CHDTTM>SDATE),(CHDTTM<(EDATE+1)) D GETINF
95 . Q
96 Q
97GETINF ;
98 N NODE0,NODE1,DFN,SSN,NAME,ADDR1,ADDR2,CITY,STATE,ZIP,SORT1,SORT2,U,SOURCE,SIEN,SITE
99 S U="^",SITE=""
100 S NODE0=$G(^IVM(301.7,ADDIEN,0))
101 S NODE1=$G(^IVM(301.7,ADDIEN,1))
102 S DFN=$P(NODE0,"^",2)
103 Q:DFN=""
104 Q:'$D(^DPT(DFN))
105 S SSN=$P($G(^DPT(DFN,0)),"^",9)
106 Q:SSN=""
107 S NAME=$P($G(^DPT(DFN,0)),"^",1)
108 S SOURCE=$P(NODE1,"^",4),SIEN=$P(NODE1,"^",3)
109 I SIEN S SITE=$P($G(^DIC(4,SIEN,0)),"^",1)
110 S ADDR1=$P(NODE1,"^",6)
111 S ADDR2=$P(NODE1,"^",7)
112 S CITY=$P(NODE1,"^",8)
113 S STATE=$P(NODE1,"^",10)
114 I STATE'="",$D(^DIC(5,STATE,0)) S STATE=$P(^DIC(5,STATE,0),"^",2)
115 S ZIP=$P(NODE1,"^",11)
116 I DOS="D" D Q
117 . S ^XTMP("IVMADDRP",$J,SSN,CHDTTM)=ADDIEN_"^"_DFN_"^"_NAME_"^"_ADDR1_"^"_ADDR2_"^"_CITY_"^"_STATE_"^"_ZIP_"^"_SOURCE_"^"_SITE
118 . S ^XTMP("IVMADDRP",$J,SSN)=$G(^XTMP("IVMADDRP",$J,SSN))+1
119 . Q
120 I DOS="S" D
121 . S SORT1=$S(SO="S":SSN,1:NAME) I NAME="" S SORT1="UNKNOWN"
122 . S SORT2=$S(SO="S":0,1:SSN)
123 . S ^XTMP("IVMADDRP",$J,SORT1,SORT2,"INF")=NAME_U_SSN
124 . S ^XTMP("IVMADDRP",$J,SORT1,SORT2,"DATE",CHDTTM)=""
125 . S ^XTMP("IVMADDRP",$J,SORT1,SORT2)=$G(^XTMP("IVMADDRP",$J,SORT1,SORT2))+1
126 . Q
127 Q
128REPORT ; Display the Report
129 D HEADER
130 I '$D(^XTMP("IVMADDRP",$J)) D Q
131 . N X S X="****** NOTHING TO REPORT ******" W !?80-$L(X)\2,X,!
132 . Q
133 I DOS="S" D SUMMARY Q
134 N SSN
135 ;
136 S SSN=""
137 F S SSN=$O(^XTMP("IVMADDRP",$J,SSN)) Q:SSN="" D DETAIL
138 Q
139DETAIL N NAME,CHDTTM,ADDR,ADDR2,CITY,STATE,ZIP,CSZ
140 N ADDR1,ADDR2,X,U,QUIT,CNT,SITE,SOURCE
141 S CHDTTM="",U="^",QUIT=0,CNT=0
142 I $G(^XTMP("IVMADDRP",$J,SSN))'>1 Q
143 F S CHDTTM=$O(^XTMP("IVMADDRP",$J,SSN,CHDTTM)) Q:CHDTTM=""!(QUIT) D
144 . S X=$G(^XTMP("IVMADDRP",$J,SSN,CHDTTM))
145 . S NAME=$P(X,U,3)
146 . S ADDR1=$P(X,U,4)
147 . S ADDR2=$P(X,U,5)
148 . S CITY=$P(X,U,6)
149 . S STATE=$P(X,U,7)
150 . S ZIP=$P(X,U,8)
151 . S SOURCE=$P(X,U,9)
152 . S SITE=$P(X,U,10)
153 . I ($Y+6)>IOSL D HEADER I QUIT Q
154 . W !,$$FSSN(SSN),?12,$E(NAME,1,20)
155 . W ?35,$$FMTE^XLFDT($P(CHDTTM,".",1))
156 . S CSZ=$$CSZ(CITY,STATE,ZIP)
157 . W ?49,$E(ADDR1,1,30),!
158 . I $L(ADDR2) W ?49,$E(ADDR2,1,30),!
159 . I $L(CSZ) W ?49,$E(CSZ,1,30),!
160 . I $L(SOURCE) W ?49,"SOURCE: ",SOURCE,!
161 . I $L(SITE) W ?49,"SITE: ",SITE
162 . S CNT=CNT+1
163 . Q
164 I 'QUIT D TOTAL(CNT)
165 Q
166SUMMARY N SORT1,QUIT,CNT
167 S SORT1="",QUIT=0,CNT=0
168 F S SORT1=$O(^XTMP("IVMADDRP",$J,SORT1)) Q:SORT1=""!(QUIT) D SORT2
169 I 'QUIT D TOTAL(CNT)
170 Q
171SORT2 N NAME,SSN
172 S SORT2=""
173 F S SORT2=$O(^XTMP("IVMADDRP",$J,SORT1,SORT2)) Q:SORT2=""!(QUIT) D
174 . I $G(^XTMP("IVMADDRP",$J,SORT1,SORT2))'>1 Q
175 . D SUMPR S CNT=CNT+1
176 . Q
177 Q
178SUMPR N X,U
179 S U="^"
180 S X=$G(^XTMP("IVMADDRP",$J,SORT1,SORT2,"INF"))
181 S NAME=$P(X,U,1),SSN=$P(X,U,2)
182 I ($Y+2)>IOSL D HEADER I QUIT Q
183 W !,$$FSSN(SSN),?12,$E(NAME,1,20)
184 W ?35,$$FMTE^XLFDT($O(^XTMP("IVMADDRP",$J,SORT1,SORT2,"DATE",""),-1))
185 S X=$G(^XTMP("IVMADDRP",$J,SORT1,SORT2))
186 W ?73,$J($FN(X,","),5)
187 Q
188TOTAL(CNT) ;
189 I ($Y+2)>IOSL D HEADER
190 W !!,"Total records found meeting criteria: ",CNT,!
191 Q
192CSZ(CITY,STATE,ZIP) ;format city, state and zip into one line
193 N X
194 S X=""
195 I $L(CITY) S X=CITY
196 I $L(STATE) D
197 . I $L(X) S X=X_", "_STATE Q
198 . S X=STATE
199 . Q
200 I $L(ZIP) D
201 . I $L(X) S X=X_" "_ZIP Q
202 . S X=ZIP
203 . Q
204 Q X
205FSSN(SSN) ; Format the SSN
206 N FMTSSN
207 I SSN="NO SSN" Q SSN
208 I $L(SSN)=9 S FMTSSN=SSN
209 I $L(SSN)>9 S FMTSSN=$E(SSN,1,10) ; Account for pseudo-SSN
210 I $L(SSN)<9 D
211 . S FMTSSN=""
212 . F FMTSSN=$L(SSN):1:9 S FMTSSN=FMTSSN_"0"
213 . S FMTSSN=FMTSSN_SSN
214 . Q
215 Q FMTSSN
216HEADER ; Print the header
217 N IDX,PGHDR
218 S QUIT=0
219 I $G(CRT),($G(PAGE)>0) I $$PAUSE(0) S QUIT=1 Q
220 S PAGE=$G(PAGE,0),PAGE=PAGE+1,PGHDR="Page: "_$J(PAGE,3)
221 W #
222 I $G(CRT) W $C(27,91,72,27,91,74) ; Additional $C to clear screen in Cache'
223 S IDX="",IDX=$O(HDR(IDX))
224 W "IVM ADDRESS CHANGE LOG REPORT",?71,PGHDR
225 W !,$$FMTE^XLFDT(SDATE)_" THRU "_$$FMTE^XLFDT(EDATE)
226 I DOS="D" D
227 . W !!,"SSN",?12,"NAME",?35,"CHANGE DATE",?49,"PRIOR ADDRESS"
228 . W !,"---",?12,"----",?35,"-----------",?49,"--------------"
229 . Q
230 I DOS="S" D
231 . W !!,"SSN",?12,"NAME",?35,"LAST UPDATED",?69,"# ENTRIES"
232 . W !,"---",?12,"----",?35,"------------",?69,"---------"
233 . Q
234 Q
235PAUSE(RESP) ; Prompt user for next page or quit
236 N DIR,DIRUT,DUOUT,DTOUT,U,X,Y
237 W !
238 S DIR(0)="E"
239 D ^DIR
240 I 'Y S RESP=1
241 Q RESP
Note: See TracBrowser for help on using the repository browser.