1 | IVM2B102 ;ALB/PJR - IVM*2.0*102 POST-INSTALL ; 12/30/04 3:51pm
|
---|
2 | ;;2.0;INCOME VERIFICATION MATCH;**102**; 21-OCT-94
|
---|
3 | ;
|
---|
4 | ;This post install routine will loop through patient file (#2)
|
---|
5 | ;and trigger a Z07 message to the HEC system
|
---|
6 | ;for all entries that have a value in the DATE OF DEATH field (#.351)
|
---|
7 | ;and a value in the SOURCE OF NOTIFICATION field (#.353)
|
---|
8 | ;of 1, 2, 3, 4, 5, 8, or 9
|
---|
9 | Q
|
---|
10 | ;
|
---|
11 | EP ;Entry point
|
---|
12 | N OK
|
---|
13 | D CHK Q:'OK
|
---|
14 | D MSG
|
---|
15 | D QUETASK
|
---|
16 | Q
|
---|
17 | ;
|
---|
18 | QUETASK ;Queue the task
|
---|
19 | N TXT,ZTRTN,ZTDESC,ZTSK,ZTIO,ZTDTH
|
---|
20 | S ZTRTN="EP1^IVM2B102",ZTIO="",ZTDTH=$$NOW^XLFDT()
|
---|
21 | S ZTDESC="DOD ENHANCEMENT POST-INSTALL"
|
---|
22 | D ^%ZTLOAD S ^XTMP("IVM2B102","TASK")=ZTSK
|
---|
23 | S TXT(1)="Task: "_ZTSK_" Queued."
|
---|
24 | D BMES^XPDUTL(.TXT)
|
---|
25 | Q
|
---|
26 | ;
|
---|
27 | EP1 ;Entry point
|
---|
28 | N X,XIEN,EVENT,IYR,ZCNT,ZIEN,ZEND,ZDATE,ZEDATE
|
---|
29 | L +^XTMP("IVM2B102"):1 E Q
|
---|
30 | S X=$G(^XTMP("IVM2B102",0)),ZCNT=+X,ZIEN=+$P(X,U,4),ZEND=ZCNT+4999
|
---|
31 | S ZDATE=$$DT^XLFDT D IVM2
|
---|
32 | S ^XTMP("IVM2B102",0)=ZCNT_U_ZDATE_U_X_U_ZIEN
|
---|
33 | S $P(^XTMP("IVM2B102","DATE"),"^")=$$FMTE^XLFDT($$NOW^XLFDT(),"5P")
|
---|
34 | D LMINUS
|
---|
35 | ;Loop through patient file
|
---|
36 | F S ZIEN=$O(^DPT(ZIEN)) Q:ZCNT>ZEND!('ZIEN) D
|
---|
37 | .S X=$G(^DPT(ZIEN,.35)) I X,"^1^2^3^4^5^8^9^"[("^"_$P(X,"^",3)_"^") D
|
---|
38 | ..S IYR=$$INCYR(ZIEN) Q:IYR=""
|
---|
39 | ..Q:'$$LOG^IVMPLOG(ZIEN,IYR,.EVENT) ;Queue Z07
|
---|
40 | ..S ZCNT=ZCNT+1 ;Tot Z07's queued
|
---|
41 | S $P(^XTMP("IVM2B102","DATE"),"^",2)=$$FMTE^XLFDT($$NOW^XLFDT(),"5P")
|
---|
42 | S ZDATE=$$DT^XLFDT,ZEDATE=$$FMTE^XLFDT(DT) D IVM2
|
---|
43 | S ^XTMP("IVM2B102",0)=ZCNT_U_ZDATE_U_X_U_(ZIEN-1)
|
---|
44 | I 'ZIEN S ^XTMP("IVM2B102","COMPLETED")=1 D MAIL
|
---|
45 | D IVM2 S X="The "_X_" process is complete"
|
---|
46 | I ZIEN S X=X_" for "_ZEDATE
|
---|
47 | S X=X_"." D BMES^XPDUTL(X)
|
---|
48 | Q
|
---|
49 | ;
|
---|
50 | CHK ;check for completion
|
---|
51 | N TXT,TASKNUM,STAT
|
---|
52 | S OK=1 L +^XTMP("IVM2B102"):1 E D Q
|
---|
53 | .S OK=0 D IVM2 S TXT(1)=X_" process has a lock table"
|
---|
54 | .S TXT(2)="problem. Nothing Done!"
|
---|
55 | .D BMES^XPDUTL(.TXT),LMINUS
|
---|
56 | ;
|
---|
57 | I $G(^XTMP("IVM2B102","COMPLETED")) D Q
|
---|
58 | .S OK=0 D IVM2 S TXT(1)=X_" process was completed in a"
|
---|
59 | .S TXT(2)="previous run. Nothing Done!"
|
---|
60 | .D BMES^XPDUTL(.TXT),LMINUS
|
---|
61 | ;
|
---|
62 | S X=$G(^XTMP("IVM2B102",0))
|
---|
63 | I $$DT^XLFDT=$P(X,U,2) D Q
|
---|
64 | .S OK=0 D IVM2 S TXT(1)=X_" is complete for today."
|
---|
65 | .S TXT(2)="Please re-start tomorrow."
|
---|
66 | .D BMES^XPDUTL(.TXT),LMINUS
|
---|
67 | ;
|
---|
68 | S TASKNUM=$G(^XTMP("IVM2B102","TASK"))
|
---|
69 | I +TASKNUM D Q
|
---|
70 | .S STAT=$$ACTIVE(TASKNUM)
|
---|
71 | .I STAT>0 D
|
---|
72 | ..S OK=0 D IVM2
|
---|
73 | ..S TXT(1)="Task: "_TASKNUM_" is currently running the"
|
---|
74 | ..S TXT(2)=X_" process."
|
---|
75 | ..S TXT(3)="Duplicate processes cannot be started."
|
---|
76 | ..D BMES^XPDUTL(.TXT)
|
---|
77 | .D LMINUS
|
---|
78 | ;
|
---|
79 | D LMINUS Q
|
---|
80 | ;
|
---|
81 | MSG ;create bulletin message in install file.
|
---|
82 | N TXT
|
---|
83 | S TXT(1)="This Post Install routine will queue a Z07 HL7 message to be sent to the"
|
---|
84 | S TXT(2)="Health Eligibility Center (HEC) for all entries in the PATIENT (#2) file"
|
---|
85 | S TXT(3)="that have a value in the DATE OF DEATH (#.531) field and a"
|
---|
86 | S TXT(4)="SOURCE OF NOTIFICATION (#.533) value of 1, 2, 3, 4, 5, 8, or 9"
|
---|
87 | S TXT(5)=" "
|
---|
88 | D BMES^XPDUTL(.TXT)
|
---|
89 | Q
|
---|
90 | ;
|
---|
91 | MAIL N SITE,STATN,SITENM,XMDUZ,XMSUB,XMY,XMTEXT,MSG
|
---|
92 | S SITE=$$SITE^VASITE,STATN=$P($G(SITE),"^",3),SITENM=$P($G(SITE),"^",2)
|
---|
93 | S:$$GET1^DIQ(869.3,"1,",.03,"I")'="P" STATN=STATN_" [TEST]"
|
---|
94 | D IVM2 S XMDUZ=X,XMSUB=XMDUZ_" - "_STATN_" (IVM*2.0*102)"
|
---|
95 | S (XMY(DUZ),XMY(.5))=""
|
---|
96 | S XMTEXT="MSG(" D IVM2
|
---|
97 | S MSG(1)="The "_X_" process"
|
---|
98 | S MSG(2)="has completed successfully."
|
---|
99 | S MSG(3)="Task: "_$G(^XTMP("IVM2B102","TASK"))
|
---|
100 | S MSG(4)=""
|
---|
101 | S MSG(5)="Site Station number: "_STATN
|
---|
102 | S MSG(6)="Site Name: "_SITENM
|
---|
103 | S MSG(7)=""
|
---|
104 | S MSG(8)="Final process started at : "_$P($G(^XTMP("IVM2B102","DATE")),"^",1)
|
---|
105 | S MSG(8)="Final process completed at : "_$P($G(^XTMP("IVM2B102","DATE")),"^",2)
|
---|
106 | S MSG(10)="Total Veterans queued for Z07: "_+$G(^XTMP("IVM2B102",0))
|
---|
107 | D ^XMD
|
---|
108 | Q
|
---|
109 | ;
|
---|
110 | INCYR(XIEN) ;Get valid income year
|
---|
111 | N I,LMT,TMP,INCYR
|
---|
112 | I $D(^IVM(301.5,"APT",XIEN)) Q $O(^IVM(301.5,"APT",XIEN,""),-1)
|
---|
113 | F I=1,2,4 S LMT=$$LST^DGMTU(XIEN,,I) S:+$G(LMT) TMP($P(LMT,"^",2))=""
|
---|
114 | I $D(TMP) S LMT=$O(TMP(""),-1),INCYR=($E(LMT,1,3)-1)_"0000" Q INCYR
|
---|
115 | S INCYR=($E(DT,1,3)-1)_"0000"
|
---|
116 | Q INCYR
|
---|
117 | ;
|
---|
118 | ACTIVE(TASK) ;Checks if task is running
|
---|
119 | ; input -- The taskman ID
|
---|
120 | ; output -- 1=The task is running
|
---|
121 | ; 0=The task is not running
|
---|
122 | N STAT,ZTSK,Y
|
---|
123 | S STAT=0,ZTSK=+TASK
|
---|
124 | D STAT^%ZTLOAD
|
---|
125 | S Y=ZTSK(1)
|
---|
126 | I Y=0 S STAT=-1
|
---|
127 | I ",1,2,"[(","_Y_",") S STAT=1
|
---|
128 | I ",3,5,"[(","_Y_",") S STAT=0
|
---|
129 | Q STAT
|
---|
130 | IVM2 S X="IVM*2.0*102 DOD Post-Install transmit Z07's to HEC" Q
|
---|
131 | LMINUS L -^XTMP("IVM2B102") Q
|
---|