MAGDQRUE ;WOIFO/MLH - Imaging RPCs for Query/Retrieve - error utilities ; 30 Dec 2011 2:17 PM
;;3.0;IMAGING;**118**;Mar 19, 2002;Build 4525;May 01, 2013
;; Per VHA Directive 2004-038, this routine should not be modified.
;; +---------------------------------------------------------------+
;; | Property of the US Government. |
;; | No permission to copy or redistribute this software is given. |
;; | Use of unreleased versions of this software requires the user |
;; | to execute a written test agreement with the VistA Imaging |
;; | Development Office of the Department of Veterans Affairs, |
;; | telephone (301) 734-0100. |
;; | The Food and Drug Administration classifies this software as |
;; | a medical device. As such, it may not be changed in any way. |
;; | Modifications to this software may result in an adulterated |
;; | medical device under 21CFR820, the use of which is considered |
;; | to be a violation of US Federal Statutes. |
;; +---------------------------------------------------------------+
;;
Q
;
ERR(X) S ^TMP("MAG",$J,"ERR",$O(^TMP("MAG",$J,"ERR"," "),-1)+1)=X
Q
;
ERRLOG N I,O,X
S O=1,I=""
F S I=$O(^TMP("MAG",$J,"ERR",I)) Q:I="" S X=$G(^(I)) D
. S O=O+1,OUT(O)=X
. Q
D LOG^MAGDQRUL("Error","",(-O)_",Errors encountered")
Q
;
ERRSAV N I,O,RESGBL,X
Q:'$G(RESULT) S RESGBL=$NA(^MAGDQR(2006.5732,RESULT))
S $P(@RESGBL@(0),"^",2,3)="OK^"_$$NOW^XLFDT()
K @RESGBL@(1)
S O=0,I=""
F S I=$O(^TMP("MAG",$J,"ERR",I)) Q:I="" S X=$G(^(I)) D
. S O=O+1,@RESGBL@(1,O,0)="0000,0902^"_X
. Q
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGDQRUE 1685 printed Dec 13, 2024@02:01:11 Page 2
MAGDQRUE ;WOIFO/MLH - Imaging RPCs for Query/Retrieve - error utilities ; 30 Dec 2011 2:17 PM
+1 ;;3.0;IMAGING;**118**;Mar 19, 2002;Build 4525;May 01, 2013
+2 ;; Per VHA Directive 2004-038, this routine should not be modified.
+3 ;; +---------------------------------------------------------------+
+4 ;; | Property of the US Government. |
+5 ;; | No permission to copy or redistribute this software is given. |
+6 ;; | Use of unreleased versions of this software requires the user |
+7 ;; | to execute a written test agreement with the VistA Imaging |
+8 ;; | Development Office of the Department of Veterans Affairs, |
+9 ;; | telephone (301) 734-0100. |
+10 ;; | The Food and Drug Administration classifies this software as |
+11 ;; | a medical device. As such, it may not be changed in any way. |
+12 ;; | Modifications to this software may result in an adulterated |
+13 ;; | medical device under 21CFR820, the use of which is considered |
+14 ;; | to be a violation of US Federal Statutes. |
+15 ;; +---------------------------------------------------------------+
+16 ;;
+17 QUIT
+18 ;
ERR(X) SET ^TMP("MAG",$JOB,"ERR",$ORDER(^TMP("MAG",$JOB,"ERR"," "),-1)+1)=X
+1 QUIT
+2 ;
ERRLOG NEW I,O,X
+1 SET O=1
SET I=""
+2 FOR
SET I=$ORDER(^TMP("MAG",$JOB,"ERR",I))
if I=""
QUIT
SET X=$GET(^(I))
Begin DoDot:1
+3 SET O=O+1
SET OUT(O)=X
+4 QUIT
End DoDot:1
+5 DO LOG^MAGDQRUL("Error","",(-O)_",Errors encountered")
+6 QUIT
+7 ;
ERRSAV NEW I,O,RESGBL,X
+1 if '$GET(RESULT)
QUIT
SET RESGBL=$NAME(^MAGDQR(2006.5732,RESULT))
+2 SET $PIECE(@RESGBL@(0),"^",2,3)="OK^"_$$NOW^XLFDT()
+3 KILL @RESGBL@(1)
+4 SET O=0
SET I=""
+5 FOR
SET I=$ORDER(^TMP("MAG",$JOB,"ERR",I))
if I=""
QUIT
SET X=$GET(^(I))
Begin DoDot:1
+6 SET O=O+1
SET @RESGBL@(1,O,0)="0000,0902^"_X
+7 QUIT
End DoDot:1
+8 QUIT
