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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLDIEDBG 7679 printed Oct 16, 2024@17:58:09 Page 2
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
