source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUPS153.m@ 1650

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

initial load of WorldVistAEHR

File size: 1.8 KB
Line 
1TIUPS153 ; SLC/AJB - Cleanup ACLAU/ACLEC ; December 31, 2002
2 ;;1.0;TEXT INTEGRATION UTILITIES;**153**;Jun 20, 1997
3 ;
4 Q
5EN ;
6 N TIUMSG,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
7 S TIUMSG(1)=""
8 S TIUMSG(2)="A task is being queued in the background to"
9 S TIUMSG(3)="remove erroneous ACLAU and ACLEC cross-references."
10 S TIUMSG(4)=""
11 S TIUMSG(5)="An alert will be sent to the initiator of this patch"
12 S TIUMSG(6)="at completion."
13 S TIUMSG(7)=""
14 S ZTDESC="TIUPS153 Cleanup Routine"
15 S ZTDTH=$H
16 S ZTIO=""
17 S ZTRTN="CLEAN^TIUPS153"
18 S ZTSAVE("DUZ")=""
19 D ^%ZTLOAD
20 S TIUMSG(8)="The task number is "_$G(ZTSK)
21 S TIUMSG(9)=""
22 D MES^XPDUTL(.TIUMSG)
23 ;
24 Q
25CLEAN ;
26 N TIUD0,TIUTYPE,TIUEXCOS,TIUPAT,TIUREFDT,TIUDA
27 S (TIUTYPE,TIUEXCOS,TIUPAT,TIUREFDT,TIUDA)=""
28 F S TIUTYPE=$O(^TIU(8925,"ACLEC",TIUTYPE)) Q:TIUTYPE="" D
29 .F S TIUEXCOS=$O(^TIU(8925,"ACLEC",TIUTYPE,TIUEXCOS)) Q:TIUEXCOS="" D
30 ..F S TIUPAT=$O(^TIU(8925,"ACLEC",TIUTYPE,TIUEXCOS,TIUPAT)) Q:TIUPAT="" D
31 ...F S TIUREFDT=$O(^TIU(8925,"ACLEC",TIUTYPE,TIUEXCOS,TIUPAT,TIUREFDT)) Q:TIUREFDT="" D
32 ....F S TIUDA=$O(^TIU(8925,"ACLEC",TIUTYPE,TIUEXCOS,TIUPAT,TIUREFDT,TIUDA)) Q:TIUDA="" D
33 .....S TIUD0=$G(^TIU(8925,TIUDA,0)) I $P(TIUD0,U,5)>6 K ^TIU(8925,"ACLEC",TIUTYPE,TIUEXCOS,TIUPAT,TIUREFDT,TIUDA)
34 S (TIUTYPE,TIUEXCOS,TIUPAT,TIUREFDT,TIUDA)=""
35 F S TIUTYPE=$O(^TIU(8925,"ACLAU",TIUTYPE)) Q:TIUTYPE="" D
36 .F S TIUEXCOS=$O(^TIU(8925,"ACLAU",TIUTYPE,TIUEXCOS)) Q:TIUEXCOS="" D
37 ..F S TIUPAT=$O(^TIU(8925,"ACLAU",TIUTYPE,TIUEXCOS,TIUPAT)) Q:TIUPAT="" D
38 ...F S TIUREFDT=$O(^TIU(8925,"ACLAU",TIUTYPE,TIUEXCOS,TIUPAT,TIUREFDT)) Q:TIUREFDT="" D
39 ....F S TIUDA=$O(^TIU(8925,"ACLAU",TIUTYPE,TIUEXCOS,TIUPAT,TIUREFDT,TIUDA)) Q:TIUDA="" D
40 .....S TIUD0=$G(^TIU(8925,TIUDA,0)) I $P(TIUD0,U,5)>5 K ^TIU(8925,"ACLAU",TIUTYPE,TIUEXCOS,TIUPAT,TIUREFDT,TIUDA)
41 ;
42 S XQA(DUZ)="",XQAMSG="TIUPS153 has finished."
43 D SETUP^XQALERT
44 Q
Note: See TracBrowser for help on using the repository browser.