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
