BLRPST ;IHS/HQT/MJL - Show processor status ; 04-Apr-2016 14:28 ; MKK
;;5.2;IHS LABORATORY;**1011,1025,1027,1030,1031,1039**;NOV 01, 1997;Build 38
;
EP ; EP
NEW DATETIME ; IHS/OIT/MKK - LR*5.2*1030
;
D INIT
F D DSP Q:BLRF
D KILL
Q
;
DSP ;
S BLRX=$G(^BLRSITE(BLRSITE,0)) ;0 NODE
S BLRPDH=$P(BLRX,U,6) ;'START PROCESSING DATE'
S BLREDH=$P(BLRX,U,7) ;'START EVENT DATE'
S BLRLOG=$P(BLRX,U,2) ;'LAB LOG TRANSACTION'
S BLRPCC=$P(BLRX,U,3) ;'LAB LOG TO PCC'
S BLRSTOP=$P(BLRX,U,9) ;'STOP PROCESSOR'
S:'BLRPDH BLRPDH=+$H ;IF NULL WE'RE STARTING TODAY
S:'BLREDH BLREDH=+$H ;IF NULL WE'RE STARTING TODAY
;
;'PROCESSING DATE' INFORMATION
S BLRX=$G(^BLRSITE(BLRSITE,21,BLRPDH,0))
S BLRLTA=+$P(BLRX,U,2) ;'LAST TRANSACTION SEQ ASSIGNED'
S BLRLTP=+$P(BLRX,U,3) ;'LAST TRANSACTION SEQ PROCESSED'
;
;LAST TRANSACTION # ASSIGNED
S BLRLSQA=+$G(^BLRSITE(BLRSITE,21,BLRPDH,BLRLTA))
;
;LAST TRANSACTION # PROCESSED
S BLRLSQP=+$G(^BLRSITE(BLRSITE,21,BLRPDH,BLRLTP))
;
;GET THE 'EVENT DATE' INFO
S BLRX=$G(^BLRSITE(BLRSITE,20,BLREDH,0))
;
S BLRLEA=+$P(BLRX,U,2) ;LAST EVENT ASSIGNED
S BLRLEP=+$P(BLRX,U,3) ;LAST EVENT PROCESSED
;
S:BLRLTA-BLRLTP>1 BLRNSQP=+$G(^BLRSITE(BLRSITE,21,BLRPDH,BLRLTP+1))
;
S:'BLRLTA BLRLSQA=0
S:'BLRLTP BLRLSQP=0
;
I BLREDH'=BLRLEDH!(BLRPDH'=BLRLPDH) S %H=BLREDH D YX^%DTC S BLRED=Y S %H=BLRPDH D YX^%DTC S BLRPD=Y,BLRLEDH=BLREDH,BLRLPDH=BLRPDH
;
D
. ; I BLREDH=BLRPDH S BLRHDR="Currently processing day "_BLRPD,BLRHDR=$J("",75-$L(BLRHDR)/2)_BLRHDR Q
. ; S BLRHDR="Currently Processing "_BLRED,BLRHDR=BLRHDR_$J("",42-$L(BLRHDR))_BLRPD
. ; ----- BEGIN IHS/OIT/MKK - LR*5.2*1027
. ; Make the Header more Standard
. I BLREDH=BLRPDH S BLRHDR="Currently processing day "_BLRPD
. I BLREDH'=BLRPDH S BLRHDR="Currently Processing "_BLRED_" "_BLRPD
. ; ----- END IHS/OIT/MKK - LR*5.2*1027
;
D HDR
W !!,"Last Entry Assigned"
;W ?23,$J($FN(BLRLEA,","),10) ;'LAST EVENT ASSIGNED'
;W ?41,$J($FN(BLRLTA,","),10) ;'LAST TRANSACTION SEQ ASSIGNED'
;W ?64,$J($FN(BLRLSQA,","),10) ;LAST TRANSACTION # ASSIGNED
;
; ----- BEGIN IHS/OIT/MKK - LR*5.2*1030
W ?22,$J($FN(BLRLEA,","),11) ;'LAST EVENT ASSIGNED'
W ?35,$J($FN(BLRLTA,","),11) ;'LAST TRANSACTION SEQ ASSIGNED'
W ?50,$J($FN(BLRLSQA,","),11) ;LAST TRANSACTION # ASSIGNED
S DATETIME=$P($G(^BLRTXLOG(BLRLSQA,1)),"^",3)
W:$L(DATETIME) ?63,$TR($$FMTE^XLFDT(DATETIME,"5MZ"),"@"," ")
; ----- END IHS/OIT/MKK - LR*5.2*1030
;
W !!,"Last Entry Processed"
;W ?23,$J($FN(BLRLEP,","),10) ;'LAST EVENT PROCESSED'
;W ?41,$J($FN(BLRLTP,","),10) ;'LAST TRANSACTION SEQ ASSIGNED'
;W ?64,$J($FN(BLRLSQP,","),10) ;LAST TRANSACTION SEQ ASSIGNED'
;
; ----- BEGIN IHS/OIT/MKK - LR*5.2*1030
W ?22,$J($FN(BLRLEP,","),11) ;'LAST EVENT PROCESSED'
W ?35,$J($FN(BLRLTP,","),11) ;'LAST TRANSACTION SEQ ASSIGNED'
W ?50,$J($FN(BLRLSQP,","),11) ;LAST TRANSACTION SEQ ASSIGNED'
S DATETIME=$P($G(^BLRTXLOG(BLRLSQP,1)),"^",3)
W:$L(DATETIME) ?63,$TR($$FMTE^XLFDT(DATETIME,"5MZ"),"@"," ")
; ----- END IHS/OIT/MKK - LR*5.2*1030
;
D:BLRLEA-BLRLEP>1!(BLRLTA-BLRLTP>1)
. W !!,"Now Processing Entry"
. ;W:BLRLEA-BLRLEP>1 ?23,$J($FN(BLRLEP+1,","),10) ;
. ;W:BLRLTA-BLRLTP>1 ?41,$J($FN(BLRLTP+1,","),10),?64,$J($FN(BLRNSQP,","),10)
. ; ----- BEGIN IHS/OIT/MKK - LR*5.2*1030
. W:BLRLEA-BLRLEP>1 ?22,$J($FN(BLRLEP+1,","),11)
. I BLRLTA-BLRLTP>1 D
.. W ?35,$J($FN(BLRLTP+1,","),11)
.. ; W ?50,$J($FN(BLRNSQP,","),10)
.. W ?50,$J($FN(BLRNSQP,","),11) ; IHS/MSC/MKK - LR*5.2*1031
.. S DATETIME=$P($G(^BLRTXLOG(BLRLSQP,1)),"^",3)
.. W:$L(DATETIME) ?63,$TR($$FMTE^XLFDT(DATETIME,"5MZ"),"@"," ")
. ; ----- END IHS/OIT/MKK - LR*5.2*1030
;
L +^BLRLOCK:0 I $T S BLRF=1
; I BLRF!'BLRLOG!'BLRPCC D
; ----- BEGIN IHS/OIT/MKK -- LR*5.2*1025 MODIFICATION -- Allow BLRSTOP Message
I BLRF!BLRSTOP!'BLRLOG!'BLRPCC D
.; ----- END IHS/OIT/MKK -- LR*5.2*1025 MODIFICATION
.I 'BLRLOG W !! W:BLRF "Processor is not running due to 'LAB LOG TRANSACTION' is off"
.E I 'BLRPCC W !! W:BLRF "Processor is not running. The 'LAB LOG TO PCC' is off" ;D W "!"
.I BLRSTOP W !," -- Halted by user" Q
;.I 'BLRLOG!'BLRPCC W:BLRF " -- " D W " disabled"
;..W:'BLRLOG "Lab Log"
;..Q:BLRPCC
;..W:'BLRLOG " and "
;..W "Update PCC"
L -^BLRLOCK
I $G(BLRNPMT) Q
; I BLRF R !!,"Press Enter to exit: ",BLR:DTIME,! W ! Q
; R !!,"Press Enter to continue: ",BLR:5,! S BLRF=$T S BLRCNT=$S(BLRF:0,1:BLRCNT+1),BLRF=$S(BLR="^":1,1:BLRCNT=(DTIME\5))
;
; ------- BEGIN IHS/MSC/MKK - LR*5.2*1031
I BLRF D Q
. D ^XBFMK
. S DIR(0)="FO"
. S DIR("A")="Press Enter to exit"
. S DIR("T")=5
. D ^DIR
. W !
D ^XBFMK
S DIR(0)="FO"
S DIR("A")="Press Enter to continue"
S DIR("T")=5
D ^DIR
S BLR=$G(X)
S BLRF=$T
S BLRCNT=$S(BLRF:0,1:BLRCNT+1)
S BLRF=$S($G(BLR)="^":1,1:BLRCNT=(DTIME\5))
; ----- END IHS/MSC/MKK - LR*5.2*1031
;
Q
;
INIT ; EP
S U="^",BLRF=0,BLRLN="",$P(BLRLN,"-",81)="",BLRCNT=0
S BLRSITE=$P($G(^AUTTSITE(1,0)),U),(BLRLEDH,BLRLPDH)=""
I '$D(IOF) S IOP="HOME" D ^%ZIS K IOP
Q
;
HDR ;
D NOW^%DTC S Y=%,%DT="S" D DD^%DT S BLRDTM=Y
; W @IOF,?33,"Processor Status",!,$J("",75-$L(BLRDTM)/2),Y
; W !!,BLRHDR
; ----- BEGIN IHS/OIT/MKK - LR*5.2*1027
; Make the Header more Standard
W @IOF
W $$CJ^XLFSTR($$LOC^XBFUNC,IOM),! ; Location
W $$CJ^XLFSTR("Processor Status",IOM),!
W $$CJ^XLFSTR($$UP^XLFSTR($$HTE^XLFDT($H)),IOM),!!
W $$CJ^XLFSTR(BLRHDR,IOM)
; ----- END IHS/OIT/MKK - LR*5.2*1027
; W !!,?40,"Entry Position",?59,"IHS Lab Transaction"
; W !,?28,"Event",?43,"in Queue",?61,"Sequence Number",!,BLRLN
;
; ----- BEGIN IHS/OIT/MKK - LR*5.2*1030
; Add New column -- Date/Time of Transaction
; Have to re-arrange all columns
W !!
W ?38,"Entry #"
W ?50,"==== IHS Lab Transaction ===="
W !
W ?28,"Event"
W ?38,"in Queue"
W ?51,"Sequence #"
W ?65,"Date"
W ?74,"Time"
W !,BLRLN
; ----- END IHS/OIT/MKK - LR*5.2*1030
;
Q
;IF NUMBER OF BLR ERRORS IN ^%ZTER IS GREATER THAN
;THE NUMBER SET IN 'ERROR OVERFLOW LIMIT' IN BLR MASTER CONTROL FILE
;IF GREATER THAN DISPLAY ALRM ON SCREEN AND STOP THE BLR PROCESSOR
ALERT ; EP
S X="IORVON;IORVOFF;IOBON;IOBOFF"
D ENDR^%ZISS
W !,IORVON,"THERE IS SOMETHNG WRONG WITH THE PCC LINK!"
W !,"TOO MANY ERRORS HAVE BEEN FOUND IN THE ERROR LOG!"
W !,IOBON,"THE PCC LINK IS BEING TURNED OFF!!",IOBOFF
W !,IORVON,"CALL YOUR SITE MANAGER IMMEDIATELY!",IORVOFF
;
; ----- BEGIN IHS/OIT/MKK - LR*5.2*1030
; Send Alert to LMI Mail Group
D SNDALERT("Too many BLR Errors have been found. PCC Link has been turned off.")
; ----- END IHS/OIT/MKK - LR*5.2*1030
;
Q
;
KILL ; EP
K %,%DT,%H,%I,BLR,BLRCNT,BLRLEDH,BLRLPDH,BLREDH,BLRPDH,BLRDTM,BLRF,BLRHDR,BLRLN,BLRLSQA,BLRLSQP,BLRNSQP,BLRLEA,BLRLEP,BLRLTA,BLRLTP,BLRPCC,BLRED,BLRPD,BLRSITE,BLRSTOP,BLRX,X,Y
Q
;
ENT ; EP
D INIT,DSP,KILL
Q
;
; ----- BEGIN IHS/OIT/MKK - LR*5.2*1030
SNDALERT(ALERTMSG) ; EP - Send alert to LMI group AND User
; Per Kernel Developer's Guide, NEW all Alert variables
NEW XQA,XQAARCH,XQACNDEL,XQADATA,XQAFLG,XQAGUID,XQAID,XQAMSG,XQAOPT
NEW XQAREVUE,XQAROU,XQASUPV,XQASURO,XQATEXT
;
S XQAMSG=ALERTMSG
S XQA("G.LMI")=""
;
; If user not part of LMI Mail Group, send them alert also
S:$$NINLMI(DUZ) XQA(DUZ)=""
;
S X=$$SETUP1^XQALERT
Q:X
;
; Alert not sent successfully. Try to store it.
NEW SUBSCRPT
S SUBSCRPT="BLRPST Alert^"_+$H_"^"_$J
; S ^XTEMP(SUBSCRPT,0)=$$FMADD^XLFDT($$DT^XLFDT,90)_"^"_$$DT^XLFDT_"^"_"PCC Linker shut down Alert."
; S ^XTEMP(SUBSCRPT,1)="PCC Linker Alert was not sent."
; S ^XTEMP(SUBSCRPT,2)=" Message that should have been sent follows:"
; S ^XTEMP(SUBSCRPT,3)=" "_ALERTMSG
; S ^XTEMP(SUBSCRPT,4)=" ALERT Error Message Follows:"
; S ^XTEMP(SUBSCRPT,5)=" "_XQALERR
;
; ----- BEGIN IHS/MSC/MKK - LR*5.2*1039 - Use ^XTMP not ^XTEMP per SAC
S ^XTMP(SUBSCRPT,0)=$$FMADD^XLFDT($$DT^XLFDT,90)_"^"_$$DT^XLFDT_"^"_"PCC Linker shut down Alert."
S ^XTMP(SUBSCRPT,1)="PCC Linker Alert was not sent."
S ^XTMP(SUBSCRPT,2)=" Message that should have been sent follows:"
S ^XTMP(SUBSCRPT,3)=" "_ALERTMSG
S ^XTMP(SUBSCRPT,4)=" ALERT Error Message Follows:"
S ^XTMP(SUBSCRPT,5)=" "_XQALERR
; ----- END IHS/MSC/MKK - LR*5.2*1039
Q
;
NINLMI(CHKDUZ) ; EP -- Check to see if DUZ is NOT part of LMI Mail Group
NEW MGRPIEN,XMDUZ
;
; 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) ; Reverse Logic
; ----- END IHS/OIT/MKK - LR*5.2*1030
BLRPST ;IHS/HQT/MJL - Show processor status ; 04-Apr-2016 14:28 ; MKK
+1 ;;5.2;IHS LABORATORY;**1011,1025,1027,1030,1031,1039**;NOV 01, 1997;Build 38
+2 ;
EP ; EP
+1 ; IHS/OIT/MKK - LR*5.2*1030
NEW DATETIME
+2 ;
+3 DO INIT
+4 FOR
DO DSP
IF BLRF
QUIT
+5 DO KILL
+6 QUIT
+7 ;
DSP ;
+1 ;0 NODE
SET BLRX=$GET(^BLRSITE(BLRSITE,0))
+2 ;'START PROCESSING DATE'
SET BLRPDH=$PIECE(BLRX,U,6)
+3 ;'START EVENT DATE'
SET BLREDH=$PIECE(BLRX,U,7)
+4 ;'LAB LOG TRANSACTION'
SET BLRLOG=$PIECE(BLRX,U,2)
+5 ;'LAB LOG TO PCC'
SET BLRPCC=$PIECE(BLRX,U,3)
+6 ;'STOP PROCESSOR'
SET BLRSTOP=$PIECE(BLRX,U,9)
+7 ;IF NULL WE'RE STARTING TODAY
IF 'BLRPDH
SET BLRPDH=+$HOROLOG
+8 ;IF NULL WE'RE STARTING TODAY
IF 'BLREDH
SET BLREDH=+$HOROLOG
+9 ;
+10 ;'PROCESSING DATE' INFORMATION
+11 SET BLRX=$GET(^BLRSITE(BLRSITE,21,BLRPDH,0))
+12 ;'LAST TRANSACTION SEQ ASSIGNED'
SET BLRLTA=+$PIECE(BLRX,U,2)
+13 ;'LAST TRANSACTION SEQ PROCESSED'
SET BLRLTP=+$PIECE(BLRX,U,3)
+14 ;
+15 ;LAST TRANSACTION # ASSIGNED
+16 SET BLRLSQA=+$GET(^BLRSITE(BLRSITE,21,BLRPDH,BLRLTA))
+17 ;
+18 ;LAST TRANSACTION # PROCESSED
+19 SET BLRLSQP=+$GET(^BLRSITE(BLRSITE,21,BLRPDH,BLRLTP))
+20 ;
+21 ;GET THE 'EVENT DATE' INFO
+22 SET BLRX=$GET(^BLRSITE(BLRSITE,20,BLREDH,0))
+23 ;
+24 ;LAST EVENT ASSIGNED
SET BLRLEA=+$PIECE(BLRX,U,2)
+25 ;LAST EVENT PROCESSED
SET BLRLEP=+$PIECE(BLRX,U,3)
+26 ;
+27 IF BLRLTA-BLRLTP>1
SET BLRNSQP=+$GET(^BLRSITE(BLRSITE,21,BLRPDH,BLRLTP+1))
+28 ;
+29 IF 'BLRLTA
SET BLRLSQA=0
+30 IF 'BLRLTP
SET BLRLSQP=0
+31 ;
+32 IF BLREDH'=BLRLEDH!(BLRPDH'=BLRLPDH)
SET %H=BLREDH
DO YX^%DTC
SET BLRED=Y
SET %H=BLRPDH
DO YX^%DTC
SET BLRPD=Y
SET BLRLEDH=BLREDH
SET BLRLPDH=BLRPDH
+33 ;
+34 Begin DoDot:1
+35 ; I BLREDH=BLRPDH S BLRHDR="Currently processing day "_BLRPD,BLRHDR=$J("",75-$L(BLRHDR)/2)_BLRHDR Q
+36 ; S BLRHDR="Currently Processing "_BLRED,BLRHDR=BLRHDR_$J("",42-$L(BLRHDR))_BLRPD
+37 ; ----- BEGIN IHS/OIT/MKK - LR*5.2*1027
+38 ; Make the Header more Standard
+39 IF BLREDH=BLRPDH
SET BLRHDR="Currently processing day "_BLRPD
+40 IF BLREDH'=BLRPDH
SET BLRHDR="Currently Processing "_BLRED_" "_BLRPD
+41 ; ----- END IHS/OIT/MKK - LR*5.2*1027
End DoDot:1
+42 ;
+43 DO HDR
+44 WRITE !!,"Last Entry Assigned"
+45 ;W ?23,$J($FN(BLRLEA,","),10) ;'LAST EVENT ASSIGNED'
+46 ;W ?41,$J($FN(BLRLTA,","),10) ;'LAST TRANSACTION SEQ ASSIGNED'
+47 ;W ?64,$J($FN(BLRLSQA,","),10) ;LAST TRANSACTION # ASSIGNED
+48 ;
+49 ; ----- BEGIN IHS/OIT/MKK - LR*5.2*1030
+50 ;'LAST EVENT ASSIGNED'
WRITE ?22,$JUSTIFY($FNUMBER(BLRLEA,","),11)
+51 ;'LAST TRANSACTION SEQ ASSIGNED'
WRITE ?35,$JUSTIFY($FNUMBER(BLRLTA,","),11)
+52 ;LAST TRANSACTION # ASSIGNED
WRITE ?50,$JUSTIFY($FNUMBER(BLRLSQA,","),11)
+53 SET DATETIME=$PIECE($GET(^BLRTXLOG(BLRLSQA,1)),"^",3)
+54 IF $LENGTH(DATETIME)
WRITE ?63,$TRANSLATE($$FMTE^XLFDT(DATETIME,"5MZ"),"@"," ")
+55 ; ----- END IHS/OIT/MKK - LR*5.2*1030
+56 ;
+57 WRITE !!,"Last Entry Processed"
+58 ;W ?23,$J($FN(BLRLEP,","),10) ;'LAST EVENT PROCESSED'
+59 ;W ?41,$J($FN(BLRLTP,","),10) ;'LAST TRANSACTION SEQ ASSIGNED'
+60 ;W ?64,$J($FN(BLRLSQP,","),10) ;LAST TRANSACTION SEQ ASSIGNED'
+61 ;
+62 ; ----- BEGIN IHS/OIT/MKK - LR*5.2*1030
+63 ;'LAST EVENT PROCESSED'
WRITE ?22,$JUSTIFY($FNUMBER(BLRLEP,","),11)
+64 ;'LAST TRANSACTION SEQ ASSIGNED'
WRITE ?35,$JUSTIFY($FNUMBER(BLRLTP,","),11)
+65 ;LAST TRANSACTION SEQ ASSIGNED'
WRITE ?50,$JUSTIFY($FNUMBER(BLRLSQP,","),11)
+66 SET DATETIME=$PIECE($GET(^BLRTXLOG(BLRLSQP,1)),"^",3)
+67 IF $LENGTH(DATETIME)
WRITE ?63,$TRANSLATE($$FMTE^XLFDT(DATETIME,"5MZ"),"@"," ")
+68 ; ----- END IHS/OIT/MKK - LR*5.2*1030
+69 ;
+70 IF BLRLEA-BLRLEP>1!(BLRLTA-BLRLTP>1)
Begin DoDot:1
+71 WRITE !!,"Now Processing Entry"
+72 ;W:BLRLEA-BLRLEP>1 ?23,$J($FN(BLRLEP+1,","),10) ;
+73 ;W:BLRLTA-BLRLTP>1 ?41,$J($FN(BLRLTP+1,","),10),?64,$J($FN(BLRNSQP,","),10)
+74 ; ----- BEGIN IHS/OIT/MKK - LR*5.2*1030
+75 IF BLRLEA-BLRLEP>1
WRITE ?22,$JUSTIFY($FNUMBER(BLRLEP+1,","),11)
+76 IF BLRLTA-BLRLTP>1
Begin DoDot:2
+77 WRITE ?35,$JUSTIFY($FNUMBER(BLRLTP+1,","),11)
+78 ; W ?50,$J($FN(BLRNSQP,","),10)
+79 ; IHS/MSC/MKK - LR*5.2*1031
WRITE ?50,$JUSTIFY($FNUMBER(BLRNSQP,","),11)
+80 SET DATETIME=$PIECE($GET(^BLRTXLOG(BLRLSQP,1)),"^",3)
+81 IF $LENGTH(DATETIME)
WRITE ?63,$TRANSLATE($$FMTE^XLFDT(DATETIME,"5MZ"),"@"," ")
End DoDot:2
+82 ; ----- END IHS/OIT/MKK - LR*5.2*1030
End DoDot:1
+83 ;
+84 LOCK +^BLRLOCK:0
IF $TEST
SET BLRF=1
+85 ; I BLRF!'BLRLOG!'BLRPCC D
+86 ; ----- BEGIN IHS/OIT/MKK -- LR*5.2*1025 MODIFICATION -- Allow BLRSTOP Message
+87 IF BLRF!BLRSTOP!'BLRLOG!'BLRPCC
Begin DoDot:1
+88 ; ----- END IHS/OIT/MKK -- LR*5.2*1025 MODIFICATION
+89 IF 'BLRLOG
WRITE !!
IF BLRF
WRITE "Processor is not running due to 'LAB LOG TRANSACTION' is off"
+90 ;D W "!"
IF '$TEST
IF 'BLRPCC
WRITE !!
IF BLRF
WRITE "Processor is not running. The 'LAB LOG TO PCC' is off"
+91 IF BLRSTOP
WRITE !," -- Halted by user"
QUIT
End DoDot:1
+92 ;.I 'BLRLOG!'BLRPCC W:BLRF " -- " D W " disabled"
+93 ;..W:'BLRLOG "Lab Log"
+94 ;..Q:BLRPCC
+95 ;..W:'BLRLOG " and "
+96 ;..W "Update PCC"
+97 LOCK -^BLRLOCK
+98 IF $GET(BLRNPMT)
QUIT
+99 ; I BLRF R !!,"Press Enter to exit: ",BLR:DTIME,! W ! Q
+100 ; R !!,"Press Enter to continue: ",BLR:5,! S BLRF=$T S BLRCNT=$S(BLRF:0,1:BLRCNT+1),BLRF=$S(BLR="^":1,1:BLRCNT=(DTIME\5))
+101 ;
+102 ; ------- BEGIN IHS/MSC/MKK - LR*5.2*1031
+103 IF BLRF
Begin DoDot:1
+104 DO ^XBFMK
+105 SET DIR(0)="FO"
+106 SET DIR("A")="Press Enter to exit"
+107 SET DIR("T")=5
+108 DO ^DIR
+109 WRITE !
End DoDot:1
QUIT
+110 DO ^XBFMK
+111 SET DIR(0)="FO"
+112 SET DIR("A")="Press Enter to continue"
+113 SET DIR("T")=5
+114 DO ^DIR
+115 SET BLR=$GET(X)
+116 SET BLRF=$TEST
+117 SET BLRCNT=$SELECT(BLRF:0,1:BLRCNT+1)
+118 SET BLRF=$SELECT($GET(BLR)="^":1,1:BLRCNT=(DTIME\5))
+119 ; ----- END IHS/MSC/MKK - LR*5.2*1031
+120 ;
+121 QUIT
+122 ;
INIT ; EP
+1 SET U="^"
SET BLRF=0
SET BLRLN=""
SET $PIECE(BLRLN,"-",81)=""
SET BLRCNT=0
+2 SET BLRSITE=$PIECE($GET(^AUTTSITE(1,0)),U)
SET (BLRLEDH,BLRLPDH)=""
+3 IF '$DATA(IOF)
SET IOP="HOME"
DO ^%ZIS
KILL IOP
+4 QUIT
+5 ;
HDR ;
+1 DO NOW^%DTC
SET Y=%
SET %DT="S"
DO DD^%DT
SET BLRDTM=Y
+2 ; W @IOF,?33,"Processor Status",!,$J("",75-$L(BLRDTM)/2),Y
+3 ; W !!,BLRHDR
+4 ; ----- BEGIN IHS/OIT/MKK - LR*5.2*1027
+5 ; Make the Header more Standard
+6 WRITE @IOF
+7 ; Location
WRITE $$CJ^XLFSTR($$LOC^XBFUNC,IOM),!
+8 WRITE $$CJ^XLFSTR("Processor Status",IOM),!
+9 WRITE $$CJ^XLFSTR($$UP^XLFSTR($$HTE^XLFDT($HOROLOG)),IOM),!!
+10 WRITE $$CJ^XLFSTR(BLRHDR,IOM)
+11 ; ----- END IHS/OIT/MKK - LR*5.2*1027
+12 ; W !!,?40,"Entry Position",?59,"IHS Lab Transaction"
+13 ; W !,?28,"Event",?43,"in Queue",?61,"Sequence Number",!,BLRLN
+14 ;
+15 ; ----- BEGIN IHS/OIT/MKK - LR*5.2*1030
+16 ; Add New column -- Date/Time of Transaction
+17 ; Have to re-arrange all columns
+18 WRITE !!
+19 WRITE ?38,"Entry #"
+20 WRITE ?50,"==== IHS Lab Transaction ===="
+21 WRITE !
+22 WRITE ?28,"Event"
+23 WRITE ?38,"in Queue"
+24 WRITE ?51,"Sequence #"
+25 WRITE ?65,"Date"
+26 WRITE ?74,"Time"
+27 WRITE !,BLRLN
+28 ; ----- END IHS/OIT/MKK - LR*5.2*1030
+29 ;
+30 QUIT
+31 ;IF NUMBER OF BLR ERRORS IN ^%ZTER IS GREATER THAN
+32 ;THE NUMBER SET IN 'ERROR OVERFLOW LIMIT' IN BLR MASTER CONTROL FILE
+33 ;IF GREATER THAN DISPLAY ALRM ON SCREEN AND STOP THE BLR PROCESSOR
ALERT ; EP
+1 SET X="IORVON;IORVOFF;IOBON;IOBOFF"
+2 DO ENDR^%ZISS
+3 WRITE !,IORVON,"THERE IS SOMETHNG WRONG WITH THE PCC LINK!"
+4 WRITE !,"TOO MANY ERRORS HAVE BEEN FOUND IN THE ERROR LOG!"
+5 WRITE !,IOBON,"THE PCC LINK IS BEING TURNED OFF!!",IOBOFF
+6 WRITE !,IORVON,"CALL YOUR SITE MANAGER IMMEDIATELY!",IORVOFF
+7 ;
+8 ; ----- BEGIN IHS/OIT/MKK - LR*5.2*1030
+9 ; Send Alert to LMI Mail Group
+10 DO SNDALERT("Too many BLR Errors have been found. PCC Link has been turned off.")
+11 ; ----- END IHS/OIT/MKK - LR*5.2*1030
+12 ;
+13 QUIT
+14 ;
KILL ; EP
+1 KILL %,%DT,%H,%I,BLR,BLRCNT,BLRLEDH,BLRLPDH,BLREDH,BLRPDH,BLRDTM,BLRF,BLRHDR,BLRLN,BLRLSQA,BLRLSQP,BLRNSQP,BLRLEA,BLRLEP,BLRLTA,BLRLTP,BLRPCC,BLRED,BLRPD,BLRSITE,BLRSTOP,BLRX,X,Y
+2 QUIT
+3 ;
ENT ; EP
+1 DO INIT
DO DSP
DO KILL
+2 QUIT
+3 ;
+4 ; ----- BEGIN IHS/OIT/MKK - LR*5.2*1030
SNDALERT(ALERTMSG) ; EP - Send alert to LMI group AND User
+1 ; Per Kernel Developer's Guide, NEW all Alert variables
+2 NEW XQA,XQAARCH,XQACNDEL,XQADATA,XQAFLG,XQAGUID,XQAID,XQAMSG,XQAOPT
+3 NEW XQAREVUE,XQAROU,XQASUPV,XQASURO,XQATEXT
+4 ;
+5 SET XQAMSG=ALERTMSG
+6 SET XQA("G.LMI")=""
+7 ;
+8 ; If user not part of LMI Mail Group, send them alert also
+9 IF $$NINLMI(DUZ)
SET XQA(DUZ)=""
+10 ;
+11 SET X=$$SETUP1^XQALERT
+12 IF X
QUIT
+13 ;
+14 ; Alert not sent successfully. Try to store it.
+15 NEW SUBSCRPT
+16 SET SUBSCRPT="BLRPST Alert^"_+$HOROLOG_"^"_$JOB
+17 ; S ^XTEMP(SUBSCRPT,0)=$$FMADD^XLFDT($$DT^XLFDT,90)_"^"_$$DT^XLFDT_"^"_"PCC Linker shut down Alert."
+18 ; S ^XTEMP(SUBSCRPT,1)="PCC Linker Alert was not sent."
+19 ; S ^XTEMP(SUBSCRPT,2)=" Message that should have been sent follows:"
+20 ; S ^XTEMP(SUBSCRPT,3)=" "_ALERTMSG
+21 ; S ^XTEMP(SUBSCRPT,4)=" ALERT Error Message Follows:"
+22 ; S ^XTEMP(SUBSCRPT,5)=" "_XQALERR
+23 ;
+24 ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1039 - Use ^XTMP not ^XTEMP per SAC
+25 SET ^XTMP(SUBSCRPT,0)=$$FMADD^XLFDT($$DT^XLFDT,90)_"^"_$$DT^XLFDT_"^"_"PCC Linker shut down Alert."
+26 SET ^XTMP(SUBSCRPT,1)="PCC Linker Alert was not sent."
+27 SET ^XTMP(SUBSCRPT,2)=" Message that should have been sent follows:"
+28 SET ^XTMP(SUBSCRPT,3)=" "_ALERTMSG
+29 SET ^XTMP(SUBSCRPT,4)=" ALERT Error Message Follows:"
+30 SET ^XTMP(SUBSCRPT,5)=" "_XQALERR
+31 ; ----- END IHS/MSC/MKK - LR*5.2*1039
+32 QUIT
+33 ;
NINLMI(CHKDUZ) ; EP -- Check to see if DUZ is NOT part of LMI Mail Group
+1 NEW MGRPIEN,XMDUZ
+2 ;
+3 ; Get IEN of LMI MaiL Group
+4 ; VA DBIA 1146
DO CHKGROUP^XMBGRP("LMI",.MGRPIEN)
+5 ; If no Mail Group, return TRUE
IF +(MGRPIEN)<1
QUIT 1
+6 ;
+7 ; XMDUZ = DUZ of the user
+8 ; Y = IEN of the mail group
+9 SET XMDUZ=DUZ
+10 SET Y=MGRPIEN
+11 ; VA DBIA 10067
DO CHK^XMA21
+12 ;
+13 ; Reverse Logic
QUIT $SELECT($TEST=1:0,1:1)
+14 ; ----- END IHS/OIT/MKK - LR*5.2*1030
