source: WorldVistAEHR/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVMLDEM9.m@ 619

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

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