MAGUTL06 ;WOIFO/SG,NST - VALIDATION OF MULTI-VALUE PARAMETERS ; OCT 18, 2018@12:53pm
;;3.0;IMAGING;**93,221**;Dec 02, 2009;Build 163
;; 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
;
;##### VALIDATES THE LIST OF NAMES/CODES
;
; CDNMLIST List of internal and/or external values of a 'set
; of codes' field defined by the FILE and FIELD
; parameters. Items should be separated by the '^'
; (see also the FLAGS parameter).
;
; FILE File/Subfile number
; FIELD Field number
;
; MAG8NODE Closed reference to a node where the results are
; returned to:
;
; @MAG8NODE@( The list of external names is returned here. Items
; are separated with the same delimiter as those in
; the source list.
;
; Code) Name
;
; [FLAGS] Flags that control the execution (can be combined):
;
; C "Capitalize" the external names
;
; , Use comma as item separator instead of '^'
; (not recommended).
;
; Z Treat 0 (zero) as valid code regardles of
; the field definition.
;
; Return Values
; =============
; <0 Error descriptor (see the $$ERROR^MAGUERR)
; 0 Success
; >0 Number of the piece of the source list that
; contains an invalid code or name.
;
VALCNLST(CDNMLIST,FILE,FIELD,MAG8NODE,FLAGS) ;
N ERR,I,ICNT,ITEM,LS,MAG8MSG,MAG8RES,MAGI,NAME,RC
S FLAGS=$G(FLAGS),LS=$S(FLAGS[",":",",1:"^")
Q:$TR(FLAGS,"C,Z")'="" $$IPVE^MAGUERR("FLAGS")
K @MAG8NODE S (ICNT,RC)=0
;
;=== Process items of the list
F MAGI=1:1:$L(CDNMLIST,LS) D Q:RC
. ;--- Get item name or code
. S ITEM=$$TRIM^XLFSTR($P(CDNMLIST,LS,MAGI)) Q:ITEM=""
. ;--- Special check for zero
. I ITEM=0,FLAGS["Z" D Q
. . S ICNT=ICNT+1,NAME="<empty>"
. . S $P(@MAG8NODE,LS,ICNT)=NAME ; External name
. . S @MAG8NODE@(0)=NAME ; Internal code
. . Q
. ;--- Validate the item
. D CHK^DIE(FILE,FIELD,"E",ITEM,.MAG8RES,"MAG8MSG")
. I MAG8RES="^" S RC=MAGI,ERR=$G(MAG8MSG("DIERR",1)) D:ERR'=701 Q
. . I ERR=401 S RC=$$IPVE^MAGUERR("FILE") Q
. . I ERR=501 S RC=$$IPVE^MAGUERR("FIELD") Q
. ;--- Store external and internal values
. S ICNT=ICNT+1
. S NAME=$S(FLAGS["C":$$SNTC^MAGUTL05(MAG8RES(0)),1:MAG8RES(0))
. S $P(@MAG8NODE,LS,ICNT)=NAME ; External name
. S @MAG8NODE@(MAG8RES)=NAME ; Internal code
. Q
;
;=== Cleanup
I RC K @MAG8NODE Q RC
Q 0
;
;##### VALIDATES THE LIST OF NAMES/POINTERS
;
; PTNMLIST Reference to a local variable that stores a list of
; IENs and/or values of the .01 field from the file
; defined by the FILE parameter. Items should be
; separated by the '^' (see also the FLAGS parameter).
;
; FILE File number. The file must have the standard
; "B" cross-reference for the .01 field.
;
;
; MAG8NODE Closed reference to a node where the results are
; returned to:
;
; @MAG8NODE@( The list of names (.01 values) is returned here.
; Items are separated with the same delimiter as those
; in the source list.
;
; IEN) Name
;
; [FLAGS] Flags that control the execution (can be combined):
;
; C "Capitalize" the names
;
; , Use comma as item separator instead of '^'.
; (not recommended).
;
; Return Values
; =============
; <0 Error descriptor (see the $$ERROR^MAGUERR)
; 0 Success
; >0 Number of the piece of the source list that
; contains an invalid code or name.
;
VALPNLST(PTNMLIST,FILE,MAG8NODE,FLAGS) ;
N MAGI,ICNT,IEN,ITEM,LS,MAGMSG,NAME,RC,ROOT,TMP,DIERR
S FLAGS=$G(FLAGS),LS=$S(FLAGS[",":",",1:"^")
Q:$TR(FLAGS,"C,")'="" $$IPVE^MAGUERR("FLAGS")
K @MAG8NODE S (ICNT,RC)=0,ROOT=$$ROOT^DILFD(FILE,,1)
Q:ROOT="" $$IPVE^MAGUERR("FILE")
;
;=== Process items of the list
F MAGI=1:1:$L(PTNMLIST,LS) D Q:RC
. ;--- Get name or IEN
. S ITEM=$$TRIM^XLFSTR($P(PTNMLIST,LS,MAGI)) Q:ITEM=""
. ;--- IEN
. I +ITEM=ITEM,$D(@ROOT@(ITEM)) D Q
. . S NAME=$$GET1^DIQ(FILE,ITEM_",",.01,,,"MAGMSG")
. . I $G(DIERR) S RC=$$DBS^MAGUERR("MAGMSG",FILE,ITEM_",") Q
. . S ICNT=ICNT+1
. . S:FLAGS["C" NAME=$$SNTC^MAGUTL05(NAME)
. . S $P(@MAG8NODE,LS,ICNT)=NAME ; Name
. . S @MAG8NODE@(ITEM)=NAME ; IEN
. . Q
. ;--- Name
. I $D(@ROOT@("B",ITEM))<10 S RC=MAGI Q
. S ICNT=ICNT+1
. S NAME=$S(FLAGS["C":$$SNTC^MAGUTL05(ITEM),1:ITEM)
. S $P(@MAG8NODE,LS,ICNT)=NAME
. S IEN=""
. F S IEN=$O(@ROOT@("B",ITEM,IEN)) Q:IEN="" D
. . S @MAG8NODE@(IEN)=NAME
. . Q
. Q
;
;=== Cleanup
I RC K @MAG8NODE Q RC
Q 0
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGUTL06 5965 printed Apr 09, 2024@21:07:54 Page 2
MAGUTL06 ;WOIFO/SG,NST - VALIDATION OF MULTI-VALUE PARAMETERS ; OCT 18, 2018@12:53pm
+1 ;;3.0;IMAGING;**93,221**;Dec 02, 2009;Build 163
+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 ;; | |
+11 ;; | The Food and Drug Administration classifies this software as |
+12 ;; | a medical device. As such, it may not be changed in any way. |
+13 ;; | Modifications to this software may result in an adulterated |
+14 ;; | medical device under 21CFR820, the use of which is considered |
+15 ;; | to be a violation of US Federal Statutes. |
+16 ;; +---------------------------------------------------------------+
+17 ;;
+18 QUIT
+19 ;
+20 ;##### VALIDATES THE LIST OF NAMES/CODES
+21 ;
+22 ; CDNMLIST List of internal and/or external values of a 'set
+23 ; of codes' field defined by the FILE and FIELD
+24 ; parameters. Items should be separated by the '^'
+25 ; (see also the FLAGS parameter).
+26 ;
+27 ; FILE File/Subfile number
+28 ; FIELD Field number
+29 ;
+30 ; MAG8NODE Closed reference to a node where the results are
+31 ; returned to:
+32 ;
+33 ; @MAG8NODE@( The list of external names is returned here. Items
+34 ; are separated with the same delimiter as those in
+35 ; the source list.
+36 ;
+37 ; Code) Name
+38 ;
+39 ; [FLAGS] Flags that control the execution (can be combined):
+40 ;
+41 ; C "Capitalize" the external names
+42 ;
+43 ; , Use comma as item separator instead of '^'
+44 ; (not recommended).
+45 ;
+46 ; Z Treat 0 (zero) as valid code regardles of
+47 ; the field definition.
+48 ;
+49 ; Return Values
+50 ; =============
+51 ; <0 Error descriptor (see the $$ERROR^MAGUERR)
+52 ; 0 Success
+53 ; >0 Number of the piece of the source list that
+54 ; contains an invalid code or name.
+55 ;
VALCNLST(CDNMLIST,FILE,FIELD,MAG8NODE,FLAGS) ;
+1 NEW ERR,I,ICNT,ITEM,LS,MAG8MSG,MAG8RES,MAGI,NAME,RC
+2 SET FLAGS=$GET(FLAGS)
SET LS=$SELECT(FLAGS[",":",",1:"^")
+3 if $TRANSLATE(FLAGS,"C,Z")'=""
QUIT $$IPVE^MAGUERR("FLAGS")
+4 KILL @MAG8NODE
SET (ICNT,RC)=0
+5 ;
+6 ;=== Process items of the list
+7 FOR MAGI=1:1:$LENGTH(CDNMLIST,LS)
Begin DoDot:1
+8 ;--- Get item name or code
+9 SET ITEM=$$TRIM^XLFSTR($PIECE(CDNMLIST,LS,MAGI))
if ITEM=""
QUIT
+10 ;--- Special check for zero
+11 IF ITEM=0
IF FLAGS["Z"
Begin DoDot:2
+12 SET ICNT=ICNT+1
SET NAME="<empty>"
+13 ; External name
SET $PIECE(@MAG8NODE,LS,ICNT)=NAME
+14 ; Internal code
SET @MAG8NODE@(0)=NAME
+15 QUIT
End DoDot:2
QUIT
+16 ;--- Validate the item
+17 DO CHK^DIE(FILE,FIELD,"E",ITEM,.MAG8RES,"MAG8MSG")
+18 IF MAG8RES="^"
SET RC=MAGI
SET ERR=$GET(MAG8MSG("DIERR",1))
if ERR'=701
Begin DoDot:2
+19 IF ERR=401
SET RC=$$IPVE^MAGUERR("FILE")
QUIT
+20 IF ERR=501
SET RC=$$IPVE^MAGUERR("FIELD")
QUIT
End DoDot:2
QUIT
+21 ;--- Store external and internal values
+22 SET ICNT=ICNT+1
+23 SET NAME=$SELECT(FLAGS["C":$$SNTC^MAGUTL05(MAG8RES(0)),1:MAG8RES(0))
+24 ; External name
SET $PIECE(@MAG8NODE,LS,ICNT)=NAME
+25 ; Internal code
SET @MAG8NODE@(MAG8RES)=NAME
+26 QUIT
End DoDot:1
if RC
QUIT
+27 ;
+28 ;=== Cleanup
+29 IF RC
KILL @MAG8NODE
QUIT RC
+30 QUIT 0
+31 ;
+32 ;##### VALIDATES THE LIST OF NAMES/POINTERS
+33 ;
+34 ; PTNMLIST Reference to a local variable that stores a list of
+35 ; IENs and/or values of the .01 field from the file
+36 ; defined by the FILE parameter. Items should be
+37 ; separated by the '^' (see also the FLAGS parameter).
+38 ;
+39 ; FILE File number. The file must have the standard
+40 ; "B" cross-reference for the .01 field.
+41 ;
+42 ;
+43 ; MAG8NODE Closed reference to a node where the results are
+44 ; returned to:
+45 ;
+46 ; @MAG8NODE@( The list of names (.01 values) is returned here.
+47 ; Items are separated with the same delimiter as those
+48 ; in the source list.
+49 ;
+50 ; IEN) Name
+51 ;
+52 ; [FLAGS] Flags that control the execution (can be combined):
+53 ;
+54 ; C "Capitalize" the names
+55 ;
+56 ; , Use comma as item separator instead of '^'.
+57 ; (not recommended).
+58 ;
+59 ; Return Values
+60 ; =============
+61 ; <0 Error descriptor (see the $$ERROR^MAGUERR)
+62 ; 0 Success
+63 ; >0 Number of the piece of the source list that
+64 ; contains an invalid code or name.
+65 ;
VALPNLST(PTNMLIST,FILE,MAG8NODE,FLAGS) ;
+1 NEW MAGI,ICNT,IEN,ITEM,LS,MAGMSG,NAME,RC,ROOT,TMP,DIERR
+2 SET FLAGS=$GET(FLAGS)
SET LS=$SELECT(FLAGS[",":",",1:"^")
+3 if $TRANSLATE(FLAGS,"C,")'=""
QUIT $$IPVE^MAGUERR("FLAGS")
+4 KILL @MAG8NODE
SET (ICNT,RC)=0
SET ROOT=$$ROOT^DILFD(FILE,,1)
+5 if ROOT=""
QUIT $$IPVE^MAGUERR("FILE")
+6 ;
+7 ;=== Process items of the list
+8 FOR MAGI=1:1:$LENGTH(PTNMLIST,LS)
Begin DoDot:1
+9 ;--- Get name or IEN
+10 SET ITEM=$$TRIM^XLFSTR($PIECE(PTNMLIST,LS,MAGI))
if ITEM=""
QUIT
+11 ;--- IEN
+12 IF +ITEM=ITEM
IF $DATA(@ROOT@(ITEM))
Begin DoDot:2
+13 SET NAME=$$GET1^DIQ(FILE,ITEM_",",.01,,,"MAGMSG")
+14 IF $GET(DIERR)
SET RC=$$DBS^MAGUERR("MAGMSG",FILE,ITEM_",")
QUIT
+15 SET ICNT=ICNT+1
+16 if FLAGS["C"
SET NAME=$$SNTC^MAGUTL05(NAME)
+17 ; Name
SET $PIECE(@MAG8NODE,LS,ICNT)=NAME
+18 ; IEN
SET @MAG8NODE@(ITEM)=NAME
+19 QUIT
End DoDot:2
QUIT
+20 ;--- Name
+21 IF $DATA(@ROOT@("B",ITEM))<10
SET RC=MAGI
QUIT
+22 SET ICNT=ICNT+1
+23 SET NAME=$SELECT(FLAGS["C":$$SNTC^MAGUTL05(ITEM),1:ITEM)
+24 SET $PIECE(@MAG8NODE,LS,ICNT)=NAME
+25 SET IEN=""
+26 FOR
SET IEN=$ORDER(@ROOT@("B",ITEM,IEN))
if IEN=""
QUIT
Begin DoDot:2
+27 SET @MAG8NODE@(IEN)=NAME
+28 QUIT
End DoDot:2
+29 QUIT
End DoDot:1
if RC
QUIT
+30 ;
+31 ;=== Cleanup
+32 IF RC
KILL @MAG8NODE
QUIT RC
+33 QUIT 0
