ORDEBUG ;SLC/JMH,AJB - CPRS Debug Support Routine ;Jul 23, 2020@11:29:03
;;3.0;ORDER ENTRY/RESULTS REPORTING;**350,498**;Dec 17, 1997;Build 38
;
SAVERPCS(ORY,ORKEY,ORDATA) ;
;
N ORI S ORI=""
S ORI=$O(^XTMP("CPRS DEBUG LOG",ORKEY,"RPCS",ORI),-1)
I 'ORI S ORI=0
S ORI=ORI+1
M ^XTMP("CPRS DEBUG LOG",ORKEY,"RPCS",ORI)=ORDATA
Q
;
SAVEDESC(ORY,ORKEY,ORDATA) ;
;
S ^XTMP("CPRS DEBUG LOG",0)=$$FMADD^XLFDT($$NOW^XLFDT,60)_U_$$NOW^XLFDT
M ^XTMP("CPRS DEBUG LOG",ORKEY,"DESCRIPTION")=ORDATA
N XMSUB,XMY,XMTEXT,XMDUZ,ORTEXT
S ORTEXT(1)="Run option OR DEBUG REPORT to view information about this Debug Report."
S XMDUZ=DUZ
S XMSUB="NEW DEBUG REPORT SUBMITTED BY "_$P($G(^VA(200,+ORKEY,0)),U)_" AT "_$P(ORKEY,U,2)
; *498 get list of recipients from new parameter, quit if no recipients
N LIST D GETLST^XPAR(.LIST,"400;DIC(4.2,","OR CPRS DEBUG EMAIL") Q:'+LIST
S LIST=0 F S LIST=$O(LIST(LIST)) Q:'+LIST S XMY($P(LIST(LIST),U,2))=""
; *498
S XMTEXT="ORTEXT("
D ^XMD
Q
EN ;
W @IOF
N DESC,POP,RTN,SAVE
S DESC="CPRS Debug Log Viewer",RTN="LOG^ORDEBUG" ; ,SAVE("*")=""
W ! D EN^XUTMDEVQ(RTN,DESC,.SAVE)
Q
LOG ;
;
N DATA,DLM S DATA=$NA(^XTMP("CPRS DEBUG LOG")),DLM=","
N INFO S INFO=$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'=4 Q ; ***** control number of results for testing
. . I P4=0 S @INFO@(DEV,DATE,TIME,P3,0,"RPC",P4)=@DATA@(P1,P2,P3,P4) S P4=3 Q ; set 0 node=RPC name set P=3 to skip 1 & 2
. . I P4=4,@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 $TR(@INFO@(P1,P2,P3,P4,P5,P6,P7),"""","'") ; ***** convert any double quotes into single quotes to avoid confusing Excel during import
. . . 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
;
K @INFO
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HORDEBUG 3686 printed Sep 23, 2025@20:06:16 Page 2
ORDEBUG ;SLC/JMH,AJB - CPRS Debug Support Routine ;Jul 23, 2020@11:29:03
+1 ;;3.0;ORDER ENTRY/RESULTS REPORTING;**350,498**;Dec 17, 1997;Build 38
+2 ;
SAVERPCS(ORY,ORKEY,ORDATA) ;
+1 ;
+2 NEW ORI
SET ORI=""
+3 SET ORI=$ORDER(^XTMP("CPRS DEBUG LOG",ORKEY,"RPCS",ORI),-1)
+4 IF 'ORI
SET ORI=0
+5 SET ORI=ORI+1
+6 MERGE ^XTMP("CPRS DEBUG LOG",ORKEY,"RPCS",ORI)=ORDATA
+7 QUIT
+8 ;
SAVEDESC(ORY,ORKEY,ORDATA) ;
+1 ;
+2 SET ^XTMP("CPRS DEBUG LOG",0)=$$FMADD^XLFDT($$NOW^XLFDT,60)_U_$$NOW^XLFDT
+3 MERGE ^XTMP("CPRS DEBUG LOG",ORKEY,"DESCRIPTION")=ORDATA
+4 NEW XMSUB,XMY,XMTEXT,XMDUZ,ORTEXT
+5 SET ORTEXT(1)="Run option OR DEBUG REPORT to view information about this Debug Report."
+6 SET XMDUZ=DUZ
+7 SET XMSUB="NEW DEBUG REPORT SUBMITTED BY "_$PIECE($GET(^VA(200,+ORKEY,0)),U)_" AT "_$PIECE(ORKEY,U,2)
+8 ; *498 get list of recipients from new parameter, quit if no recipients
+9 NEW LIST
DO GETLST^XPAR(.LIST,"400;DIC(4.2,","OR CPRS DEBUG EMAIL")
if '+LIST
QUIT
+10 SET LIST=0
FOR
SET LIST=$ORDER(LIST(LIST))
if '+LIST
QUIT
SET XMY($PIECE(LIST(LIST),U,2))=""
+11 ; *498
+12 SET XMTEXT="ORTEXT("
+13 DO ^XMD
+14 QUIT
EN ;
+1 WRITE @IOF
+2 NEW DESC,POP,RTN,SAVE
+3 ; ,SAVE("*")=""
SET DESC="CPRS Debug Log Viewer"
SET RTN="LOG^ORDEBUG"
+4 WRITE !
DO EN^XUTMDEVQ(RTN,DESC,.SAVE)
+5 QUIT
LOG ;
+1 ;
+2 NEW DATA,DLM
SET DATA=$NAME(^XTMP("CPRS DEBUG LOG"))
SET DLM=","
+3 NEW INFO
SET INFO=$NAME(^XTMP("DEBUG LOG VIEW",$JOB))
+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'=4 Q ; ***** control number of results for testing
+26 ; set 0 node=RPC name set P=3 to skip 1 & 2
IF P4=0
SET @INFO@(DEV,DATE,TIME,P3,0,"RPC",P4)=@DATA@(P1,P2,P3,P4)
SET P4=3
QUIT
+27 ; no parameters for RPC
IF P4=4
IF @DATA@(P1,P2,P3,P4)=" "
SET @INFO@(DEV,DATE,TIME,P3,1,"PARAM",P4)=""
SET RSLTS=1
QUIT
+28 IF @DATA@(P1,P2,P3,P4)["Results -----"
SET RSLTS=1
QUIT
+29 IF '+RSLTS
IF @DATA@(P1,P2,P3,P4)'=" "
SET @INFO@(DEV,DATE,TIME,P3,1,"PARAM",P4)=@DATA@(P1,P2,P3,P4)
+30 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
+31 ;
+32 ; ^XTMP format [RPC,Parameters,Results]
+33 ; P1=user name
+34 ; P2=date of log
+35 ; P3=time of log
+36 ; P4=RPC number
+37 ; P5=type of data numeric [0=RPC name,1=Parameter,2=Result]
+38 ; P6=type of data
+39 ; P7=line number
+40 ;
+41 NEW P5,P6,P7
+42 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
+43 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
+44 SET P5=""
FOR
SET P5=$ORDER(@INFO@(P1,P2,P3,P4,P5))
if P5=""
QUIT
Begin DoDot:2
+45 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
+46 IF $ORDER(@INFO@(P1,P2,P3,P4,P5,P6,P7),-1)=""
WRITE $CHAR(34)
+47 ; ***** convert any double quotes into single quotes to avoid confusing Excel during import
WRITE $TRANSLATE(@INFO@(P1,P2,P3,P4,P5,P6,P7),"""","'")
+48 IF $ORDER(@INFO@(P1,P2,P3,P4,P5,P6,P7))'=""
WRITE !
+49 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
+50 ;
+51 KILL @INFO
+52 QUIT
