Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: RTYDPST

RTYDPST.m

Go to the documentation of this file.
  1. RTYDPST ;ALB/ABR - PULL LIST FILE NAME CLEANUP ; SEP 28 1995
  1. ;;v 2.0;Record Tracking;**23**;10/22/91
  1. EN ;
  1. N ZTDESC,ZTRTN,ZTIO,ZTQUEUED,ZTSK,I,X
  1. W !!,"<<CLEAN-UP OF PULL LIST NAMES IN PULL LIST FILE (#194.2)>>",!
  1. I '$G(DUZ)!'$D(DTIME)!'$D(U) W !!,*7,">> USER NOT DEFINED. CANNOT CONTINUE" Q
  1. F I=1:1 S X=$P($T(TEXT+I),";;",2) Q:X="QUIT" W !,X
  1. QUE S ZTRTN="CLN^RTYDPST",ZTDESC="PULL LIST FILE NAME CLEAN-UP",ZTIO=""
  1. D ^%ZTLOAD
  1. W:$D(ZTSK) !!,">>>Task "_ZTSK_" has been queued."
  1. Q
  1. CLN ;entry point from Queue
  1. N RTI,RTPULL,RTSTART,DA,DIE,DR
  1. S RTI=0,RTSTART=$$HTE^XLFDT($H)
  1. S DIE="^RTV(194.2,"
  1. F S RTI=$O(^RTV(194.2,RTI)) Q:'RTI D:$D(^(RTI,0))
  1. .S RTPULL=$P(^RTV(194.2,RTI,0),U) I RTPULL'?.E1L.E Q
  1. .S RTPULL=$$UP^XLFSTR(RTPULL),DA=RTI,DR=".01///"_RTPULL
  1. .D ^DIE
  1. I '$D(ZTQUEUED) W ">> DONE!",!
  1. D MAIL
  1. Q
  1. ;
  1. MAIL ;
  1. N RTTEXT,DIFROM
  1. S RTTEXT(1)="The PULL LIST file clean-up began on "_RTSTART
  1. S RTTEXT(2)="and ran to completion on "_$$HTE^XLFDT($H)_"."
  1. S RTTEXT(3)=" ",RTTEXT(4)="** Please delete the RTYD* routines at this time. **"
  1. S XMSUB="PULL LIST File Clean-up Complete",XMTEXT="RTTEXT("
  1. S XMDUZ=.5,XMY(DUZ)=""
  1. D ^XMD
  1. Q
  1. TEXT ;display text
  1. ;;This routine will loop through the PULL LIST file, changing all Pull List names
  1. ;;to all UPPER CASE.
  1. ;;
  1. ;;THIS CLEAN-UP WILL TAKE SOME TIME AND MUST BE QUEUED!!
  1. ;;
  1. ;;QUIT
  1. Q