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