MAGVRS45 ;WOIFO/DAC,MLH - Utilities for RPC calls for DICOM file processing ; 19 Jan 2012 04:41 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
INPUTSEP() ; Name value separator for input data ie. NAME`TESTPATIENT
Q "`"
OUTSEP() ; Name value separator for output data ie. NAME|TESTPATIENT
Q "|"
STATSEP() ; Status and Result separator ie. -3``No record IEN
Q "`"
TRAVERSE(OUT,PFILENUM,IEN,DIR,CHILDIEN) ;utility - traverse a file
N OSEP,ISEP,SSEP,RETIEN,FILE,STATFIELD,ACTIVE
S OSEP=$$OUTSEP,ISEP=$$INPUTSEP,SSEP=$$STATSEP
I "^0^1^2^3^4^"'[("^"_(PFILENUM-2005.6*100)_"^") D Q
. S OUT(1)="-1"_SSEP_"Invalid file"
. Q
I ($G(IEN)'=+$G(IEN))!'IEN D Q
. S OUT(1)="-2"_SSEP_"Invalid root IEN"
. Q
I '$D(^MAGV(PFILENUM,IEN)) D Q
. S OUT(1)="-7"_SSEP_"IEN "_IEN_" not found in file "_PFILENUM
. Q
I ".FIRST.PREV.NEXT.LAST."'[("."_$TR(DIR,".")_".") D Q
. S OUT(1)="-3"_SSEP_"Invalid direction"
. Q
I DIR'="PREV",DIR'="NEXT",$G(CHILDIEN) D Q
. S OUT(1)="-4"_SSEP_"Child IEN not to be specified in command "_DIR
. Q
I DIR'="FIRST",DIR'="LAST",($G(CHILDIEN)'=+$G(CHILDIEN))!'$G(CHILDIEN) D Q
. S OUT(1)="-5"_SSEP_"Invalid child IEN in command "_DIR
. Q
I $$GET1^DIQ(PFILENUM,IEN,$$GETFIELD^MAGVRS41(PFILENUM,"STATUS"),"I")'="A" D Q
. S OUT(1)="-6"_SSEP_"Can't traverse children of inaccessible parent IEN "_IEN
. Q
S FILE=PFILENUM+.01
I DIR'="FIRST",DIR'="LAST",'$D(^MAGV(FILE,"C",IEN,CHILDIEN)) D Q
. S OUT(1)="-8"_SSEP_"Invalid child IEN in command "_DIR
. Q
S:DIR="FIRST" DIR="NEXT",CHILDIEN=""
S:DIR="LAST" DIR="PREV",CHILDIEN=""
S STATFIELD=$$GETFIELD^MAGVRS41(FILE,"STATUS")
S RETIEN=CHILDIEN,ACTIVE=0
F S RETIEN=$O(^MAGV(FILE,"C",IEN,RETIEN),$S(DIR="PREV":-1,1:1)) Q:'RETIEN D Q:ACTIVE
. S ACTIVE=($$GET1^DIQ(FILE,RETIEN,STATFIELD,"I")="A")
. Q
S:RETIEN="" RETIEN=0
S OUT(1)="0"_SSEP_SSEP_RETIEN
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGVRS45 2910 printed Nov 22, 2024@17:20:24 Page 2
MAGVRS45 ;WOIFO/DAC,MLH - Utilities for RPC calls for DICOM file processing ; 19 Jan 2012 04:41 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
INPUTSEP() ; Name value separator for input data ie. NAME`TESTPATIENT
+1 QUIT "`"
OUTSEP() ; Name value separator for output data ie. NAME|TESTPATIENT
+1 QUIT "|"
STATSEP() ; Status and Result separator ie. -3``No record IEN
+1 QUIT "`"
TRAVERSE(OUT,PFILENUM,IEN,DIR,CHILDIEN) ;utility - traverse a file
+1 NEW OSEP,ISEP,SSEP,RETIEN,FILE,STATFIELD,ACTIVE
+2 SET OSEP=$$OUTSEP
SET ISEP=$$INPUTSEP
SET SSEP=$$STATSEP
+3 IF "^0^1^2^3^4^"'[("^"_(PFILENUM-2005.6*100)_"^")
Begin DoDot:1
+4 SET OUT(1)="-1"_SSEP_"Invalid file"
+5 QUIT
End DoDot:1
QUIT
+6 IF ($GET(IEN)'=+$GET(IEN))!'IEN
Begin DoDot:1
+7 SET OUT(1)="-2"_SSEP_"Invalid root IEN"
+8 QUIT
End DoDot:1
QUIT
+9 IF '$DATA(^MAGV(PFILENUM,IEN))
Begin DoDot:1
+10 SET OUT(1)="-7"_SSEP_"IEN "_IEN_" not found in file "_PFILENUM
+11 QUIT
End DoDot:1
QUIT
+12 IF ".FIRST.PREV.NEXT.LAST."'[("."_$TRANSLATE(DIR,".")_".")
Begin DoDot:1
+13 SET OUT(1)="-3"_SSEP_"Invalid direction"
+14 QUIT
End DoDot:1
QUIT
+15 IF DIR'="PREV"
IF DIR'="NEXT"
IF $GET(CHILDIEN)
Begin DoDot:1
+16 SET OUT(1)="-4"_SSEP_"Child IEN not to be specified in command "_DIR
+17 QUIT
End DoDot:1
QUIT
+18 IF DIR'="FIRST"
IF DIR'="LAST"
IF ($GET(CHILDIEN)'=+$GET(CHILDIEN))!'$GET(CHILDIEN)
Begin DoDot:1
+19 SET OUT(1)="-5"_SSEP_"Invalid child IEN in command "_DIR
+20 QUIT
End DoDot:1
QUIT
+21 IF $$GET1^DIQ(PFILENUM,IEN,$$GETFIELD^MAGVRS41(PFILENUM,"STATUS"),"I")'="A"
Begin DoDot:1
+22 SET OUT(1)="-6"_SSEP_"Can't traverse children of inaccessible parent IEN "_IEN
+23 QUIT
End DoDot:1
QUIT
+24 SET FILE=PFILENUM+.01
+25 IF DIR'="FIRST"
IF DIR'="LAST"
IF '$DATA(^MAGV(FILE,"C",IEN,CHILDIEN))
Begin DoDot:1
+26 SET OUT(1)="-8"_SSEP_"Invalid child IEN in command "_DIR
+27 QUIT
End DoDot:1
QUIT
+28 if DIR="FIRST"
SET DIR="NEXT"
SET CHILDIEN=""
+29 if DIR="LAST"
SET DIR="PREV"
SET CHILDIEN=""
+30 SET STATFIELD=$$GETFIELD^MAGVRS41(FILE,"STATUS")
+31 SET RETIEN=CHILDIEN
SET ACTIVE=0
+32 FOR
SET RETIEN=$ORDER(^MAGV(FILE,"C",IEN,RETIEN),$SELECT(DIR="PREV":-1,1:1))
if 'RETIEN
QUIT
Begin DoDot:1
+33 SET ACTIVE=($$GET1^DIQ(FILE,RETIEN,STATFIELD,"I")="A")
+34 QUIT
End DoDot:1
if ACTIVE
QUIT
+35 if RETIEN=""
SET RETIEN=0
+36 SET OUT(1)="0"_SSEP_SSEP_RETIEN
+37 QUIT
