BGUTRACE.m

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

 ;;1.5;BGU;;MAY 26, 2005

MAIN ; -- main message processing loop

 S BGUMXL=200,BGUAPID=$G(BGUAPID,"OE-2"),BGUTCK=$P(BGUMSG,"TRACE=",2),BGUHIT=$G(BGUHIT)

 I BGUTCK'="" D CKPAR Q:'BGUTRACE   I 'BGUTCK,BGUAPD2'="" S BGUAPID=BGUAPD2

 I $D(BGUTRACE) Q:'BGUTRACE

 S BGURTN=BGUTRTN,BGUMSG1=$P(BGUMSG,U,2,999) S:$E(BGUMSG1,$L(BGUMSG1))=U BGUMSG1=$E(BGUMSG1,1,$L(BGUMSG1)-1)

 S BGUSTR="" F BGUN=1:1:$L(BGUMSG1,U)  S:BGUN>1 BGUSTR=BGUSTR_"," S BGUSTR=BGUSTR_""""_$P(BGUMSG1,U,BGUN)_""""

 S BGUSTR=$P(BGURTN,"(",1)_"("_BGUSTR_")"

 K BGUMSG1

 D TRACE

 D KILL

 Q

 ;

CKPAR ; -- Check parameter string to see if TRACE is turned on or off.

 ;   TRACE on=1, off=0 

 ;   TRACE = string  - turns TRACE on and sets APID = string

 ;   TRACE = HITS    - saves only the buffer string coming from the 

 ;                     client

 ;                   - If a string follows HITS then APID is set equal

 ;                     to the string

 S BGUTCK=$P($P(BGUTCK,U),";"),BGUTRACE=$S(BGUTCK=0:0,1:1),BGUAPD2=""

 I 'BGUTRACE D KILL Q

 I 'BGUTCK S BGUHIT=$E(BGUTCK,1,4)="HITS",BGUAPD2=$S('BGUHIT:BGUTCK,$P(BGUTCK,"HITS",2)'="":$P(BGUTCK,"HITS",2),1:"")

 Q

 ;

TRACE ;

 ; Save the following varaibles in ^BGUTRACE for this job:

 ;     $J

 ;     APPID   -- Application ID

 ;     BGUBUF  -- Buffer string

 ;     BGUSTR  -- Routine that is called by BGUTCPH, along with

 ;                values of the passed parameters

 ;     BGUDATA -- Output variable for the remote procedure routines

 ;

 L +^BGUTRACE(0):10 Q:'$T

 S BGUIEN(1)=$P($G(^BGUTRACE(0)),"^",3)+1

 ; Save data into ^BGUTRACE(SEQ)

 S BGUFDA="BGUFDA(1)"

 ; Need to get the APPID field passed in the string from the client

 S BGUFDA(1,90061,"+1,",.01)=BGUIEN(1),BGUFDA(1,90061,"+1,",".02")=BGUAPID,BGUFDA(1,90061,"+1,",".03")=$J

 D NOW^%DTC S BGUFDA(1,90061,"+1,",".04")=% K %,%H,%I

 D UPDATE^DIE("",BGUFDA,"BGUIEN","BGUEMSG")

 L -^BGUTRACE(0):1

 I BGUTYPE=4 D TRACEGLO Q

 ;S BGUY=BGUMSG,BGUN2=.05 D PARSE

 S BGUN2=.05 D PARSE(.BGUMSG)

 ;I 'BGUHIT S BGUY=BGUSTR,BGUN2=.06 S:$E(BGUY)=U BGUY=$C(30)_BGUY D PARSE S BGUN="" F  S BGUN=$O(BGUDATA(BGUN)) Q:BGUN=""  S BGUDTA=$S($L(BGUDATA(BGUN))>200:$E(BGUDATA(BGUN),1,200)_"...",1:BGUDATA(BGUN)) S BGUWPD(.07,BGUN)=BGUDTA

 I 'BGUHIT S BGUN2=.06 D PARSE(.BGUSTR,$S($E(BGUSTR)=U:$C(30),1:"")) S BGUN="" F  S BGUN=$O(BGUDATA(BGUN)) Q:BGUN=""  S BGUDTA=$S($L(BGUDATA(BGUN))>200:$E(BGUDATA(BGUN),1,200)_"...",1:BGUDATA(BGUN)) S BGUWPD(.07,BGUN)=BGUDTA

 S BGUN=0 F  S BGUN=$O(BGUWPD(BGUN)) Q:BGUN=""  D WP^DIE(90061,BGUIEN(1)_",",BGUN,"","BGUWPD("_BGUN_")","BGUWMSG")

 Q

 ;

