- 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 Feb 18, 2025@23:41:40 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))