source: WorldVistAEHR/trunk/r/REGISTRATION-DGQE-DG-DPT-GRPX-VAD-VAF-VAS-VAT-VAU--VA-VIC--DGBT--DGJ--DGYA--VALM/DG53678A.m@ 1036

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

initial load of WorldVistAEHR
File size: 8.6 KB
Line 
1DG53678A ;ALB/MRY - Pre/Post-Install ; 9/26/05 3:33pm
2 ;;5.3;Registration;**678**;Aug 13, 1993
3 ;
4POST ;Set up TaskMan to re-queue PTF records in the background
5 N ZTDESC,ZTDTH,ZTIO,ZTQUEUED,ZTREQ,ZTRTN,ZTSAVE,ZTSK
6 S ZTRTN="SCAN^DG53678A"
7 S ZTDESC="Re-queue PTF records for DG*5.3*678"
8 ;Queue Task to start in 60 seconds
9 S ZTDTH=$$SCH^XLFDT("60S",$$NOW^XLFDT)
10 S ZTIO=""
11 D ^%ZTLOAD
12 D BMES^XPDUTL("*****")
13 D
14 . I $D(ZTSK)[0 D Q
15 . .D MES^XPDUTL("TaskMan run to requeue PTF records for DG*5.3*678 was not started.")
16 . .D MES^XPDUTL("Re-run Post Install routine POST^DG53678A.")
17 . D MES^XPDUTL("Task "_ZTSK_" started to requeue PTF records.")
18 . I $D(ZTSK("D")) D
19 . . D MES^XPDUTL("Task will start at "_$$HTE^XLFDT(ZTSK("D")))
20 D MES^XPDUTL("*****")
21 Q
22 ;
23SCAN ;Search the PTF records for any messages that would have been
24 ;transmitted to the NPCD after the Katrina ERI date and re-queue
25 ;those messages.
26 ;
27 N DGSTART ;Job start date/time
28 N DGTOTCNT ;count of verified transmitted patients
29 N DGPTFCNT ;count of re-queued PTF records
30 N DGMSG ;free text message/line count passed to NOTIFY
31 N DGIEN ;IEN for PTF RELEASE file
32 N DGDTRAN ;Date Transmitted
33 N DGDTREL ;Date Released
34 N DGQUIT ;job control flag
35 N DGERIDT ;Hurricane Katrine date
36 ;
37 K ^TMP("DG53678A",$J),^TMP("DG53678",$J)
38 S DGERIDT=3050826 ;Hurricane Katrina ERI cutoff date
39 S DGSTART=$$NOW^XLFDT
40 S (DGMSG,DGQUIT,DGTOTCNT)=0
41 S DGPTFCNT="0^0"
42 S ZTREQ="@" ;delete task when finished
43 L +^DGP(45.83):3 I '$T D Q
44 . S DGMSG=2
45 . S DGMSG(1)="PTF Transmission Currently Running - Patch Re-queue Job Stopping"
46 . S DGMSG(2)="Re-run Post Install routine POST^DG53678A."
47 . D NOTIFY(DGSTART,DGTOTCNT,DGPTFCNT,.DGMSG)
48 S DGDTRAN=DGERIDT-.00001 ;PTF transmitted date
49 ;Scan thru transmitted PTFs
50 F S DGDTRAN=$O(^DGP(45.83,"AP",DGDTRAN)) Q:'DGDTRAN D Q:DGQUIT
51 . S DGDTREL=0 ;PTF released date
52 . F S DGDTREL=$O(^DGP(45.83,"AP",DGDTRAN,DGDTREL)) Q:'DGDTREL D Q:DGQUIT
53 . . S DGIEN=0 ;PTF ien
54 . . F S DGIEN=$O(^DGP(45.83,"AP",DGDTRAN,DGDTREL,DGIEN)) Q:'DGIEN D Q:DGQUIT
55 . . . ;check PTF record (admit>8/25) that were xmit'ed and re-queue them
56 . . . K DGPTFARR ;one PTF entry in array at atime
57 . . . I ($$GET1^DIQ(45,DGIEN,2,"I")>(DGERIDT-.00001)),$$GETPTF(DGIEN,DGDTREL,.DGPTFARR) D REQPTF(.DGPTFARR,.DGPTFCNT)
58 . . . I $$S^%ZTLOAD D Q
59 . . . . S DGMSG=2
60 . . . . S DGMSG(1)="Patch DG*5.3*678 PTF Re-queue Task Stopped by User"
61 . . . . S DGMSG(2)="Re-run Post Install routine POST^DG53678A."
62 . . . . S (ZTSTOP,DGQUIT)=1
63 L -^DGP(45.83)
64 D NOTIFY(DGSTART,DGPTFCNT,.DGMSG)
65 Q
66 ;
67GETPTF(DGPTF,DGQDT,DGPT) ;Find PTF records transmitted after the verification
68 ; date. Build array subscripted by record numbers set equal to the
69 ; PTF record type.
70 ;
71 ; Input
72 ; DGPTF - IEN to PTF file (#45)
73 ; DGQDT - Date queued (Released)
74 ; DGPT - array node passed by reference
75 ;
76 ; Output
77 ; DGPT - array of PTF record types and queue dates (1:PTF,2:CENSUS)
78 ; subscripted by PTF record # (ex. DGPT(1402)=2^3011212)
79 ; function result - 0 : no records found
80 ; 1 : records found
81 ;
82 N DFN ;IEN to PATIENT file (#2)
83 N DGRTY ;Record type
84 N DGPT0 ;zero node of patient's PTF record
85 ;
86 ;borrowed from DIC("S") in DREL^DGPTFDEL
87 I $D(^DGPT(DGPTF,0)),$D(^DGPT(DGPTF,70)),+^DGPT(DGPTF,70)>2901000,$D(^DGP(45.83,"C",DGPTF)) D
88 . S DGPT0=^DGPT(DGPTF,0)
89 . S DFN=$P(DGPT0,U)
90 . S DGRTY=$P(DGPT0,U,11)
91 . I ($$EMGRES^DGUTL(DFN)="K"),(DGRTY=1) D ;PTF records only
92 . . S DGPT(DGPTF)=DGRTY_U_DGQDT
93 . . D DEM^VADPT
94 . . S DGNAM=$S($D(VADM(1)):VADM(1),1:" ")
95 . . S DGSSN=$S($D(VADM(2)):$P($P(VADM(2),"^",2),"-",3),1:" ")
96 . . S ^TMP("DG53678",$J,DGNAM,DGSSN,DGPTF)=""
97 Q ($D(DGPT)>0)
98 ;
99REQPTF(DGPTFT,DGPTFC) ;Re-queue the PTF record for transmission
100 ; Input
101 ; DGPTFT - array of PTF record #'s to resend for a patient
102 ; DGPTFC - count of re-queued PTF records
103 ;
104 ; Output
105 ; DGPTFC - count of re-queued PTF records PTF^CENSUS
106 ; (ex. DGPTFC=4^1)
107 ;
108 N DGPTF ;PTF record number
109 N DGRTY ;PTF record type (1:PTF, 2:CENSUS)
110 N DGDAT ;Date of queuing for previous transmission
111 ;
112 S DGPTF=0
113 F S DGPTF=$O(DGPTFT(DGPTF)) Q:'DGPTF D
114 . S DGRTY=+DGPTFT(DGPTF),DGDAT=$P(DGPTFT(DGPTF),U,2)
115 . I $$UNREL(DGPTF,DGDAT) D RELEASE(DGPTF) D
116 . . S:'$D(^TMP("DG53678",$J,0,DGPTF)) $P(DGPTFC,U,DGRTY)=$P(DGPTFC,U,DGRTY)+1
117 . . S ^TMP("DG53678",$J,0,DGPTF)=""
118 Q
119 ;
120UNREL(DGPTF,DGDT) ;Unrelease the PTF record - borrowed from OK^DGPTFDEL
121 ;
122 ; Input:
123 ; DGPTF - PTF record number
124 ; DGDT - Date of Previously Queued Transmission
125 ;
126 ; Output:
127 ; function result 1:success, 0:failure
128 ;
129 N DA,DIK ;FileMan variables
130 ;
131 S DA(1)=DGDT
132 I 'DA(1) Q 0
133 S DIK="^DGP(45.83,"_DA(1)_",""P"",",DA=DGPTF D ^DIK
134 Q 1
135 ;
136RELEASE(DGPTF) ;Re-release the PTF record - borrowed from REL^DGPTFREL
137 ;
138 ; Input:
139 ; DGPTF - PTF record number
140 ;
141 ; Output:
142 ; none
143 ;
144 N DA,DIC,DIE,DINUM,DR,X ;FileMan variables
145 ;
146 ;if date entry doesn't exist then create new entry and "P" node
147 I '$D(^DGP(45.83,DT,0)) D
148 . S (DINUM,X)=DT,DIC="^DGP(45.83,",DIC(0)="L"
149 . K DD,DO
150 . D FILE^DICN
151 . K DINUM,DIC
152 I '($D(^DGP(45.83,DT,"P",0))#2) S ^DGP(45.83,DT,"P",0)="^45.831PA^0^0"
153 ;if transmission date exists then clear it to allow re-transmission
154 I $P(^DGP(45.83,DT,0),U,2) D
155 . S DA=DT,DIE="^DGP(45.83,",DR="1///@"
156 . D ^DIE
157 . K DA,DIE,DR
158 ;add the PTF record to the queue
159 S (DINUM,X)=DGPTF,DIC(0)="L",DA(1)=DT,DIC="^DGP(45.83,"_DT_",""P"","
160 D FILE^DICN
161 K DA,DIC,DINUM
162 ;update RELEASE DATE and RELEASED BY fields in PTF CLOSE OUT file.
163 S DA=DGPTF,DIE="^DGP(45.84,",DR="4////"_DT_";5////"_DUZ
164 D ^DIE
165 K DA,DIE,DR
166 Q
167 ;
168NOTIFY(DGSTIME,DGPTFNUM,DGMESS) ;send job msg
169 ;
170 ; Input
171 ; DGSTIME - job start date/time
172 ; DGPTFNUM - count of PTF messages re-queued
173 ; DGMESS - free text message array for task stop or errors passed
174 ; by reference
175 ;
176 ; Output
177 ; none
178 ;
179 N DIFROM,XMDUZ,XMSUB,XMTEXT,XMY,XMZ
180 N DGSITE,DGETIME,DGTEXT,DGI,DGNAM,DGSSN,DGPTF,LINECT
181 S DGSITE=$$SITE^VASITE
182 S DGETIME=$$NOW^XLFDT
183 S XMDUZ="PTF Re-queue"
184 S XMSUB="Patch DG*5.3*678 Emergency Response - Hurricane Katrina (PTF)"
185 S XMTEXT="^TMP(""DG53678A"",$J,"
186 S XMY(DUZ)=""
187 S XMY("AACVHANPCDERInotification@mail.va.gov")=""
188 S XMY("G.PTT")=""
189 S XMY("YORTY,M ROBERT@FORUM.VA.GOV")=""
190 S ^TMP("DG53678A",$J,1)=""
191 S ^TMP("DG53678A",$J,2)=" Facility Name: "_$P(DGSITE,U,2)
192 S ^TMP("DG53678A",$J,3)=" Station Number: "_$P(DGSITE,U,3)
193 S ^TMP("DG53678A",$J,4)=""
194 S ^TMP("DG53678A",$J,5)=" Date/Time job started: "_$$FMTE^XLFDT(DGSTIME)
195 S ^TMP("DG53678A",$J,6)=" Date/Time job stopped: "_$$FMTE^XLFDT(DGETIME)
196 S ^TMP("DG53678A",$J,7)=""
197 I $G(DGMESS) D
198 . F DGI=1:1:DGMESS D
199 . . S ^TMP("DG53678A",$J,7+DGI)="*** "_$E($G(DGMESS(DGI)),1,65)
200 I '$G(DGMESS) D
201 . S ^TMP("DG53678A",$J,8)="PTF Message Re-queue Complete"
202 . ;S ^TMP("DG53678A",$J,9)="Total Hurricane Katrina patients in file (#45.83): "_DGTOT
203 . S ^TMP("DG53678A",$J,10)="Total Hurricane Katrina PTF records re-queued: "_$P(DGPTFNUM,U,1)
204 . S ^TMP("DG53678A",$J,11)=""
205 . S ^TMP("DG53678A",$J,12)=" If your site has PTF records that were re-queued, please follow the steps"
206 . S ^TMP("DG53678A",$J,13)=" listed below to retransmit them: Please refer to the PIMS V5.3 ADT"
207 . S ^TMP("DG53678A",$J,14)=" Module User Manual - PTF Menu, for additional information."
208 . S ^TMP("DG53678A",$J,15)=""
209 . S ^TMP("DG53678A",$J,16)=" * Go to the PTF Menu, then PTF Transmission"
210 . S ^TMP("DG53678A",$J,17)=" * At the Start Date prompt, type ?. "
211 . S ^TMP("DG53678A",$J,18)=" You should see a list of dates available for re-transmission."
212 . S ^TMP("DG53678A",$J,19)=" * Enter the first available start date, then enter a through date"
213 . S ^TMP("DG53678A",$J,20)=" for the date ranges available."
214 . S ^TMP("DG53678A",$J,21)=" * It is recommended that you retransmit these records"
215 . S ^TMP("DG53678A",$J,22)=" within 15 days of the patch installation."
216 . I +DGPTFCNT D
217 . . Q ;don't list names
218 . . S ^TMP("DG53678A",$J,23)=""
219 . . S ^TMP("DG53678A",$J,24)="List of Transmitted PTF records re-queued with a 'Katrina' indicator."
220 . . S ^TMP("DG53678A",$J,25)="SSN(L4) PTF# Patient"
221 . . S ^TMP("DG53678A",$J,26)="-------------------------------------------"
222 . . S LINECT=26
223 . . S DGNAM=0 F S DGNAM=$O(^TMP("DG53678",$J,DGNAM)) Q:DGNAM="" D
224 . . . S DGSSN="" F S DGSSN=$O(^TMP("DG53678",$J,DGNAM,DGSSN)) Q:DGSSN="" D
225 . . . . S DGPTF="" F S DGPTF=$O(^TMP("DG53678",$J,DGNAM,DGSSN,DGPTF)) Q:DGPTF="" D
226 . . . . . S ^TMP("DG53678A",$J,LINECT+1)=DGSSN_" "_DGPTF_" "_DGNAM
227 . . . . . S LINECT=LINECT+1
228 D ^XMD
229 K ^TMP("DG53678A",$J),^TMP("DG53678",$J),XMY,VADM Q
Note: See TracBrowser for help on using the repository browser.