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 Dec 13, 2024@02:35:33 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
