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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUPS153 1933 printed Apr 09, 2024@21:46:33 Page 2
TIUPS153 ; SLC/AJB - Cleanup ACLAU/ACLEC ; December 31, 2002
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**153**;Jun 20, 1997
+2 ;
+3 QUIT
EN ;
+1 NEW TIUMSG,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTSK
+2 SET TIUMSG(1)=""
+3 SET TIUMSG(2)="A task is being queued in the background to"
+4 SET TIUMSG(3)="remove erroneous ACLAU and ACLEC cross-references."
+5 SET TIUMSG(4)=""
+6 SET TIUMSG(5)="An alert will be sent to the initiator of this patch"
+7 SET TIUMSG(6)="at completion."
+8 SET TIUMSG(7)=""
+9 SET ZTDESC="TIUPS153 Cleanup Routine"
+10 SET ZTDTH=$HOROLOG
+11 SET ZTIO=""
+12 SET ZTRTN="CLEAN^TIUPS153"
+13 SET ZTSAVE("DUZ")=""
+14 DO ^%ZTLOAD
+15 SET TIUMSG(8)="The task number is "_$GET(ZTSK)
+16 SET TIUMSG(9)=""
+17 DO MES^XPDUTL(.TIUMSG)
+18 ;
+19 QUIT
CLEAN ;
+1 NEW TIUD0,TIUTYPE,TIUEXCOS,TIUPAT,TIUREFDT,TIUDA
+2 SET (TIUTYPE,TIUEXCOS,TIUPAT,TIUREFDT,TIUDA)=""
+3 FOR
SET TIUTYPE=$ORDER(^TIU(8925,"ACLEC",TIUTYPE))
if TIUTYPE=""
QUIT
Begin DoDot:1
+4 FOR
SET TIUEXCOS=$ORDER(^TIU(8925,"ACLEC",TIUTYPE,TIUEXCOS))
if TIUEXCOS=""
QUIT
Begin DoDot:2
+5 FOR
SET TIUPAT=$ORDER(^TIU(8925,"ACLEC",TIUTYPE,TIUEXCOS,TIUPAT))
if TIUPAT=""
QUIT
Begin DoDot:3
+6 FOR
SET TIUREFDT=$ORDER(^TIU(8925,"ACLEC",TIUTYPE,TIUEXCOS,TIUPAT,TIUREFDT))
if TIUREFDT=""
QUIT
Begin DoDot:4
+7 FOR
SET TIUDA=$ORDER(^TIU(8925,"ACLEC",TIUTYPE,TIUEXCOS,TIUPAT,TIUREFDT,TIUDA))
if TIUDA=""
QUIT
Begin DoDot:5
+8 SET TIUD0=$GET(^TIU(8925,TIUDA,0))
IF $PIECE(TIUD0,U,5)>6
KILL ^TIU(8925,"ACLEC",TIUTYPE,TIUEXCOS,TIUPAT,TIUREFDT,TIUDA)
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+9 SET (TIUTYPE,TIUEXCOS,TIUPAT,TIUREFDT,TIUDA)=""
+10 FOR
SET TIUTYPE=$ORDER(^TIU(8925,"ACLAU",TIUTYPE))
if TIUTYPE=""
QUIT
Begin DoDot:1
+11 FOR
SET TIUEXCOS=$ORDER(^TIU(8925,"ACLAU",TIUTYPE,TIUEXCOS))
if TIUEXCOS=""
QUIT
Begin DoDot:2
+12 FOR
SET TIUPAT=$ORDER(^TIU(8925,"ACLAU",TIUTYPE,TIUEXCOS,TIUPAT))
if TIUPAT=""
QUIT
Begin DoDot:3
+13 FOR
SET TIUREFDT=$ORDER(^TIU(8925,"ACLAU",TIUTYPE,TIUEXCOS,TIUPAT,TIUREFDT))
if TIUREFDT=""
QUIT
Begin DoDot:4
+14 FOR
SET TIUDA=$ORDER(^TIU(8925,"ACLAU",TIUTYPE,TIUEXCOS,TIUPAT,TIUREFDT,TIUDA))
if TIUDA=""
QUIT
Begin DoDot:5
+15 SET TIUD0=$GET(^TIU(8925,TIUDA,0))
IF $PIECE(TIUD0,U,5)>5
KILL ^TIU(8925,"ACLAU",TIUTYPE,TIUEXCOS,TIUPAT,TIUREFDT,TIUDA)
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+16 ;
+17 SET XQA(DUZ)=""
SET XQAMSG="TIUPS153 has finished."
+18 DO SETUP^XQALERT
+19 QUIT