PARSE(BGUY,BGUZ) ;

 S BGUY=$G(BGUZ)_BGUY

 S BGUYLN=$L(BGUY),BGUN1=BGUYLN\BGUMXL+(BGUYLN#BGUMXL>0)

 F BGUN=1:1:BGUN1 S BGUY1=$E(BGUY,BGUN*BGUMXL-199,BGUN*BGUMXL),BGUWPD(BGUN2,BGUN)=BGUY1

 Q

 ;

TRACEGLO ;

 Q:$G(BGUDATA)=""

 K ^BGUWPD($J)

 S BGUY=BGUMSG,BGUN2=.05 D PARSEGLO

 S BGUGLO=BGUDATA,BGUCK=$P(BGUGLO,")",1),BGUN=1

 S:$D(@BGUGLO)>10 ^BGUWPD($J,.07,BGUN)=@BGUGLO,BGUN=2

 I 'BGUHIT S BGUY=BGUSTR,BGUN2=.06 S:$E(BGUY)=U BGUY=$C(30)_BGUY D PARSEGLO F  S BGUGLO=$Q(@BGUGLO) Q:BGUGLO=""!(BGUGLO'[BGUCK)  S ^BGUWPD($J,.07,BGUN)=@BGUGLO,BGUN=BGUN+1

 S BGUN=0 F  S BGUN=$O(^BGUWPD($J,BGUN)) Q:BGUN=""  D WP^DIE(90061,BGUIEN(1)_",",BGUN,"","^BGUWPD("_$J_","_BGUN_")","BGUWMSG")

 K ^BGUWPD($J)

 Q

PARSEGLO ;

 S BGUYLN=$L(BGUY),BGUN1=BGUYLN\BGUMXL+(BGUYLN#BGUMXL>0)

 F BGUN=1:1:BGUN1 S BGUY1=$E(BGUY,BGUN*BGUMXL-199,BGUN*BGUMXL),^BGUWPD($J,BGUN2,BGUN)=BGUY1

 Q

KILL ;

 K BGUAPD2,BGUDTA,BGUEMSG,BGUMXL,BGUFLGS,BGUFDA,BGUFN,BGUIEN,BGUM,BGUMSG1,BGUMSG2,BGUN,BGUN1,BGUN2,BGUREF,BGURTN,BGUSTR,BGUTCK,BGUTCK1,BGUY,BGUY1,BGUYLN,BGUWMSG,BGUWPD,DIC,DIR,BGUGLO,BGUCK

 Q

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

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

MAIN      ; -- main message processing loop

 +1        SET BGUMXL=200

           SET BGUAPID=$GET(BGUAPID,"OE-2")

           SET BGUTCK=$PIECE(BGUMSG,"TRACE=",2)

           SET BGUHIT=$GET(BGUHIT)

 +2        IF BGUTCK'=""

               DO CKPAR

               IF 'BGUTRACE

                   QUIT 

               IF 'BGUTCK

                   IF BGUAPD2'=""

                       SET BGUAPID=BGUAPD2

 +3        IF $DATA(BGUTRACE)

               IF 'BGUTRACE

                   QUIT 

 +4        SET BGURTN=BGUTRTN

           SET BGUMSG1=$PIECE(BGUMSG,U,2,999)

           IF $EXTRACT(BGUMSG1,$LENGTH(BGUMSG1))=U

               SET BGUMSG1=$EXTRACT(BGUMSG1,1,$LENGTH(BGUMSG1)-1)

 +5        SET BGUSTR=""

           FOR BGUN=1:1:$LENGTH(BGUMSG1,U)

               IF BGUN>1

                   SET BGUSTR=BGUSTR_","

               SET BGUSTR=BGUSTR_""""_$PIECE(BGUMSG1,U,BGUN)_""""

 +6        SET BGUSTR=$PIECE(BGURTN,"(",1)_"("_BGUSTR_")"

 +7        KILL BGUMSG1

 +8        DO TRACE

 +9        DO KILL

 +10       QUIT 

 +11      ;

CKPAR     ; -- Check parameter string to see if TRACE is turned on or off.

 +1       ;   TRACE on=1, off=0 

 +2       ;   TRACE = string  - turns TRACE on and sets APID = string

 +3       ;   TRACE = HITS    - saves only the buffer string coming from the 

 +4       ;                     client

 +5       ;                   - If a string follows HITS then APID is set equal

 +6       ;                     to the string

 +7        SET BGUTCK=$PIECE($PIECE(BGUTCK,U),";")

           SET BGUTRACE=$SELECT(BGUTCK=0:0,1:1)

           SET BGUAPD2=""

 +8        IF 'BGUTRACE

               DO KILL

               QUIT 

 +9        IF 'BGUTCK

               SET BGUHIT=$EXTRACT(BGUTCK,1,4)="HITS"

               SET BGUAPD2=$SELECT('BGUHIT:BGUTCK,$PIECE(BGUTCK,"HITS",2)'="":$PIECE(BGUTCK,"HITS",2),1:"")

 +10       QUIT 

 +11      ;

TRACE     ;

 +1       ; Save the following varaibles in ^BGUTRACE for this job:

 +2       ;     $J

 +3       ;     APPID   -- Application ID

 +4       ;     BGUBUF  -- Buffer string

 +5       ;     BGUSTR  -- Routine that is called by BGUTCPH, along with

 +6       ;                values of the passed parameters

 +7       ;     BGUDATA -- Output variable for the remote procedure routines

 +8       ;

 +9        LOCK +^BGUTRACE(0):10

           IF '$TEST

               QUIT 

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

 +11      ; Save data into ^BGUTRACE(SEQ)

 +12       SET BGUFDA="BGUFDA(1)"

 +13      ; Need to get the APPID field passed in the string from the client

 +14       SET BGUFDA(1,90061,"+1,",.01)=BGUIEN(1)

           SET BGUFDA(1,90061,"+1,",".02")=BGUAPID

           SET BGUFDA(1,90061,"+1,",".03")=$JOB

 +15       DO NOW^%DTC

           SET BGUFDA(1,90061,"+1,",".04")=%

           KILL %,%H,%I

 +16       DO UPDATE^DIE("",BGUFDA,"BGUIEN","BGUEMSG")

 +17       LOCK -^BGUTRACE(0):1

 +18       IF BGUTYPE=4

               DO TRACEGLO

               QUIT 

 +19      ;S BGUY=BGUMSG,BGUN2=.05 D PARSE

 +20       SET BGUN2=.05

           DO PARSE(.BGUMSG)

 +21      ;I 'BGUHIT S BGUY=BGUSTR,BGUN2=.06 S:$E(BGUY)=U BGUY=$C(30)_BGUY D PARSE S BGUN="" F  S BGUN=$O(BGUDATA(BGUN)) Q:BGUN=""  S BGUDTA=$S($L(BGUDATA(BGUN))>200:$E(BGUDATA(BGUN),1,200)_"...",1:BGUDATA(BGUN)) S BGUWPD(.07,BGUN)=BGUDTA

 +22       IF 'BGUHIT

               SET BGUN2=.06

               DO PARSE(.BGUSTR,$SELECT($EXTRACT(BGUSTR)=U:$CHAR(30),1:""))

               SET BGUN=""

               FOR 

                   SET BGUN=$ORDER(BGUDATA(BGUN))

                   IF BGUN=""

                       QUIT 

                   SET BGUDTA=$SELECT($LENGTH(BGUDATA(BGUN))>200:$EXTRACT(BGUDATA(BGUN),1,200)_"...",1:BGUDATA(BGUN))

                   SET BGUWPD(.07,BGUN)=BGUDTA

 +23       SET BGUN=0

           FOR 

               SET BGUN=$ORDER(BGUWPD(BGUN))

               IF BGUN=""

                   QUIT 

               DO WP^DIE(90061,BGUIEN(1)_",",BGUN,"","BGUWPD("_BGUN_")","BGUWMSG")

 +24       QUIT 

 +25      ;

PARSE(BGUY,BGUZ) ;

 +1        SET BGUY=$GET(BGUZ)_BGUY

 +2        SET BGUYLN=$LENGTH(BGUY)

           SET BGUN1=BGUYLN\BGUMXL+(BGUYLN#BGUMXL>0)

 +3        FOR BGUN=1:1:BGUN1

               SET BGUY1=$EXTRACT(BGUY,BGUN*BGUMXL-199,BGUN*BGUMXL)

               SET BGUWPD(BGUN2,BGUN)=BGUY1

 +4        QUIT 

 +5       ;

TRACEGLO  ;

 +1        IF $GET(BGUDATA)=""

               QUIT 

 +2        KILL ^BGUWPD($JOB)

 +3        SET BGUY=BGUMSG

           SET BGUN2=.05

           DO PARSEGLO

 +4        SET BGUGLO=BGUDATA

           SET BGUCK=$PIECE(BGUGLO,")",1)

           SET BGUN=1

 +5        IF $DATA(@BGUGLO)>10

               SET ^BGUWPD($JOB,.07,BGUN)=@BGUGLO

               SET BGUN=2

 +6        IF 'BGUHIT

               SET BGUY=BGUSTR

               SET BGUN2=.06

               IF $EXTRACT(BGUY)=U

                   SET BGUY=$CHAR(30)_BGUY

               DO PARSEGLO

               FOR 

                   SET BGUGLO=$QUERY(@BGUGLO)

                   IF BGUGLO=""!(BGUGLO'[BGUCK)

                       QUIT 

                   SET ^BGUWPD($JOB,.07,BGUN)=@BGUGLO

                   SET BGUN=BGUN+1

 +7        SET BGUN=0

           FOR 

               SET BGUN=$ORDER(^BGUWPD($JOB,BGUN))

               IF BGUN=""

                   QUIT 

               DO WP^DIE(90061,BGUIEN(1)_",",BGUN,"","^BGUWPD("_$JOB_","_BGUN_")","BGUWMSG")

 +8        KILL ^BGUWPD($JOB)

 +9        QUIT 

PARSEGLO  ;

 +1        SET BGUYLN=$LENGTH(BGUY)

           SET BGUN1=BGUYLN\BGUMXL+(BGUYLN#BGUMXL>0)

 +2        FOR BGUN=1:1:BGUN1

               SET BGUY1=$EXTRACT(BGUY,BGUN*BGUMXL-199,BGUN*BGUMXL)

               SET ^BGUWPD($JOB,BGUN2,BGUN)=BGUY1

 +3        QUIT 

KILL      ;

 +1        KILL BGUAPD2,BGUDTA,BGUEMSG,BGUMXL,BGUFLGS,BGUFDA,BGUFN,BGUIEN,BGUM,BGUMSG1,BGUMSG2,BGUN,BGUN1,BGUN2,BGUREF,BGURTN,BGUSTR,BGUTCK,BGUTCK1,BGUY,BGUY1,BGUYLN,BGUWMSG,BGUWPD,DIC,DIR,BGUGLO,BGUCK

 +2        QUIT