source: WorldVistAEHR/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVM2101C.m

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

initial load of WorldVistAEHR

File size: 5.7 KB
Line 
1IVM2101C ;ALB/CKN,GTS - FILED BY IVM FLAG CLEANUP ; 2/17/05 4:52pm
2 ;;2.0;INCOME VERIFICATION MATCH;**101**; 21-OCT-94;Build 5
3 Q
4TEST ; Test Mode
5 S MODE=0
6 ;
7EP ;
8 N TXT
9 ;Create bulletin message in install file.
10 ;Quit if initial check fails.
11 Q:$$CHECK()
12 ;Queue task
13 D QUETASK
14 Q
15NMSPC() ;
16 Q "IVM*2*101"
17 ;
18CHECK() ;Initial Checking
19 ; Output : 0 - Conversion not running or completed
20 ; 1 - Task is running or completed
21 ;
22 N DONE,STAT,TASKNUM,NAMESPC
23 S DONE=0
24 S NAMESPC=$$NMSPC()
25 I '$D(^XTMP(NAMESPC)) Q DONE
26 I $G(^XTMP(NAMESPC,"CONFIG","COMPLETED"))=1 D Q DONE
27 . D DONEMSG
28 . S DONE=1
29 S TASKNUM=$G(^XTMP(NAMESPC,"CONFIG","TASK"))
30 I TASKNUM'="" D
31 . S STAT=$$ACTIVE(TASKNUM)
32 . I STAT>0 D RUNMSG S DONE=1
33 Q DONE
34ACTIVE(TASK) ;Checks if task is running or not
35 ; input -- The taskman ID
36 ; output -- 1=The task is running
37 ; 0=The task is not running
38 ;
39 N ZTSK,STAT,Y
40 S STAT=0,ZTSK=+TASK
41 D STAT^%ZTLOAD
42 S Y=ZTSK(1)
43 I Y=0 S STAT=-1
44 I ",1,2,"[(","_Y_",") S STAT=1
45 I ",3,5,"[(","_Y_",") S STAT=0
46 Q STAT
47 ;
48QUETASK ;Queue the Task
49 N TXT,ZTRTN,ZTDESC,ZTSK,ZTIO,ZTDTH,NAMESPC
50 S NAMESPC=$$NMSPC()
51 S ZTRTN="EP1^IVM2101C",ZTIO="",ZTDTH=$$NOW^XLFDT()
52 S ZTDESC=NAMESPC_" - FILED BY IVM FLAG CLEANUP"
53 ; Create XTMP array
54 S X1=DT,X2=120 D C^%DTC
55 S ^XTMP(NAMESPC,0)=X_"^"_$$DT^XLFDT_"^"_NAMESPC_" FIX FILED BY IVM ERROR"
56 D ^%ZTLOAD S ^XTMP(NAMESPC,"CONFIG","TASK")=ZTSK
57 S TXT(1)="Task: "_ZTSK_" Queued."
58 D BMES^XPDUTL(.TXT)
59 Q
60EP1 ;Entry Point
61 N XIEN,XIYR,EIEN,XRELIEN,XDGMT,AMTIEN,SOURCE,FIVM,NAMESPC
62 N X,X1,X2,TOT,CNT,ZTSTOP
63 S ZTSTOP=0
64 S NAMESPC=$$NMSPC()
65 S XIEN=+$G(^XTMP(NAMESPC,"CONFIG","CURRENT IEN"))
66 ; Update XTMP array 0 node purge date.
67 S X1=DT,X2=120 D C^%DTC
68 S ^XTMP(NAMESPC,0)=X_"^"_$$DT^XLFDT_"^"_NAMESPC_" FIX FILED BY IVM ERROR"
69 ;Store start date
70 I '$D(^XTMP(NAMESPC,"CONFIG","START DATE")) S ^XTMP(NAMESPC,"CONFIG","START DATE")=$$FMTE^XLFDT($$NOW^XLFDT(),"5P")
71 S TOT=+$G(^XTMP(NAMESPC,"CONFIG","TOTAL PROCESSED"))
72 S CNT=+$G(^XTMP(NAMESPC,"CONFIG","TOTAL FOUND"))
73 ;Loop through 408.12 file - get Veteran IEN
74 F S XIEN=$O(^DGPR(408.12,"B",XIEN)) Q:+XIEN=0!(ZTSTOP) D
75 . S TOT=TOT+1 ;Processed records counter
76 . S ^XTMP(NAMESPC,"CONFIG","TOTAL PROCESSED")=TOT
77 . S ^XTMP(NAMESPC,"CONFIG","CURRENT IEN")=XIEN
78 . I (TOT#1000=0),$$S^%ZTLOAD S ZTSTOP=1 ;Check for stop request
79 . S XRELIEN=0
80 . ;Get 408.12 iens for each Veteran
81 . F S XRELIEN=$O(^DGPR(408.12,"B",XIEN,XRELIEN)) Q:XRELIEN="" D
82 . . S EIEN=0
83 . . F S EIEN=$O(^DGPR(408.12,XRELIEN,"E",EIEN)) Q:EIEN="" D
84 . . . ;Get Filed By IVM flag
85 . . . S FIVM=$P($G(^DGPR(408.12,XRELIEN,"E",EIEN,0)),"^",3)
86 . . . I FIVM="" Q ;Quit if flag is not set
87 . . . ; Get Annual Means test ien for FILED BY IVM flag
88 . . . S AMTIEN=$P($G(^DGPR(408.12,XRELIEN,"E",EIEN,0)),"^",4)
89 . . . Q:AMTIEN="" ;Quit if Annual MT IEN is not set.
90 . . . S XIYR=$P($G(^DGMT(408.31,AMTIEN,0)),"^") ;Income Year
91 . . . I XIYR<3040000 Q ;Quit if income year is less than 2004
92 . . . ;Get source of MT
93 . . . S SOURCE=$P($G(^DGMT(408.31,AMTIEN,0)),"^",23)
94 . . . ;If SOURCE OF INCOME TEST is VAMC or OTHER FACILITY
95 . . . I (FIVM=1),((SOURCE=1)!(SOURCE=4)) D
96 . . . . S SOURCE=SOURCE_"^"_$P($G(^DG(408.34,SOURCE,0)),"^",1)
97 . . . . S CNT=CNT+1,^XTMP(NAMESPC,"CONFIG","TOTAL FOUND")=CNT
98 . . . . S ^XTMP(NAMESPC,CNT,"PATIENT IEN")=XIEN
99 . . . . S ^XTMP(NAMESPC,CNT,"ANNUAL MT IEN")=AMTIEN
100 . . . . S ^XTMP(NAMESPC,CNT,"PATIENT RELATION IEN")=XRELIEN
101 . . . . S ^XTMP(NAMESPC,CNT,"SOURCE OF INCOME TEST")=SOURCE
102 . . . . S ^XTMP(NAMESPC,CNT,"PREVIOUS FILED BY IVM")=FIVM_"^YES"
103 . . . . ;Reset FILED BY IVM field to NULL
104 . . . . S $P(^DGPR(408.12,XRELIEN,"E",EIEN,0),"^",3)=""
105 S ^XTMP(NAMESPC,"CONFIG","STOP DATE")=$$FMTE^XLFDT($$NOW^XLFDT(),"5P")
106 I ZTSTOP D Q
107 . D ABORTMSG
108 S ^XTMP(NAMESPC,"CONFIG","COMPLETED")=1
109 D COMPMSG
110 Q
111 ;
112DONEMSG ;Send message that process is already Completed.
113 N MSG,XMDUZ,XMSUB,XMTEXT,XMY
114 S XMSUB=NAMESPC_" - FILED BY IVM FLAG CLEANUP already completed"
115 S XMDUZ=NAMESPC_" INSTALLATION PROCESS"
116 S (XMY(.5),XMY(DUZ))="",XMTEXT="MSG("
117 S MSG(1)="FILED BY IVM FLAG CLEANUP process was completed in previous run."
118 D ^XMD
119 D BMES^XPDUTL(.MSG)
120 Q
121RUNMSG ;Send message that process is currently running.
122 N NAMESPC,MSG,XMDUZ,XMSUB,XMTEXT,XMY
123 S NAMESPC=$$NMSPC()
124 S XMSUB=NAMESPC_" - FILED BY IVM FLAG CLEANUP running"
125 S XMDUZ=NAMESPC_" INSTALLATION PROCESS"
126 S (XMY(.5),XMY(DUZ))="",XMTEXT="MSG("
127 S MSG(1)="TASK: "_TASKNUM_" is currently running FILED BY IVM FLAG CLEANUP"
128 S MSG(2)="process. Duplicate process cannot be started."
129 D ^XMD
130 D BMES^XPDUTL(.MSG)
131 Q
132ABORTMSG ;Send message for stop request.
133 N MSG,XMDUX,XMSUB,XMTEXT,XMY
134 S XMSUB=NAMESPC_" - FILED BY IVM FLAG CLEANUP stopped"
135 S XMDUZ=NAMESPC_" INSTALLATION PROCESS"
136 S (XMY(.5),XMY(DUZ))="",XMTEXT="MSG("
137 S MSG(1)="TASK: "_$G(^XTMP(NAMESPC,"CONFIG","TASK"))_" FILED BY IVM FLAG CLEANUP"
138 S MSG(2)=""
139 S MSG(3)="FILED BY IVM error cleanup process was requested to stop"
140 S MSG(4)="by the user. Please restart the process by using the following"
141 S MSG(5)="command at the programmer prompt:"
142 S MSG(6)="D EP^IVM2101C"
143 D ^XMD
144 Q
145COMPMSG ;Send message for completed Task.
146 N MSG,XMDUX,XMSUB,XMTEXT,XMY
147 S XMSUB=NAMESPC_" - FILED BY IVM FLAG CLEANUP completed"
148 S XMDUZ=NAMESPC_" INSTALLATION PROCESS"
149 S (XMY(.5),XMY(DUZ))="",XMTEXT="MSG("
150 S MSG(1)="TASK: "_$G(^XTMP(NAMESPC,"CONFIG","TASK"))_" FILED BY IVM FLAG CLEANUP"
151 S MSG(2)=""
152 S MSG(3)="FILED BY IVM error cleanup process has completed. Review the"
153 S MSG(4)="following ^XTMP global for details on the Patient Relation file (408.12)"
154 S MSG(5)="records converted: ^XTMP("""_NAMESPC_""","
155 S MSG(6)=""
156 S MSG(7)="This global will be deleted in no more than 120 days from the date"
157 S MSG(8)="of this message."
158 D ^XMD
159 Q
Note: See TracBrowser for help on using the repository browser.