MAGUTL02 ;WOIFO/SG - PARAMETERS AND VALIDATION UTILITIES ; 3/9/09 12:53pm
;;3.0;IMAGING;**93**;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
;
;+++++ RETURNS THE PSEUDO-NAME (FOR ERROR MESSAGES) OF THE PARAMETER
PNAME(PNODE) ;
Q "["_$E(PNODE,$F(PNODE,"("),$L(PNODE)-1)_"]"
;
;##### PARSES MAGMSC PARAMETER LIST INTO MAGMISC PARAMETER TREE
;
; .MAGMSC( Reference to a local variable that stores misc.
; RPC parameters as a "flat" list.
;
; i) Parameter
; ^01: Parameter name
; ^02: Seq# - sequential number for multi-value
; parameters. It can also contain the "R"
; suffix to indicate a record boundary.
; ^03: Parameter value
; ^04: Additional values associated with the
; ... parameter.
;
; .MAGMISC( Reference to a local variable where miscellaneous
; parameters are returned as nodes.
;
; PName, Original value of the parameter PName.
; "E") External and internal values of the parameter
; "I") (if validation/conversion is performed)
;
; MName,
; Seq#) Item of the list MName or the line of text (word-
; processing) parameter MName.
; "E") External and internal values of the parameter
; "I") (if validation/conversion is performed)
; RName,
; Seq#,
; FName, Original value of the FName field of a parameter
; record of the type RName.
; "E") External and internal values of the parameter
; "I") (if validation/conversion is performed)
;
; [.MAGMSPDS] Reference to a local variable that stores the
; parameter definition tree generated by the
; $$LDMPDEFS^MAGUTL01. If this parameter is provided,
; then automatic validation/conversion is performed.
;
; [MAGFLAGS] Flags that control the execution (can be comnined):
;
; U Return an error (-10) if an unknown/unsupported
; parameter value (there is no definition for
; this parameter in the MAGMSPDS) is found in the
; MAGMSC list.
;
; By default or if the MAGMSPDS parameter is
; not defined, all values are copied to the
; destination tree "as is".
;
; V Perform additional validation using the CHK^DIE
; for those parameters that have associated file
; and field numbers.
;
; Return Values
; =============
; <0 Error descriptor (see $$ERROR^MAGUERR)
; 0 Success
;
; Notes
; =====
;
; During the validation/conversion of pointers, pure numeric values
; are always treated as IENs.
;
; During the validation/conversion of sets of codes, the API checks
; for internal values first. So, if there is an ambiguity between
; internal and external values, the parameter value will be treated
; as the internal one.
;
RPCMISC(MAGMSC,MAGMISC,MAGMSPDS,MAGFLAGS) ;
N MAGSRCI,RC K MAGMISC
S MAGFLAGS=$G(MAGFLAGS),MAGSRCI=""
Q:$TR(MAGFLAGS,"UV")'="" $$IPVE^MAGUERR("MAGFLAGS")
S RC=$$RPCMISCZ("MAGMSPDS","MAGMISC")
Q $S(RC<0:RC,1:0)
;
;+++++ RECURSIVE PARSER OF MAGMSC RECORDS
;
; MSPDNODE Node in the parameter definition tree (MAGMSPDS)
;
; DSTNODE Node of the MAGMISC where values will be stored.
;
; [RECNAME] Tag name and index of the current record. They are
; [RECNDX] used to detect the record boundaries.
;
; Input Variables
; ===============
; MAGFLAGS, MAGMSC, MAGSRCI
;
; Output Variables
; ================
; MAGSRCI
;
; Return Values
; =============
; <0 Error descriptor (see $$ERROR^MAGUERR)
; 0 Success
; 1 End of the list
;
; Notes
; =====
;
; This is an internal entry point. Do not call it from outside
; of this routine.
;
RPCMISCZ(MSPDNODE,DSTNODE,RECNAME,RECNDX) ;
N FILE,FIELD,NAME,NDX,PNODE,RC,SRCVAL,TMP,TYPE,VAL,VALIDATE
S RC=0
;
;===
F S MAGSRCI=$O(MAGMSC(MAGSRCI)) Q:MAGSRCI="" D Q:RC
. S NAME=$TR($P(MAGMSC(MAGSRCI),U)," ") Q:NAME=""
. ;
. ;=== Load the parameter descriptor
. S TMP=$G(@MSPDNODE@("N",NAME))
. S FILE=+TMP,FIELD=+$P(TMP,U,2),TYPE=$P(TMP,U,3)
. ;
. ;=== Check multiplicity of the parameter
. S TMP=$TR($P(MAGMSC(MAGSRCI),U,2)," "),NDX=+TMP
. I TMP["R" S:TYPE'["R" TYPE=TYPE_"R"
. I NDX>0 D
. . S PNODE=$NA(@DSTNODE@(NAME,NDX))
. . S:$D(@PNODE) RC=$$ERROR^MAGUERR(-18,,NDX,$$PNAME(PNODE))
. . Q
. E D
. . S PNODE=$NA(@DSTNODE@(NAME))
. . S:$D(@PNODE)#2 RC=$$ERROR^MAGUERR(-17,,$$PNAME(PNODE))
. . Q
. Q:RC<0
. ;
. ;=== Check if parameter is supported
. I '$D(@MSPDNODE@("N",NAME)),MAGFLAGS["U" D Q
. . S RC=$$ERROR^MAGUERR(-10,,$$PNAME(PNODE))
. . Q
. ;
. ;=== Check for record start/end
. I TYPE["R" D Q
. . ;--- If the name is the same as that of the current record, then
. . ; this either the end of the current record or a beginning of
. . ;--- the next record of the same kind (and on the same level).
. . I NAME=$G(RECNAME) D:NDX'=$G(RECNDX) S RC=2 Q
. . . ;--- If the index is different from that of the current record,
. . . ; then this is a beginning of the next record. Let the
. . . ;--- source line be re-processed on the upper execution level.
. . . S MAGSRCI=$O(MAGMSC(MAGSRCI),-1)
. . . Q
. . ;--- Start processing field values of the record
. . S RC=$$RPCMISCZ($NA(@MSPDNODE@("N",NAME)),PNODE,NAME,NDX)
. . Q
. ;
. ;=== Copy the original value "as is"
. S @PNODE=$P(MAGMSC(MAGSRCI),U,3,99999)
. ;
. ;=== Special processing of the parameter value
. S VALIDATE=$S(MAGFLAGS["V":(FILE>0)&(FIELD>0),1:0)
. S (SRCVAL,VAL)=$P(MAGMSC(MAGSRCI),U,3)
. I '(VAL?.1"@") D Q:RC<0
. . ;--- Convert the date/time value
. . I TYPE["D" D Q
. . . ;--- HL7 timestamp (TS)
. . . I TYPE["H" S VAL=$$HL7TFM^XLFDT(VAL) I VAL'>0 D Q
. . . . S RC=$$IPVE^MAGUERR("SRCVAL",$$PNAME(PNODE))
. . . ;--- If validation is requested, then the conversion
. . . ;--- will be performed at the same time.
. . . Q:VALIDATE
. . . ;--- Otherwise, calculate the internal and external values
. . . S VAL=$$DTI^MAGUTL03(VAL,"PST")
. . . I VAL<0 S RC=$$IPVE^MAGUERR("SRCVAL",$$PNAME(PNODE)) Q
. . . S @PNODE@("I")=VAL,@PNODE@("E")=$$FMTE^XLFDT(VAL)
. . . Q
. . ;--- Pointer
. . I TYPE["P" D:VALIDATE Q
. . . ;--- Construct the pseudo-external value for validation
. . . S:+VAL=VAL VAL="`"_VAL
. . . Q
. . ;--- Set of codes
. . I TYPE["S" D:VALIDATE Q
. . . N MAGMSG
. . . S TMP=$$EXTERNAL^DILFD(FILE,FIELD,,VAL,"MAGMSG")
. . . S:TMP'="" VAL=TMP
. . . Q
. . Q
. E S (@PNODE@("I"),@PNODE@("E"),VAL)=""
. ;
. ;=== Validate the value if requested
. I VALIDATE,VAL'="" D Q:RC<0
. . N MAGMSG,MAGRES
. . D CHK^DIE(FILE,FIELD,"E",VAL,.MAGRES,"MAGMSG")
. . I MAGRES="^" S RC=$$IPVE^MAGUERR("SRCVAL",$$PNAME(PNODE)) Q
. . S @PNODE@("I")=MAGRES,@PNODE@("E")=MAGRES(0)
. . Q
. Q
Q:RC<0 RC
;
;=== Check the required parameters
S NAME=""
F S NAME=$O(@MSPDNODE@("Q",NAME)) Q:NAME="" D Q:RC<0
. S PNODE=$NA(@DSTNODE@(NAME))
. S:'$D(@PNODE) RC=$$ERROR^MAGUERR(-8,,$$PNAME(PNODE))
. Q
;
;===
Q $S(RC>1:0,'RC:1,1:RC)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMAGUTL02 8567 printed Oct 16, 2024@18:09:46 Page 2
MAGUTL02 ;WOIFO/SG - PARAMETERS AND VALIDATION UTILITIES ; 3/9/09 12:53pm
+1 ;;3.0;IMAGING;**93**;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 ;+++++ RETURNS THE PSEUDO-NAME (FOR ERROR MESSAGES) OF THE PARAMETER
PNAME(PNODE) ;
+1 QUIT "["_$EXTRACT(PNODE,$FIND(PNODE,"("),$LENGTH(PNODE)-1)_"]"
+2 ;
+3 ;##### PARSES MAGMSC PARAMETER LIST INTO MAGMISC PARAMETER TREE
+4 ;
+5 ; .MAGMSC( Reference to a local variable that stores misc.
+6 ; RPC parameters as a "flat" list.
+7 ;
+8 ; i) Parameter
+9 ; ^01: Parameter name
+10 ; ^02: Seq# - sequential number for multi-value
+11 ; parameters. It can also contain the "R"
+12 ; suffix to indicate a record boundary.
+13 ; ^03: Parameter value
+14 ; ^04: Additional values associated with the
+15 ; ... parameter.
+16 ;
+17 ; .MAGMISC( Reference to a local variable where miscellaneous
+18 ; parameters are returned as nodes.
+19 ;
+20 ; PName, Original value of the parameter PName.
+21 ; "E") External and internal values of the parameter
+22 ; "I") (if validation/conversion is performed)
+23 ;
+24 ; MName,
+25 ; Seq#) Item of the list MName or the line of text (word-
+26 ; processing) parameter MName.
+27 ; "E") External and internal values of the parameter
+28 ; "I") (if validation/conversion is performed)
+29 ; RName,
+30 ; Seq#,
+31 ; FName, Original value of the FName field of a parameter
+32 ; record of the type RName.
+33 ; "E") External and internal values of the parameter
+34 ; "I") (if validation/conversion is performed)
+35 ;
+36 ; [.MAGMSPDS] Reference to a local variable that stores the
+37 ; parameter definition tree generated by the
+38 ; $$LDMPDEFS^MAGUTL01. If this parameter is provided,
+39 ; then automatic validation/conversion is performed.
+40 ;
+41 ; [MAGFLAGS] Flags that control the execution (can be comnined):
+42 ;
+43 ; U Return an error (-10) if an unknown/unsupported
+44 ; parameter value (there is no definition for
+45 ; this parameter in the MAGMSPDS) is found in the
+46 ; MAGMSC list.
+47 ;
+48 ; By default or if the MAGMSPDS parameter is
+49 ; not defined, all values are copied to the
+50 ; destination tree "as is".
+51 ;
+52 ; V Perform additional validation using the CHK^DIE
+53 ; for those parameters that have associated file
+54 ; and field numbers.
+55 ;
+56 ; Return Values
+57 ; =============
+58 ; <0 Error descriptor (see $$ERROR^MAGUERR)
+59 ; 0 Success
+60 ;
+61 ; Notes
+62 ; =====
+63 ;
+64 ; During the validation/conversion of pointers, pure numeric values
+65 ; are always treated as IENs.
+66 ;
+67 ; During the validation/conversion of sets of codes, the API checks
+68 ; for internal values first. So, if there is an ambiguity between
+69 ; internal and external values, the parameter value will be treated
+70 ; as the internal one.
+71 ;
RPCMISC(MAGMSC,MAGMISC,MAGMSPDS,MAGFLAGS) ;
+1 NEW MAGSRCI,RC
KILL MAGMISC
+2 SET MAGFLAGS=$GET(MAGFLAGS)
SET MAGSRCI=""
+3 if $TRANSLATE(MAGFLAGS,"UV")'=""
QUIT $$IPVE^MAGUERR("MAGFLAGS")
+4 SET RC=$$RPCMISCZ("MAGMSPDS","MAGMISC")
+5 QUIT $SELECT(RC<0:RC,1:0)
+6 ;
+7 ;+++++ RECURSIVE PARSER OF MAGMSC RECORDS
+8 ;
+9 ; MSPDNODE Node in the parameter definition tree (MAGMSPDS)
+10 ;
+11 ; DSTNODE Node of the MAGMISC where values will be stored.
+12 ;
+13 ; [RECNAME] Tag name and index of the current record. They are
+14 ; [RECNDX] used to detect the record boundaries.
+15 ;
+16 ; Input Variables
+17 ; ===============
+18 ; MAGFLAGS, MAGMSC, MAGSRCI
+19 ;
+20 ; Output Variables
+21 ; ================
+22 ; MAGSRCI
+23 ;
+24 ; Return Values
+25 ; =============
+26 ; <0 Error descriptor (see $$ERROR^MAGUERR)
+27 ; 0 Success
+28 ; 1 End of the list
+29 ;
+30 ; Notes
+31 ; =====
+32 ;
+33 ; This is an internal entry point. Do not call it from outside
+34 ; of this routine.
+35 ;
RPCMISCZ(MSPDNODE,DSTNODE,RECNAME,RECNDX) ;
+1 NEW FILE,FIELD,NAME,NDX,PNODE,RC,SRCVAL,TMP,TYPE,VAL,VALIDATE
+2 SET RC=0
+3 ;
+4 ;===
+5 FOR
SET MAGSRCI=$ORDER(MAGMSC(MAGSRCI))
if MAGSRCI=""
QUIT
Begin DoDot:1
+6 SET NAME=$TRANSLATE($PIECE(MAGMSC(MAGSRCI),U)," ")
if NAME=""
QUIT
+7 ;
+8 ;=== Load the parameter descriptor
+9 SET TMP=$GET(@MSPDNODE@("N",NAME))
+10 SET FILE=+TMP
SET FIELD=+$PIECE(TMP,U,2)
SET TYPE=$PIECE(TMP,U,3)
+11 ;
+12 ;=== Check multiplicity of the parameter
+13 SET TMP=$TRANSLATE($PIECE(MAGMSC(MAGSRCI),U,2)," ")
SET NDX=+TMP
+14 IF TMP["R"
if TYPE'["R"
SET TYPE=TYPE_"R"
+15 IF NDX>0
Begin DoDot:2
+16 SET PNODE=$NAME(@DSTNODE@(NAME,NDX))
+17 if $DATA(@PNODE)
SET RC=$$ERROR^MAGUERR(-18,,NDX,$$PNAME(PNODE))
+18 QUIT
End DoDot:2
+19 IF '$TEST
Begin DoDot:2
+20 SET PNODE=$NAME(@DSTNODE@(NAME))
+21 if $DATA(@PNODE)#2
SET RC=$$ERROR^MAGUERR(-17,,$$PNAME(PNODE))
+22 QUIT
End DoDot:2
+23 if RC<0
QUIT
+24 ;
+25 ;=== Check if parameter is supported
+26 IF '$DATA(@MSPDNODE@("N",NAME))
IF MAGFLAGS["U"
Begin DoDot:2
+27 SET RC=$$ERROR^MAGUERR(-10,,$$PNAME(PNODE))
+28 QUIT
End DoDot:2
QUIT
+29 ;
+30 ;=== Check for record start/end
+31 IF TYPE["R"
Begin DoDot:2
+32 ;--- If the name is the same as that of the current record, then
+33 ; this either the end of the current record or a beginning of
+34 ;--- the next record of the same kind (and on the same level).
+35 IF NAME=$GET(RECNAME)
if NDX'=$GET(RECNDX)
Begin DoDot:3
+36 ;--- If the index is different from that of the current record,
+37 ; then this is a beginning of the next record. Let the
+38 ;--- source line be re-processed on the upper execution level.
+39 SET MAGSRCI=$ORDER(MAGMSC(MAGSRCI),-1)
+40 QUIT
End DoDot:3
SET RC=2
QUIT
+41 ;--- Start processing field values of the record
+42 SET RC=$$RPCMISCZ($NAME(@MSPDNODE@("N",NAME)),PNODE,NAME,NDX)
+43 QUIT
End DoDot:2
QUIT
+44 ;
+45 ;=== Copy the original value "as is"
+46 SET @PNODE=$PIECE(MAGMSC(MAGSRCI),U,3,99999)
+47 ;
+48 ;=== Special processing of the parameter value
+49 SET VALIDATE=$SELECT(MAGFLAGS["V":(FILE>0)&(FIELD>0),1:0)
+50 SET (SRCVAL,VAL)=$PIECE(MAGMSC(MAGSRCI),U,3)
+51 IF '(VAL?.1"@")
Begin DoDot:2
+52 ;--- Convert the date/time value
+53 IF TYPE["D"
Begin DoDot:3
+54 ;--- HL7 timestamp (TS)
+55 IF TYPE["H"
SET VAL=$$HL7TFM^XLFDT(VAL)
IF VAL'>0
Begin DoDot:4
+56 SET RC=$$IPVE^MAGUERR("SRCVAL",$$PNAME(PNODE))
End DoDot:4
QUIT
+57 ;--- If validation is requested, then the conversion
+58 ;--- will be performed at the same time.
+59 if VALIDATE
QUIT
+60 ;--- Otherwise, calculate the internal and external values
+61 SET VAL=$$DTI^MAGUTL03(VAL,"PST")
+62 IF VAL<0
SET RC=$$IPVE^MAGUERR("SRCVAL",$$PNAME(PNODE))
QUIT
+63 SET @PNODE@("I")=VAL
SET @PNODE@("E")=$$FMTE^XLFDT(VAL)
+64 QUIT
End DoDot:3
QUIT
+65 ;--- Pointer
+66 IF TYPE["P"
if VALIDATE
Begin DoDot:3
+67 ;--- Construct the pseudo-external value for validation
+68 if +VAL=VAL
SET VAL="`"_VAL
+69 QUIT
End DoDot:3
QUIT
+70 ;--- Set of codes
+71 IF TYPE["S"
if VALIDATE
Begin DoDot:3
+72 NEW MAGMSG
+73 SET TMP=$$EXTERNAL^DILFD(FILE,FIELD,,VAL,"MAGMSG")
+74 if TMP'=""
SET VAL=TMP
+75 QUIT
End DoDot:3
QUIT
+76 QUIT
End DoDot:2
if RC<0
QUIT
+77 IF '$TEST
SET (@PNODE@("I"),@PNODE@("E"),VAL)=""
+78 ;
+79 ;=== Validate the value if requested
+80 IF VALIDATE
IF VAL'=""
Begin DoDot:2
+81 NEW MAGMSG,MAGRES
+82 DO CHK^DIE(FILE,FIELD,"E",VAL,.MAGRES,"MAGMSG")
+83 IF MAGRES="^"
SET RC=$$IPVE^MAGUERR("SRCVAL",$$PNAME(PNODE))
QUIT
+84 SET @PNODE@("I")=MAGRES
SET @PNODE@("E")=MAGRES(0)
+85 QUIT
End DoDot:2
if RC<0
QUIT
+86 QUIT
End DoDot:1
if RC
QUIT
+87 if RC<0
QUIT RC
+88 ;
+89 ;=== Check the required parameters
+90 SET NAME=""
+91 FOR
SET NAME=$ORDER(@MSPDNODE@("Q",NAME))
if NAME=""
QUIT
Begin DoDot:1
+92 SET PNODE=$NAME(@DSTNODE@(NAME))
+93 if '$DATA(@PNODE)
SET RC=$$ERROR^MAGUERR(-8,,$$PNAME(PNODE))
+94 QUIT
End DoDot:1
if RC<0
QUIT
+95 ;
+96 ;===
+97 QUIT $SELECT(RC>1:0,'RC:1,1:RC)
