- 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 Jan 18, 2025@03:31:09 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