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

BLRPSTST.m

Go to the documentation of this file. 
  1. BLRPST ; IHS/HQT/MJL - Show processor status ; [ 08/01/2002  7:58 AM ]
  1.  ;;5.2;LR;**1011**;MAY 01, 2001
  1.  ;
  1.  D INIT
  1.  F  D DSP Q:BLRF
  1.  D KILL
  1.  Q
  1.  ;
  1. DSP ;
  1.  S BLRX=$G(^BLRSITE(BLRSITE,0))  ;0 NODE
  1.  S BLRPDH=$P(BLRX,U,6)           ;'START PROCESSING DATE'
  1.  S BLREDH=$P(BLRX,U,7)           ;'START EVENT DATE'
  1.  S BLRLOG=$P(BLRX,U,2)           ;'LAB LOG TRANSACTION'
  1.  S BLRPCC=$P(BLRX,U,3)           ;'LAB LOG TO PCC'
  1.  S BLRSTOP=$P(BLRX,U,9)          ;'STOP PROCESSOR'
  1.  S:'BLRPDH BLRPDH=+$H            ;IF NULL WE'RE STARTING TODAY
  1.  S:'BLREDH BLREDH=+$H            ;IF NULL WE'RE STARTING TODAY
  1.  ;
  1.  ;'PROCESSING DATE' INFORMATION
  1.  S BLRX=$G(^BLRSITE(BLRSITE,21,BLRPDH,0))
  1.  S BLRLTA=+$P(BLRX,U,2)          ;'LAST TRANSACTION SEQ ASSIGNED'
  1.  S BLRLTP=+$P(BLRX,U,3)          ;'LAST TRANSACTION SEQ PROCESSED'
  1.  ;
  1.  ;LAST TRANSACTION # ASSIGNED
  1.  S BLRLSQA=+$G(^BLRSITE(BLRSITE,21,BLRPDH,BLRLTA))
  1.  ;
  1.  ;LAST TRANSACTION # PROCESSED
  1.  S BLRLSQP=+$G(^BLRSITE(BLRSITE,21,BLRPDH,BLRLTP))
  1.  ;
  1.  S BLREPHAS=$P($G(^BLRSITE(BLRSITE,20,1,BLRPDH,0)),U,2)
  1.  S BLREOPTN=$P($G(^BLRSITE(BLRSITE,20,1,BLRPDH,0)),U,3)
  1.  ;
  1.  ;GET THE 'EVENT DATE' INFO
  1.  S BLRX=$G(^BLRSITE(BLRSITE,20,BLREDH,0))
  1.  ;
  1.  S BLRLEA=+$P(BLRX,U,2) ;LAST EVENT ASSIGNED
  1.  S BLRLEP=+$P(BLRX,U,3) ;LAST EVENT PROCESSED
  1.  ;
  1.  S:BLRLTA-BLRLTP>1 BLRNSQP=+$G(^BLRSITE(BLRSITE,21,BLRPDH,BLRLTP+1))
  1.  ;
  1.  S:'BLRLTA BLRLSQA=0
  1.  S:'BLRLTP BLRLSQP=0
  1.  ;
  1.  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
  1.  ;
  1.  D
  1.  .;I BLREDH=BLRPDH S BLRHDR="Currently processing day "_BLRPD,BLRHDR=$J("",75-$L(BLRHDR)/2)_BLRHDR Q
  1.  .;S BLRHDR="Currently Processing      "_BLRED,BLRHDR=BLRHDR_$J("",42-$L(BLRHDR))_BLRPD
  1.  .;
  1.  .S %H=BLREDH D YX^%DTC S CURPRDT=Y
  1.  .S SUBTITLE="Currently Processing events from "_$G(CURPRDT)
  1.  .W !!,$J("",$G(IOM)-$L(SUBTITLE)/2),SUBTITLE Q
  1.  ;
  1.  D HDR
  1.  W !!,"Last Event # Assigned"
  1.  W ?23,$J($FN(BLRLEA,","),10)  ;'LAST EVENT ASSIGNED'
  1.  W ?41,$J($FN(BLRLTA,","),10)  ;'LAST TRANSACTION SEQ ASSIGNED'
  1.  W ?64,$J($FN(BLRLSQA,","),10) ;LAST TRANSACTION # ASSIGNED (#9009022)
  1.  ;
  1.  W !!,"Last Event # Processed"
  1.  W ?23,$J($FN(BLRLEP,","),10)  ;'LAST EVENT PROCESSED'
  1.  W ?41,$J($FN(BLRLTP,","),10)  ;'LAST TRANSACTION SEQ ASSIGNED'
  1.  W ?64,$J($FN(BLRLSQP,","),10) ;LAST TRANSACTION # ASSIGNED' (#9009022)
  1.  ;
  1.  ;
  1.  D:BLRLEA-BLRLEP>1!(BLRLTA-BLRLTP>1)
  1.  .W !!,"Now Processing Event #"
  1.  .W:BLRLEA-BLRLEP>1 ?23,$J($FN(BLRLEP+1,","),10)  ;
  1.  .W:BLRLTA-BLRLTP>1 ?41,$J($FN(BLRLTP+1,","),10),?64,$J($FN(BLRNSQP,","),10)
  1.  .W:BLRLEA-BLRLEP>1 !!?23,$G(BLREPHAS),?31,$G(BLREOPTN)
  1.  ;
  1.  L +^BLRLOCK:0 I $T S BLRF=1
  1.  I BLRF!'BLRLOG!'BLRPCC D
  1.  .I 'BLRLOG W !! W:BLRF "Processor is not running due to 'LAB LOG TRANSACTION' is off"
  1.  .E  I 'BLRPCC W !! W:BLRF "Processor is not running. The 'LAB LOG TO PCC' is off"               ;D  W "!"
  1.  .I BLRSTOP W " -- Halted by user" Q
  1.  L -^BLRLOCK
  1.  I $G(BLRNPMT) Q
  1.  I BLRF R !!,"Press Enter to exit: ",BLR:DTIME,! Q
  1.  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))
  1.  ;
  1.  Q
  1.  ;
  1. INIT ;
  1.  S U="^",BLRF=0,BLRLN="",$P(BLRLN,"-",81)="",BLRCNT=0
  1.  S BLRSITE=$P($G(^AUTTSITE(1,0)),U)
  1.  S:BLRSITE="" BLRSITE="UNKNOWN"
  1.  S (BLRLEDH,BLRLPDH)=""
  1.  S BLRSNAME=$P($G(^AUTTLOC(BLRSITE,0)),U,2)
  1.  S:BLRSNAME="" BLRNAME="UNKNOWN SITE"
  1.  I '$D(IOF) S IOP="HOME" D ^%ZIS K IOP
  1.  Q
  1.  ;
  1. HDR ;
  1.  D NOW^%DTC S Y=%,%DT="S" D DD^%DT S BLRDTM=Y
  1.  W @IOF
  1.  S TITLE="Processor Status (Test)"
  1.  W $J("",$G(IOM)-$L(TITLE)/2),TITLE,!,$J("",$G(IOM)-$L(BLRDTM)/2),Y
  1.  ;W !!,$G(BLRHDR)
  1.  W !!,$G(SUBTITLE)
  1.  ;
  1.  ;"Event # of the day" refers to the 5th subscript in node 20
  1.  ;^BLRSITE(1575,20,58714,1,1,0)="M^R^^^HE 0924 5^1575^746"
  1.  ;"Entry Position in Queue" refers to the 4th subscript in node 21
  1.  ;^BLRSITE(1575,21,58714,1)="9552"
  1.  ;
  1.  W !!,?43,"Position",?59,"IHS Lab Transaction"
  1.  W !,?28,"Event",?43,"in",?61,"Sequence Number"
  1.  W !,?28,"# of",?43,"Transaction",?63,"Assigned"
  1.  W !,?28,$G(CURPRDT),?43,"Queue"
  1.  W !,$G(BLRLN)
  1.  Q
  1.  ;IF NUMBER OF BLR ERRORS IN ^%ZTER IS GREATER THAN
  1.  ;THE NUMBER SET IN 'ERROR OVERFLOW LIMIT' IN BLR MASTER CONTROL FILE
  1.  ;IF GREATER THAN DISPLAY ALRM ON SCREEN AND STOP THE BLR PROCESSOR
  1. ALERT ;
  1.  S X="IORVON;IORVOFF;IOBON;IOBOFF"
  1.  D ENDR^%ZISS
  1.  W !,IORVON,"THERE IS SOMETHNG WRONG WITH THE PCC LINK!"
  1.  W !,"TOO MANY ERRORS HAVE BEEN FOUND IN THE ERROR LOG!"
  1.  W !,IOBON,"THE PCC LINK IS BEING TURNED OFF!!",IOBOFF
  1.  W !,IORVON,"CALL YOUR SITE MANAGER IMMEDIATELY!",IORVOFF
  1.  Q
  1.  ;
  1. KILL ;
  1.  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
  1.  Q
  1.  ;
  1. ENT ;
  1.  D INIT,DSP,KILL
  1.  Q