Routine: BLRPCCST

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

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")

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

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)

ADDIT(LINER) ; EP - Add line to MAILSTR array

 S MAILLINE=MAILLINE+1

 S MAILSTR(MAILLINE)=LINER

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

KILL ;

 K %,%DT,%H,%I,X,Y

ENT ;

 D INIT,DSP,KILL

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

BLRPCCST.m