BLRPCCST ;IHS/OIT/MKK - Lab To PCC Linker Status Check ;JUL 06, 2010 3:14 PM
;;5.2;IHS LABORATORY;**1030**;NOV 01, 1997
;
; Based upon the BLRPST routine
;
EP ; EP -
NEW BLR,BLRCNT,BLRDTM,BLRED,BLREDH,BLRF,BLRHDR,BLRLEA,BLRLEDH
NEW BLRLEP,BLRLN,BLRLOG,BLRLPDH,BLRLSQA,BLRLSQP,BLRLTA,BLRLTP
NEW BLRNPMT,BLRNSQP,BLRPCC,BLRPD,BLRPDH,BLRSITE,BLRSTOP,BLRTA
NEW BLRTP,BLRX,IOBOFF,IOBON
NEW MAILSTR,MAILLINE,RM
;
D INIT
D DSP
D KILL
Q
;
DSP ; EP
S BLRX=$G(^BLRSITE(BLRSITE,0)) ; 0 NODE
S BLRSTOP=+$P(BLRX,U,9) ; 'STOP PROCESSOR'
Q:'BLRSTOP ; If processor not stopped, quit
;
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:'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) D
. S %H=BLREDH
. D YX^%DTC
. S BLRED=Y
. S %H=BLRPDH
. D YX^%DTC
. S BLRPD=Y,BLRLEDH=BLREDH,BLRLPDH=BLRPDH
;
I BLREDH=BLRPDH S BLRHDR="Currently processing day "_BLRPD
I BLREDH'=BLRPDH S BLRHDR="Currently Processing "_BLRED_" "_BLRPD
;
D HDR
D ADDIT(" ")
K STR
S STR="Last Entry Assigned"
S $E(STR,23)=$J($FN(BLRLEA,","),10) ;'LAST EVENT ASSIGNED'
S $E(STR,41)=$J($FN(BLRLTA,","),10) ;'LAST TRANSACTION SEQ ASSIGNED'
S $E(STR,64)=$J($FN(BLRLSQA,","),10) ;LAST TRANSACTION # ASSIGNED
D ADDIT(STR)
;
D ADDIT(" ")
K STR
S STR="Last Entry Processed"
S $E(STR,23)=$J($FN(BLRLEP,","),10) ;'LAST EVENT PROCESSED'
S $E(STR,41)=$J($FN(BLRLTP,","),10) ;'LAST TRANSACTION SEQ ASSIGNED'
S $E(STR,64)=$J($FN(BLRLSQP,","),10) ;LAST TRANSACTION SEQ ASSIGNED'
D ADDIT(STR)
;
I BLRLEA-BLRLEP>1!(BLRLTA-BLRLTP>1) D
. D ADDIT(" ")
. K STR
. S STR="Now Processing Entry"
. S:BLRLEA-BLRLEP>1 $E(STR,23)=$J($FN(BLRLEP+1,","),10) ;
. S:BLRLTA-BLRLTP>1 $E(STR,41)=$J($FN(BLRLTP+1,","),10),$E(STR,64)=$J($FN(BLRNSQP,","),10)
. D ADDIT(STR)
;
D SENDMAIL^BLRUTIL3("IHS Lab to PCC Link Process is Stopped",.MAILSTR,"BLRPCCST")
;
Q
;
INIT ;
S RM=78
S U="^",BLRF=0,BLRLN="",$P(BLRLN,"-",RM)="",BLRCNT=0
S BLRSITE=$P($G(^AUTTSITE(1,0)),U),(BLRLEDH,BLRLPDH)=""
I '$D(IOF) S IOP="HOME" D ^%ZIS K IOP
S MAILLINE=0
Q
;
HDR ;
D NOW^%DTC S Y=%,%DT="S" D DD^%DT S BLRDTM=Y
D ADDIT($$CJ^XLFSTR($$LOC^XBFUNC,RM)) ; Location
D ADDIT($$CJ^XLFSTR("Processor Status",RM))
D ADDIT($$CJ^XLFSTR($$UP^XLFSTR($$HTE^XLFDT($H)),RM))
D ADDIT($$CJ^XLFSTR(BLRHDR,RM))
D ADDIT(" ")
K STR
S $E(STR,40)="Entry Position"
S $E(STR,59)="IHS Lab Transaction"
D ADDIT(STR)
K STR
S $E(STR,28)="Event"
S $E(STR,43)="in Queue"
S $E(STR,61)="Sequence Number"
D ADDIT(STR)
D ADDIT(BLRLN)
Q
;
ADDIT(LINER) ; EP - Add line to MAILSTR array
S MAILLINE=MAILLINE+1
S MAILSTR(MAILLINE)=LINER
Q
;
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,X,Y
Q
;
ENT ;
D INIT,DSP,KILL
Q
BLRPCCST ;IHS/OIT/MKK - Lab To PCC Linker Status Check ;JUL 06, 2010 3:14 PM
+1 ;;5.2;IHS LABORATORY;**1030**;NOV 01, 1997
+2 ;
+3 ; Based upon the BLRPST routine
+4 ;
EP ; EP -
+1 NEW BLR,BLRCNT,BLRDTM,BLRED,BLREDH,BLRF,BLRHDR,BLRLEA,BLRLEDH
+2 NEW BLRLEP,BLRLN,BLRLOG,BLRLPDH,BLRLSQA,BLRLSQP,BLRLTA,BLRLTP
+3 NEW BLRNPMT,BLRNSQP,BLRPCC,BLRPD,BLRPDH,BLRSITE,BLRSTOP,BLRTA
+4 NEW BLRTP,BLRX,IOBOFF,IOBON
+5 NEW MAILSTR,MAILLINE,RM
+6 ;
+7 DO INIT
+8 DO DSP
+9 DO KILL
+10 QUIT
+11 ;
DSP ; EP
+1 ; 0 NODE
SET BLRX=$GET(^BLRSITE(BLRSITE,0))
+2 ; 'STOP PROCESSOR'
SET BLRSTOP=+$PIECE(BLRX,U,9)
+3 ; If processor not stopped, quit
IF 'BLRSTOP
QUIT
+4 ;
+5 ; 'START PROCESSING DATE'
SET BLRPDH=$PIECE(BLRX,U,6)
+6 ; 'START EVENT DATE'
SET BLREDH=$PIECE(BLRX,U,7)
+7 ; 'LAB LOG TRANSACTION'
SET BLRLOG=$PIECE(BLRX,U,2)
+8 ; 'LAB LOG TO PCC'
SET BLRPCC=$PIECE(BLRX,U,3)
+9 ; IF NULL WE'RE STARTING TODAY
IF 'BLRPDH
SET BLRPDH=+$HOROLOG
+10 ; IF NULL WE'RE STARTING TODAY
IF 'BLREDH
SET BLREDH=+$HOROLOG
+11 ;
+12 ; 'PROCESSING DATE' INFORMATION
+13 SET BLRX=$GET(^BLRSITE(BLRSITE,21,BLRPDH,0))
+14 ;'LAST TRANSACTION SEQ ASSIGNED'
SET BLRLTA=+$PIECE(BLRX,U,2)
+15 ;'LAST TRANSACTION SEQ PROCESSED'
SET BLRLTP=+$PIECE(BLRX,U,3)
+16 ;
+17 ; LAST TRANSACTION # ASSIGNED
+18 SET BLRLSQA=+$GET(^BLRSITE(BLRSITE,21,BLRPDH,BLRLTA))
+19 ;
+20 ; LAST TRANSACTION # PROCESSED
+21 SET BLRLSQP=+$GET(^BLRSITE(BLRSITE,21,BLRPDH,BLRLTP))
+22 ;
+23 ; GET THE 'EVENT DATE' INFO
+24 SET BLRX=$GET(^BLRSITE(BLRSITE,20,BLREDH,0))
+25 ;
+26 ;LAST EVENT ASSIGNED
SET BLRLEA=+$PIECE(BLRX,U,2)
+27 ;LAST EVENT PROCESSED
SET BLRLEP=+$PIECE(BLRX,U,3)
+28 ;
+29 IF BLRLTA-BLRLTP>1
SET BLRNSQP=+$GET(^BLRSITE(BLRSITE,21,BLRPDH,BLRLTP+1))
+30 ;
+31 IF 'BLRLTA
SET BLRLSQA=0
+32 IF 'BLRLTP
SET BLRLSQP=0
+33 ;
+34 IF BLREDH'=BLRLEDH!(BLRPDH'=BLRLPDH)
Begin DoDot:1
+35 SET %H=BLREDH
+36 DO YX^%DTC
+37 SET BLRED=Y
+38 SET %H=BLRPDH
+39 DO YX^%DTC
+40 SET BLRPD=Y
SET BLRLEDH=BLREDH
SET BLRLPDH=BLRPDH
End DoDot:1
+41 ;
+42 IF BLREDH=BLRPDH
SET BLRHDR="Currently processing day "_BLRPD
+43 IF BLREDH'=BLRPDH
SET BLRHDR="Currently Processing "_BLRED_" "_BLRPD
+44 ;
+45 DO HDR
+46 DO ADDIT(" ")
+47 KILL STR
+48 SET STR="Last Entry Assigned"
+49 ;'LAST EVENT ASSIGNED'
SET $EXTRACT(STR,23)=$JUSTIFY($FNUMBER(BLRLEA,","),10)
+50 ;'LAST TRANSACTION SEQ ASSIGNED'
SET $EXTRACT(STR,41)=$JUSTIFY($FNUMBER(BLRLTA,","),10)
+51 ;LAST TRANSACTION # ASSIGNED
SET $EXTRACT(STR,64)=$JUSTIFY($FNUMBER(BLRLSQA,","),10)
+52 DO ADDIT(STR)
+53 ;
+54 DO ADDIT(" ")
+55 KILL STR
+56 SET STR="Last Entry Processed"
+57 ;'LAST EVENT PROCESSED'
SET $EXTRACT(STR,23)=$JUSTIFY($FNUMBER(BLRLEP,","),10)
+58 ;'LAST TRANSACTION SEQ ASSIGNED'
SET $EXTRACT(STR,41)=$JUSTIFY($FNUMBER(BLRLTP,","),10)
+59 ;LAST TRANSACTION SEQ ASSIGNED'
SET $EXTRACT(STR,64)=$JUSTIFY($FNUMBER(BLRLSQP,","),10)
+60 DO ADDIT(STR)
+61 ;
+62 IF BLRLEA-BLRLEP>1!(BLRLTA-BLRLTP>1)
Begin DoDot:1
+63 DO ADDIT(" ")
+64 KILL STR
+65 SET STR="Now Processing Entry"
+66 ;
IF BLRLEA-BLRLEP>1
SET $EXTRACT(STR,23)=$JUSTIFY($FNUMBER(BLRLEP+1,","),10)
+67 IF BLRLTA-BLRLTP>1
SET $EXTRACT(STR,41)=$JUSTIFY($FNUMBER(BLRLTP+1,","),10)
SET $EXTRACT(STR,64)=$JUSTIFY($FNUMBER(BLRNSQP,","),10)
+68 DO ADDIT(STR)
End DoDot:1
+69 ;
+70 DO SENDMAIL^BLRUTIL3("IHS Lab to PCC Link Process is Stopped",.MAILSTR,"BLRPCCST")
+71 ;
+72 QUIT
+73 ;
INIT ;
+1 SET RM=78
+2 SET U="^"
SET BLRF=0
SET BLRLN=""
SET $PIECE(BLRLN,"-",RM)=""
SET BLRCNT=0
+3 SET BLRSITE=$PIECE($GET(^AUTTSITE(1,0)),U)
SET (BLRLEDH,BLRLPDH)=""
+4 IF '$DATA(IOF)
SET IOP="HOME"
DO ^%ZIS
KILL IOP
+5 SET MAILLINE=0
+6 QUIT
+7 ;
HDR ;
+1 DO NOW^%DTC
SET Y=%
SET %DT="S"
DO DD^%DT
SET BLRDTM=Y
+2 ; Location
DO ADDIT($$CJ^XLFSTR($$LOC^XBFUNC,RM))
+3 DO ADDIT($$CJ^XLFSTR("Processor Status",RM))
+4 DO ADDIT($$CJ^XLFSTR($$UP^XLFSTR($$HTE^XLFDT($HOROLOG)),RM))
+5 DO ADDIT($$CJ^XLFSTR(BLRHDR,RM))
+6 DO ADDIT(" ")
+7 KILL STR
+8 SET $EXTRACT(STR,40)="Entry Position"
+9 SET $EXTRACT(STR,59)="IHS Lab Transaction"
+10 DO ADDIT(STR)
+11 KILL STR
+12 SET $EXTRACT(STR,28)="Event"
+13 SET $EXTRACT(STR,43)="in Queue"
+14 SET $EXTRACT(STR,61)="Sequence Number"
+15 DO ADDIT(STR)
+16 DO ADDIT(BLRLN)
+17 QUIT
+18 ;
ADDIT(LINER) ; EP - Add line to MAILSTR array
+1 SET MAILLINE=MAILLINE+1
+2 SET MAILSTR(MAILLINE)=LINER
+3 QUIT
+4 ;
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,X,Y
+2 QUIT
+3 ;
ENT ;
+1 DO INIT
DO DSP
DO KILL
+2 QUIT
