source: FOIAVistA/trunk/r/INCOME_VERIFICATION_MATCH-IVM/IVM2B102.m@ 1166

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

initial load of FOIAVistA 6/30/08 version

File size: 4.2 KB
Line 
1IVM2B102 ;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 ;
11EP ;Entry point
12 N OK
13 D CHK Q:'OK
14 D MSG
15 D QUETASK
16 Q
17 ;
18QUETASK ;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 ;
27EP1 ;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 ;
50CHK ;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 ;
81MSG ;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 ;
91MAIL 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 ;
110INCYR(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 ;
118ACTIVE(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
130IVM2 S X="IVM*2.0*102 DOD Post-Install transmit Z07's to HEC" Q
131LMINUS L -^XTMP("IVM2B102") Q
Note: See TracBrowser for help on using the repository browser.