BLRPST ; IHS/HQT/MJL - Show processor status ; [ 08/01/2002 7:58 AM ]
;;5.2;LR;**1011**;MAY 01, 2001
;
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))
;
S BLREPHAS=$P($G(^BLRSITE(BLRSITE,20,1,BLRPDH,0)),U,2)
S BLREOPTN=$P($G(^BLRSITE(BLRSITE,20,1,BLRPDH,0)),U,3)
;
;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
.;
.S %H=BLREDH D YX^%DTC S CURPRDT=Y
.S SUBTITLE="Currently Processing events from "_$G(CURPRDT)
.W !!,$J("",$G(IOM)-$L(SUBTITLE)/2),SUBTITLE Q
;
D HDR
W !!,"Last Event # 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 (#9009022)
;
W !!,"Last Event # 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 # ASSIGNED' (#9009022)
;
;
D:BLRLEA-BLRLEP>1!(BLRLTA-BLRLTP>1)
.W !!,"Now Processing Event #"
.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)
.W:BLRLEA-BLRLEP>1 !!?23,$G(BLREPHAS),?31,$G(BLREOPTN)
;
L +^BLRLOCK:0 I $T S BLRF=1
I BLRF!'BLRLOG!'BLRPCC D
.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
L -^BLRLOCK
I $G(BLRNPMT) Q
I BLRF R !!,"Press Enter to exit: ",BLR:DTIME,! 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))
;
Q
;
INIT ;
S U="^",BLRF=0,BLRLN="",$P(BLRLN,"-",81)="",BLRCNT=0
S BLRSITE=$P($G(^AUTTSITE(1,0)),U)
S:BLRSITE="" BLRSITE="UNKNOWN"
S (BLRLEDH,BLRLPDH)=""
S BLRSNAME=$P($G(^AUTTLOC(BLRSITE,0)),U,2)
S:BLRSNAME="" BLRNAME="UNKNOWN SITE"
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
S TITLE="Processor Status (Test)"
W $J("",$G(IOM)-$L(TITLE)/2),TITLE,!,$J("",$G(IOM)-$L(BLRDTM)/2),Y
;W !!,$G(BLRHDR)
W !!,$G(SUBTITLE)
;
;"Event # of the day" refers to the 5th subscript in node 20
;^BLRSITE(1575,20,58714,1,1,0)="M^R^^^HE 0924 5^1575^746"
;"Entry Position in Queue" refers to the 4th subscript in node 21
;^BLRSITE(1575,21,58714,1)="9552"
;
W !!,?43,"Position",?59,"IHS Lab Transaction"
W !,?28,"Event",?43,"in",?61,"Sequence Number"
W !,?28,"# of",?43,"Transaction",?63,"Assigned"
W !,?28,$G(CURPRDT),?43,"Queue"
W !,$G(BLRLN)
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 ;
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
Q
;
KILL ;
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 ;
D INIT,DSP,KILL
Q
BLRPST ; IHS/HQT/MJL - Show processor status ; [ 08/01/2002 7:58 AM ]
+1 ;;5.2;LR;**1011**;MAY 01, 2001
+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 SET BLREPHAS=$PIECE($GET(^BLRSITE(BLRSITE,20,1,BLRPDH,0)),U,2)
+22 SET BLREOPTN=$PIECE($GET(^BLRSITE(BLRSITE,20,1,BLRPDH,0)),U,3)
+23 ;
+24 ;GET THE 'EVENT DATE' INFO
+25 SET BLRX=$GET(^BLRSITE(BLRSITE,20,BLREDH,0))
+26 ;
+27 ;LAST EVENT ASSIGNED
SET BLRLEA=+$PIECE(BLRX,U,2)
+28 ;LAST EVENT PROCESSED
SET BLRLEP=+$PIECE(BLRX,U,3)
+29 ;
+30 IF BLRLTA-BLRLTP>1
SET BLRNSQP=+$GET(^BLRSITE(BLRSITE,21,BLRPDH,BLRLTP+1))
+31 ;
+32 IF 'BLRLTA
SET BLRLSQA=0
+33 IF 'BLRLTP
SET BLRLSQP=0
+34 ;
+35 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
+36 ;
+37 Begin DoDot:1
+38 ;I BLREDH=BLRPDH S BLRHDR="Currently processing day "_BLRPD,BLRHDR=$J("",75-$L(BLRHDR)/2)_BLRHDR Q
+39 ;S BLRHDR="Currently Processing "_BLRED,BLRHDR=BLRHDR_$J("",42-$L(BLRHDR))_BLRPD
+40 ;
+41 SET %H=BLREDH
DO YX^%DTC
SET CURPRDT=Y
+42 SET SUBTITLE="Currently Processing events from "_$GET(CURPRDT)
+43 WRITE !!,$JUSTIFY("",$GET(IOM)-$LENGTH(SUBTITLE)/2),SUBTITLE
QUIT
End DoDot:1
+44 ;
+45 DO HDR
+46 WRITE !!,"Last Event # Assigned"
+47 ;'LAST EVENT ASSIGNED'
WRITE ?23,$JUSTIFY($FNUMBER(BLRLEA,","),10)
+48 ;'LAST TRANSACTION SEQ ASSIGNED'
WRITE ?41,$JUSTIFY($FNUMBER(BLRLTA,","),10)
+49 ;LAST TRANSACTION # ASSIGNED (#9009022)
WRITE ?64,$JUSTIFY($FNUMBER(BLRLSQA,","),10)
+50 ;
+51 WRITE !!,"Last Event # Processed"
+52 ;'LAST EVENT PROCESSED'
WRITE ?23,$JUSTIFY($FNUMBER(BLRLEP,","),10)
+53 ;'LAST TRANSACTION SEQ ASSIGNED'
WRITE ?41,$JUSTIFY($FNUMBER(BLRLTP,","),10)
+54 ;LAST TRANSACTION # ASSIGNED' (#9009022)
WRITE ?64,$JUSTIFY($FNUMBER(BLRLSQP,","),10)
+55 ;
+56 ;
+57 IF BLRLEA-BLRLEP>1!(BLRLTA-BLRLTP>1)
Begin DoDot:1
+58 WRITE !!,"Now Processing Event #"
+59 ;
IF BLRLEA-BLRLEP>1
WRITE ?23,$JUSTIFY($FNUMBER(BLRLEP+1,","),10)
+60 IF BLRLTA-BLRLTP>1
WRITE ?41,$JUSTIFY($FNUMBER(BLRLTP+1,","),10),?64,$JUSTIFY($FNUMBER(BLRNSQP,","),10)
+61 IF BLRLEA-BLRLEP>1
WRITE !!?23,$GET(BLREPHAS),?31,$GET(BLREOPTN)
End DoDot:1
+62 ;
+63 LOCK +^BLRLOCK:0
IF $TEST
SET BLRF=1
+64 IF BLRF!'BLRLOG!'BLRPCC
Begin DoDot:1
+65 IF 'BLRLOG
WRITE !!
IF BLRF
WRITE "Processor is not running due to 'LAB LOG TRANSACTION' is off"
+66 ;D W "!"
IF '$TEST
IF 'BLRPCC
WRITE !!
IF BLRF
WRITE "Processor is not running. The 'LAB LOG TO PCC' is off"
+67 IF BLRSTOP
WRITE " -- Halted by user"
QUIT
End DoDot:1
+68 LOCK -^BLRLOCK
+69 IF $GET(BLRNPMT)
QUIT
+70 IF BLRF
READ !!,"Press Enter to exit: ",BLR:DTIME,!
QUIT
+71 READ !!,"Press Enter to continue: ",BLR:5,!
SET BLRF=$TEST
SET BLRCNT=$SELECT(BLRF:0,1:BLRCNT+1)
SET BLRF=$SELECT(BLR="^":1,1:BLRCNT=(DTIME\5))
+72 ;
+73 QUIT
+74 ;
INIT ;
+1 SET U="^"
SET BLRF=0
SET BLRLN=""
SET $PIECE(BLRLN,"-",81)=""
SET BLRCNT=0
+2 SET BLRSITE=$PIECE($GET(^AUTTSITE(1,0)),U)
+3 IF BLRSITE=""
SET BLRSITE="UNKNOWN"
+4 SET (BLRLEDH,BLRLPDH)=""
+5 SET BLRSNAME=$PIECE($GET(^AUTTLOC(BLRSITE,0)),U,2)
+6 IF BLRSNAME=""
SET BLRNAME="UNKNOWN SITE"
+7 IF '$DATA(IOF)
SET IOP="HOME"
DO ^%ZIS
KILL IOP
+8 QUIT
+9 ;
HDR ;
+1 DO NOW^%DTC
SET Y=%
SET %DT="S"
DO DD^%DT
SET BLRDTM=Y
+2 WRITE @IOF
+3 SET TITLE="Processor Status (Test)"
+4 WRITE $JUSTIFY("",$GET(IOM)-$LENGTH(TITLE)/2),TITLE,!,$JUSTIFY("",$GET(IOM)-$LENGTH(BLRDTM)/2),Y
+5 ;W !!,$G(BLRHDR)
+6 WRITE !!,$GET(SUBTITLE)
+7 ;
+8 ;"Event # of the day" refers to the 5th subscript in node 20
+9 ;^BLRSITE(1575,20,58714,1,1,0)="M^R^^^HE 0924 5^1575^746"
+10 ;"Entry Position in Queue" refers to the 4th subscript in node 21
+11 ;^BLRSITE(1575,21,58714,1)="9552"
+12 ;
+13 WRITE !!,?43,"Position",?59,"IHS Lab Transaction"
+14 WRITE !,?28,"Event",?43,"in",?61,"Sequence Number"
+15 WRITE !,?28,"# of",?43,"Transaction",?63,"Assigned"
+16 WRITE !,?28,$GET(CURPRDT),?43,"Queue"
+17 WRITE !,$GET(BLRLN)
+18 QUIT
+19 ;IF NUMBER OF BLR ERRORS IN ^%ZTER IS GREATER THAN
+20 ;THE NUMBER SET IN 'ERROR OVERFLOW LIMIT' IN BLR MASTER CONTROL FILE
+21 ;IF GREATER THAN DISPLAY ALRM ON SCREEN AND STOP THE BLR PROCESSOR
ALERT ;
+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 QUIT
+8 ;
KILL ;
+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 ;
+1 DO INIT
DO DSP
DO KILL
+2 QUIT
