[613] | 1 | DG53678A ;ALB/MRY - Pre/Post-Install ; 9/26/05 3:33pm
|
---|
| 2 | ;;5.3;Registration;**678**;Aug 13, 1993
|
---|
| 3 | ;
|
---|
| 4 | POST ;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 | ;
|
---|
| 23 | SCAN ;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 | ;
|
---|
| 67 | GETPTF(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 | ;
|
---|
| 99 | REQPTF(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 | ;
|
---|
| 120 | UNREL(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 | ;
|
---|
| 136 | RELEASE(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 | ;
|
---|
| 168 | NOTIFY(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
|
---|