Routine: BLRRFILE

BLRRFILE ; IHS/DIR/FJE - REFILES ENTRY IN IHS LAB TX LOG ; [ 07/30/2002  8:45 AM ]

 ;;5.2;LR;**1013**;JUL 30, 2002

CTL ;

 D INIT

 D SEQ1 Q:BLRDONE

 D:'BLRDONE TEMP

 D KILL

INIT ;

 S BLR="",BLRPCC=$G(BLRPCC) I BLRPCC'="" S BLRHDR="WITH PCC ERRORS" S:BLRPCC'="ALL" BLRHDR=BLRHDR_" CONTAINING "_BLRPCC

 I '$D(IOF) S IOP="HOME" D ^%ZIS K IOP

ASKSEQS ;

 S DIC("A")="START WITH SEQUENCE NUMBER: ",DIC("B")=1 D ASKSEQ Q:'BLRDONE  S BLRFIRST=+Y

ASKSEQS1 S DIC("A")="GO TO SEQUENCE NUMBER: ",DIC("B")=$P(^BLRTXLOG(0),U,3)

 D ASKSEQ Q:'BLRDONE

 I Y<BLRFIRST W "LAST must be greater than START !" G ASKSEQS1

 S BLRLAST=+Y

SEQ ;

 D SEQ1,KILL

SEQ1 ;

 D ASKSEQ Q:'BLRDONE

 S BLRLOGDA=+Y D SHOW

ASKSEQ ;

 S BLRDONE=0

 S DIC=9009022,DIC(0)="AQEM" D ^DIC Q:Y<1

 S BLRDONE=1

SHOW K DA,DR S DA=BLRLOGDA D EN^DIQ

 W !!,"Do you wish to try and refile this entry?",!

 S DIR(0)="Y",DIR("A")="Enter Yes or No",DIR("B")="N" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I $D(DIRUT) W !,"Entry NOT filed",! Q

 I +Y=0 W !,"Entry NOT filed",! Q

 D TOP^BLRQUE(BLRLOGDA,0)

SORT ;

 D INIT,TEMP,KILL

PCCERR ;

 S BLRGLO="^TMP($J)"

 D INIT,ASKSEQS I BLRDONE D CHECK D ASKQUE:BLRFND

 D KILL

 K ^TMP($J)

TEMP ;

 ; Ask for template

 S BLRGLO="^DIBT(BLRTMP,1)",DIC=.401,DIC(0)="AQEMZ" D ^DIC Q:Y<1

 I $P(Y(0),U,4)'=9009022 W !!,"Template must read IHS Lab Transaction Log! (File #9009022)",! G TEMP

 S BLRTMP=+Y

 D ASKQUE

