- BLRLABJD ;IHS/MSC/MKK - Display Lab Job(s) (including HLZTCP) detail, if running; 17-Oct-2014 09:22 ; MKK
- ;;5.2;IHS LABORATORY;**1034**;NOV 01, 1997;Build 88
- ;
- EEP ; EP - Ersatz EP
- D EEP^BLRGMENU
- Q
- ;
- EP ; EP
- PEP ; EP
- NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
- ;
- D BLRHLZTI
- ;
- F Q:'RSET.Next() D BLRHLZTL
- ;
- W !!,?4,CNTJOBS," Jobs analyzed."
- W !!,?9,$S(CNT<1:"No",1:CNT)," Lab Job"_$S(CNT>1:"s.",1:".")
- W !!,?14,$S(CNTTCP<1:"No HLZTCP Jobs found on the system.",1:CNTTCP_" HLZTCP Job"_$S(CNTTCP>1:"s.",1:"."))
- D PRESSKEY^BLRGMENU(4)
- Q
- ;
- BLRHLZTI ; EP -- Initialization
- S BLRVERN=$$TRIM^XLFSTR($P($T(+1),";"),"LR"," ")
- ;
- ; The following line of code will determine the MAJOR version of
- ; Cache that is running. If it's > 2007, then it's known
- ; that the %SYSTEM.Process class has been superseded by the
- ; %SYS.ProcessQuery class.
- S WOTSYS=$system.Version.GetMajor()
- ;
- S:WOTSYS<2008 SYSCALL="##class(%SYSTEM.Process).%OpenId(PID)."
- S:WOTSYS>2007 SYSCALL="##class(%SYS.ProcessQuery).%OpenId(PID)."
- ;
- S DEFUCI=$NAMESPACE
- ;
- S HEADER(1)="Lab Job Processes"
- S HEADER(2)=" "
- D HEADERDT^BLRGMENU
- W ?4,"Job Analysis"
- ;
- S (CNT,CNTJOBS,CNTTCP)=0
- ;
- S RSET=##class(%ResultSet).%New("%SYS.ProcessQuery:ListPids")
- D RSET.Execute()
- ;
- Q
- ;
- RESTHEAD ; EP - Rest of HEADER array
- S HEADER(3)="PID/User"
- S $E(HEADER(3),10)="Routine"
- S $E(HEADER(3),20)="Port #"
- S $E(HEADER(3),28)="IP Address"
- S $E(HEADER(3),44)="UCI"
- ;
- D HEADERDT^BLRGMENU
- Q
- ;
- BLRHLZTL ; EP - Line of Data
- S PID=RSET.GetData(1)
- Q:PID<1
- ;
- S CNTJOBS=CNTJOBS+1
- ;
- I CNT<1 W "." I $X>74 W !,?4
- ;
- S RTN=$$GETSYS("Routine")
- Q:RTN'["HLZTCP"&($E(RTN,1,3)'="BLR")&($E(RTN,1,2)'="LA")&($E(RTN,1,3)'="LR")
- ;
- S:RTN["HLZTCP" CNTTCP=CNTTCP+1
- ;
- D JOBVBRKO
- ;
- D:CNT<1 RESTHEAD
- ;
- W PID
- W ?9,$E(RTN,1,8)
- W ?19,$E($G(PORT),1,6)
- W ?27,$E($G(IPADDR),1,17)
- W ?43,$G(UCI)
- W !
- S LINES=LINES+1
- S CNT=CNT+1
- ;
- Q
- ;
- GETSYS(WOTDETAIL) ; EP -- Get System Information
- S GETWOT=SYSCALL_WOTDETAIL_"Get()"
- Q @GETWOT
- ;
- JOBVBRKO ; EP -- JOB Variables BReaKOut
- D JOBVBRKS
- ;
- S PORT=$P(PORT,"|",3)
- S:$P(PORT,":",2)'="" PORT=$P(PORT,":",2)
- ;
- S LOOKHERE="NO"
- S:RTN="HLZTCP" LOOKHERE="YES",HLZTCPCNT=1+$G(HLZTCPCNT)
- Q
- ;
- JOBVBRKS ; EP -- JOB Variables BReaKOut -- System variables
- S UCI=$$GETSYS("NameSpace")
- S IPADDR=$$GETSYS("ClientIPAddress")
- S PORT=$$GETSYS("CurrentDevice")
- S USERNAME=$$GETSYS("UserName")
- S USERNAME=$S(USERNAME="SYSTEM":"",USERNAME=UCI:"",1:USERNAME)
- Q
- BLRLABJD ;IHS/MSC/MKK - Display Lab Job(s) (including HLZTCP) detail, if running; 17-Oct-2014 09:22 ; MKK
- +1 ;;5.2;IHS LABORATORY;**1034**;NOV 01, 1997;Build 88
- +2 ;
- EEP ; EP - Ersatz EP
- +1 DO EEP^BLRGMENU
- +2 QUIT
- +3 ;
- EP ; EP
- PEP ; EP
- +1 NEW (DILOCKTM,DISYS,DT,DTIME,DUZ,IO,IOBS,IOF,IOM,ION,IOS,IOSL,IOST,IOT,IOXY,U,XPARSYS,XQXFLG)
- +2 ;
- +3 DO BLRHLZTI
- +4 ;
- +5 FOR
- IF 'RSET.Next()
- QUIT
- DO BLRHLZTL
- +6 ;
- +7 WRITE !!,?4,CNTJOBS," Jobs analyzed."
- +8 WRITE !!,?9,$SELECT(CNT<1:"No",1:CNT)," Lab Job"_$SELECT(CNT>1:"s.",1:".")
- +9 WRITE !!,?14,$SELECT(CNTTCP<1:"No HLZTCP Jobs found on the system.",1:CNTTCP_" HLZTCP Job"_$SELECT(CNTTCP>1:"s.",1:"."))
- +10 DO PRESSKEY^BLRGMENU(4)
- +11 QUIT
- +12 ;
- BLRHLZTI ; EP -- Initialization
- +1 SET BLRVERN=$$TRIM^XLFSTR($PIECE($TEXT(+1),";"),"LR"," ")
- +2 ;
- +3 ; The following line of code will determine the MAJOR version of
- +4 ; Cache that is running. If it's > 2007, then it's known
- +5 ; that the %SYSTEM.Process class has been superseded by the
- +6 ; %SYS.ProcessQuery class.
- +7
- *** ERROR ***
- SET WOTSYS=$system.Version.GetMajor()
- +8 ;
- +9 IF WOTSYS<2008
- SET SYSCALL="##class(%SYSTEM.Process).%OpenId(PID)."
- +10 IF WOTSYS>2007
- SET SYSCALL="##class(%SYS.ProcessQuery).%OpenId(PID)."
- +11 ;
- +12
- *** ERROR ***
- SET DEFUCI=$NAMESPACE
- +13 ;
- +14 SET HEADER(1)="Lab Job Processes"
- +15 SET HEADER(2)=" "
- +16 DO HEADERDT^BLRGMENU
- +17 WRITE ?4,"Job Analysis"
- +18 ;
- +19 SET (CNT,CNTJOBS,CNTTCP)=0
- +20 ;
- +21 SET RSET=##class(%ResultSet).%New("%SYS.ProcessQuery:ListPids")
- +22 DO RSET.Execute()
- +23 ;
- +24 QUIT
- +25 ;
- RESTHEAD ; EP - Rest of HEADER array
- +1 SET HEADER(3)="PID/User"
- +2 SET $EXTRACT(HEADER(3),10)="Routine"
- +3 SET $EXTRACT(HEADER(3),20)="Port #"
- +4 SET $EXTRACT(HEADER(3),28)="IP Address"
- +5 SET $EXTRACT(HEADER(3),44)="UCI"
- +6 ;
- +7 DO HEADERDT^BLRGMENU
- +8 QUIT
- +9 ;
- BLRHLZTL ; EP - Line of Data
- +1 SET PID=RSET.GetData(1)
- +2 IF PID<1
- QUIT
- +3 ;
- +4 SET CNTJOBS=CNTJOBS+1
- +5 ;
- +6 IF CNT<1
- WRITE "."
- IF $X>74
- WRITE !,?4
- +7 ;
- +8 SET RTN=$$GETSYS("Routine")
- +9 IF RTN'["HLZTCP"&($EXTRACT(RTN,1,3)'="BLR")&($EXTRACT(RTN,1,2)'="LA")&($EXTRACT(RTN,1,3)'="LR")
- QUIT
- +10 ;
- +11 IF RTN["HLZTCP"
- SET CNTTCP=CNTTCP+1
- +12 ;
- +13 DO JOBVBRKO
- +14 ;
- +15 IF CNT<1
- DO RESTHEAD
- +16 ;
- +17 WRITE PID
- +18 WRITE ?9,$EXTRACT(RTN,1,8)
- +19 WRITE ?19,$EXTRACT($GET(PORT),1,6)
- +20 WRITE ?27,$EXTRACT($GET(IPADDR),1,17)
- +21 WRITE ?43,$GET(UCI)
- +22 WRITE !
- +23 SET LINES=LINES+1
- +24 SET CNT=CNT+1
- +25 ;
- +26 QUIT
- +27 ;
- GETSYS(WOTDETAIL) ; EP -- Get System Information
- +1 SET GETWOT=SYSCALL_WOTDETAIL_"Get()"
- +2 QUIT @GETWOT
- +3 ;
- JOBVBRKO ; EP -- JOB Variables BReaKOut
- +1 DO JOBVBRKS
- +2 ;
- +3 SET PORT=$PIECE(PORT,"|",3)
- +4 IF $PIECE(PORT,"
- SET PORT=$PIECE(PORT,":",2)
- +5 ;
- +6 SET LOOKHERE="NO"
- +7 IF RTN="HLZTCP"
- SET LOOKHERE="YES"
- SET HLZTCPCNT=1+$GET(HLZTCPCNT)
- +8 QUIT
- +9 ;
- JOBVBRKS ; EP -- JOB Variables BReaKOut -- System variables
- +1 SET UCI=$$GETSYS("NameSpace")
- +2 SET IPADDR=$$GETSYS("ClientIPAddress")
- +3 SET PORT=$$GETSYS("CurrentDevice")
- +4 SET USERNAME=$$GETSYS("UserName")
- +5 SET USERNAME=$SELECT(USERNAME="SYSTEM":"",USERNAME=UCI:"",1:USERNAME)
- +6 QUIT
