MAGUFFLA ;WOIFO/MLH - Imaging FileMan utility - return list of attributes for a field; 24 Sep 2011 01:49 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
;
FIELDATT(OUT,FILENO,FIELDNO) ; rpc MAG FILEMAN FIELD ATTS
; input: FILENO The number of a Fileman file or subfile
; FIELDNO The number of a field within the file
;
; output: OUT() Array of return values formatted as follows:
; If no input or processing error:
; OUT(1) = 0``n where n = number of entries on the OUT() array
; OUT(m) where 1 < m <= n
; = attribute`value
; If an input or processing error:
; OUT(1) = n`error_message
;
; All ^DD references permitted under ICR #5551
;
K OUT
I FILENO=+FILENO,$D(^DD(FILENO)) ; valid input
E S OUT(1)="-1`'"_FILENO_"' not a valid Fileman file or subfile number" Q
I FIELDNO=+FIELDNO,$D(^DD(FILENO,FIELDNO)) ; valid input
E S OUT(1)="-2`'"_FIELDNO_"' not a valid field number" Q
N ATTSTR,ATTARY,ATT,WPIX,OUTIX
S ATTSTR="AUDIT;AUDIT CONDITION;COMPUTE ALGORITHM;COMPUTED FIELDS USED;"
S ATTSTR=ATTSTR_"DATE FIELD LAST EDITED;DECIMAL DEFAULT;DELETE ACCESS;"
S ATTSTR=ATTSTR_"DESCRIPTION;FIELD LENGTH;GLOBAL SUBSCRIPT LOCATION;"
S ATTSTR=ATTSTR_"HELP-PROMPT;INPUT TRANSFORM;LABEL,MULTIPLE-VALUED;"
S ATTSTR=ATTSTR_"OUTPUT TRANSFORM;POINTER;READ ACCESS;SOURCE;SPECIFIER;"
S ATTSTR=ATTSTR_"TECHNICAL DESCRIPTION;TITLE;TYPE;WRITE ACCESS;"
S ATTSTR=ATTSTR_"XECUTABLE HELP"
D FIELD^DID(FILENO,FIELDNO,"N",ATTSTR,"ATTARY")
S ATT="",OUTIX=1
F S ATT=$O(ATTARY(ATT)) Q:ATT="" D
. I $D(ATTARY(ATT))=1 D Q
. . S OUTIX=OUTIX+1,OUT(OUTIX)=ATT_"`"_ATTARY(ATT)
. . Q
. S WPIX=""
. F S WPIX=$O(ATTARY(ATT,WPIX)) Q:WPIX="" D
. . S OUTIX=OUTIX+1,OUT(OUTIX)=ATT_"`"_ATTARY(ATT,WPIX)
. . Q
. Q
S OUT(1)="0``"_OUTIX ; count
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGUFFLA 2874 printed Dec 13, 2024@02:08:57 Page 2
MAGUFFLA ;WOIFO/MLH - Imaging FileMan utility - return list of attributes for a field; 24 Sep 2011 01:49 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 ;
FIELDATT(OUT,FILENO,FIELDNO) ; rpc MAG FILEMAN FIELD ATTS
+1 ; input: FILENO The number of a Fileman file or subfile
+2 ; FIELDNO The number of a field within the file
+3 ;
+4 ; output: OUT() Array of return values formatted as follows:
+5 ; If no input or processing error:
+6 ; OUT(1) = 0``n where n = number of entries on the OUT() array
+7 ; OUT(m) where 1 < m <= n
+8 ; = attribute`value
+9 ; If an input or processing error:
+10 ; OUT(1) = n`error_message
+11 ;
+12 ; All ^DD references permitted under ICR #5551
+13 ;
+14 KILL OUT
+15 ; valid input
IF FILENO=+FILENO
IF $DATA(^DD(FILENO))
+16 IF '$TEST
SET OUT(1)="-1`'"_FILENO_"' not a valid Fileman file or subfile number"
QUIT
+17 ; valid input
IF FIELDNO=+FIELDNO
IF $DATA(^DD(FILENO,FIELDNO))
+18 IF '$TEST
SET OUT(1)="-2`'"_FIELDNO_"' not a valid field number"
QUIT
+19 NEW ATTSTR,ATTARY,ATT,WPIX,OUTIX
+20 SET ATTSTR="AUDIT;AUDIT CONDITION;COMPUTE ALGORITHM;COMPUTED FIELDS USED;"
+21 SET ATTSTR=ATTSTR_"DATE FIELD LAST EDITED;DECIMAL DEFAULT;DELETE ACCESS;"
+22 SET ATTSTR=ATTSTR_"DESCRIPTION;FIELD LENGTH;GLOBAL SUBSCRIPT LOCATION;"
+23 SET ATTSTR=ATTSTR_"HELP-PROMPT;INPUT TRANSFORM;LABEL,MULTIPLE-VALUED;"
+24 SET ATTSTR=ATTSTR_"OUTPUT TRANSFORM;POINTER;READ ACCESS;SOURCE;SPECIFIER;"
+25 SET ATTSTR=ATTSTR_"TECHNICAL DESCRIPTION;TITLE;TYPE;WRITE ACCESS;"
+26 SET ATTSTR=ATTSTR_"XECUTABLE HELP"
+27 DO FIELD^DID(FILENO,FIELDNO,"N",ATTSTR,"ATTARY")
+28 SET ATT=""
SET OUTIX=1
+29 FOR
SET ATT=$ORDER(ATTARY(ATT))
if ATT=""
QUIT
Begin DoDot:1
+30 IF $DATA(ATTARY(ATT))=1
Begin DoDot:2
+31 SET OUTIX=OUTIX+1
SET OUT(OUTIX)=ATT_"`"_ATTARY(ATT)
+32 QUIT
End DoDot:2
QUIT
+33 SET WPIX=""
+34 FOR
SET WPIX=$ORDER(ATTARY(ATT,WPIX))
if WPIX=""
QUIT
Begin DoDot:2
+35 SET OUTIX=OUTIX+1
SET OUT(OUTIX)=ATT_"`"_ATTARY(ATT,WPIX)
+36 QUIT
End DoDot:2
+37 QUIT
End DoDot:1
+38 ; count
SET OUT(1)="0``"_OUTIX
+39 QUIT
