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

TIUP271.m

Go to the documentation of this file. 
  1. TIUP271 ;SMT - Clean up utility for TIU*271 ; 4/12/13 10:57am
  1.  ;;1.0;TEXT INTEGRATION UTILITIES;**271**;Aug 23, 2012;Build 12
  1.  Q
  1.  ; Utility By Seth Thompson - updated by Daniel Huffman
  1.  ; Clean up String Dates in Field 1301 of file 8925
  1.  ;
  1. EN ;
  1.  N DIE,DA,DR,TIUDT,TIUDA,CNT,RECS,ERR
  1.  ;
  1.  I $D(^TMP("TIU271")) W !,"Already Running! Only one instance allowed" Q
  1.  S ^TMP("TIU271",0)="TIU*1*271 CLEANUP RUNNING"
  1.  ;
  1.  S TIUDT=9999999,ERR=0,CNT=1,RECS=0
  1.  F  S TIUDT=$O(^TIU(8925,"D",TIUDT)) Q:'TIUDT  D
  1.  . S DA=0 F  S DA=$O(^TIU(8925,"D",TIUDT,DA)) Q:'DA  D
  1.  . . S RECS=RECS+1 D LOCK^TIUSRVP(.ERR,DA)
  1.  . . I 'ERR D  Q
  1.  . . . S DIE="^TIU(8925,",DR="1301///"_+TIUDT
  1.  . . . D ^DIE
  1.  . . . D UNLOCK^TIUSRVP(.ERR,DA)
  1.  . . I $D(^TIU(8925,"D",TIUDT,DA)) D  ;If the node still exists...
  1.  . . . S ^TMP("TIU271",CNT)="TIU Document:"_DA_" Reference Date:"_$$GET1^DIQ(8925,DA,1301,"I"),CNT=CNT+1
  1.  . . . S ^TMP("TIU271",CNT)=" Reason: "_$S(ERR:$P(ERR,"^",2),1:"UNKNOWN"),CNT=CNT+1
  1.  D MAIL
  1.  K ^TMP("TIU271")
  1.  S $P(^XTMP("TIUP271",0,"LAST"),U)="COMPLETED"  ;  djh update Set Completed status
  1.  S $P(^XTMP("TIUP271",0,"LAST"),U,3)=$$NOW^XLFDT  ;  djh update Set completed date/time
  1.  Q
  1.  ;
  1. MAIL ;
  1.  ; djh update - Change XMD to XMY in newed list
  1.  N CNT,MSG,XMY,XMDUZ,DIFROM,XMSUB,XMTEXT,I,NMSP,VAR
  1.  ;
  1.  S CNT=1
  1.  S XMY(DUZ)="",XMY("G.TIU CACS")=""
  1.  ; djh update add 'Patch ' to from text (XMDUZ) - fixes problem with mailman msg not being sent if any user name starts with TIU
  1.  S XMSUB="REFERENCE DATES CORRECTED",XMTEXT="MSG(",XMDUZ="Patch TIU*1.0*271"
  1.  S MSG(CNT)="This is a list of TIU Documents that had erroneous dates in the REFERENCE DATE ",CNT=CNT+1
  1.  S MSG(CNT)="field and could not be cleaned up.",CNT=CNT+1
  1.  S MSG(CNT)="For more information about the related issue, please see patch TIU*1*271",CNT=CNT+1
  1.  S MSG(CNT)="",CNT=CNT+1
  1.  ;
  1.  S I=0 F  S I=$O(^TMP("TIU271",I)) Q:'I  S MSG(CNT)=^TMP("TIU271",I),CNT=CNT+1
  1.  S:$O(^TMP("TIU271",0))="" MSG(CNT)="No Problems in REFERENCE DATE correction."
  1.  D ^XMD
  1.  Q
  1.  ;
  1. QUE ;  Entry point from kids Install
  1.  N NAMSP,PATCH,JOBN,DTOUT,DUOUT,ZTSK,ZTRTN,ZTIO,ZTDTH,ZTDESC,QUIT,Y,ZTQUEUED,ZTREQ,ZTSAVE
  1.  S NAMSP=$$NAMSP
  1.  S JOBN="REFERENCE DATE UPDATE"
  1.  S PATCH="TIU*1.0*271"
  1.  ;
  1.  L +^XTMP(NAMSP):$G(DILOCKTM,3) I '$T D  Q
  1.  . D BMES^XPDUTL(JOBN_" job is already running.  Halting...")
  1.  . D MES^XPDUTL("")
  1.  . D QUIT
  1.  ;
  1.  I '$D(^XTMP(NAMSP)) D INITXTMP(NAMSP,JOBN_", "_PATCH,90)        ;90 day life
  1.  S QUIT=0
  1.  ;
  1.  I $G(^XTMP(NAMSP,0,"LAST"))["COMPLETED" D  Q
  1.  . W !!,*7,"This job has been run before to completion on "
  1.  . ; djh update - use completed date from piece 3
  1.  . W $$FMTE^XLFDT($P($G(^XTMP(NAMSP,0,"LAST")),"^",3)),!!
  1.  . W "If you want to run it again, the global subscript ^XTMP('"_NAMSP_"') must be",!
  1.  . W "deleted prior to doing so.",!!
  1.  . D QUIT
  1.  ;
  1.  ;ques 2, if running from mumps prompt
  1.  I '$D(XPDQUES("POS2")) D  I 'ZTDTH D QUIT Q
  1.  . K DIR
  1.  . S DIR("A",1)=" Enter when to Queue the "_JOBN_" job to run"
  1.  . S DIR("A")=" in date@time format"
  1.  . S DIR("B")="NOW"
  1.  . S DIR(0)="D^::%DT"
  1.  . S DIR("?")=" Enter when to start the job. The default is Now. You can enter a date and time in the format like this: 021506@3:30p"
  1.  . D ^DIR I $D(DUOUT) W !,"Halting..." S ZTDTH="" Q
  1.  . S:$D(DTOUT) Y=$$NOW^XLFDT S ZTDTH=$$FMTH^XLFDT(Y)
  1.  . S $P(^XTMP(NAMSP,0,"LAST"),"^",1,2)="RUN^"_$$NOW^XLFDT
  1.  ;
  1.  ;ques 2, if running from kids install
  1.  I $D(XPDQUES("POS2")) S ZTDTH=$$FMTH^XLFDT(XPDQUES("POS2"))
  1.  ;
  1.  D BMES^XPDUTL("=============================================================")
  1.  D MES^XPDUTL("Queuing background job for "_JOBN_"...")
  1.  D MES^XPDUTL("Start time: "_$$HTE^XLFDT(ZTDTH))
  1.  D MES^XPDUTL("==============================================================")
  1.  I ZTDTH="" D BMES^XPDUTL(JOBN_" NOT QUEUED") D QUIT Q
  1.  ;
  1.  S:$D(^XTMP(NAMSP,0,"LAST")) ^XTMP(NAMSP,0,"ZAUDIT",$H)="RE-STARTED ON"_"^"_$$NOW^XLFDT_"^"_$P(^XTMP(NAMSP,0,"LAST"),"^",2,5)
  1.  ;
  1.  I $P($G(^XTMP(NAMSP,0,"LAST")),"^")="STOP" D
  1.  . S $P(^XTMP(NAMSP,0,"LAST"),"^",1,2)="RUN^"_$$NOW^XLFDT
  1.  E  D
  1.  . S ^XTMP(NAMSP,0,"LAST")="RUN^"_$$NOW^XLFDT_"^^^"
  1.  ;
  1.  S ZTRTN="EN^"_NAMSP,ZTIO=""
  1.  S ZTDESC="Background job "_JOBN_" updated via "_PATCH
  1.  S ZTSAVE("JOBN")=""
  1.  L -^XTMP(NAMSP)
  1.  D ^%ZTLOAD
  1.  D:$D(ZTSK)
  1.  . D MES^XPDUTL("*** Task #"_ZTSK_" Queued! ***")
  1.  . D BMES^XPDUTL("")
  1.  D BMES^XPDUTL("")
  1.  K XPDQUES
  1.  Q
  1.  ;
  1. NAMSP() ;
  1.  Q $T(+0)
  1.  ;
  1. STOP ;stop job command
  1.  I $$ST S ^XTMP($$NAMSP,0,"STOP")="" D
  1.  . W !,"TALLY MISSING EXPIRATION DATES Job - set to STOP Soon"
  1.  . W !!,"Check Status to be sure it has stopped and is not running..."
  1.  . W !,"     (D STATUS^PSOTEXP1)"
  1.  Q
  1.  ;
  1. ST() ;status
  1.  L +^XTMP($$NAMSP):$G(DILOCKTM,3) I $T D  Q 0
  1.  . L -^XTMP($$NAMSP)
  1.  . W !,"*** NOT CURRENTLY RUNNING! ***",!
  1.  Q 1
  1.  ;
  1. INITXTMP(NAMSP,TITLE,LIFE) ;create ^Xtmp according to SAC std
  1.  N BEGDT,PURGDT
  1.  S BEGDT=$$NOW^XLFDT()
  1.  S PURGDT=$$FMADD^XLFDT(BEGDT,LIFE)
  1.  I $G(^XTMP(NAMSP,0))']"" S ^XTMP(NAMSP,0)=PURGDT_"^"_BEGDT_"^"_TITLE
  1.  Q
  1.  ;
  1. QUIT ;
  1.  L -^XTMP(NAMSP)
  1.  Q
  1.  ;