HLDIEDB0 ;CIOFO-O/LJA - Debug Data Display Code ;12/29/03 10:39
;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13,1995
;
FILEIEN ; Input FILE,IEN to find debug data to display...
N ABORT,CT,DATE,FILE,GBL,GCT,IEN,JOB,LOC,RTN,X
;
W @IOF,$$CJ^XLFSTR("Debug Data Display by FILE,IEN",IOM)
W !,$$REPEAT^XLFSTR("=",IOM)
;
I '$D(^XTMP("HLDIE-DEBUGX")) D QUIT ;->
. W !!,"No debug data exists..."
. H 1
;
S GBL="^XTMP(""HLDIE-DEBUGX"")"
;
F D QUIT:'FILE ;->
. D SF
. R !!,"Enter FILE#: ",FILE:99 Q:FILE']""!(FILE[U) ;->
. F D QUIT:'IEN ;->
. . D SI(FILE)
. . R !!,"Enter IEN: ",IEN:99 Q:'IEN ;->
. . W !!,?2,"#",?5,"File & IEN",?20,"Date",?35,"Job#",?50,"Rtn",?68,"Debug#"
. . W !,$$REPEAT^XLFSTR("=",IOM)
. . KILL ^TMP($J,"H")
. . S DATE=0,ABORT=0,GCT=0
. . F S DATE=$O(@GBL@(FILE,IEN,DATE)) Q:'DATE!(ABORT) D
. . . S JOB=0
. . . F S JOB=$O(@GBL@(FILE,IEN,DATE,JOB)) Q:'JOB!(ABORT) D
. . . . S RTN=""
. . . . F S RTN=$O(@GBL@(FILE,IEN,DATE,JOB,RTN)) Q:RTN']""!(ABORT) D
. . . . . S LOC=""
. . . . . F S LOC=$O(@GBL@(FILE,IEN,DATE,JOB,RTN,LOC)) Q:LOC']""!(ABORT) D
. . . . . . S GCT=GCT+1
. . . . . . S ^TMP($J,"H",GCT)=DATE_U_JOB_U_RTN_U_LOC
. . . . . . W !,$J(GCT,3),?5,FILE,"[#",IEN,"]",?20,DATE,?35,JOB,?50,RTN,?68,LOC
. . F D QUIT:'GCT
. . . R !!,"Enter #: ",GCT:99 Q:'GCT ;->
. . . S X=$G(^TMP($J,"H",+GCT)),DATE=+X,JOB=$P(X,U,2),RTN=$P(X,U,3),LOC=$P(X,U,4) QUIT:LOC']"" ;->
. . . D INDIV(DATE\1,JOB,RTN,LOC)
. . . W !,$$REPEAT^XLFSTR("-",IOM)
;
KILL ^TMP($J,"H")
;
Q
;
SF ; Show files...
; GBL -- req
N CT,FILE
W !!,$$CJ^XLFSTR(" Files w/Debug Data ",IOM,"=")
S CT=0,FILE=0
F S FILE=$O(@GBL@(FILE)) Q:'FILE D
. S CT=CT+1 W:CT>1 ", "
. W FILE
W !,$$REPEAT^XLFSTR("-",IOM)
Q
;
SI(FILE) ; Show IENs for file...
; GBL -- req
N CT,IEN
W !!,$$CJ^XLFSTR(" IENs w/Debug Data for File# "_FILE_" ",IOM,"=")
S CT=0,IEN=0
F S IEN=$O(@GBL@(FILE,IEN)) Q:'IEN!(CT>100) D
. S CT=CT+1
. W:$X>65 ! W:$X<6 ?6 W:$X>6 ","
. W IEN
I CT>100 D
. W !!,"Some IENs not displayed (because there were too many)..."
. W !,"(The LAST IEN is ",$O(@GBL@(FILE,":"),-1),".)"
W !,$$REPEAT^XLFSTR("-",IOM)
Q
;
SEARCH ; Search of global data to find & display...
N ABORT,CONT,CT,DATA,FIND,LP,ORIG,POSX,SRCH,ST,X
;
W @IOF,$$CJ^XLFSTR("Debug Data Display by Global Search",IOM)
W !,$$REPEAT^XLFSTR("=",IOM)
;
I '$D(^XTMP("HLDIE-DEBUGX")) D QUIT ;->
. W !!,"No debug data exists..."
. H 1
;
S1 KILL SRCH
;
F R !!,"Search string: ",SRCH:999 Q:SRCH']""!(SRCH=U) D
. S SRCH($$UP^XLFSTR(SRCH))=""
;
QUIT:$O(SRCH(""))']"" ;->
;
W !!,"Searching..."
;
S CT=0,ABORT=0,CONT=0
;
S LP="^XTMP(""HLDIE-DEBUF""",ST="^XTMP(""HLDIE-DEBUG",LP=LP_")"
F S LP=$Q(@LP) Q:LP'[ST!(ABORT) D
. S ORIG=@LP,DATA=$$UP^XLFSTR(ORIG),FIND=0,SRCH=""
. F S SRCH=$O(SRCH(SRCH)) Q:SRCH']""!(FIND) D
. . QUIT:DATA'[SRCH&(LP'[SRCH) ;->
. . S FIND=1
. QUIT:'FIND ;->
. W !,LP,"="
. W:$X>55 !,?10,"-> "
. S POSX=$X
. F D QUIT:ORIG']""
. . W:$X>POSX ! W:$X<POSX ?POSX
. . W $E(ORIG,1,IOM-POSX)
. . S ORIG=$E(ORIG,IOM-POSX+1,999)
. QUIT:CONT ;->
. S CT=CT+1 Q:(CT#10) ;->
. W " <-" R X:99 S:X]""&(X'=" ") ABORT=1 S:X=" " CONT=1
;
I ABORT=1 W !!,"... aborting ..."
;
G S1 ;->
;
API ; Select RTN & SUBRTN to find & show debug data...
N DATE,FILE,MAX,NUM,RTN,SUB
;
W @IOF,$$CJ^XLFSTR("Debug Data Display by API Call",IOM)
W !,$$REPEAT^XLFSTR("=",IOM)
;
I '$D(^XTMP("HLDIE-DEBUGX")) D QUIT ;->
. W !!,"No debug data exists..."
. H 1
;
W !
D COLLECT
D SHOW
;
R1 R !!,"File: ",FILE:99 QUIT:FILE']"" ;->
I '$D(^XTMP("HLDIE-DEBUGX",FILE)) D G R1 ;->
. W " no data..."
;
R !,"Rtn: ",RTN:99 G:RTN']"" R1 ;->
R !,"Subrtn: ",SUB:99 G:SUB']"" R1 ;->
S RTN=RTN_"~"_SUB
;
R !,"Max#: 20// ",MAX:99 S:MAX']"" MAX=20
S MAX=$S(MAX:MAX,1:20)
;
F D QUIT:DATE']"" ;->
. KILL ^TMP($J,"R")
. R !!,"Enter Date/time (FM): ",DATE:99 QUIT:DATE']"" ;->
. I DATE'?7N.E W " invalid format..." QUIT ;->
.
. W !
. D SHOWDT(FILE,DATE,RTN,MAX)
. QUIT:'$D(^TMP($J,"R")) ;->
.
. F D QUIT:NUM']""!(NUM[U)
. . R !!,"Enter # to display: ",NUM:99 Q:NUM']""!(NUM[U) ;->
. . I '$D(^TMP($J,"R",NUM)) D QUIT ;->
. . . W " entry not found..."
. . D SHOWONE(+NUM)
;
H 2
;
D SHOW
;
G R1 ;->
;
SHOWONE(NUM) ; REquires ^TMP($J,"R",NUM)
N DATA,DATE,FILE,IEN,JOB,LOC,RTN
;
S DATA=^TMP($J,"R",NUM)
;
S FILE=+DATA,IEN=$P(DATA,U,2),DATE=$P(DATA,U,3)\1
S JOB=$P(DATA,U,4),RTN=$P(DATA,U,5),LOC=$P(DATA,U,6)
;
D INDIV(DATE,JOB,RTN,LOC)
;
Q
;
INDIV(DATE,JOB,RTN,LOC) ; Display entry's data from ^XTMP global...
N LP,REF,ST
;
S LP="^XTMP(""HLDIE-DEBUG-"_DATE_""","_JOB_","""_RTN_""","_LOC
S ST=LP,LP=LP_")"
;
W !!,"...",$P(LP,"^XTMP(""HLDIE-DEBUG-"_DATE,2),"="
D SDATA($X,$G(@LP))
;
F S LP=$Q(@LP) Q:LP'[ST D
. S REF=$P(LP,"^XTMP(""HLDIE-DEBUG-"_DATE,2)_"="
. W !,"...",REF
. D SDATA($X,@LP)
;
W !
;
Q
;
SDATA(POSX,DATA) ; Show data...
;
F D Q:DATA']""
. QUIT:DATA']"" ;->
. W:$X>POSX ! W:$X<POSX ?POSX
. W $E(DATA,1,IOM-POSX)
. S DATA=$E(DATA,IOM-POSX+1,999)
;
Q
;
SHOWDT(FILE,DATE,RTN,MAX) ; Show entries and create ^TMP($J,"R")...
N ABORT,CT,DATA,GBL,IEN,JOB,JOBLAST,LDT,NO,NUM
;
S GBL="^XTMP(""HLDIE-DEBUGX"","_FILE_")"
;
D SHOWDTHD
;
S IEN=0,CT=0,ABORT=0,JOBLAST=""
F S IEN=$O(@GBL@(IEN)) Q:'IEN!(CT'<MAX) D
. S LDT=DATE-.0000000001
. F S LDT=$O(@GBL@(IEN,LDT)) Q:'LDT D
. . S JOB=0
. . F S JOB=$O(@GBL@(IEN,LDT,JOB)) Q:JOB'>0 D
. . . S NO=$O(@GBL@(IEN,LDT,JOB,RTN,":"),-1)/2\1 QUIT:'NO ;->
. . . S NUM=0
. . . F S NUM=$O(@GBL@(IEN,LDT,JOB,RTN,NUM)) Q:'NUM D
. . . . S CT=CT+1
. . . . S DATA=$G(@GBL@(IEN,LDT,JOB,RTN,NUM))
. . . . S ^TMP($J,"R",CT)=FILE_U_IEN_U_LDT_U_JOB_U_RTN_U_NUM
. . . . I JOBLAST'=""&(JOBLAST) W ! S JOBLAST=0
. . . . D EADTHD(CT,FILE,IEN,LDT,JOB,RTN,NUM,+DATA)
. . . S JOBLAST=JOB
;
Q
;
EADTHD(CT,FILE,IEN,LDT,JOB,RTN,NUM,LOC) ;
W !,$J(CT,3),?5,FILE,?15,+IEN,?25,"@",$P(LDT,".",2)
W ?35,JOB,?50,RTN,?70,LOC,$S(LOC=1:"<-Beg",1:"")
Q
;
SHOWDTHD ;
W !!,"#",?5,"File",?15,"IEN",?25,"Time",?35,"Job#",?50,"Location"
W ?70,"Call#"
W !,$$REPEAT^XLFSTR("=",IOM)
Q
;
SHOW ;
N CT,DATE,FILE,RTN
;
W !!,"File",?17,"Date",?40,"API"
W !,$$REPEAT^XLFSTR("=",IOM)
;
S FILE=0
F S FILE=$O(^TMP($J,"D",FILE)) Q:'FILE D
. W !,FILE," [#",^TMP($J,"D",FILE),"]"
. S DATE=0
. F S DATE=$O(^TMP($J,"D",FILE,DATE)) Q:'DATE D
. . W:$X>17 ! W:$X<17 ?17
. . W DATE," [#",^TMP($J,"D",FILE,DATE),"]"
. . S RTN=""
. . F S RTN=$O(^TMP($J,"D",FILE,DATE,RTN)) Q:RTN']"" D
. . . W:$X>40 ! W:$X<40 ?40
. . . W RTN," [#",^TMP($J,"D",FILE,DATE,RTN),"]"
;
Q
;
COLLECT ; Collect data into ^TMP($J,"D")...
N DATE,FILE,IEN,JOB,LOC,RTN
;
KILL ^TMP($J)
;
S FILE=0
F S FILE=$O(^XTMP("HLDIE-DEBUGX",FILE)) QUIT:'FILE D
. S IEN=0
. F S IEN=$O(^XTMP("HLDIE-DEBUGX",FILE,IEN)) Q:'IEN D
. . S DATE=0
. . F S DATE=$O(^XTMP("HLDIE-DEBUGX",FILE,IEN,DATE)) Q:'DATE D
. . . ; HLDIE-DEBUGX data hangs around longer...
. . . QUIT:'$D(^XTMP("HLDIE-DEBUG-"_(DATE\1))) ;->
. . . S JOB=0
. . . F S JOB=$O(^XTMP("HLDIE-DEBUGX",FILE,IEN,DATE,JOB)) Q:'JOB D
. . . . S RTN=""
. . . . F S RTN=$O(^XTMP("HLDIE-DEBUGX",FILE,IEN,DATE,JOB,RTN)) Q:RTN']"" D
. . . . . S LOC=0
. . . . . F S LOC=$O(^XTMP("HLDIE-DEBUGX",FILE,IEN,DATE,JOB,RTN,LOC)) Q:'LOC D
. . . . . . D COLL1(FILE,IEN,DATE\1,JOB,RTN,LOC)
;
Q
;
COLL1(FILE,IEN,DATE,JOB,RTN,LOC) ; Called by COLLECT...
;
S ^TMP($J,"D",FILE)=$G(^TMP($J,"D",FILE))+1
S ^TMP($J,"D",FILE,DATE)=$G(^TMP($J,"D",FILE,DATE))+1
S ^TMP($J,"D",FILE,DATE,RTN)=$G(^TMP($J,"D",FILE,DATE,RTN))+1
;
Q
;
ONLYASC(TXT) ; Return ASCII only. No CTRL characters...
N ASCII,CHAR,NTXT,POS
S NTXT=""
F POS=1:1:$L(TXT) D
. S CHAR=$E(TXT,+POS),ASCII=$A(CHAR)
. I ASCII<32 S CHAR="{"_ASCII_"}"
. S NTXT=NTXT_CHAR
QUIT NTXT
;
EOR ;HLDIEDBO - Direct 772 & 773 Sets DEBUG CODE ; 11/18/2003 11:17
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HHLDIEDB0 8413 printed Oct 16, 2024@17:58:05 Page 2
HLDIEDB0 ;CIOFO-O/LJA - Debug Data Display Code ;12/29/03 10:39
+1 ;;1.6;HEALTH LEVEL SEVEN;**109**;Oct 13,1995
+2 ;
FILEIEN ; Input FILE,IEN to find debug data to display...
+1 NEW ABORT,CT,DATE,FILE,GBL,GCT,IEN,JOB,LOC,RTN,X
+2 ;
+3 WRITE @IOF,$$CJ^XLFSTR("Debug Data Display by FILE,IEN",IOM)
+4 WRITE !,$$REPEAT^XLFSTR("=",IOM)
+5 ;
+6 ;->
IF '$DATA(^XTMP("HLDIE-DEBUGX"))
Begin DoDot:1
+7 WRITE !!,"No debug data exists..."
+8 HANG 1
End DoDot:1
QUIT
+9 ;
+10 SET GBL="^XTMP(""HLDIE-DEBUGX"")"
+11 ;
+12 ;->
FOR
Begin DoDot:1
+13 DO SF
+14 ;->
READ !!,"Enter FILE#: ",FILE:99
if FILE']""!(FILE[U)
QUIT
+15 ;->
FOR
Begin DoDot:2
+16 DO SI(FILE)
+17 ;->
READ !!,"Enter IEN: ",IEN:99
if 'IEN
QUIT
+18 WRITE !!,?2,"#",?5,"File & IEN",?20,"Date",?35,"Job#",?50,"Rtn",?68,"Debug#"
+19 WRITE !,$$REPEAT^XLFSTR("=",IOM)
+20 KILL ^TMP($JOB,"H")
+21 SET DATE=0
SET ABORT=0
SET GCT=0
+22 FOR
SET DATE=$ORDER(@GBL@(FILE,IEN,DATE))
if 'DATE!(ABORT)
QUIT
Begin DoDot:3
+23 SET JOB=0
+24 FOR
SET JOB=$ORDER(@GBL@(FILE,IEN,DATE,JOB))
if 'JOB!(ABORT)
QUIT
Begin DoDot:4
+25 SET RTN=""
+26 FOR
SET RTN=$ORDER(@GBL@(FILE,IEN,DATE,JOB,RTN))
if RTN']""!(ABORT)
QUIT
Begin DoDot:5
+27 SET LOC=""
+28 FOR
SET LOC=$ORDER(@GBL@(FILE,IEN,DATE,JOB,RTN,LOC))
if LOC']""!(ABORT)
QUIT
Begin DoDot:6
+29 SET GCT=GCT+1
+30 SET ^TMP($JOB,"H",GCT)=DATE_U_JOB_U_RTN_U_LOC
+31 WRITE !,$JUSTIFY(GCT,3),?5,FILE,"[#",IEN,"]",?20,DATE,?35,JOB,?50,RTN,?68,LOC
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
+32 FOR
Begin DoDot:3
+33 ;->
READ !!,"Enter #: ",GCT:99
if 'GCT
QUIT
+34 ;->
SET X=$GET(^TMP($JOB,"H",+GCT))
SET DATE=+X
SET JOB=$PIECE(X,U,2)
SET RTN=$PIECE(X,U,3)
SET LOC=$PIECE(X,U,4)
if LOC']""
QUIT
+35 DO INDIV(DATE\1,JOB,RTN,LOC)
+36 WRITE !,$$REPEAT^XLFSTR("-",IOM)
End DoDot:3
if 'GCT
QUIT
End DoDot:2
if 'IEN
QUIT
End DoDot:1
if 'FILE
QUIT
+37 ;
+38 KILL ^TMP($JOB,"H")
+39 ;
+40 QUIT
+41 ;
SF ; Show files...
+1 ; GBL -- req
+2 NEW CT,FILE
+3 WRITE !!,$$CJ^XLFSTR(" Files w/Debug Data ",IOM,"=")
+4 SET CT=0
SET FILE=0
+5 FOR
SET FILE=$ORDER(@GBL@(FILE))
if 'FILE
QUIT
Begin DoDot:1
+6 SET CT=CT+1
if CT>1
WRITE ", "
+7 WRITE FILE
End DoDot:1
+8 WRITE !,$$REPEAT^XLFSTR("-",IOM)
+9 QUIT
+10 ;
SI(FILE) ; Show IENs for file...
+1 ; GBL -- req
+2 NEW CT,IEN
+3 WRITE !!,$$CJ^XLFSTR(" IENs w/Debug Data for File# "_FILE_" ",IOM,"=")
+4 SET CT=0
SET IEN=0
+5 FOR
SET IEN=$ORDER(@GBL@(FILE,IEN))
if 'IEN!(CT>100)
QUIT
Begin DoDot:1
+6 SET CT=CT+1
+7 if $X>65
WRITE !
if $X<6
WRITE ?6
if $X>6
WRITE ","
+8 WRITE IEN
End DoDot:1
+9 IF CT>100
Begin DoDot:1
+10 WRITE !!,"Some IENs not displayed (because there were too many)..."
+11 WRITE !,"(The LAST IEN is ",$ORDER(@GBL@(FILE,":"),-1),".)"
End DoDot:1
+12 WRITE !,$$REPEAT^XLFSTR("-",IOM)
+13 QUIT
+14 ;
SEARCH ; Search of global data to find & display...
+1 NEW ABORT,CONT,CT,DATA,FIND,LP,ORIG,POSX,SRCH,ST,X
+2 ;
+3 WRITE @IOF,$$CJ^XLFSTR("Debug Data Display by Global Search",IOM)
+4 WRITE !,$$REPEAT^XLFSTR("=",IOM)
+5 ;
+6 ;->
IF '$DATA(^XTMP("HLDIE-DEBUGX"))
Begin DoDot:1
+7 WRITE !!,"No debug data exists..."
+8 HANG 1
End DoDot:1
QUIT
+9 ;
S1 KILL SRCH
+1 ;
+2 FOR
READ !!,"Search string: ",SRCH:999
if SRCH']""!(SRCH=U)
QUIT
Begin DoDot:1
+3 SET SRCH($$UP^XLFSTR(SRCH))=""
End DoDot:1
+4 ;
+5 ;->
if $ORDER(SRCH(""))']""
QUIT
+6 ;
+7 WRITE !!,"Searching..."
+8 ;
+9 SET CT=0
SET ABORT=0
SET CONT=0
+10 ;
+11 SET LP="^XTMP(""HLDIE-DEBUF"""
SET ST="^XTMP(""HLDIE-DEBUG"
SET LP=LP_")"
+12 FOR
SET LP=$QUERY(@LP)
if LP'[ST!(ABORT)
QUIT
Begin DoDot:1
+13 SET ORIG=@LP
SET DATA=$$UP^XLFSTR(ORIG)
SET FIND=0
SET SRCH=""
+14 FOR
SET SRCH=$ORDER(SRCH(SRCH))
if SRCH']""!(FIND)
QUIT
Begin DoDot:2
+15 ;->
if DATA'[SRCH&(LP'[SRCH)
QUIT
+16 SET FIND=1
End DoDot:2
+17 ;->
if 'FIND
QUIT
+18 WRITE !,LP,"="
+19 if $X>55
WRITE !,?10,"-> "
+20 SET POSX=$X
+21 FOR
Begin DoDot:2
+22 if $X>POSX
WRITE !
if $X<POSX
WRITE ?POSX
+23 WRITE $EXTRACT(ORIG,1,IOM-POSX)
+24 SET ORIG=$EXTRACT(ORIG,IOM-POSX+1,999)
End DoDot:2
if ORIG']""
QUIT
+25 ;->
if CONT
QUIT
+26 ;->
SET CT=CT+1
if (CT#10)
QUIT
+27 WRITE " <-"
READ X:99
if X]""&(X'=" ")
SET ABORT=1
if X=" "
SET CONT=1
End DoDot:1
+28 ;
+29 IF ABORT=1
WRITE !!,"... aborting ..."
+30 ;
+31 ;->
GOTO S1
+32 ;
API ; Select RTN & SUBRTN to find & show debug data...
+1 NEW DATE,FILE,MAX,NUM,RTN,SUB
+2 ;
+3 WRITE @IOF,$$CJ^XLFSTR("Debug Data Display by API Call",IOM)
+4 WRITE !,$$REPEAT^XLFSTR("=",IOM)
+5 ;
+6 ;->
IF '$DATA(^XTMP("HLDIE-DEBUGX"))
Begin DoDot:1
+7 WRITE !!,"No debug data exists..."
+8 HANG 1
End DoDot:1
QUIT
+9 ;
+10 WRITE !
+11 DO COLLECT
+12 DO SHOW
+13 ;
R1 ;->
READ !!,"File: ",FILE:99
if FILE']""
QUIT
+1 ;->
IF '$DATA(^XTMP("HLDIE-DEBUGX",FILE))
Begin DoDot:1
+2 WRITE " no data..."
End DoDot:1
GOTO R1
+3 ;
+4 ;->
READ !,"Rtn: ",RTN:99
if RTN']""
GOTO R1
+5 ;->
READ !,"Subrtn: ",SUB:99
if SUB']""
GOTO R1
+6 SET RTN=RTN_"~"_SUB
+7 ;
+8 READ !,"Max#: 20// ",MAX:99
if MAX']""
SET MAX=20
+9 SET MAX=$SELECT(MAX:MAX,1:20)
+10 ;
+11 ;->
FOR
Begin DoDot:1
+12 KILL ^TMP($JOB,"R")
+13 ;->
READ !!,"Enter Date/time (FM): ",DATE:99
if DATE']""
QUIT
+14 ;->
IF DATE'?7N.E
WRITE " invalid format..."
QUIT
+15 +16 WRITE !
+17 DO SHOWDT(FILE,DATE,RTN,MAX)
+18 ;->
if '$DATA(^TMP($JOB,"R"))
QUIT
+19 +20 FOR
Begin DoDot:2
+21 ;->
READ !!,"Enter # to display: ",NUM:99
if NUM']""!(NUM[U)
QUIT
+22 ;->
IF '$DATA(^TMP($JOB,"R",NUM))
Begin DoDot:3
+23 WRITE " entry not found..."
End DoDot:3
QUIT
+24 DO SHOWONE(+NUM)
End DoDot:2
if NUM']""!(NUM[U)
QUIT
End DoDot:1
if DATE']""
QUIT
+25 ;
+26 HANG 2
+27 ;
+28 DO SHOW
+29 ;
+30 ;->
GOTO R1
+31 ;
SHOWONE(NUM) ; REquires ^TMP($J,"R",NUM)
+1 NEW DATA,DATE,FILE,IEN,JOB,LOC,RTN
+2 ;
+3 SET DATA=^TMP($JOB,"R",NUM)
+4 ;
+5 SET FILE=+DATA
SET IEN=$PIECE(DATA,U,2)
SET DATE=$PIECE(DATA,U,3)\1
+6 SET JOB=$PIECE(DATA,U,4)
SET RTN=$PIECE(DATA,U,5)
SET LOC=$PIECE(DATA,U,6)
+7 ;
+8 DO INDIV(DATE,JOB,RTN,LOC)
+9 ;
+10 QUIT
+11 ;
INDIV(DATE,JOB,RTN,LOC) ; Display entry's data from ^XTMP global...
+1 NEW LP,REF,ST
+2 ;
+3 SET LP="^XTMP(""HLDIE-DEBUG-"_DATE_""","_JOB_","""_RTN_""","_LOC
+4 SET ST=LP
SET LP=LP_")"
+5 ;
+6 WRITE !!,"...",$PIECE(LP,"^XTMP(""HLDIE-DEBUG-"_DATE,2),"="
+7 DO SDATA($X,$GET(@LP))
+8 ;
+9 FOR
SET LP=$QUERY(@LP)
if LP'[ST
QUIT
Begin DoDot:1
+10 SET REF=$PIECE(LP,"^XTMP(""HLDIE-DEBUG-"_DATE,2)_"="
+11 WRITE !,"...",REF
+12 DO SDATA($X,@LP)
End DoDot:1
+13 ;
+14 WRITE !
+15 ;
+16 QUIT
+17 ;
SDATA(POSX,DATA) ; Show data...
+1 ;
+2 FOR
Begin DoDot:1
+3 ;->
if DATA']""
QUIT
+4 if $X>POSX
WRITE !
if $X<POSX
WRITE ?POSX
+5 WRITE $EXTRACT(DATA,1,IOM-POSX)
+6 SET DATA=$EXTRACT(DATA,IOM-POSX+1,999)
End DoDot:1
if DATA']""
QUIT
+7 ;
+8 QUIT
+9 ;
SHOWDT(FILE,DATE,RTN,MAX) ; Show entries and create ^TMP($J,"R")...
+1 NEW ABORT,CT,DATA,GBL,IEN,JOB,JOBLAST,LDT,NO,NUM
+2 ;
+3 SET GBL="^XTMP(""HLDIE-DEBUGX"","_FILE_")"
+4 ;
+5 DO SHOWDTHD
+6 ;
+7 SET IEN=0
SET CT=0
SET ABORT=0
SET JOBLAST=""
+8 FOR
SET IEN=$ORDER(@GBL@(IEN))
if 'IEN!(CT'<MAX)
QUIT
Begin DoDot:1
+9 SET LDT=DATE-.0000000001
+10 FOR
SET LDT=$ORDER(@GBL@(IEN,LDT))
if 'LDT
QUIT
Begin DoDot:2
+11 SET JOB=0
+12 FOR
SET JOB=$ORDER(@GBL@(IEN,LDT,JOB))
if JOB'>0
QUIT
Begin DoDot:3
+13 ;->
SET NO=$ORDER(@GBL@(IEN,LDT,JOB,RTN,":"),-1)/2\1
if 'NO
QUIT
+14 SET NUM=0
+15 FOR
SET NUM=$ORDER(@GBL@(IEN,LDT,JOB,RTN,NUM))
if 'NUM
QUIT
Begin DoDot:4
+16 SET CT=CT+1
+17 SET DATA=$GET(@GBL@(IEN,LDT,JOB,RTN,NUM))
+18 SET ^TMP($JOB,"R",CT)=FILE_U_IEN_U_LDT_U_JOB_U_RTN_U_NUM
+19 IF JOBLAST'=""&(JOBLAST)
WRITE !
SET JOBLAST=0
+20 DO EADTHD(CT,FILE,IEN,LDT,JOB,RTN,NUM,+DATA)
End DoDot:4
+21 SET JOBLAST=JOB
End DoDot:3
End DoDot:2
End DoDot:1
+22 ;
+23 QUIT
+24 ;
EADTHD(CT,FILE,IEN,LDT,JOB,RTN,NUM,LOC) ;
+1 WRITE !,$JUSTIFY(CT,3),?5,FILE,?15,+IEN,?25,"@",$PIECE(LDT,".",2)
+2 WRITE ?35,JOB,?50,RTN,?70,LOC,$SELECT(LOC=1:"<-Beg",1:"")
+3 QUIT
+4 ;
SHOWDTHD ;
+1 WRITE !!,"#",?5,"File",?15,"IEN",?25,"Time",?35,"Job#",?50,"Location"
+2 WRITE ?70,"Call#"
+3 WRITE !,$$REPEAT^XLFSTR("=",IOM)
+4 QUIT
+5 ;
SHOW ;
+1 NEW CT,DATE,FILE,RTN
+2 ;
+3 WRITE !!,"File",?17,"Date",?40,"API"
+4 WRITE !,$$REPEAT^XLFSTR("=",IOM)
+5 ;
+6 SET FILE=0
+7 FOR
SET FILE=$ORDER(^TMP($JOB,"D",FILE))
if 'FILE
QUIT
Begin DoDot:1
+8 WRITE !,FILE," [#",^TMP($JOB,"D",FILE),"]"
+9 SET DATE=0
+10 FOR
SET DATE=$ORDER(^TMP($JOB,"D",FILE,DATE))
if 'DATE
QUIT
Begin DoDot:2
+11 if $X>17
WRITE !
if $X<17
WRITE ?17
+12 WRITE DATE," [#",^TMP($JOB,"D",FILE,DATE),"]"
+13 SET RTN=""
+14 FOR
SET RTN=$ORDER(^TMP($JOB,"D",FILE,DATE,RTN))
if RTN']""
QUIT
Begin DoDot:3
+15 if $X>40
WRITE !
if $X<40
WRITE ?40
+16 WRITE RTN," [#",^TMP($JOB,"D",FILE,DATE,RTN),"]"
End DoDot:3
End DoDot:2
End DoDot:1
+17 ;
+18 QUIT
+19 ;
COLLECT ; Collect data into ^TMP($J,"D")...
+1 NEW DATE,FILE,IEN,JOB,LOC,RTN
+2 ;
+3 KILL ^TMP($JOB)
+4 ;
+5 SET FILE=0
+6 FOR
SET FILE=$ORDER(^XTMP("HLDIE-DEBUGX",FILE))
if 'FILE
QUIT
Begin DoDot:1
+7 SET IEN=0
+8 FOR
SET IEN=$ORDER(^XTMP("HLDIE-DEBUGX",FILE,IEN))
if 'IEN
QUIT
Begin DoDot:2
+9 SET DATE=0
+10 FOR
SET DATE=$ORDER(^XTMP("HLDIE-DEBUGX",FILE,IEN,DATE))
if 'DATE
QUIT
Begin DoDot:3
+11 ; HLDIE-DEBUGX data hangs around longer...
+12 ;->
if '$DATA(^XTMP("HLDIE-DEBUG-"_(DATE\1)))
QUIT
+13 SET JOB=0
+14 FOR
SET JOB=$ORDER(^XTMP("HLDIE-DEBUGX",FILE,IEN,DATE,JOB))
if 'JOB
QUIT
Begin DoDot:4
+15 SET RTN=""
+16 FOR
SET RTN=$ORDER(^XTMP("HLDIE-DEBUGX",FILE,IEN,DATE,JOB,RTN))
if RTN']""
QUIT
Begin DoDot:5
+17 SET LOC=0
+18 FOR
SET LOC=$ORDER(^XTMP("HLDIE-DEBUGX",FILE,IEN,DATE,JOB,RTN,LOC))
if 'LOC
QUIT
Begin DoDot:6
+19 DO COLL1(FILE,IEN,DATE\1,JOB,RTN,LOC)
End DoDot:6
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+20 ;
+21 QUIT
+22 ;
COLL1(FILE,IEN,DATE,JOB,RTN,LOC) ; Called by COLLECT...
+1 ;
+2 SET ^TMP($JOB,"D",FILE)=$GET(^TMP($JOB,"D",FILE))+1
+3 SET ^TMP($JOB,"D",FILE,DATE)=$GET(^TMP($JOB,"D",FILE,DATE))+1
+4 SET ^TMP($JOB,"D",FILE,DATE,RTN)=$GET(^TMP($JOB,"D",FILE,DATE,RTN))+1
+5 ;
+6 QUIT
+7 ;
ONLYASC(TXT) ; Return ASCII only. No CTRL characters...
+1 NEW ASCII,CHAR,NTXT,POS
+2 SET NTXT=""
+3 FOR POS=1:1:$LENGTH(TXT)
Begin DoDot:1
+4 SET CHAR=$EXTRACT(TXT,+POS)
SET ASCII=$ASCII(CHAR)
+5 IF ASCII<32
SET CHAR="{"_ASCII_"}"
+6 SET NTXT=NTXT_CHAR
End DoDot:1
+7 QUIT NTXT
+8 ;
EOR ;HLDIEDBO - Direct 772 & 773 Sets DEBUG CODE ; 11/18/2003 11:17
