Routine: BLRDBG

BLRDBG ; IHS/DIR/FJE - REFILES ENTRY IN IHS LAB TX LOG -- USED ONLY WHEN DEBUGGING ; [ 10/05/1999  9:35 AM ]

 ;;5.2;BLR;**1008,1009**;OCT 01, 1999

 S BLRLINK=1,DIC=9009022,DIC(0)="AQEM" D ^DIC ;IHS/DIR/FJE SETS BLRLINK TO BYPASS THE SCREEN IN PCC V LAB ENTRY FOR SITE/SPECIMEN

 Q:+Y<1

 S BLRLOGDA=+Y

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)

 D DEBUG^BLRLINK

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,!!

BLRDBG    ; IHS/DIR/FJE - REFILES ENTRY IN IHS LAB TX LOG -- USED ONLY WHEN DEBUGGING ; [ 10/05/1999  9:35 AM ]

 +1       ;;5.2;BLR;**1008,1009**;OCT 01, 1999

 +2       ;

 +3       ;IHS/DIR/FJE SETS BLRLINK TO BYPASS THE SCREEN IN PCC V LAB ENTRY FOR SITE/SPECIMEN

           SET BLRLINK=1

           SET DIC=9009022

           SET DIC(0)="AQEM"

           DO ^DIC

 +4        IF +Y<1

               QUIT

 +5        SET BLRLOGDA=+Y

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       ;D TOP^BLRQUE(BLRLOGDA,0)

 +6        DO DEBUG^BLRLINK

 +7        QUIT

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

BLRDBG.m