CHECK ;

 S BLRFND=0,BLRN=$S($G(BLRFIRST):BLRFIRST-1,1:0)

 F  S BLRN=$O(^BLRTXLOG(BLRN)) Q:$S('BLRN:1,BLRLAST:BLRN>BLRLAST)  D

 .S BLRERR=$P($G(^BLRTXLOG(BLRN,1)),U,6)

 .I BLRPCC="ALL" S:BLRERR'="" BLRFND=1,^TMP($J,BLRN)="" Q

 .S:BLRERR[BLRPCC BLRFND=1,^TMP($J,BLRN)=""

 W:'BLRFND !,"No Matches found",!

ASKQUE ;

 D HDR

 S BLRN=0 F  S BLRN=$O(@BLRGLO@(BLRN)) Q:'BLRN  W BLRN,?$X+10\10*10 I $X>70 W !  I $Y#20=0 W !,"Press enter to continue: " R BLR:10,! Q:BLR="^"  D HDR

 I BLR="^" W "request aborted",! Q

 W !!,"Do you wish to Queue these entries for processing?",!

 S DIR(0)="Y",DIR("A")="Enter Yes or No",DIR("B")="N" D ^DIR K DIR S:$D(DUOUT) DIRUT=1

 I +Y=0 W !,"Entries NOT Queued",! Q

 S BLRN=0 F  S BLRN=$O(@BLRGLO@(BLRN)) Q:'BLRN  D TOP^BLRQUE(BLRN)

HDR ;

 W @IOF,!,?22,"IHS LAB Transaction Sequence Numbers",! W:BLRPCC'="" ?(80-$L(BLRHDR))/2,BLRHDR,! W !

START ;STARTS LOOP FOR REFILING

 S BLRX=0 F  S BLRX=$O(^BLRTXLOG(BLRX)) Q:+BLRX=0  D ONE Q:$G(DUOUT)

 W !,"FINISHED",!! Q

ONE S BLRY=$G(^BLRTXLOG(BLRX,1))

 Q:$P(BLRY,U,6)=""

 S BLRLOGDA=BLRX,DIC="^BLRTXLOG(" D SHOW

 S BLRY=$G(^BLRTXLOG(BLRX,1))

 W:$L($P(BLRY,U,6)) !!,"ERROR** "_$P(BLRY,U,6)_" **REPORTED",*7,!!

KILL ;

 K BLR,BLRDONE,BLRERR,BLRGLO,BLRHDR,BLRLOGDA,BLRN,BLRPCC,BLRTMP,BLRX,BLRY,DA,DIC,DIR,DIRUT

BLRRFILE  ; IHS/DIR/FJE - REFILES ENTRY IN IHS LAB TX LOG ; [ 07/30/2002  8:45 AM ]

 +1       ;;5.2;LR;**1013**;JUL 30, 2002

CTL       ;

 +1        DO INIT

 +2        DO SEQ1

           IF BLRDONE

               QUIT

 +3        IF 'BLRDONE

               DO TEMP

 +4        DO KILL

 +5        QUIT

 +6       ;

INIT      ;

 +1        SET BLR=""

           SET BLRPCC=$GET(BLRPCC)

           IF BLRPCC'=""

               SET BLRHDR="WITH PCC ERRORS"

               IF BLRPCC'="ALL"

                   SET BLRHDR=BLRHDR_" CONTAINING "_BLRPCC

 +2        IF '$DATA(IOF)

               SET IOP="HOME"

               DO ^%ZIS

               KILL IOP

 +3        QUIT

 +4       ;

ASKSEQS   ;

 +1        SET DIC("A")="START WITH SEQUENCE NUMBER: "

           SET DIC("B")=1

           DO ASKSEQ

           IF 'BLRDONE

               QUIT

           SET BLRFIRST=+Y

ASKSEQS1   SET DIC("A")="GO TO SEQUENCE NUMBER: "

           SET DIC("B")=$PIECE(^BLRTXLOG(0),U,3)

 +1        DO ASKSEQ

           IF 'BLRDONE

               QUIT

 +2        IF Y<BLRFIRST

               WRITE "LAST must be greater than START !"

               GOTO ASKSEQS1

 +3        SET BLRLAST=+Y

 +4        QUIT

 +5       ;

SEQ       ;

 +1        DO SEQ1

           DO KILL

 +2        QUIT

 +3       ;

SEQ1      ;

 +1        DO ASKSEQ

           IF 'BLRDONE

               QUIT

 +2        SET BLRLOGDA=+Y

           DO SHOW

 +3        QUIT

 +4       ;

ASKSEQ    ;

 +1        SET BLRDONE=0

 +2        SET DIC=9009022

           SET DIC(0)="AQEM"

           DO ^DIC

           IF Y<1

               QUIT

 +3        SET BLRDONE=1

 +4        QUIT

 +5       ;

SHOW       KILL DA,DR

           SET DA=BLRLOGDA

           DO EN^DIQ

 +1        WRITE !!,"Do you wish to try and refile this entry?",!

 +2        SET DIR(0)="Y"

           SET DIR("A")="Enter Yes or No"

           SET DIR("B")="N"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +3        IF $DATA(DIRUT)

               WRITE !,"Entry NOT filed",!

               QUIT

 +4        IF +Y=0

               WRITE !,"Entry NOT filed",!

               QUIT

 +5        DO TOP^BLRQUE(BLRLOGDA,0)

 +6        QUIT

 +7       ;

SORT      ;

 +1        DO INIT

           DO TEMP

           DO KILL

 +2        QUIT

 +3       ;

PCCERR    ;

 +1        SET BLRGLO="^TMP($J)"

 +2        DO INIT

           DO ASKSEQS

           IF BLRDONE

               DO CHECK

               IF BLRFND

                   DO ASKQUE

 +3        DO KILL

 +4        KILL ^TMP($JOB)

 +5        QUIT

 +6       ;

TEMP      ;

 +1       ; Ask for template

 +2       ;

 +3        SET BLRGLO="^DIBT(BLRTMP,1)"

           SET DIC=.401

           SET DIC(0)="AQEMZ"

           DO ^DIC

           IF Y<1

               QUIT

 +4        IF $PIECE(Y(0),U,4)'=9009022

               WRITE !!,"Template must read IHS Lab Transaction Log! (File #9009022)",!

               GOTO TEMP

 +5        SET BLRTMP=+Y

 +6        DO ASKQUE

 +7        QUIT

 +8       ;

CHECK     ;

 +1        SET BLRFND=0

           SET BLRN=$SELECT($GET(BLRFIRST):BLRFIRST-1,1:0)

 +2        FOR

               SET BLRN=$ORDER(^BLRTXLOG(BLRN))

               IF $SELECT('BLRN

                   QUIT

               Begin DoDot:1

 +3                SET BLRERR=$PIECE($GET(^BLRTXLOG(BLRN,1)),U,6)

 +4                IF BLRPCC="ALL"

                       IF BLRERR'=""

                           SET BLRFND=1

                           SET ^TMP($JOB,BLRN)=""

                       QUIT

 +5                IF BLRERR[BLRPCC

                       SET BLRFND=1

                       SET ^TMP($JOB,BLRN)=""

               End DoDot:1

 +6        IF 'BLRFND

               WRITE !,"No Matches found",!

 +7        QUIT

 +8       ;

ASKQUE    ;

 +1        DO HDR

 +2        SET BLRN=0

FOR

               SET BLRN=$ORDER(@BLRGLO@(BLRN))

               IF 'BLRN

                   QUIT

               WRITE BLRN,?$X+10\10*10

               IF $X>70

                   WRITE !

                   IF $Y#20=0

                       WRITE !,"Press enter to continue: "

                       READ BLR:10,!

                       IF BLR="^"

                           QUIT

                       DO HDR

 +3        IF BLR="^"

               WRITE "request aborted",!

               QUIT

 +4        WRITE !!,"Do you wish to Queue these entries for processing?",!

 +5        SET DIR(0)="Y"

           SET DIR("A")="Enter Yes or No"

           SET DIR("B")="N"

           DO ^DIR

           KILL DIR

           IF $DATA(DUOUT)

               SET DIRUT=1

 +6        IF +Y=0

               WRITE !,"Entries NOT Queued",!

               QUIT

 +7        SET BLRN=0

FOR

               SET BLRN=$ORDER(@BLRGLO@(BLRN))

               IF 'BLRN

                   QUIT

               DO TOP^BLRQUE(BLRN)

 +8        QUIT

 +9       ;

HDR       ;

 +1        WRITE @IOF,!,?22,"IHS LAB Transaction Sequence Numbers",!

           IF BLRPCC'=""

               WRITE ?(80-$LENGTH(BLRHDR))/2,BLRHDR,!

           WRITE !

 +2        QUIT

 +3       ;

START     ;STARTS LOOP FOR REFILING

 +1        SET BLRX=0

FOR

               SET BLRX=$ORDER(^BLRTXLOG(BLRX))

               IF +BLRX=0

                   QUIT

               DO ONE

               IF $GET(DUOUT)

                   QUIT

 +2        WRITE !,"FINISHED",!!

           QUIT

 +3       ;

ONE        SET BLRY=$GET(^BLRTXLOG(BLRX,1))

 +1        IF $PIECE(BLRY,U,6)=""

               QUIT

 +2        SET BLRLOGDA=BLRX

           SET DIC="^BLRTXLOG("

           DO SHOW

 +3        SET BLRY=$GET(^BLRTXLOG(BLRX,1))

 +4        IF $LENGTH($PIECE(BLRY,U,6))

               WRITE !!,"ERROR** "_$PIECE(BLRY,U,6)_" **REPORTED",*7,!!

 +5        QUIT

 +6       ;

KILL      ;

 +1        KILL BLR,BLRDONE,BLRERR,BLRGLO,BLRHDR,BLRLOGDA,BLRN,BLRPCC,BLRTMP,BLRX,BLRY,DA,DIC,DIR,DIRUT

 +2        QUIT

BLRRFILE.m