1 | IVM2101C ;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
|
---|
4 | TEST ; Test Mode
|
---|
5 | S MODE=0
|
---|
6 | ;
|
---|
7 | EP ;
|
---|
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
|
---|
15 | NMSPC() ;
|
---|
16 | Q "IVM*2*101"
|
---|
17 | ;
|
---|
18 | CHECK() ;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
|
---|
34 | ACTIVE(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 | ;
|
---|
48 | QUETASK ;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
|
---|
60 | EP1 ;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 | ;
|
---|
112 | DONEMSG ;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
|
---|
121 | RUNMSG ;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
|
---|
132 | ABORTMSG ;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
|
---|
145 | COMPMSG ;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
|
---|