BLRTASKS ;IHS/OIT/MKK - IHS LAB TASKS REPORT ; 17-Dec-2015 15:37 ; MKK
;;5.2;LR;**1030,1033,1034,1038**;NOV 01, 1997;Build 6
;
; Report to examine the TaskMan globals to determine IF all the
; REQUIRED Lab Tasks are tasked, or, if not, try to determine when
; they last run.
;
EEP ; Ersatz EP
D EEP^BLRGMENU
Q
;
EP ; EP - Main Entry Point
NEW CNT,IEN,LABTASKS,NXTRUNDT,OPTION,ROOT,TASK,TASKDESC
NEW HEADER,HD1,LINES,MAXLINES,QFLG
NEW CHKOPT,NOWDATE,NOWTIME,SCHDDATE,SCHDTASK,SCHDTIME,TODAY
NEW MESSAGE,MSGLINE,ALERTMSG,ALRTLINE
;
D INITVARS
;
F S OPTION=$O(LABTASKS(OPTION)) Q:OPTION="" D
. K ROOT ; IHS/MSC/MKK - LR*5.2*1038
. S CHKOPT=OPTION
. D OPTSTAT^XUTMOPT(CHKOPT,.ROOT)
. S TASK=$P($G(ROOT(1)),"^")
. S SCHDDATE=$P($G(ROOT(1)),"^",2)
. S HOWOFTEN=$P($G(ROOT(1)),"^",3)
. ;
. ; If DEBUG set, then report no matter what
. I +$G(DEBUG) D MAKEMESG(OPTION,SCHDDATE,.MESSAGE,.MSGLINE) Q
. ;
. ; If No date or if scheduled in the PAST, it means it's not Running. Report it.
. I +$P(SCHDDATE,"@")<TODAY D MAKEMESG(OPTION,SCHDDATE,.MESSAGE,.MSGLINE)
. ;
;
W:+$G(DEBUG) !,"DEBUG SET. $D(MESSAGE)=",$D(MESSAGE),!
;
D:$D(MESSAGE) SENDMAIL("Daily LAB Option(s) Not Scheduled.",.MESSAGE)
;
D CHEKSNAP ; IHS/MSC/MKK - LR*5.2*1033
;
Q
;
INITVARS ; EP
NEW FIRSTINS,HED,INSTALLN,INSTLLDT,LABPATCH,PTR,STATUS,WOTPATCH
;
S LABTASKS("LRTASK ROLLOVER")=""
S LABTASKS("BLRTASK LAB LOG CLEANUP")=""
S LABTASKS("LRTASK NIGHTY")=""
S LABTASKS("LA7TASK NIGHTY")=""
;
S OPTION=""
;
S TODAY=$$DT^XLFDT
;
S STATUS=0,WOTPATCH="LR*5.2*1099"
F S WOTPATCH=$O(^XPD(9.7,"B",WOTPATCH),-1) Q:WOTPATCH=""!($E(WOTPATCH,1,2)'="LR")!(STATUS=3) D
. S PTR="AAA"
. F S PTR=$O(^XPD(9.7,"B",WOTPATCH,PTR),-1) Q:PTR=""!(STATUS=3) D
.. S STATUS=$P($G(^XPD(9.7,PTR,0)),"^",9)
.. I STATUS=3 S LABPATCH=WOTPATCH,INSTALLN=PTR
;
S INSTLLDT=$P($G(^XPD(9.7,INSTALLN,0)),"^",3)
S INSTLLDT=$TR($$FMTE^XLFDT(INSTLLDT,"2MZ"),"@"," ")
S HEADER(1)=$$CJ^XLFSTR("Latest IHS Lab Patch: "_LABPATCH,IOM)
S HEADER(2)=$$CJ^XLFSTR("Latest IHS Lab Patch Install Date: "_INSTLLDT,IOM)
S HED=2
;
; Find out about First-Time Install of Latest Lab Patch
S PTR=$O(^XPD(9.7,"B",LABPATCH,0))
S FIRSTINS=$P($G(^XPD(9.7,PTR,0)),"^",3)
S FIRSTINS=$TR($$FMTE^XLFDT(FIRSTINS,"2MZ"),"@"," ")
S:FIRSTINS'=INSTLLDT HED=HED+1,HEADER(HED)=$$CJ^XLFSTR("First Install Date for "_LABPATCH_": "_FIRSTINS,IOM)
;
S HED=HED+1 S HEADER(HED)=$$CJ^XLFSTR("LABORATORY TASKS",IOM)
;
I '$$TM^%ZTLOAD S HED=HED+1 S HEADER(HED)=$$CJ^XLFSTR("*** TaskMan is NOT Running ***",IOM) ; IHS/MSC/MKK - LR*5.2*1034
;
S MAXLINES=22
S LINES=MAXLINES+10,PG=0,(HD1,QFLG)="NO"
;
S (MSGLINE,ALRTLINE)=0
S CNT=0 ; IHS/MSC/MKK - LR*5.2*1033
Q
;
CTMFUTDT ; EP - Check TaskMan FUTure DaTe
K ZTSK
S ZTSK=TASK
D ISQED^%ZTLOAD ; Return Task Status
S SCHDTASK=$G(ZTSK("D"))
;
S SCHDDATE=$P(SCHDTASK,",")
S SCHDTIME=$P(SCHDTASK,",",2)
;
Q:SCHDDATE<NOWDATE
Q:SCHDDATE=NOWDATE&(SCHDTIME<NOWTIME)
;
S STATUS=$P($G(^%ZTSK(TASK,.1)),"^",1)
S STATUS=$S($G(STATUS)'="":$P($G(STATUS(STATUS)),"^"),1:"***")
Q
;
; Create/Add to MESSAGE array
MAKEMESG(OPTION,SCHDDATE,MESSAGE,MSGLINE) ; EP
NEW STR
;
I MSGLINE>0 D
. S MSGLINE=MSGLINE+1
. S MESSAGE(MSGLINE)=" "
;
S STR="Option >>> "_OPTION_" <<< Not Scheduled in TaskMan."
;
S MSGLINE=MSGLINE+1
S MESSAGE(MSGLINE)=STR
;
I +$G(SCHDDATE)>0 D
. S STR=$J("",10)_"Scheduled Date:"_$$UP^XLFSTR($$FMTE^XLFDT(SCHDDATE,"5MPZ"))
. S MSGLINE=MSGLINE+1
. S MESSAGE(MSGLINE)=STR
;
Q
;
SENDALRT(ALERTMSG) ; EP - Send alert to LMI group AND Installer
N XQA,XQAMSG
;
S XQAMSG=ALERTMSG_" MailMan Message Sent."
S XQA("G.LMI")=""
;
; If installer not part of LMI Mail Group, send them alert also
S:$$NINLMI(DUZ) XQA(DUZ)=""
;
D SETUP^XQALERT
;
Q
;
NINLMI(CHKDUZ) ; EP -- Check to see if DUZ is NOT part of LMI Mail Group
NEW MGRPIEN,XMDUZ
;
Q:CHKDUZ=.5 0 ; IHS/MSC/MKK - LR*5.2*1033 - Do NOT send anything to POSTMASTER (DUZ=.5)
;
; Get IEN of LMI MaiL Group
D CHKGROUP^XMBGRP("LMI",.MGRPIEN) ; VA DBIA 1146
Q:+(MGRPIEN)<1 1 ; If no Mail Group, return TRUE
;
; XMDUZ = DUZ of the user
; Y = IEN of the mail group
S XMDUZ=DUZ
S Y=MGRPIEN
D CHK^XMA21 ; VA DBIA 10067
;
Q $S($T=1:0,1:1)
;
SENDMAIL(MAILMSG,MESSAGE) ; EP -- Send MailMan E-mail to LMI group AND User
NEW DIFROM
;
K XMY
S XMY("G.LMI")=""
;
; If user not part of LMI Mail Group, send them e-mail also
S:$$NINLMI(DUZ) XMY(DUZ)=""
;
S LRBLNOW=$E($$NOW^XLFDT,1,12)
;
S XMSUB=MAILMSG
S XMTEXT="MESSAGE("
S XMDUZ="BLRTASKS"
S XMZ="NOT OKAY"
D ^XMD
;
I $G(XMMG)'=""!(XMZ="NOT OKAY") D
. D BMES^XPDUTL($J("",5)_"MAILMAN ERROR.")
. D BMES^XPDUTL($J("",10)_"XMZ:"_XMZ)
. D BMES^XPDUTL($J("",10)_"XMMG:"_XMMG)
;
K X,XMDUZ,XMSUB,XMTEXT,XMY,XMZ,Y ; Cleanup
;
D SENDALRT(MAILMSG)
Q
;
DEBUG ; EP
NEW DEBUG
;
S DEBUG=1
D EP
Q
;
DEBUGRPT ; EP
W ?4,OPTION
W ?34,$$UP^XLFSTR($$FMTE^XLFDT(SCHDDATE,"5MPZ"))
W ?64,HOWOFTEN
W !
Q
;
; ----- BEGIN IHS/MSC/MKK - LR*5.1*1033
CHEKSNAP ; EP - Make certain the TAKE SNAPSHOTS field in the BLR MASTER CONTROL file is set to NO.
NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
;
S SITE=.9999999
F S SITE=$O(^BLRSITE(SITE)) Q:SITE<1 D
. Q:+$$GET1^DIQ(9009029,SITE,"TAKE SNAPSHOTS","I")<1 ; Skip if NO or NULL.
. ;
. D ^XBFMK
. K FDA,ERRS
. S FDA(9009029,SITE_",",1)=0
. D FILE^DIE("K","FDA","ERRS")
. ;
. S ^TMP("BLRTASKS",$J,SITE)=$$GET1^DIQ(4,SITE,"NAME")
. S ^TMP("BLRTASKS",$J,SITE,$H)=$$HTE^XLFDT($H,"5MZ")
. S ^TMP("BLRTASKS",$J,SITE,$H,"TAKE SNAPSHOTS")=$$GET1^DIQ(9009029,SITE,"TAKE SNAPSHOTS")
. M:$D(ERRS) ^TMP("BLRTASKS",$J,SITE,$H,"TAKE SNAPSHOTS","ERRS")=ERRS
Q
;
SCRNREPT ; EP - DEBUG -- Print Report to the screen
NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
;
D INITVARS
;
D SCRNINIT
;
F S OPTION=$O(LABTASKS(OPTION)) Q:OPTION="" D SCRNLINE
D HLZTCPCK ; IHS/MSC/MKK - LR*5.2*1038
;
D PRESSKEY^BLRGMENU(9)
Q
;
SCRNINIT ; EP - DEBUG -- Initialization of variables
D OTHRINIT Q ; IHS/MSC/MKK - LR*5.2*1034
;
S HEADER(4)=$$CJ^XLFSTR("TODAY:"_TODAY_" ["_$$FMTE^XLFDT(TODAY,"5DZ")_"]",IOM)
S HEADER(5)=" "
S HEADER(6)="OPTION"
S $E(HEADER(6),26)="TASK"
S $E(HEADER(6),36)="SCHDDATE"
S $E(HEADER(6),49)="$$FMTE SCHDDATE"
S $E(HEADER(6),74)="Sched"
S BLRVERN=$TR($P($T(+1),";")," ")
S BLRVERN2="SCRNREPT"
Q
;
; ----- BEGIN IHS/MSC/MKK - LR*5.2*1034
OTHRINIT ; EP Different version of SCRINIT above
NEW HED
;
S HED=$O(HEADER("A"),-1)
; S HED=HED+1,HEADER(HED)=$$CJ^XLFSTR("TODAY:"_TODAY_" ["_$$FMTE^XLFDT(TODAY,"5DZ")_"]",IOM)
S HED=HED+1,HEADER(HED)=$$CJ^XLFSTR("TODAY:"_$$FMTE^XLFDT(TODAY,"5DZ")_" ["_TODAY_"]",IOM) ; IHS/MSC/MKK - LR*5.2*1038
S HED=HED+1,HEADER(HED)=" "
S HED=HED+1,HEADER(HED)="OPTION"
; S $E(HEADER(HED),26)="TASK"
S $E(HEADER(6),26)="TASK #" ; IHS/MSC/MKK - LR*5.2*1038
S $E(HEADER(HED),36)="SCHDDATE"
; S $E(HEADER(HED),49)="$$FMTE SCHDDATE"
S $E(HEADER(HED),50)="$$FMTE SCHDDATE" ; IHS/MSC/MKK - LR*5.2*1038
S $E(HEADER(HED),74)="Sched"
S BLRVERN=$TR($P($T(+1),";")," ")
S BLRVERN2="SCRNREPT"
Q
; ----- END IHS/MSC/MKK - LR*5.2*1034
;
SCRNLINE ; EP - DEBUG -- Print line of data
D SCRNBRKO
;
I CNT<1 D HEADERDT^BLRGMENU
W OPTION,?25,TASK,?35,SCHDDATE,?49,EXTSCHDT,?74,HOWOFTEN
W !
S CNT=CNT+1
Q
;
SCRNBRKO ; EP - DEBUG -- "Break out" Variables
S CHKOPT=OPTION
K ROOT ; IHS/MSC/MKK - LR*5.2*1038
D OPTSTAT^XUTMOPT(CHKOPT,.ROOT)
S TASK=$P($G(ROOT(1)),"^")
S SCHDDATE=+$P($P($G(ROOT(1)),"^",2),"@")
S EXTSCHDT=$$UP^XLFSTR($$FMTE^XLFDT(SCHDDATE,"5MPZ"))
S HOWOFTEN=$P($G(ROOT(1)),"^",3)
Q
; ----- END IHS/MSC/MKK - LR*5.1*1033
;
; ----- BEGIN IHS/MSC/MKK - LR*5.1*1038
HLZTCPCK ; EP - Check to see if HLZTCP interface routine is running
NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
;
; Setup SYSTEM call
S SYSCALL="##class(%SYS.ProcessQuery).%OpenId(PID)."
;
; Setup Cache Objects to retrieve PIDs of jobs
S RSET=##class(%ResultSet).%New("%SYS.ProcessQuery:ListPids")
D RSET.Execute()
;
S (HLZTCP,RTNCNT)=0
;
; Loop through PIDs
F Q:'RSET.Next()!(HLZTCP) D
. S PID=RSET.GetData(1)
. Q:PID<1
. ;
. ; Only analyze routines running on the current UCI.
. Q:$$GETSYS("NameSpace")'=$NAMESPACE
. ;
. S RTN=$$GETSYS("Routine")
. S:RTN'["NOJOBRTN" RTNCNT=RTNCNT+1
. ;
. S:RTN["HLZTCP" HLZTCP=PID
;
; W:HLZTCP<1 !,$$CJ^XLFSTR(RTNCNT_" Routines analyzed.",IOM)
W !,$$CJ^XLFSTR("HLZTCP is"_$S(HLZTCP:"",1:" >> NOT <<")_" running.",IOM)
Q
;
GETSYS(WOTDETAIL) ; EP -- Get System Information
S GETWOT=SYSCALL_WOTDETAIL_"Get()"
Q @GETWOT
;
;
TESTGPID ; EP - Test the 'Get PID' code by looking at LAB routines ONLY
NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
;
S HEADER(1)="%SYS.ProcessQuery:ListPids"
S HEADER(2)="Testing RSET.Next() Looping"
D HEADERDT^BLRGMENU
;
S HEADER(3)=$$CJ^XLFSTR("LAB Routines ONLY",IOM)
S HEADER(4)=" "
S $E(HEADER(5),15)="PID"
S $E(HEADER(5),25)="UCI"
S $E(HEADER(5),35)="Routine"
;
; Setup SYSTEM call
S SYSCALL="##class(%SYS.ProcessQuery).%OpenId(PID)."
;
S RSET=##class(%ResultSet).%New("%SYS.ProcessQuery:ListPids")
D RSET.Execute()
S (HLZTCP,LABCNT,RTNCNT)=0
;
F Q:'RSET.Next()!(HLZTCP) D
. S PID=RSET.GetData(1)
. Q:PID<1
. ;
. S UCI=$$GETSYS("NameSpace")
. ;
. S RTN=$$GETSYS("Routine")
. S RTNCNT=RTNCNT+1
. Q:$E(RTN,1,3)'="BLR"&($E(RTN,1,2)'="LA")&($E(RTN,1,2)'="LR")
. ;
. S LABCNT=LABCNT+1
. D:LABCNT=1 HEADERDT^BLRGMENU
. W ?4,$J(LABCNT,3),")",?14,PID,?24,UCI,?34,RTN,!
;
I LABCNT<1 D
. F X=3:1:5 K HEADER(X)
. D HEADERDT^BLRGMENU
;
W !,?4,RTNCNT," Routines analyzed."
W !!,?9,$S(LABCNT:LABCNT,1:"No")," LAB routine",$S(LABCNT=1:"",1:"s")," running."
D PRESSKEY^BLRGMENU(4)
Q
; ----- END IHS/MSC/MKK - LR*5.1*1038
BLRTASKS ;IHS/OIT/MKK - IHS LAB TASKS REPORT ; 17-Dec-2015 15:37 ; MKK
+1 ;;5.2;LR;**1030,1033,1034,1038**;NOV 01, 1997;Build 6
+2 ;
+3 ; Report to examine the TaskMan globals to determine IF all the
+4 ; REQUIRED Lab Tasks are tasked, or, if not, try to determine when
+5 ; they last run.
+6 ;
EEP ; Ersatz EP
+1 DO EEP^BLRGMENU
+2 QUIT
+3 ;
EP ; EP - Main Entry Point
+1 NEW CNT,IEN,LABTASKS,NXTRUNDT,OPTION,ROOT,TASK,TASKDESC
+2 NEW HEADER,HD1,LINES,MAXLINES,QFLG
+3 NEW CHKOPT,NOWDATE,NOWTIME,SCHDDATE,SCHDTASK,SCHDTIME,TODAY
+4 NEW MESSAGE,MSGLINE,ALERTMSG,ALRTLINE
+5 ;
+6 DO INITVARS
+7 ;
+8 FOR
SET OPTION=$ORDER(LABTASKS(OPTION))
IF OPTION=""
QUIT
Begin DoDot:1
+9 ; IHS/MSC/MKK - LR*5.2*1038
KILL ROOT
+10 SET CHKOPT=OPTION
+11 DO OPTSTAT^XUTMOPT(CHKOPT,.ROOT)
+12 SET TASK=$PIECE($GET(ROOT(1)),"^")
+13 SET SCHDDATE=$PIECE($GET(ROOT(1)),"^",2)
+14 SET HOWOFTEN=$PIECE($GET(ROOT(1)),"^",3)
+15 ;
+16 ; If DEBUG set, then report no matter what
+17 IF +$GET(DEBUG)
DO MAKEMESG(OPTION,SCHDDATE,.MESSAGE,.MSGLINE)
QUIT
+18 ;
+19 ; If No date or if scheduled in the PAST, it means it's not Running. Report it.
+20 IF +$PIECE(SCHDDATE,"@")<TODAY
DO MAKEMESG(OPTION,SCHDDATE,.MESSAGE,.MSGLINE)
+21 ;
End DoDot:1
+22 ;
+23 IF +$GET(DEBUG)
WRITE !,"DEBUG SET. $D(MESSAGE)=",$DATA(MESSAGE),!
+24 ;
+25 IF $DATA(MESSAGE)
DO SENDMAIL("Daily LAB Option(s) Not Scheduled.",.MESSAGE)
+26 ;
+27 ; IHS/MSC/MKK - LR*5.2*1033
DO CHEKSNAP
+28 ;
+29 QUIT
+30 ;
INITVARS ; EP
+1 NEW FIRSTINS,HED,INSTALLN,INSTLLDT,LABPATCH,PTR,STATUS,WOTPATCH
+2 ;
+3 SET LABTASKS("LRTASK ROLLOVER")=""
+4 SET LABTASKS("BLRTASK LAB LOG CLEANUP")=""
+5 SET LABTASKS("LRTASK NIGHTY")=""
+6 SET LABTASKS("LA7TASK NIGHTY")=""
+7 ;
+8 SET OPTION=""
+9 ;
+10 SET TODAY=$$DT^XLFDT
+11 ;
+12 SET STATUS=0
SET WOTPATCH="LR*5.2*1099"
+13 FOR
SET WOTPATCH=$ORDER(^XPD(9.7,"B",WOTPATCH),-1)
IF WOTPATCH=""!($EXTRACT(WOTPATCH,1,2)'="LR")!(STATUS=3)
QUIT
Begin DoDot:1
+14 SET PTR="AAA"
+15 FOR
SET PTR=$ORDER(^XPD(9.7,"B",WOTPATCH,PTR),-1)
IF PTR=""!(STATUS=3)
QUIT
Begin DoDot:2
+16 SET STATUS=$PIECE($GET(^XPD(9.7,PTR,0)),"^",9)
+17 IF STATUS=3
SET LABPATCH=WOTPATCH
SET INSTALLN=PTR
End DoDot:2
End DoDot:1
+18 ;
+19 SET INSTLLDT=$PIECE($GET(^XPD(9.7,INSTALLN,0)),"^",3)
+20 SET INSTLLDT=$TRANSLATE($$FMTE^XLFDT(INSTLLDT,"2MZ"),"@"," ")
+21 SET HEADER(1)=$$CJ^XLFSTR("Latest IHS Lab Patch: "_LABPATCH,IOM)
+22 SET HEADER(2)=$$CJ^XLFSTR("Latest IHS Lab Patch Install Date: "_INSTLLDT,IOM)
+23 SET HED=2
+24 ;
+25 ; Find out about First-Time Install of Latest Lab Patch
+26 SET PTR=$ORDER(^XPD(9.7,"B",LABPATCH,0))
+27 SET FIRSTINS=$PIECE($GET(^XPD(9.7,PTR,0)),"^",3)
+28 SET FIRSTINS=$TRANSLATE($$FMTE^XLFDT(FIRSTINS,"2MZ"),"@"," ")
+29 IF FIRSTINS'=INSTLLDT
SET HED=HED+1
SET HEADER(HED)=$$CJ^XLFSTR("First Install Date for "_LABPATCH_": "_FIRSTINS,IOM)
+30 ;
+31 SET HED=HED+1
SET HEADER(HED)=$$CJ^XLFSTR("LABORATORY TASKS",IOM)
+32 ;
+33 ; IHS/MSC/MKK - LR*5.2*1034
IF '$$TM^%ZTLOAD
SET HED=HED+1
SET HEADER(HED)=$$CJ^XLFSTR("*** TaskMan is NOT Running ***",IOM)
+34 ;
+35 SET MAXLINES=22
+36 SET LINES=MAXLINES+10
SET PG=0
SET (HD1,QFLG)="NO"
+37 ;
+38 SET (MSGLINE,ALRTLINE)=0
+39 ; IHS/MSC/MKK - LR*5.2*1033
SET CNT=0
+40 QUIT
+41 ;
CTMFUTDT ; EP - Check TaskMan FUTure DaTe
+1 KILL ZTSK
+2 SET ZTSK=TASK
+3 ; Return Task Status
DO ISQED^%ZTLOAD
+4 SET SCHDTASK=$GET(ZTSK("D"))
+5 ;
+6 SET SCHDDATE=$PIECE(SCHDTASK,",")
+7 SET SCHDTIME=$PIECE(SCHDTASK,",",2)
+8 ;
+9 IF SCHDDATE<NOWDATE
QUIT
+10 IF SCHDDATE=NOWDATE&(SCHDTIME<NOWTIME)
QUIT
+11 ;
+12 SET STATUS=$PIECE($GET(^%ZTSK(TASK,.1)),"^",1)
+13 SET STATUS=$SELECT($GET(STATUS)'="":$PIECE($GET(STATUS(STATUS)),"^"),1:"***")
+14 QUIT
+15 ;
+16 ; Create/Add to MESSAGE array
MAKEMESG(OPTION,SCHDDATE,MESSAGE,MSGLINE) ; EP
+1 NEW STR
+2 ;
+3 IF MSGLINE>0
Begin DoDot:1
+4 SET MSGLINE=MSGLINE+1
+5 SET MESSAGE(MSGLINE)=" "
End DoDot:1
+6 ;
+7 SET STR="Option >>> "_OPTION_" <<< Not Scheduled in TaskMan."
+8 ;
+9 SET MSGLINE=MSGLINE+1
+10 SET MESSAGE(MSGLINE)=STR
+11 ;
+12 IF +$GET(SCHDDATE)>0
Begin DoDot:1
+13 SET STR=$JUSTIFY("",10)_"Scheduled Date:"_$$UP^XLFSTR($$FMTE^XLFDT(SCHDDATE,"5MPZ"))
+14 SET MSGLINE=MSGLINE+1
+15 SET MESSAGE(MSGLINE)=STR
End DoDot:1
+16 ;
+17 QUIT
+18 ;
SENDALRT(ALERTMSG) ; EP - Send alert to LMI group AND Installer
+1 NEW XQA,XQAMSG
+2 ;
+3 SET XQAMSG=ALERTMSG_" MailMan Message Sent."
+4 SET XQA("G.LMI")=""
+5 ;
+6 ; If installer not part of LMI Mail Group, send them alert also
+7 IF $$NINLMI(DUZ)
SET XQA(DUZ)=""
+8 ;
+9 DO SETUP^XQALERT
+10 ;
+11 QUIT
+12 ;
NINLMI(CHKDUZ) ; EP -- Check to see if DUZ is NOT part of LMI Mail Group
+1 NEW MGRPIEN,XMDUZ
+2 ;
+3 ; IHS/MSC/MKK - LR*5.2*1033 - Do NOT send anything to POSTMASTER (DUZ=.5)
IF CHKDUZ=.5
QUIT 0
+4 ;
+5 ; Get IEN of LMI MaiL Group
+6 ; VA DBIA 1146
DO CHKGROUP^XMBGRP("LMI",.MGRPIEN)
+7 ; If no Mail Group, return TRUE
IF +(MGRPIEN)<1
QUIT 1
+8 ;
+9 ; XMDUZ = DUZ of the user
+10 ; Y = IEN of the mail group
+11 SET XMDUZ=DUZ
+12 SET Y=MGRPIEN
+13 ; VA DBIA 10067
DO CHK^XMA21
+14 ;
+15 QUIT $SELECT($TEST=1:0,1:1)
+16 ;
SENDMAIL(MAILMSG,MESSAGE) ; EP -- Send MailMan E-mail to LMI group AND User
+1 NEW DIFROM
+2 ;
+3 KILL XMY
+4 SET XMY("G.LMI")=""
+5 ;
+6 ; If user not part of LMI Mail Group, send them e-mail also
+7 IF $$NINLMI(DUZ)
SET XMY(DUZ)=""
+8 ;
+9 SET LRBLNOW=$EXTRACT($$NOW^XLFDT,1,12)
+10 ;
+11 SET XMSUB=MAILMSG
+12 SET XMTEXT="MESSAGE("
+13 SET XMDUZ="BLRTASKS"
+14 SET XMZ="NOT OKAY"
+15 DO ^XMD
+16 ;
+17 IF $GET(XMMG)'=""!(XMZ="NOT OKAY")
Begin DoDot:1
+18 DO BMES^XPDUTL($JUSTIFY("",5)_"MAILMAN ERROR.")
+19 DO BMES^XPDUTL($JUSTIFY("",10)_"XMZ:"_XMZ)
+20 DO BMES^XPDUTL($JUSTIFY("",10)_"XMMG:"_XMMG)
End DoDot:1
+21 ;
+22 ; Cleanup
KILL X,XMDUZ,XMSUB,XMTEXT,XMY,XMZ,Y
+23 ;
+24 DO SENDALRT(MAILMSG)
+25 QUIT
+26 ;
DEBUG ; EP
+1 NEW DEBUG
+2 ;
+3 SET DEBUG=1
+4 DO EP
+5 QUIT
+6 ;
DEBUGRPT ; EP
+1 WRITE ?4,OPTION
+2 WRITE ?34,$$UP^XLFSTR($$FMTE^XLFDT(SCHDDATE,"5MPZ"))
+3 WRITE ?64,HOWOFTEN
+4 WRITE !
+5 QUIT
+6 ;
+7 ; ----- BEGIN IHS/MSC/MKK - LR*5.1*1033
CHEKSNAP ; EP - Make certain the TAKE SNAPSHOTS field in the BLR MASTER CONTROL file is set to NO.
+1 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
+2 ;
+3 SET SITE=.9999999
+4 FOR
SET SITE=$ORDER(^BLRSITE(SITE))
IF SITE<1
QUIT
Begin DoDot:1
+5 ; Skip if NO or NULL.
IF +$$GET1^DIQ(9009029,SITE,"TAKE SNAPSHOTS","I")<1
QUIT
+6 ;
+7 DO ^XBFMK
+8 KILL FDA,ERRS
+9 SET FDA(9009029,SITE_",",1)=0
+10 DO FILE^DIE("K","FDA","ERRS")
+11 ;
+12 SET ^TMP("BLRTASKS",$JOB,SITE)=$$GET1^DIQ(4,SITE,"NAME")
+13 SET ^TMP("BLRTASKS",$JOB,SITE,$HOROLOG)=$$HTE^XLFDT($HOROLOG,"5MZ")
+14 SET ^TMP("BLRTASKS",$JOB,SITE,$HOROLOG,"TAKE SNAPSHOTS")=$$GET1^DIQ(9009029,SITE,"TAKE SNAPSHOTS")
+15 IF $DATA(ERRS)
MERGE ^TMP("BLRTASKS",$JOB,SITE,$HOROLOG,"TAKE SNAPSHOTS","ERRS")=ERRS
End DoDot:1
+16 QUIT
+17 ;
SCRNREPT ; EP - DEBUG -- Print Report to the screen
+1 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
+2 ;
+3 DO INITVARS
+4 ;
+5 DO SCRNINIT
+6 ;
+7 FOR
SET OPTION=$ORDER(LABTASKS(OPTION))
IF OPTION=""
QUIT
DO SCRNLINE
+8 ; IHS/MSC/MKK - LR*5.2*1038
DO HLZTCPCK
+9 ;
+10 DO PRESSKEY^BLRGMENU(9)
+11 QUIT
+12 ;
SCRNINIT ; EP - DEBUG -- Initialization of variables
+1 ; IHS/MSC/MKK - LR*5.2*1034
DO OTHRINIT
QUIT
+2 ;
+3 SET HEADER(4)=$$CJ^XLFSTR("TODAY:"_TODAY_" ["_$$FMTE^XLFDT(TODAY,"5DZ")_"]",IOM)
+4 SET HEADER(5)=" "
+5 SET HEADER(6)="OPTION"
+6 SET $EXTRACT(HEADER(6),26)="TASK"
+7 SET $EXTRACT(HEADER(6),36)="SCHDDATE"
+8 SET $EXTRACT(HEADER(6),49)="$$FMTE SCHDDATE"
+9 SET $EXTRACT(HEADER(6),74)="Sched"
+10 SET BLRVERN=$TRANSLATE($PIECE($TEXT(+1),";")," ")
+11 SET BLRVERN2="SCRNREPT"
+12 QUIT
+13 ;
+14 ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1034
OTHRINIT ; EP Different version of SCRINIT above
+1 NEW HED
+2 ;
+3 SET HED=$ORDER(HEADER("A"),-1)
+4 ; S HED=HED+1,HEADER(HED)=$$CJ^XLFSTR("TODAY:"_TODAY_" ["_$$FMTE^XLFDT(TODAY,"5DZ")_"]",IOM)
+5 ; IHS/MSC/MKK - LR*5.2*1038
SET HED=HED+1
SET HEADER(HED)=$$CJ^XLFSTR("TODAY:"_$$FMTE^XLFDT(TODAY,"5DZ")_" ["_TODAY_"]",IOM)
+6 SET HED=HED+1
SET HEADER(HED)=" "
+7 SET HED=HED+1
SET HEADER(HED)="OPTION"
+8 ; S $E(HEADER(HED),26)="TASK"
+9 ; IHS/MSC/MKK - LR*5.2*1038
SET $EXTRACT(HEADER(6),26)="TASK #"
+10 SET $EXTRACT(HEADER(HED),36)="SCHDDATE"
+11 ; S $E(HEADER(HED),49)="$$FMTE SCHDDATE"
+12 ; IHS/MSC/MKK - LR*5.2*1038
SET $EXTRACT(HEADER(HED),50)="$$FMTE SCHDDATE"
+13 SET $EXTRACT(HEADER(HED),74)="Sched"
+14 SET BLRVERN=$TRANSLATE($PIECE($TEXT(+1),";")," ")
+15 SET BLRVERN2="SCRNREPT"
+16 QUIT
+17 ; ----- END IHS/MSC/MKK - LR*5.2*1034
+18 ;
SCRNLINE ; EP - DEBUG -- Print line of data
+1 DO SCRNBRKO
+2 ;
+3 IF CNT<1
DO HEADERDT^BLRGMENU
+4 WRITE OPTION,?25,TASK,?35,SCHDDATE,?49,EXTSCHDT,?74,HOWOFTEN
+5 WRITE !
+6 SET CNT=CNT+1
+7 QUIT
+8 ;
SCRNBRKO ; EP - DEBUG -- "Break out" Variables
+1 SET CHKOPT=OPTION
+2 ; IHS/MSC/MKK - LR*5.2*1038
KILL ROOT
+3 DO OPTSTAT^XUTMOPT(CHKOPT,.ROOT)
+4 SET TASK=$PIECE($GET(ROOT(1)),"^")
+5 SET SCHDDATE=+$PIECE($PIECE($GET(ROOT(1)),"^",2),"@")
+6 SET EXTSCHDT=$$UP^XLFSTR($$FMTE^XLFDT(SCHDDATE,"5MPZ"))
+7 SET HOWOFTEN=$PIECE($GET(ROOT(1)),"^",3)
+8 QUIT
+9 ; ----- END IHS/MSC/MKK - LR*5.1*1033
+10 ;
+11 ; ----- BEGIN IHS/MSC/MKK - LR*5.1*1038
HLZTCPCK ; EP - Check to see if HLZTCP interface routine is running
+1 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
+2 ;
+3 ; Setup SYSTEM call
+4 SET SYSCALL="##class(%SYS.ProcessQuery).%OpenId(PID)."
+5 ;
+6 ; Setup Cache Objects to retrieve PIDs of jobs
+7 SET RSET=##class(%ResultSet).%New("%SYS.ProcessQuery:ListPids")
+8 DO RSET.Execute()
+9 ;
+10 SET (HLZTCP,RTNCNT)=0
+11 ;
+12 ; Loop through PIDs
+13 FOR
IF 'RSET.Next()!(HLZTCP)
QUIT
Begin DoDot:1
+14 SET PID=RSET.GetData(1)
+15 IF PID<1
QUIT
+16 ;
+17 ; Only analyze routines running on the current UCI.
+18
*** ERROR ***
IF $$GETSYS("NameSpace")'=$NAMESPACE
QUIT
+19 ;
+20 SET RTN=$$GETSYS("Routine")
+21 IF RTN'["NOJOBRTN"
SET RTNCNT=RTNCNT+1
+22 ;
+23 IF RTN["HLZTCP"
SET HLZTCP=PID
End DoDot:1
+24 ;
+25 ; W:HLZTCP<1 !,$$CJ^XLFSTR(RTNCNT_" Routines analyzed.",IOM)
+26 WRITE !,$$CJ^XLFSTR("HLZTCP is"_$SELECT(HLZTCP:"",1:" >> NOT <<")_" running.",IOM)
+27 QUIT
+28 ;
GETSYS(WOTDETAIL) ; EP -- Get System Information
+1
*** ERROR ***
+2 QUIT @GETWOT
+3 ;
+4 ;
TESTGPID ; EP - Test the 'Get PID' code by looking at LAB routines ONLY
+1 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
+2 ;
+3 SET HEADER(1)="%SYS.ProcessQuery:ListPids"
+4 SET HEADER(2)="Testing RSET.Next() Looping"
+5 DO HEADERDT^BLRGMENU
+6 ;
+7 SET HEADER(3)=$$CJ^XLFSTR("LAB Routines ONLY",IOM)
+8 SET HEADER(4)=" "
+9 SET $EXTRACT(HEADER(5),15)="PID"
+10 SET $EXTRACT(HEADER(5),25)="UCI"
+11 SET $EXTRACT(HEADER(5),35)="Routine"
+12 ;
+13 ; Setup SYSTEM call
+14 SET SYSCALL="##class(%SYS.ProcessQuery).%OpenId(PID)."
+15 ;
+16 SET RSET=##class(%ResultSet).%New("%SYS.ProcessQuery:ListPids")
+17 DO RSET.Execute()
+18 SET (HLZTCP,LABCNT,RTNCNT)=0
+19 ;
+20 FOR
IF 'RSET.Next()!(HLZTCP)
QUIT
Begin DoDot:1
+21 SET PID=RSET.GetData(1)
+22 IF PID<1
QUIT
+23 ;
+24 SET UCI=$$GETSYS("NameSpace")
+25 ;
+26 SET RTN=$$GETSYS("Routine")
+27 SET RTNCNT=RTNCNT+1
+28 IF $EXTRACT(RTN,1,3)'="BLR"&($EXTRACT(RTN,1,2)'="LA")&($EXTRACT(RTN,1,2)'="LR")
QUIT
+29 ;
+30 SET LABCNT=LABCNT+1
+31 IF LABCNT=1
DO HEADERDT^BLRGMENU
+32 WRITE ?4,$JUSTIFY(LABCNT,3),")",?14,PID,?24,UCI,?34,RTN,!
End DoDot:1
+33 ;
+34 IF LABCNT<1
Begin DoDot:1
+35 FOR X=3:1:5
KILL HEADER(X)
+36 DO HEADERDT^BLRGMENU
End DoDot:1
+37 ;
+38 WRITE !,?4,RTNCNT," Routines analyzed."
+39 WRITE !!,?9,$SELECT(LABCNT:LABCNT,1:"No")," LAB routine",$SELECT(LABCNT=1:"",1:"s")," running."
+40 DO PRESSKEY^BLRGMENU(4)
+41 QUIT
+42 ; ----- END IHS/MSC/MKK - LR*5.1*1038
