TIUPS153 ; SLC/AJB - Cleanup ACLAU/ACLEC ; December 31, 2002
 ;;1.0;TEXT INTEGRATION UTILITIES;**153**;Jun 20, 1997
 ;
 Q
EN ;
 N TIUMSG,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
 S TIUMSG(1)=""
 S TIUMSG(2)="A task is being queued in the background to"
 S TIUMSG(3)="remove erroneous ACLAU and ACLEC cross-references."
 S TIUMSG(4)=""
 S TIUMSG(5)="An alert will be sent to the initiator of this patch"
 S TIUMSG(6)="at completion."
 S TIUMSG(7)=""
 S ZTDESC="TIUPS153 Cleanup Routine"
 S ZTDTH=$H
 S ZTIO=""
 S ZTRTN="CLEAN^TIUPS153"
 S ZTSAVE("DUZ")=""
 D ^%ZTLOAD
 S TIUMSG(8)="The task number is "_$G(ZTSK)
 S TIUMSG(9)=""
 D MES^XPDUTL(.TIUMSG)
 ;
 Q
CLEAN ;
 N TIUD0,TIUTYPE,TIUEXCOS,TIUPAT,TIUREFDT,TIUDA
 S (TIUTYPE,TIUEXCOS,TIUPAT,TIUREFDT,TIUDA)=""
 F  S TIUTYPE=$O(^TIU(8925,"ACLEC",TIUTYPE)) Q:TIUTYPE=""  D
 .F  S TIUEXCOS=$O(^TIU(8925,"ACLEC",TIUTYPE,TIUEXCOS)) Q:TIUEXCOS=""  D
 ..F  S TIUPAT=$O(^TIU(8925,"ACLEC",TIUTYPE,TIUEXCOS,TIUPAT)) Q:TIUPAT=""  D
 ...F  S TIUREFDT=$O(^TIU(8925,"ACLEC",TIUTYPE,TIUEXCOS,TIUPAT,TIUREFDT)) Q:TIUREFDT=""  D
 ....F  S TIUDA=$O(^TIU(8925,"ACLEC",TIUTYPE,TIUEXCOS,TIUPAT,TIUREFDT,TIUDA)) Q:TIUDA=""  D
 .....S TIUD0=$G(^TIU(8925,TIUDA,0)) I $P(TIUD0,U,5)>6 K ^TIU(8925,"ACLEC",TIUTYPE,TIUEXCOS,TIUPAT,TIUREFDT,TIUDA)
 S (TIUTYPE,TIUEXCOS,TIUPAT,TIUREFDT,TIUDA)=""
 F  S TIUTYPE=$O(^TIU(8925,"ACLAU",TIUTYPE)) Q:TIUTYPE=""  D
 .F  S TIUEXCOS=$O(^TIU(8925,"ACLAU",TIUTYPE,TIUEXCOS)) Q:TIUEXCOS=""  D
 ..F  S TIUPAT=$O(^TIU(8925,"ACLAU",TIUTYPE,TIUEXCOS,TIUPAT)) Q:TIUPAT=""  D
 ...F  S TIUREFDT=$O(^TIU(8925,"ACLAU",TIUTYPE,TIUEXCOS,TIUPAT,TIUREFDT)) Q:TIUREFDT=""  D
 ....F  S TIUDA=$O(^TIU(8925,"ACLAU",TIUTYPE,TIUEXCOS,TIUPAT,TIUREFDT,TIUDA)) Q:TIUDA=""  D
 .....S TIUD0=$G(^TIU(8925,TIUDA,0)) I $P(TIUD0,U,5)>5 K ^TIU(8925,"ACLAU",TIUTYPE,TIUEXCOS,TIUPAT,TIUREFDT,TIUDA)
 ;
 S XQA(DUZ)="",XQAMSG="TIUPS153 has finished."
 D SETUP^XQALERT
 Q