- 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 23, 2025@18:58:36 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
