BGUTRLU.m

BGUTRLU ; IHS/OIT/MJL - DEBUGGING TRACE FACILITY ;

 ;;1.5;BGU;;MAY 26, 2005

 S U="^" D GFL,LISTSEQ:BGULSQA

 K BGULSQA

 Q

 ;

GFL ;

 S BGULSQA=$P($G(^BGUTRACE(0)),"^",3) I 'BGULSQA W !,"No sequences recorded" Q

 W "LAST SEQUENCE ASSIGNED: ",BGULSQA

 F  D  Q:$D(DIRUT)

 .S DIR(0)="NO",DIR("A")="START FROM" D ^DIR Q:$D(DIRUT)  S BGUS=$S(X=" ":$S($G(BGUS)'="":BGUS,1:0),1:X) W:X=" " *8,BGUS

 .S DIR(0)="FO",DIR("A")="END AT" D ^DIR Q:$D(DIROUT)  S BGUE=$S($D(DIRUT):$O(^BGUTRACE("A"),-1),1:X) I X="" K DIRUT W BGUE

 .S BGUN=BGUS-1,DIR(0)="FOA",DIR("A")="<>"

 .F BGUQ=1:1 S BGUN=$O(^BGUTRACE(BGUN)) Q:'BGUN!(BGUN>BGUE)!$D(DUOUT)  W !,BGUN," ",$G(^BGUTRACE(BGUN,1,1,0),"Incomplete file entry") I BGUQ#20=0 D ^DIR Q:$D(DIROUT)  K DIRUT

 K BGUE,BGUS,BGUN,BGUQ,DIR,DIRUT,DIROUT,X

 Q

 ;

LISTSEQ ;

 ;S DI="^BGUTRACE(",DK=90061

 ;D B^DII

 S DIC="^BGUTRACE(",DIC(0)="AQEM" D ^DIC S DA=+Y

 I +Y>0 S DIC="^BGUTRACE(" D EN^DIQ G LISTSEQ

 K %ZISOS,D1,DIK,DISYS,DIW,DIWL,DIWR,DIWT,DN,DX,IOBS,IOF,ION,IOSL,IOT,IOXY,POP

 Q

BGUTRLU   ; IHS/OIT/MJL - DEBUGGING TRACE FACILITY ;

 +1       ;;1.5;BGU;;MAY 26, 2005

 +2        SET U="^"

           DO GFL

           IF BGULSQA

               DO LISTSEQ

 +3        KILL BGULSQA

 +4        QUIT 

 +5       ;

GFL       ;

 +1        SET BGULSQA=$PIECE($GET(^BGUTRACE(0)),"^",3)

           IF 'BGULSQA

               WRITE !,"No sequences recorded"

               QUIT 

 +2        WRITE "LAST SEQUENCE ASSIGNED: ",BGULSQA

 +3        FOR 

               Begin DoDot:1

 +4                SET DIR(0)="NO"

                   SET DIR("A")="START FROM"

                   DO ^DIR

                   IF $DATA(DIRUT)

                       QUIT 

                   SET BGUS=$SELECT(X=" ":$SELECT($GET(BGUS)'="":BGUS,1:0),1:X)

                   IF X=" "

                       WRITE *8,BGUS

 +5                SET DIR(0)="FO"

                   SET DIR("A")="END AT"

                   DO ^DIR

                   IF $DATA(DIROUT)

                       QUIT 

                   SET BGUE=$SELECT($DATA(DIRUT):$ORDER(^BGUTRACE("A"),-1),1:X)

                   IF X=""

                       KILL DIRUT

                       WRITE BGUE

 +6                SET BGUN=BGUS-1

                   SET DIR(0)="FOA"

                   SET DIR("A")="<>"

 +7                FOR BGUQ=1:1

                       SET BGUN=$ORDER(^BGUTRACE(BGUN))

                       IF 'BGUN!(BGUN>BGUE)!$DATA(DUOUT)

                           QUIT 

                       WRITE !,BGUN," ",$GET(^BGUTRACE(BGUN,1,1,0),"Incomplete file entry")

                       IF BGUQ#20=0

                           DO ^DIR

                           IF $DATA(DIROUT)

                               QUIT 

                           KILL DIRUT

               End DoDot:1

               IF $DATA(DIRUT)

                   QUIT 

 +8        KILL BGUE,BGUS,BGUN,BGUQ,DIR,DIRUT,DIROUT,X

 +9        QUIT 

 +10      ;

LISTSEQ   ;

 +1       ;S DI="^BGUTRACE(",DK=90061

 +2       ;D B^DII

 +3        SET DIC="^BGUTRACE("

           SET DIC(0)="AQEM"

           DO ^DIC

           SET DA=+Y

 +4        IF +Y>0

               SET DIC="^BGUTRACE("

               DO EN^DIQ

               GOTO LISTSEQ

 +5        KILL %ZISOS,D1,DIK,DISYS,DIW,DIWL,DIWR,DIWT,DN,DX,IOBS,IOF,ION,IOSL,IOT,IOXY,POP

 +6        QUIT