ORDEBUG1 ;SLC/AJB - CPRS Debug Support Routine ;10/13/15 10:13
;;3.0;ORDER ENTRY/RESULTS REPORTING;**350**;Dec 17, 1997;Build 77
;
Q
;
EN ;
W @IOF
N DESC,POP,RTN,SAVE
S DESC="CPRS Debug Log Viewer",RTN="SHOWME^ORDEBUG1" ; ,SAVE("*")=""
W ! D EN^XUTMDEVQ(RTN,DESC,.SAVE)
Q
SHOWME ;
;
N DATA,DLM S DATA=$NA(^XTMP("CPRS DEBUG LOG")),DLM=","
N INFO S INFO="TEMP" ; $NA(^XTMP("DEBUG LOG VIEW",$J))
K @INFO
;
; ^XTMP format
; P1="<usr IEN>^DD/MM/YYYY HH:MM:SS"
; P2=type of data [description, rpc, etc.]
; P3=counter for type
; P4=counter for # of lines in type
;
W """USER"",""DATE"",""TIME"",""RPC #"",""DESCRIPTION/RPC"",""PARAMETERS"",""RESULTS"""
;
; get XTMP data and sort for various output
N P1,P2,P3,P4
S P1=0 F S P1=$O(@DATA@(P1)) Q:'+P1 S P2="" F S P2=$O(@DATA@(P1,P2)) Q:P2="" S P3="" F S P3=$O(@DATA@(P1,P2,P3)) Q:P3="" D
. N DEV,DATE,TIME
. S DEV=$$GET1^DIQ(200,$P(P1,U),.01)
. S DATE=$P($P(P1,U,2)," ")
. S TIME=$P($P(P1,U,2)," ",2)
. I P2="DESCRIPTION" D
. . S:P3=0 @INFO@(DEV,DATE,TIME,0,0,P2,0)=@DATA@(P1,P2,P3)
. . S:P3'=0 @INFO@(DEV,DATE,TIME,0,0,P2,P3)=@DATA@(P1,P2,P3)
. N RSLTS S RSLTS=0 S P4="" F S P4=$O(@DATA@(P1,P2,P3,P4)) Q:P4="" D
. . ; I P3'=76 Q ; ***** control number of results
. . I P4=1!(P4=2) Q ; skip first " " entry and "Parameters ---..." entry
. . I P4=0 S @INFO@(DEV,DATE,TIME,P3,0,"RPC",P4)=@DATA@(P1,P2,P3,P4) Q ; set 0 node=RPC name
. . I P4=3,@DATA@(P1,P2,P3,P4)=" " S @INFO@(DEV,DATE,TIME,P3,1,"PARAM",P4)="",RSLTS=1 Q ; no parameters for RPC
. . I @DATA@(P1,P2,P3,P4)["Results -----" S RSLTS=1 Q
. . I '+RSLTS,@DATA@(P1,P2,P3,P4)'=" " S @INFO@(DEV,DATE,TIME,P3,1,"PARAM",P4)=@DATA@(P1,P2,P3,P4)
. . I +RSLTS,@DATA@(P1,P2,P3,P4)'=" " S @INFO@(DEV,DATE,TIME,P3,2,"RESULT",P4)=@DATA@(P1,P2,P3,P4)
;
; ^XTMP format [RPC,Parameters,Results]
; P1=user name
; P2=date of log
; P3=time of log
; P4=RPC number
; P5=type of data numeric [0=RPC name,1=Parameter,2=Result]
; P6=type of data
; P7=line number
;
N P5,P6,P7
S P1="" F S P1=$O(@INFO@(P1)) Q:P1="" S P2="" F S P2=$O(@INFO@(P1,P2)) Q:P2="" S P3="" F S P3=$O(@INFO@(P1,P2,P3)) Q:P3="" S P4="" F S P4=$O(@INFO@(P1,P2,P3,P4)) Q:P4="" D
. W !,$C(34),P1,$C(34),DLM,$C(34),P2,$C(34),DLM,$C(34),P3,$C(34),DLM,$C(34),P4,$C(34),DLM
. S P5="" F S P5=$O(@INFO@(P1,P2,P3,P4,P5)) Q:P5="" D
. . S P6="" F S P6=$O(@INFO@(P1,P2,P3,P4,P5,P6)) Q:P6="" S P7="" F S P7=$O(@INFO@(P1,P2,P3,P4,P5,P6,P7)) Q:P7="" D
. . . I $O(@INFO@(P1,P2,P3,P4,P5,P6,P7),-1)="" W $C(34)
. . . W @INFO@(P1,P2,P3,P4,P5,P6,P7)
. . . I $O(@INFO@(P1,P2,P3,P4,P5,P6,P7))'="" W !
. . . I $O(@INFO@(P1,P2,P3,P4,P5,P6,P7))="" W $C(34) I P4'=0 I P5=0!(P5=1) W DLM
;
;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORDEBUG1 2765 printed Sep 23, 2025@20:06:17 Page 2
ORDEBUG1 ;SLC/AJB - CPRS Debug Support Routine ;10/13/15 10:13
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**350**;Dec 17, 1997;Build 77
+2 ;
+3 QUIT
+4 ;
EN ;
+1 WRITE @IOF
+2 NEW DESC,POP,RTN,SAVE
+3 ; ,SAVE("*")=""
SET DESC="CPRS Debug Log Viewer"
SET RTN="SHOWME^ORDEBUG1"
+4 WRITE !
DO EN^XUTMDEVQ(RTN,DESC,.SAVE)
+5 QUIT
SHOWME ;
+1 ;
+2 NEW DATA,DLM
SET DATA=$NAME(^XTMP("CPRS DEBUG LOG"))
SET DLM=","
+3 ; $NA(^XTMP("DEBUG LOG VIEW",$J))
NEW INFO
SET INFO="TEMP"
+4 KILL @INFO
+5 ;
+6 ; ^XTMP format
+7 ; P1="<usr IEN>^DD/MM/YYYY HH:MM:SS"
+8 ; P2=type of data [description, rpc, etc.]
+9 ; P3=counter for type
+10 ; P4=counter for # of lines in type
+11 ;
+12 WRITE """USER"",""DATE"",""TIME"",""RPC #"",""DESCRIPTION/RPC"",""PARAMETERS"",""RESULTS"""
+13 ;
+14 ; get XTMP data and sort for various output
+15 NEW P1,P2,P3,P4
+16 SET P1=0
FOR
SET P1=$ORDER(@DATA@(P1))
if '+P1
QUIT
SET P2=""
FOR
SET P2=$ORDER(@DATA@(P1,P2))
if P2=""
QUIT
SET P3=""
FOR
SET P3=$ORDER(@DATA@(P1,P2,P3))
if P3=""
QUIT
Begin DoDot:1
+17 NEW DEV,DATE,TIME
+18 SET DEV=$$GET1^DIQ(200,$PIECE(P1,U),.01)
+19 SET DATE=$PIECE($PIECE(P1,U,2)," ")
+20 SET TIME=$PIECE($PIECE(P1,U,2)," ",2)
+21 IF P2="DESCRIPTION"
Begin DoDot:2
+22 if P3=0
SET @INFO@(DEV,DATE,TIME,0,0,P2,0)=@DATA@(P1,P2,P3)
+23 if P3'=0
SET @INFO@(DEV,DATE,TIME,0,0,P2,P3)=@DATA@(P1,P2,P3)
End DoDot:2
+24 NEW RSLTS
SET RSLTS=0
SET P4=""
FOR
SET P4=$ORDER(@DATA@(P1,P2,P3,P4))
if P4=""
QUIT
Begin DoDot:2
+25 ; I P3'=76 Q ; ***** control number of results
+26 ; skip first " " entry and "Parameters ---..." entry
IF P4=1!(P4=2)
QUIT
+27 ; set 0 node=RPC name
IF P4=0
SET @INFO@(DEV,DATE,TIME,P3,0,"RPC",P4)=@DATA@(P1,P2,P3,P4)
QUIT
+28 ; no parameters for RPC
IF P4=3
IF @DATA@(P1,P2,P3,P4)=" "
SET @INFO@(DEV,DATE,TIME,P3,1,"PARAM",P4)=""
SET RSLTS=1
QUIT
+29 IF @DATA@(P1,P2,P3,P4)["Results -----"
SET RSLTS=1
QUIT
+30 IF '+RSLTS
IF @DATA@(P1,P2,P3,P4)'=" "
SET @INFO@(DEV,DATE,TIME,P3,1,"PARAM",P4)=@DATA@(P1,P2,P3,P4)
+31 IF +RSLTS
IF @DATA@(P1,P2,P3,P4)'=" "
SET @INFO@(DEV,DATE,TIME,P3,2,"RESULT",P4)=@DATA@(P1,P2,P3,P4)
End DoDot:2
End DoDot:1
+32 ;
+33 ; ^XTMP format [RPC,Parameters,Results]
+34 ; P1=user name
+35 ; P2=date of log
+36 ; P3=time of log
+37 ; P4=RPC number
+38 ; P5=type of data numeric [0=RPC name,1=Parameter,2=Result]
+39 ; P6=type of data
+40 ; P7=line number
+41 ;
+42 NEW P5,P6,P7
+43 SET P1=""
FOR
SET P1=$ORDER(@INFO@(P1))
if P1=""
QUIT
SET P2=""
FOR
SET P2=$ORDER(@INFO@(P1,P2))
if P2=""
QUIT
SET P3=""
FOR
SET P3=$ORDER(@INFO@(P1,P2,P3))
if P3=""
QUIT
SET P4=""
FOR
SET P4=$ORDER(@INFO@(P1,P2,P3,P4))
if P4=""
QUIT
Begin DoDot:1
+44 WRITE !,$CHAR(34),P1,$CHAR(34),DLM,$CHAR(34),P2,$CHAR(34),DLM,$CHAR(34),P3,$CHAR(34),DLM,$CHAR(34),P4,$CHAR(34),DLM
+45 SET P5=""
FOR
SET P5=$ORDER(@INFO@(P1,P2,P3,P4,P5))
if P5=""
QUIT
Begin DoDot:2
+46 SET P6=""
FOR
SET P6=$ORDER(@INFO@(P1,P2,P3,P4,P5,P6))
if P6=""
QUIT
SET P7=""
FOR
SET P7=$ORDER(@INFO@(P1,P2,P3,P4,P5,P6,P7))
if P7=""
QUIT
Begin DoDot:3
+47 IF $ORDER(@INFO@(P1,P2,P3,P4,P5,P6,P7),-1)=""
WRITE $CHAR(34)
+48 WRITE @INFO@(P1,P2,P3,P4,P5,P6,P7)
+49 IF $ORDER(@INFO@(P1,P2,P3,P4,P5,P6,P7))'=""
WRITE !
+50 IF $ORDER(@INFO@(P1,P2,P3,P4,P5,P6,P7))=""
WRITE $CHAR(34)
IF P4'=0
IF P5=0!(P5=1)
WRITE DLM
End DoDot:3
End DoDot:2
End DoDot:1
+51 ;
+52 ;
+53 QUIT
