[613] | 1 | DG488 ;ALB/GN - CLEANUP PATIENT RELATION & INCOME FILES;12/11/02 ; 2/4/03 1:25pm
|
---|
| 2 | ;;5.3;REGISTRATION;**488**;5-1-2001
|
---|
| 3 | ;
|
---|
| 4 | Q
|
---|
| 5 | ;
|
---|
| 6 | TEST ; Entry point for testing this routine, then fall thru.
|
---|
| 7 | S TESTING=1
|
---|
| 8 | EN ; Entry point to start job
|
---|
| 9 | ;
|
---|
| 10 | N QUIT,ZTDESC,ZTIO,ZTRTN,ZTSK,ZTQUEUED,ZTSAVE
|
---|
| 11 | ;
|
---|
| 12 | S TESTING=+$G(TESTING)
|
---|
| 13 | ; setup TM variables and Load
|
---|
| 14 | S ZTSAVE("TESTING")=""
|
---|
| 15 | S ZTRTN=("TASK^DG488")
|
---|
| 16 | S ZTDESC="Cleanup Patient Relation & Income Files"
|
---|
| 17 | S ZTIO=""
|
---|
| 18 | W !!,ZTDESC,!
|
---|
| 19 | ;
|
---|
| 20 | ;check if already running or completed.
|
---|
| 21 | S QUIT=$$CHKSTAT
|
---|
| 22 | I QUIT L -^XTMP($$NAMSPC) K TESTING Q
|
---|
| 23 | D ^%ZTLOAD
|
---|
| 24 | L -^XTMP($$NAMSPC)
|
---|
| 25 | K TESTING
|
---|
| 26 | I $D(ZTSK) D
|
---|
| 27 | . W !,"This request queued as Task # ",ZTSK,!
|
---|
| 28 | Q
|
---|
| 29 | ;
|
---|
| 30 | TASK ; Entry point for taskman
|
---|
| 31 | L +^XTMP($$NAMSPC):10 I '$T D Q ;quit if can't get a lock
|
---|
| 32 | . S $P(^XTMP($$NAMSPC,0,0),U,12)="NO LOCK GAINED"
|
---|
| 33 | N ZTSTOP,LSTREC,DIK,DA,NAMSPC,DGT12,DG12,DG12X,DGT22,DG22,DG22X
|
---|
| 34 | N BEGTIME,PURGDT,DGFIL,IEN,DGIEN,BTIME,STAT,STIME,DGT21,DG21,DG21X
|
---|
| 35 | S NAMSPC=$$NAMSPC
|
---|
| 36 | S ZTDESC=$G(ZTDESC,"Cleanup of Patient Related Income files")
|
---|
| 37 | ;
|
---|
| 38 | S TESTING=$G(TESTING,1) ;assume testing if not defined
|
---|
| 39 | ;setup XTMP according to stds.
|
---|
| 40 | S BEGTIME=$$NOW^XLFDT()
|
---|
| 41 | S PURGDT=$$FMADD^XLFDT(BEGTIME,30)
|
---|
| 42 | S ^XTMP(NAMSPC,0)=PURGDT_U_BEGTIME_U_ZTDESC
|
---|
| 43 | S ^XTMP(NAMSPC,0,"TASKID")=$G(ZTSK,"DIRECT")
|
---|
| 44 | S ^XTMP(NAMSPC,0,"TESTING")=TESTING
|
---|
| 45 | ;get last run data
|
---|
| 46 | D GETLAST
|
---|
| 47 | ;init begin time, if not there, and status & stop time fields
|
---|
| 48 | S $P(^XTMP(NAMSPC,0,0),U,12,13)="RUNNING^"
|
---|
| 49 | S:$P(^XTMP(NAMSPC,0,0),U,11)="" $P(^XTMP(NAMSPC,0,0),U,11)=$$NOW^XLFDT
|
---|
| 50 | ;start/restart cleanups
|
---|
| 51 | S:DGFIL="" DGFIL=408.12
|
---|
| 52 | I DGFIL=408.12 D
|
---|
| 53 | . S IEN=DGIEN,DGIEN=0
|
---|
| 54 | . D DG40812(IEN)
|
---|
| 55 | . S:'ZTSTOP DGFIL=408.21 ;continue if stop not requested
|
---|
| 56 | I DGFIL=408.21 D
|
---|
| 57 | . S IEN=DGIEN,DGIEN=0
|
---|
| 58 | . D DG40821(IEN)
|
---|
| 59 | . S:'ZTSTOP DGFIL=408.22 ;continue if stop not requested
|
---|
| 60 | I DGFIL=408.22 D
|
---|
| 61 | . S IEN=DGIEN
|
---|
| 62 | . D DG40822(IEN)
|
---|
| 63 | ;
|
---|
| 64 | ;set status and mail stats
|
---|
| 65 | I ZTSTOP S $P(^XTMP(NAMSPC,0,0),U,12,13)="STOPPED"_U_$$NOW^XLFDT
|
---|
| 66 | E S $P(^XTMP(NAMSPC,0,0),U,12,13)="COMPLETED"_U_$$NOW^XLFDT
|
---|
| 67 | D MAIL^DG488M
|
---|
| 68 | L -^XTMP(NAMSPC)
|
---|
| 69 | K TESTING
|
---|
| 70 | Q
|
---|
| 71 | ;
|
---|
| 72 | DG40812(IEN) ; Main Cleanup driver for file 408.12
|
---|
| 73 | N REC12 S ZTSTOP=0
|
---|
| 74 | F S IEN=$O(^DGPR(408.12,"B",IEN)) Q:('IEN)!(ZTSTOP) D
|
---|
| 75 | . S REC12=0
|
---|
| 76 | . F S REC12=$O(^DGPR(408.12,"B",IEN,REC12)) Q:('REC12)!(ZTSTOP) D
|
---|
| 77 | . . S DGT12=DGT12+1
|
---|
| 78 | . . ;
|
---|
| 79 | . . ;if bad xref then kill the xref, else check for damaged 0 node
|
---|
| 80 | . . I '$D(^DGPR(408.12,REC12)) D
|
---|
| 81 | . . . S ^XTMP(NAMSPC,408.12,"B",IEN,REC12)=""
|
---|
| 82 | . . . I 'TESTING K ^DGPR(408.12,"B",IEN,REC12)
|
---|
| 83 | . . . S DG12X=DG12X+1
|
---|
| 84 | . . E D
|
---|
| 85 | . . . Q:+$P(^DGPR(408.12,REC12,0),U,3) ;quit if piece 3 is there
|
---|
| 86 | . . . M ^XTMP(NAMSPC,"408.12",REC12)=^DGPR(408.12,REC12)
|
---|
| 87 | . . . D DEL40821(REC12,.DG21,.DG21X)
|
---|
| 88 | . . . ;
|
---|
| 89 | . . . ;delete bad 408.12
|
---|
| 90 | . . . S DIK="^DGPR(408.12,",DA=REC12
|
---|
| 91 | . . . I 'TESTING D ^DIK
|
---|
| 92 | . . . K DIK,DA
|
---|
| 93 | . . . S DG12=DG12+1
|
---|
| 94 | . . ;
|
---|
| 95 | . . ;check for stop request after every 100 processed recs
|
---|
| 96 | . . I DGT12#100=0 D
|
---|
| 97 | . . . S:$$S^%ZTLOAD ZTSTOP=1
|
---|
| 98 | . . . I $D(^XTMP(NAMSPC,0,"STOP")) S ZTSTOP=1 K ^XTMP(NAMSPC,0,"STOP")
|
---|
| 99 | . . S LSTREC=DGFIL_"/"_IEN
|
---|
| 100 | . . S $P(^XTMP(NAMSPC,0,0),U,1)=LSTREC
|
---|
| 101 | . . S $P(^XTMP(NAMSPC,0,0),U,2,6)=DGT12_U_DG12_U_DG12X_U_DGT22_U_DG22
|
---|
| 102 | . . S $P(^XTMP(NAMSPC,0,0),U,9,10)=DG21_U_DG21X
|
---|
| 103 | Q
|
---|
| 104 | ;
|
---|
| 105 | DEL40821(R12,DG21,DG21X) ; Delete any entries in 408.21 that point to the bad
|
---|
| 106 | ; 408.12 record.
|
---|
| 107 | N REC21 S REC21=0
|
---|
| 108 | F S REC21=$O(^DGMT(408.21,"C",R12,REC21)) Q:'REC21 D
|
---|
| 109 | . ;if bad xref then kill the xref, else kill the real record
|
---|
| 110 | . I '$D(^DGMT(408.21,REC21)) D
|
---|
| 111 | . . S ^XTMP(NAMSPC,408.21,"C",R12,REC21)=""
|
---|
| 112 | . . I 'TESTING K ^DGMT(408.21,"C",R12,REC21)
|
---|
| 113 | . . S DG21X=DG21X+1
|
---|
| 114 | . E D
|
---|
| 115 | . . M ^XTMP(NAMSPC,"408.21",REC21)=^DGMT(408.21,REC21)
|
---|
| 116 | . . D DG22AIND(REC21)
|
---|
| 117 | . . S DIK="^DGMT(408.21,",DA=REC21
|
---|
| 118 | . . I 'TESTING D ^DIK
|
---|
| 119 | . . K DIK,DA
|
---|
| 120 | . . S DG21=DG21+1
|
---|
| 121 | Q
|
---|
| 122 | ;
|
---|
| 123 | DG22AIND(R21) ;Delete any entries in 408.22 that is pointing to the bad 408.21
|
---|
| 124 | N REC22 S REC22=0
|
---|
| 125 | F S REC22=$O(^DGMT(408.22,"AIND",R21,REC22)) Q:'REC22 D
|
---|
| 126 | . S DGT22=DGT22+1
|
---|
| 127 | . ;if bad xref then kill the xref, else kill the real record
|
---|
| 128 | . I '$D(^DGMT(408.22,REC22)) D
|
---|
| 129 | . . I 'TESTING K ^DGMT(408.22,"AIND",R21,REC22)
|
---|
| 130 | . . S DG22=DG22+1
|
---|
| 131 | . E D
|
---|
| 132 | . . M ^XTMP(NAMSPC,"408.22",REC22)=^DGMT(408.22,REC22)
|
---|
| 133 | . . S DIK="^DGMT(408.22,",DA=REC22
|
---|
| 134 | . . I 'TESTING D ^DIK
|
---|
| 135 | . . K DIK,DA
|
---|
| 136 | . . S DG22=DG22+1
|
---|
| 137 | Q
|
---|
| 138 | ;
|
---|
| 139 | DG40821(IEN) ; Main Cleanup driver for file 408.21, If 408.21 not pointed to
|
---|
| 140 | ; by any 408.22 record, then delete it and check 408.12 for possible
|
---|
| 141 | ; deletion as well.
|
---|
| 142 | N REC21 S ZTSTOP=0
|
---|
| 143 | F S IEN=$O(^DGMT(408.21,"B",IEN)) Q:('IEN)!(ZTSTOP) D
|
---|
| 144 | . S REC21=0
|
---|
| 145 | . F S REC21=$O(^DGMT(408.21,"B",IEN,REC21)) Q:('REC21)!(ZTSTOP) D
|
---|
| 146 | . . S DGT21=DGT21+1
|
---|
| 147 | . . ;if bad xref then kill the xref, else check for damaged 0 node
|
---|
| 148 | . . I '$D(^DGMT(408.21,REC21)) D
|
---|
| 149 | . . . S ^XTMP(NAMSPC,408.21,"B",IEN,REC21)=""
|
---|
| 150 | . . . I 'TESTING K ^DGMT(408.21,"B",IEN,REC21)
|
---|
| 151 | . . . S DG21X=DG21X+1
|
---|
| 152 | . . E D
|
---|
| 153 | . . . Q:$D(^DGMT(408.22,"AIND",REC21)) ;quit if 408.21 pointed to
|
---|
| 154 | . . . M ^XTMP(NAMSPC,"408.21",REC21)=^DGMT(408.21,REC21)
|
---|
| 155 | . . . S REC12=0
|
---|
| 156 | . . . D DEL21(REC21,.REC12,.DG21)
|
---|
| 157 | . . . D:REC12 CHK40812(REC12,REC21,.DG12)
|
---|
| 158 | . . ;
|
---|
| 159 | . . ;check for stop request after every 100 processed recs
|
---|
| 160 | . . I DGT21#100=0 D
|
---|
| 161 | . . . S:$$S^%ZTLOAD ZTSTOP=1
|
---|
| 162 | . . . I $D(^XTMP(NAMSPC,0,"STOP")) S ZTSTOP=1 K ^XTMP(NAMSPC,0,"STOP")
|
---|
| 163 | . . S LSTREC=DGFIL_"/"_IEN
|
---|
| 164 | . . S $P(^XTMP(NAMSPC,0,0),U,1)=LSTREC
|
---|
| 165 | . . S $P(^XTMP(NAMSPC,0,0),U,3)=DG12
|
---|
| 166 | . . S $P(^XTMP(NAMSPC,0,0),U,8,10)=DGT21_U_DG21_U_DG21X
|
---|
| 167 | Q
|
---|
| 168 | ;
|
---|
| 169 | DEL21(R21,R12,DG21) ; save to Xtmp & associated REC12, then delete the 408.21
|
---|
| 170 | Q:'$D(^DGMT(408.21,R21))
|
---|
| 171 | M ^XTMP(NAMSPC,"408.21",R21)=^DGMT(408.21,R21)
|
---|
| 172 | S R12=+$P($G(^DGMT(408.21,R21,0)),U,2)
|
---|
| 173 | S DIK="^DGMT(408.21,",DA=R21
|
---|
| 174 | I 'TESTING D ^DIK
|
---|
| 175 | K DIK,DA
|
---|
| 176 | S DG21=DG21+1
|
---|
| 177 | Q
|
---|
| 178 | ;
|
---|
| 179 | CHK40812(R12,R21,DG12) ; delete 408.12's if no other 408.21's pointing to it
|
---|
| 180 | N XX,OK,REC21 S (REC21,OK)=0
|
---|
| 181 | F XX=0:1 S REC21=$O(^DGMT(408.21,"C",R12,REC21)) Q:'REC21 D
|
---|
| 182 | . S:REC21=R21 OK=1
|
---|
| 183 | Q:XX>1 ;quit if other 408.21's are pointing to 408.12
|
---|
| 184 | Q:(XX=1)&('OK) ;quit if only one rec and not the correct one
|
---|
| 185 | ;
|
---|
| 186 | M ^XTMP(NAMSPC,"408.12",R12)=^DGPR(408.12,R12)
|
---|
| 187 | S DIK="^DGPR(408.12,",DA=R12
|
---|
| 188 | I 'TESTING D ^DIK
|
---|
| 189 | K DIK,DA
|
---|
| 190 | S DG12=DG12+1
|
---|
| 191 | Q
|
---|
| 192 | ;
|
---|
| 193 | DG40822(IEN) ; Main Cleanup driver for file 408.22
|
---|
| 194 | N REC22 S ZTSTOP=0
|
---|
| 195 | F S IEN=$O(^DGMT(408.22,"B",IEN)) Q:('IEN)!(ZTSTOP) D
|
---|
| 196 | . S REC22=0
|
---|
| 197 | . F S REC22=$O(^DGMT(408.22,"B",IEN,REC22)) Q:('REC22)!(ZTSTOP) D
|
---|
| 198 | . . S DGT22=DGT22+1
|
---|
| 199 | . . ;
|
---|
| 200 | . . ;if bad xref then kill the xref, else check for damaged 0 node
|
---|
| 201 | . . I '$D(^DGMT(408.22,REC22)) D
|
---|
| 202 | . . . S ^XTMP(NAMSPC,"408.22","B",IEN,REC22)=""
|
---|
| 203 | . . . I 'TESTING K ^DGMT(408.22,"B",IEN,REC22)
|
---|
| 204 | . . . S DG22X=DG22X+1
|
---|
| 205 | . . E D
|
---|
| 206 | . . . Q:+$P(^DGMT(408.22,REC22,0),U,2) ;quit if piece 2 is there
|
---|
| 207 | . . . ;save & delete bad 408.22 rec
|
---|
| 208 | . . . M ^XTMP(NAMSPC,"408.22",REC22)=^DGMT(408.22,REC22)
|
---|
| 209 | . . . S DIK="^DGMT(408.22,",DA=REC22
|
---|
| 210 | . . . I 'TESTING D ^DIK
|
---|
| 211 | . . . K DIK,DA
|
---|
| 212 | . . . S DG22=DG22+1
|
---|
| 213 | . . ;
|
---|
| 214 | . . ;check for stop request after every 100 processed recs
|
---|
| 215 | . . I DGT22#100=0 D
|
---|
| 216 | . . . S:$$S^%ZTLOAD ZTSTOP=1
|
---|
| 217 | . . . I $D(^XTMP(NAMSPC,0,"STOP")) S ZTSTOP=1 K ^XTMP(NAMSPC,0,"STOP")
|
---|
| 218 | . . S LSTREC=DGFIL_"/"_IEN
|
---|
| 219 | . . S $P(^XTMP(NAMSPC,0,0),U,1)=LSTREC
|
---|
| 220 | . . S $P(^XTMP(NAMSPC,0,0),U,5,7)=DGT22_U_DG22_U_DG22X
|
---|
| 221 | Q
|
---|
| 222 | ;
|
---|
| 223 | CHKSTAT() ;check if job is running, stopped, or completed
|
---|
| 224 | N Y,DUOUT,DTOUT,QUIT,NAMSPC
|
---|
| 225 | S QUIT=0
|
---|
| 226 | S NAMSPC=$$NAMSPC
|
---|
| 227 | L +^XTMP(NAMSPC):1
|
---|
| 228 | I '$T W !!,*7,"*** ALREADY RUNNING ***" H 4 Q 1
|
---|
| 229 | ;
|
---|
| 230 | ; get current mode
|
---|
| 231 | N TESTMODE S TESTMODE=$G(^XTMP(NAMSPC,0,"TESTING"))
|
---|
| 232 | ; get job status
|
---|
| 233 | S STAT=$P($G(^XTMP(NAMSPC,0,0)),U,12)
|
---|
| 234 | S STIME=$P($G(^XTMP(NAMSPC,0,0)),U,13)
|
---|
| 235 | Q:STAT="" QUIT
|
---|
| 236 | ;
|
---|
| 237 | ;if job Completed or trying to resume in Live mode when previously
|
---|
| 238 | ;incompleted in Test mode, ask to Re-Run
|
---|
| 239 | I STAT="COMPLETED" D
|
---|
| 240 | . D MSG(.QUIT)
|
---|
| 241 | E D
|
---|
| 242 | . I ('TESTING&TESTMODE)!(TESTING&'TESTMODE) D MSG(.QUIT)
|
---|
| 243 | Q QUIT
|
---|
| 244 | ;
|
---|
| 245 | GETLAST ;get last run info
|
---|
| 246 | S DGFIL=$P($G(^XTMP(NAMSPC,0,0)),"/") ;file
|
---|
| 247 | S DGIEN=+$P($G(^XTMP(NAMSPC,0,0)),"/",2) ;ien
|
---|
| 248 | S DGT12=+$P($G(^XTMP(NAMSPC,0,0)),U,2) ;tot 408.12 recs processed
|
---|
| 249 | S DG12=+$P($G(^XTMP(NAMSPC,0,0)),U,3) ;tot 408.12 recs purged
|
---|
| 250 | S DG12X=+$P($G(^XTMP(NAMSPC,0,0)),U,4) ;tot bad 408.12 "B" purged
|
---|
| 251 | S DGT22=+$P($G(^XTMP(NAMSPC,0,0)),U,5) ;tot 408.22 recs processed
|
---|
| 252 | S DG22=+$P($G(^XTMP(NAMSPC,0,0)),U,6) ;tot 408.22 recs purged
|
---|
| 253 | S DG22X=+$P($G(^XTMP(NAMSPC,0,0)),U,7) ;tot bad 408.22 "B" purged
|
---|
| 254 | S DGT21=+$P($G(^XTMP(NAMSPC,0,0)),U,8) ;tot 408.21 recs processed
|
---|
| 255 | S DG21=+$P($G(^XTMP(NAMSPC,0,0)),U,9) ;tot 408.21 recs purged
|
---|
| 256 | S DG21X=+$P($G(^XTMP(NAMSPC,0,0)),U,10) ;tot bad 408.21 "C" purged
|
---|
| 257 | S BTIME=$P($G(^XTMP(NAMSPC,0,0)),U,11) ;begin time
|
---|
| 258 | S STAT=$P($G(^XTMP(NAMSPC,0,0)),U,12) ;status
|
---|
| 259 | S STIME=$P($G(^XTMP(NAMSPC,0,0)),U,13) ;stop time
|
---|
| 260 | Q
|
---|
| 261 | ;
|
---|
| 262 | MSG(QUIT) ;print message to user
|
---|
| 263 | W " was "_STAT_" on "_$$FMTE^XLFDT(STIME)
|
---|
| 264 | W " in "_$S(TESTMODE:"TEST",1:"LIVE")_" mode "
|
---|
| 265 | W !," Do you want to Re-Run in "_$S(TESTING:"TEST",1:"LIVE")
|
---|
| 266 | W " mode?"
|
---|
| 267 | K DIR
|
---|
| 268 | S DIR("?",1)=" Entering Y, will delete the XTMP global where the previous cleanup"
|
---|
| 269 | S DIR("?")=" information was stored and begin a new job, or N to cancel request"
|
---|
| 270 | S DIR(0)="Y" D ^DIR
|
---|
| 271 | I 'Y S QUIT=1 Q
|
---|
| 272 | W !," ARE YOU SURE?"
|
---|
| 273 | K DIR
|
---|
| 274 | S DIR("?")="Enter Y to begin a new Job or N to cancel request"
|
---|
| 275 | S DIR(0)="Y" D ^DIR
|
---|
| 276 | I 'Y S QUIT=1 Q
|
---|
| 277 | ;fall thru to re-run mode, kill ^XTMP
|
---|
| 278 | K ^XTMP(NAMSPC)
|
---|
| 279 | Q
|
---|
| 280 | ;
|
---|
| 281 | STOP ; alternate stop method
|
---|
| 282 | S ^XTMP($$NAMSPC,0,"STOP")=""
|
---|
| 283 | Q
|
---|
| 284 | NAMSPC() ;
|
---|
| 285 | Q "DG*5.3*488"
|
---|