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

BLRTASKS.m

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