- HLDIEDBG ;CIOFO-O/LJA - Direct 772 & 773 Sets DEBUG CODE ;12/29/03 10:39
- ;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13,1995
- ;
- ; D MENU^HLDIE to invoke debug menu. Debugger documentation included.
- ;
- D INIT^HLDIEDB1
- Q
- ;
- SETDEBUG ; Set or "unset" the DEBUG string...
- N IOBOFF,IOBON,IOINHI,IOINORM,NEWSTR,STRING,X
- W @IOF,$$CJ^XLFSTR("HLDIE Debug String Set/Unset Utility",IOM)
- W !,$$REPEAT^XLFSTR("=",IOM)
- ;
- S X="IOINHI;IOINORM" D ENDR^%ZISS
- ;
- ; Ask for a new string...
- W !!,"When asked for a new debug string, you may take one of the following actions:"
- W !!," * Enter RETURN or '^' to exit."
- W !," * Enter a debug string. (E.g., '1' or '1^2' or '1^1^1'.)"
- W !," * Enter '@' to delete the debug string, (If a debug string exists)."
- ;
- SET1 ;
- ; Get current DEBUG value...
- S STRING=$G(^XTMP("HLDIE-DEBUG","STATUS"))
- ;
- ; Show user current value...
- W !!!!,"Current DEBUG string = ",IOINHI,STRING,IOINORM
- ;
- ; Get new debug string...
- W !!,"Enter DEBUG string, ",$S(STRING]"":"'@', ",1:""),"or RETURN to exit: "
- R NEWSTR:999 QUIT:'$T ;->
- ;
- ; Exit conditions...
- I NEWSTR=U!(NEWSTR']"") D QUIT ;->
- . I STRING']"" D QUIT ;->
- . . W " no changes made. Exiting... "
- . . H 2
- . W !!,"No changes made. (If you want to stop debugging, enter '"
- . W IOINHI,"@",IOINORM,"'.) Exiting..."
- ;
- ; Reset to null if @...
- I NEWSTR="@" S NEWSTR=""
- ;
- ; User didn't change anything!!!
- I NEWSTR=STRING W " no changes made... " G SET1 ;->
- ;
- ; If debug string to be set to null...
- I NEWSTR']"" D G SET1 ;->
- . KILL ^XTMP("HLDIE-DEBUG","STATUS")
- . W " stopped all debugging!"
- ;
- ; Debug string has text, so just set it...
- S ^XTMP("HLDIE-DEBUG",0)=$$FMADD^XLFDT(DT,7)_U_$$NOW^XLFDT_U_"Control string for HLDIE debugging"
- S ^XTMP("HLDIE-DEBUG","STATUS")=NEWSTR
- W " debugging set..."
- ;
- Q
- ;
- ;
- ; ================================================================
- ;
- ;
- DEBUG(RTN,LOC,STORE,XEC) ; Store debug data... (Don't call unless all
- ; checks have been made and debug data IS to be stored!)
- ;
- ; ROOT() -- req
- ;
- ; RTN -- Where (subrtn~rtn, usually) call to FILE^HLDIE made from.
- ;
- ; LOC -- Location... BEFORE FILE^HLDIE call = 1
- ; AFTER FILE^HLDIE call = 2
- ;
- ; STORE -- "" = Don't collect
- ; 1 = Collect "select" (see above) data.
- ; 2 = Collect "all" data.
- ;
- ; XEC -- If XEC=1 then S STORE=$$STORE^HLDIEDB0(RTN,LOC,STORE) is
- ; called to optionally change the value of STORE (and thus
- ; control whether data is stored.)
- ;
- N CT,DEBUGNO,DEBUGNOW,HLFILE,HLIEN,INCRNO,NO,X,XTMP
- ;
- S DEBUGNOW=$$NOW^XLFDT,DT=DEBUGNOW\1
- ;
- ; Get file and ien for storing in XTMP...
- S FILE=$G(FILE),IEN=$G(IEN)
- I FILE,IEN S HLFILE=FILE,HLIEN=IEN
- I 'FILE!('IEN) D
- . S (HLFILE,HLIEN)=0
- . I $G(ROOT)]"" S HLFILE=$O(@ROOT@(0)),HLIEN=+$O(@ROOT@(+HLFILE,""))
- ;
- ; Get storage number...
- S DEBUGNO=$O(^XTMP("HLDIE-DEBUG-"_DT,$J,RTN,":"),-1)+1
- ;
- ; How many stored? Can't store more than 20...
- S CT=0,NO=0
- F S NO=$O(^XTMP("HLDIE-DEBUG-"_DT,$J,RTN,NO)) Q:'NO D
- . S CT=CT+1
- ;
- ; If M code passed, check w/^DIM, then execute.
- I XEC=1 S STORE=$$STORESCR^HLDIEDB2(RTN,LOC,STORE) QUIT:'STORE ;->
- ;
- ERRESUME ; If $$STORESCR code errors, there has to be a place for
- ; error trapping to GOTO. This is that place...
- ;
- ; Quit if 20 occurences stored...
- QUIT:CT'<20 ;->
- ;
- ; Zero node & XTMP...
- ;
- ; Debug data retained for 7 days...
- S XTMP="HLDIE-DEBUG-"_DT
- S:$G(^XTMP(XTMP,0))']"" ^XTMP(XTMP,0)=$$FMADD^XLFDT(DT,7)_U_DEBUGNOW_U_"Debug data created by HLDIEDBG routine"
- ;
- ; Xref data retain for 7 days from last time any DEBUG data created...
- S XTMP="HLDIE-DEBUGX"
- S:$G(^XTMP(XTMP,0))']"" ^XTMP(XTMP,0)=$$FMADD^XLFDT(DT,7)_U_$$NOW^XLFDT_U_"Debug data created by HLDIEDBG routine"
- I $P(^XTMP(XTMP,0),U)'=$$FMADD^XLFDT(DT,7) S $P(^XTMP(XTMP,0),U)=$$FMADD^XLFDT(DT,7)
- ;
- ; Get incremental number...
- S INCRNO=$I(^XTMP("HLDIE-DEBUGN","N"),1)
- ;
- ; Do following for STORE=1 and STORE=2...
- S ^XTMP("HLDIE-DEBUG-"_DT,$J,RTN,+DEBUGNO)=LOC_U_DEBUGNOW_U_$G(HLFILE)_U_$G(HLIEN)_U_$TR($P($G(XQY0),U,1,2),U,"~")_U_$TR($G(HLEDITOR),U,"~")
- D STOREMSG(+$G(HLFILE),+$G(HLIEN),RTN,DEBUGNO,LOC,INCRNO)
- ;
- ; Store "select" data...
- I STORE=1,LOC'=2,$G(ROOT)]"" D QUIT ;->
- . MERGE ^XTMP("HLDIE-DEBUG-"_DT,$J,RTN,+DEBUGNO)=@ROOT
- ;
- QUIT:STORE'=2 ;->
- ;
- ; Store "all" local variable data...
- S X="^XTMP(""HLDIE-DEBUG-"_DT_""","_$J_","""_RTN_""","_DEBUGNO_","
- D DOLRO^%ZOSV
- ;
- D ONLYASC(X)
- ;
- Q
- ;
- ONLYASC(REF) ; Convert control characters to {ASCII}...
- N DATA,LP
- ;
- S LP=$E(REF,1,$L(REF)-1)_")"
- F S LP=$Q(@LP) Q:LP'[REF D
- . S DATA=$$ONLYASC^HLDIEDB0(@LP)
- . I $L(DATA),$TR(DATA," ","")']"" S DATA="{#"_$L(DATA)_" spaces}"
- . S @LP=DATA
- ;
- Q
- ;
- STOREMSG(FILE,IEN,RTN,DEBUGNO,LOC,INCRNO) ; Store message data in ^XTMP...
- ; DEBUGNOW -- req
- N GBL,NODE
- ;
- ; Set XREF XTMP...
- S ^XTMP("HLDIE-DEBUGX",FILE,IEN,DEBUGNOW,$J,RTN,DEBUGNO)=LOC_U_$TR($G(HLEDITOR),U,"~")
- S ^XTMP("HLDIE-DEBUGN","N",INCRNO)=FILE_U_IEN_U_DEBUGNOW_U_$J_U_RTN_U_DEBUGNO_U_LOC_U_$TR($G(HLEDITOR),U,"~")
- ;
- ; Get GBL...
- S GBL=$S(FILE=772:"^HL(772,"_IEN_")",1:"^HLMA("_IEN_")")
- ;
- ; Collect message data...
- F NODE=0,1,2,"P","S",$S(FILE=772:"IN",1:"MSH") D NODE(GBL,NODE)
- ;
- Q
- ;
- NODE(GBL,NODE) ; Collect message data...
- ; RTN,DEBUGNO -- req
- N LAST,LNO,TXT,X
- ;
- I NODE="MSH" D QUIT ;->
- . N LNO,TXT
- . S LNO=0
- . F S LNO=$O(@GBL@("MSH",LNO)) Q:'LNO D
- . . S TXT=$G(@GBL@("MSH",+LNO,0)) QUIT:TXT']"" ;->
- . . S ^XTMP("HLDIE-DEBUG-"_DT,$J,RTN,DEBUGNO,"D","MSH",LNO,0)=TXT
- ;
- I NODE="IN" D QUIT ;->
- . N LAST,TXT
- . S LAST=$O(@GBL@("IN",":"),-1)
- . S TXT=$G(@GBL@("IN",1,0)) QUIT:TXT']"" ;->
- . S ^XTMP("HLDIE-DEBUG-"_DT,$J,RTN,DEBUGNO,"D","IN",1,0)=1_":"_LAST_"~"_TXT
- ;
- ; Store node...
- S X=$G(@GBL@(NODE)) I X]"" S ^XTMP("HLDIE-DEBUG-"_DT,$J,RTN,DEBUGNO,"D",NODE)=X
- ;
- Q
- ;
- KILLALL ; Don't call here unless it's OK to remove ALL-ALL debug data...
- N KILL,OFF,XTMP
- ;
- I $O(^XTMP("HLDIE-DEBUG"))']"HLDIE-DEBUG" D QUIT ;->
- . W !!,"No debug data exists..."
- ;
- W !
- S KILL=$$YN^HLCSRPT4("Kill **ALL** debug data","No")
- I 'KILL W " no data will be killed..." QUIT ;->
- ;
- W !!,"KILLing all debug data..."
- S XTMP="HLDIE-DEBUG"
- F S XTMP=$O(^XTMP(XTMP)) Q:XTMP'["HLDIE-DEBUG" D
- . KILL ^XTMP(XTMP)
- ;
- Q
- ;
- LOG(SUBSV,KEEP,STOP) ; Log local vars into ^XTMP("HLDIE "_DT)...
- ;
- ; Documentation in MENU^HLDIE...
- ;
- N NO,NOW,NOXTMP,X,XTMP
- ;
- ; Presets...
- S SUBSV=$G(SUBSV),KEEP=$G(KEEP),STOP=$G(STOP),NOXTMP=0,NOW=$$NOW^XLFDT
- S SUBSV=$TR($S(SUBSV]"":SUBSV,1:"UNKNOWN"),"""","")
- ;
- ; # to keep setup...
- S KEEP=$S(KEEP&(KEEP<100):KEEP,1:20)
- ;
- ; XTMP setup...
- S XTMP="HLDIE-"_DT
- S:'$D(^XTMP(XTMP,0)) ^XTMP(XTMP,0)=$$FMADD^XLFDT(NOW,7)_U_$$NOW^XLFDT_U_"Data logged by LOG~HLDIE"
- ;
- ; Count number entries...
- I STOP=1 D
- . S NOXTMP=0,NO=0
- . F S NO=$O(^XTMP(XTMP,SUBSV,NO)) Q:'NO D
- . . S NOXTMP=NOXTMP+1
- ;
- ; Incremented sequential store #...
- S NO=$O(^XTMP(XTMP,SUBSV,":"),-1)+1
- ;
- ; STOP now?
- I STOP,NOXTMP'<KEEP QUIT ;->
- ;
- ; Store all local variables...
- S X="^XTMP("""_XTMP_""","""_SUBSV_""","_NO_"," D DOLRO^%ZOSV
- S ^XTMP(XTMP,SUBSV,NO)=$$NOW^XLFDT
- ;
- I $ZE]"" S ^XTMP(XTMP,SUBSV,NO,"$ZE")=$ZE
- ;
- ; Keep only KEEP instances...
- F NO=NO-KEEP:-1:1 KILL ^XTMP(XTMP,SUBSV,NO)
- ;
- Q
- ;
- EOR ;HLDIEDBG - Direct 772 & 773 Sets DEBUG CODE ; 11/18/2003 11:17
- HLDIEDBG ;CIOFO-O/LJA - Direct 772 & 773 Sets DEBUG CODE ;12/29/03 10:39
- +1 ;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13,1995
- +2 ;
- +3 ; D MENU^HLDIE to invoke debug menu. Debugger documentation included.
- +4 ;
- +1 DO INIT^HLDIEDB1
- +2 QUIT
- +3 ;
- SETDEBUG ; Set or "unset" the DEBUG string...
- +1 NEW IOBOFF,IOBON,IOINHI,IOINORM,NEWSTR,STRING,X
- +2 WRITE @IOF,$$CJ^XLFSTR("HLDIE Debug String Set/Unset Utility",IOM)
- +3 WRITE !,$$REPEAT^XLFSTR("=",IOM)
- +4 ;
- +5 SET X="IOINHI;IOINORM"
- DO ENDR^%ZISS
- +6 ;
- +7 ; Ask for a new string...
- +8 WRITE !!,"When asked for a new debug string, you may take one of the following actions:"
- +9 WRITE !!," * Enter RETURN or '^' to exit."
- +10 WRITE !," * Enter a debug string. (E.g., '1' or '1^2' or '1^1^1'.)"
- +11 WRITE !," * Enter '@' to delete the debug string, (If a debug string exists)."
- +12 ;
- SET1 ;
- +1 ; Get current DEBUG value...
- +2 SET STRING=$GET(^XTMP("HLDIE-DEBUG","STATUS"))
- +3 ;
- +4 ; Show user current value...
- +5 WRITE !!!!,"Current DEBUG string = ",IOINHI,STRING,IOINORM
- +6 ;
- +7 ; Get new debug string...
- +8 WRITE !!,"Enter DEBUG string, ",$SELECT(STRING]"":"'@', ",1:""),"or RETURN to exit: "
- +9 ;->
- READ NEWSTR:999
- IF '$TEST
- QUIT
- +10 ;
- +11 ; Exit conditions...
- +12 ;->
- IF NEWSTR=U!(NEWSTR']"")
- Begin DoDot:1
- +13 ;->
- IF STRING']""
- Begin DoDot:2
- +14 WRITE " no changes made. Exiting... "
- +15 HANG 2
- End DoDot:2
- QUIT
- +16 WRITE !!,"No changes made. (If you want to stop debugging, enter '"
- +17 WRITE IOINHI,"@",IOINORM,"'.) Exiting..."
- End DoDot:1
- QUIT
- +18 ;
- +19 ; Reset to null if @...
- +20 IF NEWSTR="@"
- SET NEWSTR=""
- +21 ;
- +22 ; User didn't change anything!!!
- +23 ;->
- IF NEWSTR=STRING
- WRITE " no changes made... "
- GOTO SET1
- +24 ;
- +25 ; If debug string to be set to null...
- +26 ;->
- IF NEWSTR']""
- Begin DoDot:1
- +27 KILL ^XTMP("HLDIE-DEBUG","STATUS")
- +28 WRITE " stopped all debugging!"
- End DoDot:1
- GOTO SET1
- +29 ;
- +30 ; Debug string has text, so just set it...
- +31 SET ^XTMP("HLDIE-DEBUG",0)=$$FMADD^XLFDT(DT,7)_U_$$NOW^XLFDT_U_"Control string for HLDIE debugging"
- +32 SET ^XTMP("HLDIE-DEBUG","STATUS")=NEWSTR
- +33 WRITE " debugging set..."
- +34 ;
- +35 QUIT
- +36 ;
- +37 ;
- +38 ; ================================================================
- +39 ;
- +40 ;
- DEBUG(RTN,LOC,STORE,XEC) ; Store debug data... (Don't call unless all
- +1 ; checks have been made and debug data IS to be stored!)
- +2 ;
- +3 ; ROOT() -- req
- +4 ;
- +5 ; RTN -- Where (subrtn~rtn, usually) call to FILE^HLDIE made from.
- +6 ;
- +7 ; LOC -- Location... BEFORE FILE^HLDIE call = 1
- +8 ; AFTER FILE^HLDIE call = 2
- +9 ;
- +10 ; STORE -- "" = Don't collect
- +11 ; 1 = Collect "select" (see above) data.
- +12 ; 2 = Collect "all" data.
- +13 ;
- +14 ; XEC -- If XEC=1 then S STORE=$$STORE^HLDIEDB0(RTN,LOC,STORE) is
- +15 ; called to optionally change the value of STORE (and thus
- +16 ; control whether data is stored.)
- +17 ;
- +18 NEW CT,DEBUGNO,DEBUGNOW,HLFILE,HLIEN,INCRNO,NO,X,XTMP
- +19 ;
- +20 SET DEBUGNOW=$$NOW^XLFDT
- SET DT=DEBUGNOW\1
- +21 ;
- +22 ; Get file and ien for storing in XTMP...
- +23 SET FILE=$GET(FILE)
- SET IEN=$GET(IEN)
- +24 IF FILE
- IF IEN
- SET HLFILE=FILE
- SET HLIEN=IEN
- +25 IF 'FILE!('IEN)
- Begin DoDot:1
- +26 SET (HLFILE,HLIEN)=0
- +27 IF $GET(ROOT)]""
- SET HLFILE=$ORDER(@ROOT@(0))
- SET HLIEN=+$ORDER(@ROOT@(+HLFILE,""))
- End DoDot:1
- +28 ;
- +29 ; Get storage number...
- +30 SET DEBUGNO=$ORDER(^XTMP("HLDIE-DEBUG-"_DT,$JOB,RTN,":"),-1)+1
- +31 ;
- +32 ; How many stored? Can't store more than 20...
- +33 SET CT=0
- SET NO=0
- +34 FOR
- SET NO=$ORDER(^XTMP("HLDIE-DEBUG-"_DT,$JOB,RTN,NO))
- IF 'NO
- QUIT
- Begin DoDot:1
- +35 SET CT=CT+1
- End DoDot:1
- +36 ;
- +37 ; If M code passed, check w/^DIM, then execute.
- +38 ;->
- IF XEC=1
- SET STORE=$$STORESCR^HLDIEDB2(RTN,LOC,STORE)
- IF 'STORE
- QUIT
- +39 ;
- ERRESUME ; If $$STORESCR code errors, there has to be a place for
- +1 ; error trapping to GOTO. This is that place...
- +2 ;
- +3 ; Quit if 20 occurences stored...
- +4 ;->
- IF CT'<20
- QUIT
- +5 ;
- +6 ; Zero node & XTMP...
- +7 ;
- +8 ; Debug data retained for 7 days...
- +9 SET XTMP="HLDIE-DEBUG-"_DT
- +10 IF $GET(^XTMP(XTMP,0))']""
- SET ^XTMP(XTMP,0)=$$FMADD^XLFDT(DT,7)_U_DEBUGNOW_U_"Debug data created by HLDIEDBG routine"
- +11 ;
- +12 ; Xref data retain for 7 days from last time any DEBUG data created...
- +13 SET XTMP="HLDIE-DEBUGX"
- +14 IF $GET(^XTMP(XTMP,0))']""
- SET ^XTMP(XTMP,0)=$$FMADD^XLFDT(DT,7)_U_$$NOW^XLFDT_U_"Debug data created by HLDIEDBG routine"
- +15 IF $PIECE(^XTMP(XTMP,0),U)'=$$FMADD^XLFDT(DT,7)
- SET $PIECE(^XTMP(XTMP,0),U)=$$FMADD^XLFDT(DT,7)
- +16 ;
- +17 ; Get incremental number...
- +18
- *** ERROR ***
- SET INCRNO=$I(^XTMP("HLDIE-DEBUGN","N"),1)
- +19 ;
- +20 ; Do following for STORE=1 and STORE=2...
- +21 SET ^XTMP("HLDIE-DEBUG-"_DT,$JOB,RTN,+DEBUGNO)=LOC_U_DEBUGNOW_U_$GET(HLFILE)_U_$GET(HLIEN)_U_$TRANSLATE($PIECE($GET(XQY0),U,1,2),U,"~")_U_$TRANSLATE($GET(HLEDITOR),U,"~")
- +22 DO STOREMSG(+$GET(HLFILE),+$GET(HLIEN),RTN,DEBUGNO,LOC,INCRNO)
- +23 ;
- +24 ; Store "select" data...
- +25 ;->
- IF STORE=1
- IF LOC'=2
- IF $GET(ROOT)]""
- Begin DoDot:1
- +26 MERGE ^XTMP("HLDIE-DEBUG-"_DT,$JOB,RTN,+DEBUGNO)=@ROOT
- End DoDot:1
- QUIT
- +27 ;
- +28 ;->
- IF STORE'=2
- QUIT
- +29 ;
- +30 ; Store "all" local variable data...
- +31 SET X="^XTMP(""HLDIE-DEBUG-"_DT_""","_$JOB_","""_RTN_""","_DEBUGNO_","
- +32 DO DOLRO^%ZOSV
- +33 ;
- +34 DO ONLYASC(X)
- +35 ;
- +36 QUIT
- +37 ;
- ONLYASC(REF) ; Convert control characters to {ASCII}...
- +1 NEW DATA,LP
- +2 ;
- +3 SET LP=$EXTRACT(REF,1,$LENGTH(REF)-1)_")"
- +4 FOR
- SET LP=$QUERY(@LP)
- IF LP'[REF
- QUIT
- Begin DoDot:1
- +5 SET DATA=$$ONLYASC^HLDIEDB0(@LP)
- +6 IF $LENGTH(DATA)
- IF $TRANSLATE(DATA," ","")']""
- SET DATA="{#"_$LENGTH(DATA)_" spaces}"
- +7 SET @LP=DATA
- End DoDot:1
- +8 ;
- +9 QUIT
- +10 ;
- STOREMSG(FILE,IEN,RTN,DEBUGNO,LOC,INCRNO) ; Store message data in ^XTMP...
- +1 ; DEBUGNOW -- req
- +2 NEW GBL,NODE
- +3 ;
- +4 ; Set XREF XTMP...
- +5 SET ^XTMP("HLDIE-DEBUGX",FILE,IEN,DEBUGNOW,$JOB,RTN,DEBUGNO)=LOC_U_$TRANSLATE($GET(HLEDITOR),U,"~")
- +6 SET ^XTMP("HLDIE-DEBUGN","N",INCRNO)=FILE_U_IEN_U_DEBUGNOW_U_$JOB_U_RTN_U_DEBUGNO_U_LOC_U_$TRANSLATE($GET(HLEDITOR),U,"~")
- +7 ;
- +8 ; Get GBL...
- +9 SET GBL=$SELECT(FILE=772:"^HL(772,"_IEN_")",1:"^HLMA("_IEN_")")
- +10 ;
- +11 ; Collect message data...
- +12 FOR NODE=0,1,2,"P","S",$SELECT(FILE=772:"IN",1:"MSH")
- DO NODE(GBL,NODE)
- +13 ;
- +14 QUIT
- +15 ;
- NODE(GBL,NODE) ; Collect message data...
- +1 ; RTN,DEBUGNO -- req
- +2 NEW LAST,LNO,TXT,X
- +3 ;
- +4 ;->
- IF NODE="MSH"
- Begin DoDot:1
- +5 NEW LNO,TXT
- +6 SET LNO=0
- +7 FOR
- SET LNO=$ORDER(@GBL@("MSH",LNO))
- IF 'LNO
- QUIT
- Begin DoDot:2
- +8 ;->
- SET TXT=$GET(@GBL@("MSH",+LNO,0))
- IF TXT']""
- QUIT
- +9 SET ^XTMP("HLDIE-DEBUG-"_DT,$JOB,RTN,DEBUGNO,"D","MSH",LNO,0)=TXT
- End DoDot:2
- End DoDot:1
- QUIT
- +10 ;
- +11 ;->
- IF NODE="IN"
- Begin DoDot:1
- +12 NEW LAST,TXT
- +13 SET LAST=$ORDER(@GBL@("IN",":"),-1)
- +14 ;->
- SET TXT=$GET(@GBL@("IN",1,0))
- IF TXT']""
- QUIT
- +15 SET ^XTMP("HLDIE-DEBUG-"_DT,$JOB,RTN,DEBUGNO,"D","IN",1,0)=1_":"_LAST_"~"_TXT
- End DoDot:1
- QUIT
- +16 ;
- +17 ; Store node...
- +18 SET X=$GET(@GBL@(NODE))
- IF X]""
- SET ^XTMP("HLDIE-DEBUG-"_DT,$JOB,RTN,DEBUGNO,"D",NODE)=X
- +19 ;
- +20 QUIT
- +21 ;
- KILLALL ; Don't call here unless it's OK to remove ALL-ALL debug data...
- +1 NEW KILL,OFF,XTMP
- +2 ;
- +3 ;->
- IF $ORDER(^XTMP("HLDIE-DEBUG"))']"HLDIE-DEBUG"
- Begin DoDot:1
- +4 WRITE !!,"No debug data exists..."
- End DoDot:1
- QUIT
- +5 ;
- +6 WRITE !
- +7 SET KILL=$$YN^HLCSRPT4("Kill **ALL** debug data","No")
- +8 ;->
- IF 'KILL
- WRITE " no data will be killed..."
- QUIT
- +9 ;
- +10 WRITE !!,"KILLing all debug data..."
- +11 SET XTMP="HLDIE-DEBUG"
- +12 FOR
- SET XTMP=$ORDER(^XTMP(XTMP))
- IF XTMP'["HLDIE-DEBUG"
- QUIT
- Begin DoDot:1
- +13 KILL ^XTMP(XTMP)
- End DoDot:1
- +14 ;
- +15 QUIT
- +16 ;
- LOG(SUBSV,KEEP,STOP) ; Log local vars into ^XTMP("HLDIE "_DT)...
- +1 ;
- +2 ; Documentation in MENU^HLDIE...
- +3 ;
- +4 NEW NO,NOW,NOXTMP,X,XTMP
- +5 ;
- +6 ; Presets...
- +7 SET SUBSV=$GET(SUBSV)
- SET KEEP=$GET(KEEP)
- SET STOP=$GET(STOP)
- SET NOXTMP=0
- SET NOW=$$NOW^XLFDT
- +8 SET SUBSV=$TRANSLATE($SELECT(SUBSV]"":SUBSV,1:"UNKNOWN"),"""","")
- +9 ;
- +10 ; # to keep setup...
- +11 SET KEEP=$SELECT(KEEP&(KEEP<100):KEEP,1:20)
- +12 ;
- +13 ; XTMP setup...
- +14 SET XTMP="HLDIE-"_DT
- +15 IF '$DATA(^XTMP(XTMP,0))
- SET ^XTMP(XTMP,0)=$$FMADD^XLFDT(NOW,7)_U_$$NOW^XLFDT_U_"Data logged by LOG~HLDIE"
- +16 ;
- +17 ; Count number entries...
- +18 IF STOP=1
- Begin DoDot:1
- +19 SET NOXTMP=0
- SET NO=0
- +20 FOR
- SET NO=$ORDER(^XTMP(XTMP,SUBSV,NO))
- IF 'NO
- QUIT
- Begin DoDot:2
- +21 SET NOXTMP=NOXTMP+1
- End DoDot:2
- End DoDot:1
- +22 ;
- +23 ; Incremented sequential store #...
- +24 SET NO=$ORDER(^XTMP(XTMP,SUBSV,":"),-1)+1
- +25 ;
- +26 ; STOP now?
- +27 ;->
- IF STOP
- IF NOXTMP'<KEEP
- QUIT
- +28 ;
- +29 ; Store all local variables...
- +30 SET X="^XTMP("""_XTMP_""","""_SUBSV_""","_NO_","
- DO DOLRO^%ZOSV
- +31 SET ^XTMP(XTMP,SUBSV,NO)=$$NOW^XLFDT
- +32 ;
- +33 IF $ZE]""
- SET ^XTMP(XTMP,SUBSV,NO,"$ZE")=$ZE
- +34 ;
- +35 ; Keep only KEEP instances...
- +36 FOR NO=NO-KEEP:-1:1
- KILL ^XTMP(XTMP,SUBSV,NO)
- +37 ;
- +38 QUIT
- +39 ;
- EOR ;HLDIEDBG - Direct 772 & 773 Sets DEBUG CODE ; 11/18/2003 11:17
