- RTYDPST ;ALB/ABR - PULL LIST FILE NAME CLEANUP ; SEP 28 1995
- ;;v 2.0;Record Tracking;**23**;10/22/91
- EN ;
- N ZTDESC,ZTRTN,ZTIO,ZTQUEUED,ZTSK,I,X
- W !!,"<<CLEAN-UP OF PULL LIST NAMES IN PULL LIST FILE (#194.2)>>",!
- I '$G(DUZ)!'$D(DTIME)!'$D(U) W !!,*7,">> USER NOT DEFINED. CANNOT CONTINUE" Q
- F I=1:1 S X=$P($T(TEXT+I),";;",2) Q:X="QUIT" W !,X
- QUE S ZTRTN="CLN^RTYDPST",ZTDESC="PULL LIST FILE NAME CLEAN-UP",ZTIO=""
- D ^%ZTLOAD
- W:$D(ZTSK) !!,">>>Task "_ZTSK_" has been queued."
- Q
- CLN ;entry point from Queue
- N RTI,RTPULL,RTSTART,DA,DIE,DR
- S RTI=0,RTSTART=$$HTE^XLFDT($H)
- S DIE="^RTV(194.2,"
- F S RTI=$O(^RTV(194.2,RTI)) Q:'RTI D:$D(^(RTI,0))
- .S RTPULL=$P(^RTV(194.2,RTI,0),U) I RTPULL'?.E1L.E Q
- .S RTPULL=$$UP^XLFSTR(RTPULL),DA=RTI,DR=".01///"_RTPULL
- .D ^DIE
- I '$D(ZTQUEUED) W ">> DONE!",!
- D MAIL
- Q
- ;
- MAIL ;
- N RTTEXT,DIFROM
- S RTTEXT(1)="The PULL LIST file clean-up began on "_RTSTART
- S RTTEXT(2)="and ran to completion on "_$$HTE^XLFDT($H)_"."
- S RTTEXT(3)=" ",RTTEXT(4)="** Please delete the RTYD* routines at this time. **"
- S XMSUB="PULL LIST File Clean-up Complete",XMTEXT="RTTEXT("
- S XMDUZ=.5,XMY(DUZ)=""
- D ^XMD
- Q
- TEXT ;display text
- ;;This routine will loop through the PULL LIST file, changing all Pull List names
- ;;to all UPPER CASE.
- ;;
- ;;THIS CLEAN-UP WILL TAKE SOME TIME AND MUST BE QUEUED!!
- ;;
- ;;QUIT
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRTYDPST 1388 printed Mar 13, 2025@21:40:39 Page 2
- RTYDPST ;ALB/ABR - PULL LIST FILE NAME CLEANUP ; SEP 28 1995
- +1 ;;v 2.0;Record Tracking;**23**;10/22/91
- EN ;
- +1 NEW ZTDESC,ZTRTN,ZTIO,ZTQUEUED,ZTSK,I,X
- +2 WRITE !!,"<<CLEAN-UP OF PULL LIST NAMES IN PULL LIST FILE (#194.2)>>",!
- +3 IF '$GET(DUZ)!'$DATA(DTIME)!'$DATA(U)
- WRITE !!,*7,">> USER NOT DEFINED. CANNOT CONTINUE"
- QUIT
- +4 FOR I=1:1
- SET X=$PIECE($TEXT(TEXT+I),";;",2)
- if X="QUIT"
- QUIT
- WRITE !,X
- QUE SET ZTRTN="CLN^RTYDPST"
- SET ZTDESC="PULL LIST FILE NAME CLEAN-UP"
- SET ZTIO=""
- +1 DO ^%ZTLOAD
- +2 if $DATA(ZTSK)
- WRITE !!,">>>Task "_ZTSK_" has been queued."
- +3 QUIT
- CLN ;entry point from Queue
- +1 NEW RTI,RTPULL,RTSTART,DA,DIE,DR
- +2 SET RTI=0
- SET RTSTART=$$HTE^XLFDT($HOROLOG)
- +3 SET DIE="^RTV(194.2,"
- +4 FOR
- SET RTI=$ORDER(^RTV(194.2,RTI))
- if 'RTI
- QUIT
- if $DATA(^(RTI,0))
- Begin DoDot:1
- +5 SET RTPULL=$PIECE(^RTV(194.2,RTI,0),U)
- IF RTPULL'?.E1L.E
- QUIT
- +6 SET RTPULL=$$UP^XLFSTR(RTPULL)
- SET DA=RTI
- SET DR=".01///"_RTPULL
- +7 DO ^DIE
- End DoDot:1
- +8 IF '$DATA(ZTQUEUED)
- WRITE ">> DONE!",!
- +9 DO MAIL
- +10 QUIT
- +11 ;
- MAIL ;
- +1 NEW RTTEXT,DIFROM
- +2 SET RTTEXT(1)="The PULL LIST file clean-up began on "_RTSTART
- +3 SET RTTEXT(2)="and ran to completion on "_$$HTE^XLFDT($HOROLOG)_"."
- +4 SET RTTEXT(3)=" "
- SET RTTEXT(4)="** Please delete the RTYD* routines at this time. **"
- +5 SET XMSUB="PULL LIST File Clean-up Complete"
- SET XMTEXT="RTTEXT("
- +6 SET XMDUZ=.5
- SET XMY(DUZ)=""
- +7 DO ^XMD
- +8 QUIT
- TEXT ;display text
- +1 ;;This routine will loop through the PULL LIST file, changing all Pull List names
- +2 ;;to all UPPER CASE.
- +3 ;;
- +4 ;;THIS CLEAN-UP WILL TAKE SOME TIME AND MUST BE QUEUED!!
- +5 ;;
- +6 ;;QUIT
- +7 QUIT