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

BLRPST.m

Go to the documentation of this file. 
  1. 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
  1.  ;
  1. EP ; EP
  1.  NEW DATETIME        ; IHS/OIT/MKK - LR*5.2*1030
  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.  ;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.  . ; ----- BEGIN IHS/OIT/MKK - LR*5.2*1027
  1.  . ; Make the Header more Standard
  1.  . I BLREDH=BLRPDH S BLRHDR="Currently processing day "_BLRPD
  1.  . I BLREDH'=BLRPDH S BLRHDR="Currently Processing "_BLRED_"  "_BLRPD
  1.  . ; ----- END IHS/OIT/MKK - LR*5.2*1027
  1.  ;
  1.  D HDR
  1.  W !!,"Last Entry 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
  1.  ;
  1.  ; ----- BEGIN IHS/OIT/MKK - LR*5.2*1030
  1.  W ?22,$J($FN(BLRLEA,","),11)     ;'LAST EVENT ASSIGNED'
  1.  W ?35,$J($FN(BLRLTA,","),11)     ;'LAST TRANSACTION SEQ ASSIGNED'
  1.  W ?50,$J($FN(BLRLSQA,","),11)    ;LAST TRANSACTION # ASSIGNED
  1.  S DATETIME=$P($G(^BLRTXLOG(BLRLSQA,1)),"^",3)
  1.  W:$L(DATETIME) ?63,$TR($$FMTE^XLFDT(DATETIME,"5MZ"),"@"," ")
  1.  ; ----- END IHS/OIT/MKK - LR*5.2*1030
  1.  ; 
  1.  W !!,"Last Entry 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 SEQ ASSIGNED'
  1.  ;
  1.  ; ----- BEGIN IHS/OIT/MKK - LR*5.2*1030
  1.  W ?22,$J($FN(BLRLEP,","),11)     ;'LAST EVENT PROCESSED'
  1.  W ?35,$J($FN(BLRLTP,","),11)     ;'LAST TRANSACTION SEQ ASSIGNED'
  1.  W ?50,$J($FN(BLRLSQP,","),11)    ;LAST TRANSACTION SEQ ASSIGNED'
  1.  S DATETIME=$P($G(^BLRTXLOG(BLRLSQP,1)),"^",3)
  1.  W:$L(DATETIME) ?63,$TR($$FMTE^XLFDT(DATETIME,"5MZ"),"@"," ")
  1.  ; ----- END IHS/OIT/MKK - LR*5.2*1030
  1.  ;
  1.  D:BLRLEA-BLRLEP>1!(BLRLTA-BLRLTP>1)
  1.  . W !!,"Now Processing Entry"
  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.  . ; ----- BEGIN IHS/OIT/MKK - LR*5.2*1030
  1.  . W:BLRLEA-BLRLEP>1 ?22,$J($FN(BLRLEP+1,","),11)
  1.  . I BLRLTA-BLRLTP>1 D
  1.  .. W ?35,$J($FN(BLRLTP+1,","),11)
  1.  .. ; W ?50,$J($FN(BLRNSQP,","),10)
  1.  .. W ?50,$J($FN(BLRNSQP,","),11)                ; IHS/MSC/MKK - LR*5.2*1031
  1.  .. S DATETIME=$P($G(^BLRTXLOG(BLRLSQP,1)),"^",3)
  1.  .. W:$L(DATETIME) ?63,$TR($$FMTE^XLFDT(DATETIME,"5MZ"),"@"," ")
  1.  . ; ----- END IHS/OIT/MKK - LR*5.2*1030
  1.  ;
  1.  L +^BLRLOCK:0 I $T S BLRF=1
  1.  ; I BLRF!'BLRLOG!'BLRPCC D
  1.  ; ----- BEGIN IHS/OIT/MKK -- LR*5.2*1025 MODIFICATION -- Allow BLRSTOP Message
  1.  I BLRF!BLRSTOP!'BLRLOG!'BLRPCC D
  1.  .; ----- END IHS/OIT/MKK -- LR*5.2*1025 MODIFICATION
  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.  ;.I 'BLRLOG!'BLRPCC W:BLRF " -- " D  W " disabled"
  1.  ;..W:'BLRLOG "Lab Log"
  1.  ;..Q:BLRPCC
  1.  ;..W:'BLRLOG " and "
  1.  ;..W "Update PCC"
  1.  L -^BLRLOCK
  1.  I $G(BLRNPMT) Q
  1.  ; I BLRF R !!,"Press Enter to exit: ",BLR:DTIME,! W ! 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.  ; ------- BEGIN IHS/MSC/MKK - LR*5.2*1031
  1.  I BLRF D  Q
  1.  . D ^XBFMK
  1.  . S DIR(0)="FO"
  1.  . S DIR("A")="Press Enter to exit"
  1.  . S DIR("T")=5
  1.  . D ^DIR
  1.  . W !
  1.  D ^XBFMK
  1.  S DIR(0)="FO"
  1.  S DIR("A")="Press Enter to continue"
  1.  S DIR("T")=5
  1.  D ^DIR
  1.  S BLR=$G(X)
  1.  S BLRF=$T
  1.  S BLRCNT=$S(BLRF:0,1:BLRCNT+1)
  1.  S BLRF=$S($G(BLR)="^":1,1:BLRCNT=(DTIME\5))
  1.  ; ----- END IHS/MSC/MKK - LR*5.2*1031
  1.  ;
  1.  Q
  1.  ;
  1. INIT ; EP
  1.  S U="^",BLRF=0,BLRLN="",$P(BLRLN,"-",81)="",BLRCNT=0
  1.  S BLRSITE=$P($G(^AUTTSITE(1,0)),U),(BLRLEDH,BLRLPDH)=""
  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,?33,"Processor Status",!,$J("",75-$L(BLRDTM)/2),Y
  1.  ; W !!,BLRHDR
  1.  ; ----- BEGIN IHS/OIT/MKK - LR*5.2*1027
  1.  ; Make the Header more Standard
  1.  W @IOF
  1.  W $$CJ^XLFSTR($$LOC^XBFUNC,IOM),!     ; Location
  1.  W $$CJ^XLFSTR("Processor Status",IOM),!
  1.  W $$CJ^XLFSTR($$UP^XLFSTR($$HTE^XLFDT($H)),IOM),!!
  1.  W $$CJ^XLFSTR(BLRHDR,IOM)
  1.  ; ----- END IHS/OIT/MKK - LR*5.2*1027
  1.  ; W !!,?40,"Entry Position",?59,"IHS Lab Transaction"
  1.  ; W !,?28,"Event",?43,"in Queue",?61,"Sequence Number",!,BLRLN
  1.  ; 
  1.  ; ----- BEGIN IHS/OIT/MKK - LR*5.2*1030
  1.  ; Add New column -- Date/Time of Transaction
  1.  ; Have to re-arrange all columns
  1.  W !!
  1.  W ?38,"Entry #"
  1.  W ?50,"==== IHS Lab Transaction ===="
  1.  W !
  1.  W ?28,"Event"
  1.  W ?38,"in Queue"
  1.  W ?51,"Sequence #"
  1.  W ?65,"Date"
  1.  W ?74,"Time"
  1.  W !,BLRLN
  1.  ; ----- END IHS/OIT/MKK - LR*5.2*1030
  1.  ; 
  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 ; EP
  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.  ;
  1.  ; ----- BEGIN IHS/OIT/MKK - LR*5.2*1030
  1.  ; Send Alert to LMI Mail Group
  1.  D SNDALERT("Too many BLR Errors have been found.  PCC Link has been turned off.")
  1.  ; ----- END IHS/OIT/MKK - LR*5.2*1030
  1.  ;
  1.  Q
  1.  ;
  1. KILL ; EP
  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 ; EP
  1.  D INIT,DSP,KILL
  1.  Q
  1.  ;
  1.  ; ----- BEGIN IHS/OIT/MKK - LR*5.2*1030
  1. SNDALERT(ALERTMSG) ; EP - Send alert to LMI group AND User
  1.  ; Per Kernel Developer's Guide, NEW all Alert variables
  1.  NEW XQA,XQAARCH,XQACNDEL,XQADATA,XQAFLG,XQAGUID,XQAID,XQAMSG,XQAOPT
  1.  NEW XQAREVUE,XQAROU,XQASUPV,XQASURO,XQATEXT
  1.  ;
  1.  S XQAMSG=ALERTMSG
  1.  S XQA("G.LMI")=""
  1.  ;
  1.  ; If user not part of LMI Mail Group, send them alert also
  1.  S:$$NINLMI(DUZ) XQA(DUZ)=""
  1.  ;
  1.  S X=$$SETUP1^XQALERT
  1.  Q:X
  1.  ;
  1.  ; Alert not sent successfully.  Try to store it.
  1.  NEW SUBSCRPT
  1.  S SUBSCRPT="BLRPST Alert^"_+$H_"^"_$J
  1.  ; S ^XTEMP(SUBSCRPT,0)=$$FMADD^XLFDT($$DT^XLFDT,90)_"^"_$$DT^XLFDT_"^"_"PCC Linker shut down Alert."
  1.  ; S ^XTEMP(SUBSCRPT,1)="PCC Linker Alert was not sent."
  1.  ; S ^XTEMP(SUBSCRPT,2)="  Message that should have been sent follows:"
  1.  ; S ^XTEMP(SUBSCRPT,3)="     "_ALERTMSG
  1.  ; S ^XTEMP(SUBSCRPT,4)="  ALERT Error Message Follows:"
  1.  ; S ^XTEMP(SUBSCRPT,5)="     "_XQALERR
  1.  ;
  1.  ; ----- BEGIN IHS/MSC/MKK - LR*5.2*1039 - Use ^XTMP not ^XTEMP per SAC
  1.  S ^XTMP(SUBSCRPT,0)=$$FMADD^XLFDT($$DT^XLFDT,90)_"^"_$$DT^XLFDT_"^"_"PCC Linker shut down Alert."
  1.  S ^XTMP(SUBSCRPT,1)="PCC Linker Alert was not sent."
  1.  S ^XTMP(SUBSCRPT,2)="  Message that should have been sent follows:"
  1.  S ^XTMP(SUBSCRPT,3)="     "_ALERTMSG
  1.  S ^XTMP(SUBSCRPT,4)="  ALERT Error Message Follows:"
  1.  S ^XTMP(SUBSCRPT,5)="     "_XQALERR
  1.  ; ----- END IHS/MSC/MKK - LR*5.2*1039
  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.  ; 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)                   ; Reverse Logic
  1.  ; ----- END IHS/OIT/MKK - LR*5.2*1030