source: WorldVistAEHR/trunk/r/ENROLLMENT_APPLICATION_SYSTEM-EAS/EAS25UEI.m@ 1578

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

initial load of WorldVistAEHR

File size: 6.1 KB
Line 
1EAS25UEI ;ALB/CKN - GEOGRAPHIC MEANS TEST PHASE II ; 03-MAR-2003
2 ;;1.0;ENROLLMENT APPLICATION SYSTEM;**25**;Mar 15, 2001
3 ;This post install routine will check inpatient/outpatient encounters,
4 ;future appointments and fee basis authorizations to determine
5 ;User Enrollee status for each Veteran in PATIENT(#2) file.
6 ;User Enrollee data will be stored in PATIENT file and transmitted
7 ;to HEC via Z07 HL7 messages.
8 Q
9EP ;Entry point
10 N DONE,TXT
11 ;create bulletin message in install file.
12 S TXT(1)="The Post Install will now process through PATIENT (#2) file"
13 S TXT(2)="to determine User Enrollee status for each Veteran by checking"
14 S TXT(3)="inpatient/outpatient encounter for current fiscal year, any"
15 S TXT(4)="future appointments and any fee basis authorizations."
16 S TXT(5)=" "
17 D BMES^XPDUTL(.TXT)
18 ;check for completion of checkpoint, quit if checkpoint completed.
19 ;create new checkpoint if necessary
20 D CHECK Q:DONE
21 D QUETASK
22 Q
23CHECK ;Initial checking
24 N STAT,TASKNUM
25 S DONE=0
26 I '$D(^XTMP("EAS*1*25")) Q
27 I $G(^XTMP("EAS*1*25","COMPLETED"))=1 D Q
28 . N MSG,XMDUZ,XMSUB,XMTEXT,XMY
29 . S (XMDUZ,XMSUB)="USER ENROLLEE INITIAL DETERMINATION PROCESS"
30 . S (XMY(.5),XMY(DUZ))="",XMTEXT="MSG("
31 . S MSG(1)="User Enrollee initial determination process was completed in previous run."
32 . S DONE=1 D ^XMD
33 . D BMES^XPDUTL(.MSG)
34 S TASKNUM=$G(^XTMP("EAS*1*25","TASK"))
35 I TASKNUM'="" D
36 . S STAT=$$ACTIVE(TASKNUM)
37 . I STAT>0 D
38 . . N MSG,XMDUZ,XMSUB,XMTEXT,XMY
39 . . S (XMDUZ,XMSUB)="USER ENROLLEE INITIAL DETERMINATION PROCESS"
40 . . S (XMY(.5),XMY(DUZ))="",XMTEXT="MSG("
41 . . S MSG(1)="Task: "_TASKNUM_" is currently running User Enrollee determination"
42 . . S MSG(2)="process. Duplicate process cannot be started."
43 . . S DONE=1 D ^XMD
44 . . D BMES^XPDUTL(.MSG)
45 Q
46ACTIVE(TASK) ;Checks if task is running or not
47 ; input -- The taskman ID
48 ; output -- 1=The task is running
49 ; 0=The task is not running
50 ;
51 N ZTSK,STAT,Y
52 S STAT=0,ZTSK=+TASK
53 D STAT^%ZTLOAD
54 S Y=ZTSK(1)
55 I Y=0 S STAT=-1
56 I ",1,2,"[(","_Y_",") S STAT=1
57 I ",3,5,"[(","_Y_",") S STAT=0
58 Q STAT
59 ;
60QUETASK ;Queue the task
61 N TXT,ZTRTN,ZTDESC,ZTSK,ZTIO,ZTDTH
62 S ZTRTN="EP1^EAS25UEI",ZTIO="",ZTDTH=$$NOW^XLFDT()
63 S ZTDESC="USER ENROLLEE INITIAL DETERMINATION PROCESS"
64 D ^%ZTLOAD S ^XTMP("EAS*1*25","TASK")=ZTSK
65 S TXT(1)="Task: "_ZTSK_" Queued."
66 D BMES^XPDUTL(.TXT)
67 Q
68EP1 ;Entry point
69 N X,X1,X2,BDT,FDT,UEST,CNT,TXT,XIEN,TOT,ZTSTOP
70 S ZTSTOP=0
71 S XIEN=+$G(^XTMP("EAS*1*25","CURRENT IEN"))
72 S X1=DT,X2=60 D C^%DTC
73 S ^XTMP("EAS*1*25",0)=X_"^"_$$DT^XLFDT_"^EAS*1*25 GMT PHASE II-UE POST INSTALL"
74 ;store start date
75 I '$D(^XTMP("EAS*1*25","DATE")) S $P(^XTMP("EAS*1*25","DATE"),"^",1)=$$FMTE^XLFDT($$NOW^XLFDT(),"5P")
76 S TOT=$P($G(^XTMP("EAS*1*25",1)),"^"),CNT=$P($G(^XTMP("EAS*1*25",1)),"^",2)
77 ;Loop through Patient file (#2)
78 F S XIEN=$O(^DPT(XIEN)) Q:+XIEN=0!(ZTSTOP) D
79 . S TOT=TOT+1 ;processed records counter
80 . S ^XTMP("EAS*1*25","CURRENT IEN")=XIEN
81 . I (TOT#1000=0),$$S^%ZTLOAD S ZTSTOP=1 ;Check for Stop request
82 . I $$DECEASED^EASMTUTL(XIEN) D Q ; Quit if Deceased
83 . . S ^XTMP("EAS*1*25",1)=TOT_"^"_CNT
84 . ;Remove current value to avoid any invalid data
85 . S CURUE=$P($G(^DPT(XIEN,.361)),"^",7,8)
86 . I $P(CURUE,"^")'=""!($P(CURUE,"^",2)'="") D
87 . . S (DATA(.3617),DATA(.3618))="@"
88 . . S UPD=$$UPD^DGENDBS(2,XIEN,.DATA)
89 . . K UPD,DATA,CURUE
90 . K TEMP
91 . D SCHED,ENC,FBENC ;Determine UE status
92 . S UEST=$O(TEMP("UE",9999999),-1) ;get last from all encounters
93 . I +$G(UEST) D
94 . . S CNT=CNT+1 ;User Enrollee counter
95 . . I $$UPDCHK^EASUER(XIEN,UEST) D FILE^EASUER(XIEN,UEST) ;file data
96 . S ^XTMP("EAS*1*25",1)=TOT_"^"_CNT
97 S $P(^XTMP("EAS*1*25","DATE"),"^",2)=$$FMTE^XLFDT($$NOW^XLFDT(),"5P")
98 I ZTSTOP D Q
99 . N MSG,XMDUZ,XMSUB,XMTEXT,XMY
100 . S (XMDUZ,XMSUB)="USER ENROLLEE INITIAL DETERMINATION PROCESS"
101 . S (XMY(.5),XMY(DUZ))="",XMTEXT="MSG("
102 . S MSG(1)="USER ENROLLEE INITIAL DETERMINATION PROCESS TASK: "_$G(^XTMP("EAS*1*25","TASK"))
103 . S MSG(2)=""
104 . S MSG(3)="User Enrollee initial determination process is requested to stop"
105 . S MSG(4)="by the user. Please restart the process by using the following"
106 . S MSG(5)="command at the programmer prompt:"
107 . S MSG(6)=""
108 . S MSG(7)="D EP^EAS25UEI"
109 . D ^XMD
110 D MAIL ;send mailman message to User
111 S ^XTMP("EAS*1*25","COMPLETED")=1
112 D BMES^XPDUTL("Post install process for initial User Enrollee determination is completed.")
113 Q
114SCHED ;Check for future appointment
115 N XDT,NODE,SDRESULT
116 D GETAPPT^SDAMA201(XIEN,1,"R",DT,,.SDRESULT)
117 I SDRESULT>0 D
118 . S NODE=$O(^TMP($J,"SDAMA201","GETAPPT",""),-1)
119 . S XDT=$G(^TMP($J,"SDAMA201","GETAPPT",NODE,1))
120 . S XDT=$$FY^EASUER(XDT) I +$G(XDT) S TEMP("UE",XDT)="SCH"
121 Q
122ENC ;Check for Inpatient/Outpatient encounters
123 N ENC,DFN,SDRESULT,DFN,VAIP
124 S ENC=$$EXOE^SDOEOE(XIEN,3021001,DT)
125 I ENC D Q
126 . S XDT=$$FY^EASUER(DT),TEMP("UE",XDT)="ENC"
127 I $O(^DPT(XIEN,"S",9999999))="" D ;Get appt between Oct1 - today
128 . D GETAPPT^SDAMA201(XIEN,1,"R",3021001,DT,.SDRESULT)
129 . I SDRESULT>0 D
130 . . S XDT=$$FY^EASUER(DT),TEMP("UE",XDT)="ENC"
131 I $G(SDRESULT)>0 Q
132 S DFN=XIEN D IN5^VADPT I +$G(VAIP(10)) D Q ;Check for Inpatient
133 . S XDT=$$FY^EASUER(DT),TEMP("UE",XDT)="ENC"
134 Q
135FBENC ;Check for Fee basis encounters
136 N EDATE,TDATE
137 S TDATE=$$AUTH^FBGMT2(XIEN)
138 I TDATE=0!(TDATE<3021001) Q
139 S TDATE=$$FY^EASUER(TDATE) I +$G(TDATE) S TEMP("UE",TDATE)="FB"
140 Q
141MAIL ;
142 N MSG,XMDUZ,XMSUB,XMTEXT,XMY,SITE,STATN,SITENM
143 S SITE=$$SITE^VASITE,STATN=$P($G(SITE),"^",3),SITENM=$P($G(SITE),"^",2)
144 S (XMDUZ,XMSUB)="GMTII - USER ENROLLEE INITIAL DETERMINATION PROCESS"
145 S (XMY(DUZ),XMY(.5))="",XMY("NAIK.CHINTAN@FORUM.VA.GOV")=""
146 S XMTEXT="MSG("
147 S MSG(1)="User Enrollee initial determination process is completed successfully."
148 S MSG(1.5)="Task: "_$G(^XTMP("EAS*1*25","TASK"))
149 S MSG(2)=""
150 S MSG(3)="Site Station number: "_STATN
151 S MSG(4)="Site Name: "_SITENM
152 S MSG(5)=""
153 S MSG(6)="Process started at : "_$P($G(^XTMP("EAS*1*25","DATE")),"^",1)
154 S MSG(7)="Process completed at : "_$P($G(^XTMP("EAS*1*25","DATE")),"^",2)
155 S MSG(8)="Total Veterans processed : "_$P($G(^XTMP("EAS*1*25",1)),"^",1)
156 S MSG(9)="Total Veterans with UE status: "_$P($G(^XTMP("EAS*1*25",1)),"^",2)
157 D ^XMD
158 Q
Note: See TracBrowser for help on using the repository browser.