- 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 Feb 18, 2025@23:27:38 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
