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

LRJSMLU.m

Go to the documentation of this file. 
  1. LRJSMLU ;ALBOI/GTS - Lab VistA LRJ DATA SERVER UTILITY ;OCT 2, 2010
  1.  ;;5.2;LAB SERVICE;**425**;Sep 27, 1994;Build 30
  1.  ;
  1.  ;
  1. ADD(VALMCNT,MSG,LRBOLD) ; -- add line to build display
  1.  SET VALMCNT=VALMCNT+1
  1.  DO SET^VALM10(VALMCNT,MSG)
  1.  IF $GET(LRBOLD) DO CNTRL^VALM10(VALMCNT,1,79,IOINHI,IOINORM)
  1.  QUIT
  1.  ;
  1. STARTDTM(LRDEF) ; Prompt for Date and Time to schedule task
  1.  ; Called from SCHDBCKG^LRJSML6
  1.  ;
  1.  ; Input:
  1.  ;        LRDEF - Default Date/Time
  1.  ;
  1.  ; Output:
  1.  ;        LROK^LRSTDTM^LRY where -
  1.  ;        
  1.  ;          LROK : 1 - User did not time out or enter ^ to exit
  1.  ;                 0 - User timed out or entered ^ to exit
  1.  ;
  1.  ;          LRSTDTM : Fileman formatted Date/Time
  1.  ;                        or
  1.  ;                     Null when Date/Time not entered
  1.  ;                     
  1.  ;          LRY : Y returned from %DT
  1.  ;         
  1.  NEW LRY,LROK,LRSTDTM
  1.  WRITE !!,"This is the date/time you want this option to be started by TaskMan.",!
  1.  SET LRSTDTM=""
  1.  SET LROK=1
  1.  SET DIR(0)="FAO^^D BJITT^LRJSML6"
  1.  SET DIR("A")="QUEUED TO RUN AT WHAT TIME: "
  1.  SET:$G(LRDEF)'="" DIR("B")=LRDEF
  1.  SET DIR("?")="^D ITTHELP^LRJSMLU(X)"
  1.  DO ^DIR
  1.  SET LRY=X
  1.  SET:($D(DTOUT)!(X["^")!((Y']"")&(X'="@"))) LROK=0
  1.  KILL DIR,X,Y,%DT
  1.  SET %DT="FR"
  1.  SET X=LRY
  1.  DO ^%DT
  1.  SET:Y>0 LRSTDTM=Y ;Date/Time to start background task
  1.  KILL DIR,X,Y,DTOUT,DIRUT,DUOUT,%DT
  1.  SET LROK=LROK_"^"_LRSTDTM_"^"_LRY
  1.  QUIT LROK
  1.  ;
  1. ITTHELP(LRX) ; Display Help for Queued Start Time prompt
  1.  IF LRX="?" DO
  1.  .NEW DIR,X,Y,DTOUT,DIRUT,DUOUT
  1.  .WRITE !,"Time must be at least 2 minutes in the future."
  1.  .WRITE !,"Changing or deleting this date/time field will re-queue or un-queue the Option."
  1.  .WRITE !
  1.  .WRITE !,"     Examples of Valid Dates:"
  1.  .WRITE !,"       JAN 20 1957 or 20 JAN 57 or 1/20/57 or 012057"
  1.  .WRITE !,"       T   (for TODAY),  T+1 (for TOMORROW),  T+2,  T+7,  etc."
  1.  IF LRX="??" DO
  1.  .NEW DIR,LRCONT
  1.  .SET LRCONT=1
  1.  .WRITE !,"Changing or deleting this date/time field will re-queue or un-queue the Option."
  1.  .WRITE !!,"If this field has a value, the Task Manager will try to run this OPTION"
  1.  .WRITE !,"on or after the date/time entered.  This field should NOT have a"
  1.  .WRITE !,"value if the OPTION TYPE is MENU, INQUIRY, or EDIT, since it doesn't"
  1.  .WRITE !,"make sense to start up automatically a process that requires user"
  1.  .WRITE !,"terminal input."
  1.  .WRITE !!,"     Examples of Valid Dates:"
  1.  .WRITE !,"       JAN 20 1957 or 20 JAN 57 or 1/20/57 or 012057"
  1.  .WRITE !,"       T   (for TODAY),  T+1 (for TOMORROW),  T+2,  T+7,  etc."
  1.  .WRITE !!,"     If the year is omitted, the computer uses CURRENT YEAR.  Two digit year"
  1.  .WRITE !,"       assumes no more than 20 years in the future, or 80 years in the past.",!
  1.  QUIT
  1.  ;
  1. BJITS ;input transform for background job re-sch freq
  1.  ; Also called from SCHDBCKG^LRJSML6
  1.  ;
  1.  IF $$ENTCHK^LRJSML6(X) QUIT
  1.  DO ITSHELP("?")
  1.  KILL X
  1.  QUIT
  1.  ;
  1. ITSHELP(LRX) ; Display Help for Schedule Freq prompt
  1.  ; Also called from SCHDBCKG^LRJSML6
  1.  ;
  1.  IF LRX="?" DO
  1.  .WRITE !,"FOR AUTOMATIC RE-QUEUING, ANSWER WITH INCREMENT OF HOURS, DAYS, OR MONTHS"
  1.  .WRITE !,"  with codes from 2 - 15 characters."
  1.  IF (LRX="?")!(LRX="??")!(LRX="???") DO
  1.  .WRITE !,"Examples:"
  1.  .WRITE !,"   120S = job will be re-run every two minutes"
  1.  .WRITE !,"   1H = job will be rerun every hour"
  1.  .WRITE !,"   7D = job will be re-run every week"
  1.  .WRITE !,"   3M = job will be run once a quarter"
  1.  IF LRX="??"!(LRX="???") DO
  1.  .NEW DIR,LRCONT
  1.  .SET LRCONT=1
  1.  .WRITE !!,"This field has a value only if the OPTION is to be re-queued automatically"
  1.  .WRITE !,"for a subsequent run every time it is run by the TaskManager."
  1.  .WRITE !!,"Valid codes are:"
  1.  .WRITE !,"       Every n seconds         nS"
  1.  .WRITE !,"       Every n hours           nH"
  1.  .WRITE !,"       Every n days            nD"
  1.  .WRITE !,"       Every n months          nM"
  1.  .WRITE !,"       Day of Week             day[@time]"
  1.  .WRITE !,"       weekday                 D[@time]"
  1.  .WRITE !,"       weekend day             E[@time] (saturday, sunday)"
  1.  .WRITE !,"       Different days in month nM(sch...)"
  1.  .WRITE !,"           sch:    dd[@time]       day of month ie: 15"
  1.  .WRITE !,"                   nDay[@time]     day of week in month"
  1.  .WRITE !,"                                   ie: 1W,3W  first and third wednesday"
  1.  .WRITE !,"                   L               last",!
  1.  .SET DIR(0)="E"
  1.  .DO ^DIR
  1.  .SET LRCONT=+Y
  1.  .IF LRCONT DO
  1.  ..WRITE !!,"       day:=   M       monday"
  1.  ..WRITE !,"               T       tuesday"
  1.  ..WRITE !,"               W       wednesday"
  1.  ..WRITE !,"               R       thursday"
  1.  ..WRITE !,"               F       friday"
  1.  ..WRITE !,"               S       saturday"
  1.  ..WRITE !,"               U       sunday"
  1.  ..WRITE !!,"       Examples:"
  1.  ..WRITE !,"               1M(1,15)        The first and 15th of the month."
  1.  ..WRITE !,"               1M(L)           The last day of the month."
  1.  ..WRITE !,"               1M(LS)          The last saturday of the month."
  1.  ..WRITE !,"               D               Each weekday",!
  1.  QUIT
  1.  ;
  1. HANGCHAR(LRCHAR) ; Display Hang Characters
  1.  NEW LRBS,LRD,LRS
  1.  SET:'$D(LRCHAR) LRCHAR=0
  1.  SET LRD="- ]"
  1.  SET LRS="\ ]"
  1.  SET LRBS="/ ]"
  1.  NEW LRRESET,LRY
  1.  SET LRY=$Y
  1.  DO IOXY^XGF(IOSL-1,75) ;IA #3173
  1.  SET LRRESET=0
  1.  SET:LRCHAR=0 LRCHAR=LRBS
  1.  IF 'LRRESET,LRCHAR=LRD SET LRCHAR=LRS SET LRRESET=1
  1.  IF 'LRRESET,LRCHAR=LRS SET LRCHAR=LRBS SET LRRESET=1
  1.  IF 'LRRESET,LRCHAR=LRBS SET LRCHAR=LRD SET LRRESET=1
  1.  WRITE LRCHAR
  1.  IF 1 ;Needed for ^DIC screen calls
  1.  Q
  1.  ;
  1. UUEN(STR) ; Uuencode string passed in.
  1.  N J,K,LEN,LRI,LRX,S,TMP,X,Y
  1.  S TMP="",LEN=$L(STR)
  1.  F LRI=1:3:LEN D
  1.  . S LRX=$E(STR,LRI,LRI+2)
  1.  . I $L(LRX)<3 S LRX=LRX_$E("   ",1,3-$L(LRX))
  1.  . S S=$A(LRX,1)*256+$A(LRX,2)*256+$A(LRX,3),Y=""
  1.  . F K=0:1:23 S Y=(S\(2**K)#2)_Y
  1.  . F K=1:6:24 D
  1.  . . S J=$$DEC^XLFUTL($E(Y,K,K+5),2)
  1.  . . S TMP=TMP_$C(J+32)
  1.  S TMP=$C(LEN+32)_TMP
  1.  Q TMP
  1.  ;
  1. BLDNUM() ; -- returns the build number
  1.  QUIT +$PIECE($PIECE($TEXT(LRJSMLU+1),";",7),"Build ",2)
  1.  ;
  1. VERNUM() ; -- returns the version number for this build
  1.  QUIT +$PIECE($TEXT(LRJSMLU+1),";",3)
  1.  ;
  1. MGRCHK() ; -- does DUZ have LRJ HL TOOLS MGR key
  1.  N LRSEC
  1.  D OWNSKEY^XUSRB(.LRSEC,"LRJ HL TOOLS MGR")
  1.  Q +$G(LRSEC(0))