source: FOIAVistA/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVMLDEM9.m@ 649

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

initial load of FOIAVistA 6/30/08 version
File size: 7.4 KB
Line 
1IVMLDEM9 ;ALB/BRM/PHH - IVM ADDRESS UPDATES PENDING REVIEW RPT ; 10/18/06 12:47pm
2 ;;2.0;INCOME VERIFICATION MATCH;**79,93,119**; 21-OCT-94;Build 1
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4 ;
5 Q
6 ;
7EN2 ;entry point for IVM ADDR UPDT PENDING REVIEW menu option
8 K ^TMP("IVMLDEM9",$J)
9 K ^TMP($J,"IVMLDEM9")
10 ;If mail group has no member or remote-member
11 I '$$MEMBER() D Q
12 . I '$D(ZTQUEUED) W !!,"IVM ADDR UPDT REPORT does not have a member. Report not sent." K DIR S DIR(0)="E" D ^DIR K DIR
13 I +$G(ZTSK) D PRINT,EXIT Q ;started by Taskman job
14 ;User runs the option
15 I '$D(ZTQUEUED) D
16 . W !!,"The report will be sent to mail group IVM ADDR UPDT REPORT"
17 . D QUE
18 . D EXIT
19 . K DIR S DIR(0)="E" D ^DIR K DIR
20 Q
21 ;
22LOOP(DTPARAM,FILDAT) ;main loop
23 N DFN,IVMDT,IVMDA,IVMDA1,IVMDA2,RF171,TODAY,AUTODT,DTDIFF,NAME,UPLDT
24 N X1,X2,Y,SSN,DFN
25 D DT^DILF("X","T"_$G(DTPARAM),.AUTODT)
26 S TODAY=$$DT^XLFDT S:'$G(FILDAT) FILDAT=0
27 Q:'$G(AUTODT) ;this should never occur, but just in case
28 S RF171=$O(^IVM(301.92,"C","RF171","")),IVMDA2=""
29 Q:'RF171
30 F S IVMDA2=$O(^IVM(301.5,IVMDA2)) Q:IVMDA2="" D
31 .S DFN=$P($G(^IVM(301.5,IVMDA2,0)),"^"),IVMDA1=""
32 .Q:('DFN)!('$D(^DPT(+DFN)))!('$D(^IVM(301.5,IVMDA2,"IN")))
33 .F S IVMDA1=$O(^IVM(301.5,IVMDA2,"IN",IVMDA1)) Q:IVMDA1="" D
34 ..Q:'$D(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM","B",RF171))
35 ..S IVMDA=""
36 ..F S IVMDA=$O(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM","B",RF171,IVMDA)) Q:'IVMDA D
37 ...S IVMDT=$P($G(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM",IVMDA,0)),"^",3)
38 ...Q:('IVMDT)!(IVMDT>AUTODT)
39 ...; report addresses that will be auto-uploaded in DTDIFF days
40 ...S X1=TODAY,X2=IVMDT D ^%DTC S DTDIFF=+$G(X)
41 ...S NAME=$P($G(^DPT(DFN,0)),"^"),SSN=$P($G(^DPT(DFN,0)),"^",9)
42 ...S X1=IVMDT,X2=14 D C^%DTC S UPLDT=$G(X)
43 ...S ^TMP("IVMLDEM9",$J,DTDIFF,SSN,IVMDA)=$G(NAME)_"^"_$P(IVMDT,".")_"^"_$P(UPLDT,".")_"^"_DFN_"^"_IVMDA2_"^"_IVMDA1
44 Q
45 ;
46AUTOLOAD(DFN,IVMDA2,IVMDA1) ;auto-upload records that not been reviewed
47 ; this tag is called from ^IVMLDEMC
48 ;
49 Q:('$G(DFN))!('$G(IVMDA2))!('$G(IVMDA1))
50 N IVMI,IVMJ,IVMFIELD,IVMVALUE,IVMNODE,IVMFLAG,DUZ
51 S DUZ="IVM AUTO ADDR JOB"
52 ;
53 ; determine appropriate address change dt/tm to be used
54 D ADDRDT^IVMLDEM6(DFN,IVMDA2,IVMDA1)
55 ;
56 N DGPRIOR D GETPRIOR^DGADDUTL(DFN,.DGPRIOR)
57 ;
58 ; loop through the record to be uploaded
59 S IVMI=0 F S IVMI=$O(^IVM(301.92,"AD",IVMI)) Q:IVMI']"" D
60 .S IVMJ=0 F S IVMJ=$O(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM","B",IVMI,IVMJ)) Q:IVMJ']"" D
61 ..;
62 ..; check for data node in (#301.511) sub-file
63 ..S IVMNODE=$G(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM",IVMJ,0))
64 ..Q:('+IVMNODE)!($P(IVMNODE,"^",2)']"")
65 ..;
66 ..; check for residence phone number -> do not auto-upload
67 ..Q:(+IVMNODE=$O(^IVM(301.92,"B","PHONE NUMBER [RESIDENCE]",0)))
68 ..;
69 ..; do not auto-upload if there is an active prescription
70 ..I $$PHARM^IVMLDEM6(+DFN) D REJTADD Q
71 ..;
72 ..; set upload parameters
73 ..S IVMFIELD=$P($G(^IVM(301.92,+IVMNODE,0)),"^",5)
74 ..S IVMVALUE=$P(IVMNODE,"^",2)
75 ..;
76 ..; load addr field into the Patient (#2) file
77 ..D UPLOAD^IVMLDEM6(DFN,IVMFIELD,IVMVALUE) S IVMFLAG=1
78 ..;
79 ..; remove entry from (#301.511) sub-file
80 ..D DELENT^IVMLDEMU(IVMDA2,IVMDA1,IVMJ)
81 ..;
82 ..; if no display or uploadable fields, delete PID segment
83 ..I ('$$DEMO^IVMLDEM5(IVMDA2,IVMDA1,0))&('$$DEMO^IVMLDEM5(IVMDA2,IVMDA1,1)) D DELETE^IVMLDEM5(IVMDA2,IVMDA1," ")
84 ;
85 I +$G(IVMFLAG) D
86 .N DGCURR
87 .D GETUPDTS^DGADDUTL(DFN,.DGCURR)
88 .D UPDADDLG^DGADDUTL(DFN,.DGPRIOR,.DGCURR)
89 Q
90REJTADD ;Reject the address
91 ; update the ADDRESS CHANGE DT/TM field #.118 in PATIENT file #2
92 D UPDDTTM^DGADDUTL(DFN,"PERM")
93 ;
94 ; trigger the record to transmit the existing address on file to HEC
95 N DGENUPLD ; Used in SETSTAT^IVMPLOG to prevent filing.
96 N DA,X,IVMX
97 S (DA,X)=DFN
98 S IVMX=X,X="IVMPXFR" X ^%ZOSF("TEST") D:$T DPT^IVMPXFR S X=IVMX
99 Q
100PRINT ;report output
101 N DAYS,SSN,DATA,EX,PAGE,IVMDA,DATA,IVMLN,XMY,XMSUB,XMDUZ,XMTEXT
102 D LOOP("",0)
103 D HDR
104 D DISPLAY
105 D EMAIL
106 Q
107DISPLAY ;Display the report
108 S DAYS=""
109 I '$D(^TMP("IVMLDEM9",$J)) Q
110 F S DAYS=$O(^TMP("IVMLDEM9",$J,DAYS),-1) Q:DAYS=""!($G(EX)) D
111 .S SSN=""
112 .F S SSN=$O(^TMP("IVMLDEM9",$J,DAYS,SSN)) Q:SSN=""!($G(EX)) D
113 ..S IVMDA=""
114 ..F S IVMDA=$O(^TMP("IVMLDEM9",$J,DAYS,SSN,IVMDA)) Q:(IVMDA="")!($G(EX)) D
115 ...S DATA=$G(^TMP("IVMLDEM9",$J,DAYS,SSN,IVMDA))
116 ... D LNPLUS
117 ... S ^TMP($J,"IVMLDEM9",IVMLN)=" "_$$FMTE^XLFDT($P(DATA,"^",3))_" "_$$FMTE^XLFDT($P(DATA,"^",2))_" "_SSN_" "_$P(DATA,"^")
118 ... S ^TMP($J,"IVMLDEM9","TOTAL")=$G(^TMP($J,"IVMLDEM9","TOTAL"))+1
119 D TOTAL
120 D
121 . D LNPLUS
122 . S ^TMP($J,"IVMLDEM9",IVMLN)=""
123 . D LNPLUS
124 . S ^TMP($J,"IVMLDEM9",IVMLN)=" <<END OF REPORT>>"
125 I $E(IOST)="C" W ! K DIR S DIR(0)="E" D ^DIR K DIR
126 Q
127HDR ;print header
128 N IVMDT,Y,DLINE
129 I $D(ZTQUEUED),$$S^%ZTLOAD S (ZTSTOP,EX)=1 Q
130 S Y=DT X ^DD("DD") S IVMDT=Y
131 D
132 . D LNPLUS
133 . S ^TMP($J,"IVMLDEM9",IVMLN)=""
134 . D LNPLUS
135 . S ^TMP($J,"IVMLDEM9",IVMLN)=" IVM ADDRESS UPDATES PENDING REVIEW "_IVMDT
136 . D LNPLUS
137 . S $P(^TMP($J,"IVMLDEM9",IVMLN),"=",78)=""
138 . D LNPLUS
139 . S ^TMP($J,"IVMLDEM9",IVMLN)=""
140 . D LNPLUS
141 . S ^TMP($J,"IVMLDEM9",IVMLN)=" Auto-Upload Date Date Received SSN Patient Name"
142 . D LNPLUS
143 . S ^TMP($J,"IVMLDEM9",IVMLN)=" ---------------- ------------- --------- ------------"
144 Q
145EXIT D ^%ZISC,HOME^%ZIS Q
146 K ^TMP($J,"IVMLDEM9")
147 K ^TMP("IVMLDEM9",$J)
148 ;
149ADRDTCK(DFN,IVMDA2,IVMDA1) ;is the incoming address older than #2 address?
150 Q:'$G(DFN)!('$G(IVMDA2))!('$G(IVMDA1)) "0^MISSING INPUT PARAMETER"
151 N OADDRDT,NADDRDT,ERR,IVMDA,IEN92,IENS
152 S OADDRDT=$$GET1^DIQ(2,DFN_",",.118,"I","","ERR") Q:$D(ERR) "0^OLD ADDR ERROR"
153 S IEN92=$O(^IVM(301.92,"C","RF171","")) Q:'IEN92 "0^BAD #301.92 ENTRY FOR RF171"
154 I '$D(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM","B",IEN92)) Q "0^ADDR DT NOT PRESENT"
155 S IVMDA=$O(^IVM(301.5,IVMDA2,"IN",IVMDA1,"DEM","B",IEN92,"")) Q:'IVMDA "0^MISSING ADDR DT IN 301.5"
156 S IENS=IVMDA_","_IVMDA1_","_IVMDA2_","
157 S NADDRDT=$$GET1^DIQ(301.511,IENS,.02,"I","","ERR") Q:$D(ERR) "0^NEW ADDR ERROR"
158 Q:(OADDRDT="")&(NADDRDT="") 0
159 Q:(NADDRDT="")!(OADDRDT'<NADDRDT) 1
160 Q "0^INCOMING ADDRESS IS NEWER THAN PATIENT FILE ADDR"
161MEMBER() ;Return 0 if mail group has no local or remote member
162 N RESULT,IVMIEN,IVMRMT
163 S RESULT=1
164 S IVMIEN=$$FIND1^DIC(3.8,"","X","IVM ADDR UPDT REPORT")
165 D LIST^DIC(3.812,","_IVMIEN_",",.01,"P","","","","","","","IVMRMT")
166 I ($P($G(IVMRMT("DILIST",0)),U)'>0),('$$GOTLOCAL^XMXAPIG("IVM ADDR UPDT REPORT")) S RESULT=0
167 Q RESULT
168EMAIL ;Set up parameters to email the report
169 ;If called within a task, protect variables
170 I $D(ZTQUEUED) N %,DIFROM
171 N RDT
172 D NOW^%DTC S Y=% X ^DD("DD")
173 S RDT=$P(Y,"@",1)_"@"_$P($P(Y,"@",2),":",1,2)
174 S XMSUB="IVM Address Pending Review ("_RDT_")"
175 S XMY("G.IVM ADDR UPDT REPORT")=""
176 I $G(^TMP($J,"IVMLDEM9","TOTAL"))<1 D
177 . D LNPLUS
178 . S ^TMP($J,"IVMLDEM9",IVMLN)=""
179 . D LNPLUS
180 . S ^TMP($J,"IVMLDEM9",IVMLN)="*** NO RECORDS TO PRINT ***"
181 S XMTEXT="^TMP($J,""IVMLDEM9"","
182 D ^XMD
183 Q
184QUE ;Que the task if user invokes option
185 N ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZTSK,ZUSR,POP,X,ERR,IOP
186 W !
187 S ZTIO=""
188 S ZTRTN="PRINT^IVMLDEM9"
189 S ZTDESC="IVM AUTO ADDRESS UPLOAD RPT"
190 D ^%ZTLOAD
191 D ^%ZISC,HOME^%ZIS
192 W !,$S($D(ZTSK):"REQUEST QUEUED AS TASK#"_ZTSK,1:"REQUEST CANCELLED!")
193 Q
194TOTAL ;Display record total on the report
195 N IVMTOTAL
196 S IVMTOTAL=$G(^TMP($J,"IVMLDEM9","TOTAL"))
197 D
198 . D LNPLUS
199 . S ^TMP($J,"IVMLDEM9",IVMLN)=""
200 . D LNPLUS
201 . S ^TMP($J,"IVMLDEM9",IVMLN)="TOTAL RECORD(S): "_$G(IVMTOTAL)
202 Q
203LNPLUS ;Increase line number for the email text
204 S IVMLN=$G(IVMLN)+1
205 Q
Note: See TracBrowser for help on using the repository browser.