RAMAGU09 ;HCIOFO/SG - ORDERS/EXAMS API (RAMISC VALIDATION) ; 2/24/09 3:10pm
;;5.0;Radiology/Nuclear Medicine;**90**;Mar 16, 1998;Build 20
;
;
; NOTE: All entry points in this routine are internal ones. Do not
; call it from outside of routines that validate miscellaneous
; exam parameters (^RAMAGU08, ^RAMAGU10, ^RAMAGU14, etc.).
;
Q
;
;+++++ CHECKS THE FIELD VALUE
;
; PNODE Name of the parameter
; VALUE Parameter value
;
; FILE File number
; FIELD Field number
;
; [[.]IENS] IENS of the record. If this parameter is not defined
; or empty, a new IENS is automatically generated by
; the $$IENS^RAMAGU09.
;
; [REQUIRED] If this parameter is defined and not zero, then "@"
; or an empty string (deletion) are not allowed.
;
; Input variables:
; RAFDA
;
; Output variables:
; RAFDA
;
; Return values:
; <0 Error descriptor (see $$ERROR^RAERR)
; 0 Ok
;
CHECKFLD(PNODE,VALUE,FILE,FIELD,IENS,REQUIRED) ;
N RAMSG,RESULT
I $G(REQUIRED) Q:VALUE?.1"@" $$IPVE^RAERR(PNODE)
S:$G(IENS)="" IENS=$$IENS
D VAL^DIE(FILE,IENS,FIELD,"F",VALUE,.RESULT,"RAFDA","RAMSG")
Q:$G(DIERR) $$DBS^RAERR("RAMSG",-9)
Q $S(RESULT="^":$$IPVE^RAERR(PNODE),1:0)
;
;+++++ GENERATES IENS FOR ADDING A RECORD TO A MULTIPLE
;
; Input variables:
; RAFDA
;
; Output variables:
; RAFDA
;
IENS() ;
S RAFDA("RACNT")=$G(RAFDA("RACNT"))+1
Q "+"_RAFDA("RACNT")_","_RAFDA("RAIENS")
;
;+++++ VALIDATES EXAM CATEGORY SPECIFIC PARAMETERS
;
; RACAT Exam category
;
; Input variables:
; RAIENS, RAMISC
;
; Output variables:
; RAFDA, RAMISC
;
; Return values:
; <0 Error code
; 0 Parameters are valid
;
VALECPRM(RACAT) ;
N ERRCNT,PNODE,RC,TMP
S (ERRCNT,RC)=0
;---
I RACAT="I" D ;--- Inpatient
. ;--- Bedsection
. S PNODE=$NA(RAMISC("BEDSECT"))
. I $D(@PNODE)#10 D
. . S TMP=$$VI($P(@PNODE,U))
. . S:$$CHECKFLD(PNODE,TMP,70.03,19,RAIENS)<0 ERRCNT=ERRCNT+1
. ;--- Service
. S PNODE=$NA(RAMISC("SERVICE"))
. I $D(@PNODE)#10 D
. . S TMP=$$VI($P(@PNODE,U))
. . S:$$CHECKFLD(PNODE,TMP,70.03,7,RAIENS)<0 ERRCNT=ERRCNT+1
. ;--- Ward
. S PNODE=$NA(RAMISC("WARD"))
. I $D(@PNODE)#10 D
. . S TMP=$$VI($P(@PNODE,U))
. . S:$$CHECKFLD(PNODE,TMP,70.03,6,RAIENS)<0 ERRCNT=ERRCNT+1
. ;---
. K RAMISC("PRINCLIN")
E D ;--- Other categories
. ;--- Principal Clinic
. S PNODE=$NA(RAMISC("PRINCLIN"))
. I $D(@PNODE)#10 S RC=0 D
. . S TMP=$$VI($P(@PNODE,U))
. . S:$$CHECKFLD(PNODE,TMP,70.03,8,RAIENS,1)<0 ERRCNT=ERRCNT+1
. ;---
. F I="BEDSECT","SERVICE","WARD" K RAMISC(I)
;---
Q $S(ERRCNT>0:-11,1:0)
;
;+++++ VALIDATES THE PARAMETER
;
; NAME Parameter name
;
; [SEQ] Sequential number of the parameter value. If this
; parameter is greater than 0, then the parameter
; value is loaded from the @NODE@(NAME,SEQ) node.
; Otherwise, the parameter value is loaded from the
; @NODE@(NAME) node.
;
; [[.]IENS] IENS of the record. If this parameter is not defined
; or empty, a new IENS is automatically generated by
; the $$IENS^RAMAGU09.
;
; [NODE] Base node in the RAMISC arrays. By default
; ($G(NODE)=""), the RAMISC variable is assumed.
;
; [FLAGS] Flags that control the execution (can be combined):
;
; C Perform the checks but do not record errors.
;
; O If this flag is defined, then the validated
; parameter is considered 'optional' regardless
; of requirements stored in the RAMSPSDEFS.
;
; R If this flag is defined, then the validated
; parameter is considered 'required' regardless
; of requirements stored in the RAMSPSDEFS.
;
; Input variables:
; RAFDA, RAMISC, RAMSPSDEFS
;
; Output variables:
; RAFDA
;
; Return values:
; <0 Error descriptor (see $$ERROR^RAERR)
; 0 Ok (parameter is not defined)
; >0 Ok (parameter is defined)
;
VALPRM(NAME,SEQ,IENS,NODE,FLAGS) ;
N FILE,FIELD,LSTPRM,PNODE,PRMDEF,RAMSG,RARES,RC,REQUIRED,TMP,TYPE,VALUE
S:$G(NODE)="" NODE="RAMISC"
S PNODE=$S($G(SEQ)>0:$NA(@NODE@(NAME,SEQ)),1:$NA(@NODE@(NAME)))
;
;=== Check the flags
S FLAGS=$G(FLAGS),TMP=0
S:FLAGS["O" REQUIRED=0,TMP=TMP+1
S:FLAGS["R" REQUIRED=1,TMP=TMP+1
Q:TMP>1 $$IPVE^RAERR("FLAGS")
;
;=== Get the parameter definition
S PRMDEF=$G(RAMSPSDEFS("N",NAME))
S FILE=+$P(PRMDEF,U),FIELD=+$P(PRMDEF,U,2),TYPE=$P(PRMDEF,U,3)
S LSTPRM=(TYPE["M")&($G(SEQ)'>0) ; "List" mode
Q:(FILE'>0)!('LSTPRM&(FIELD'>0)) $$ERROR^RAERR(-58,,NAME)
S:$G(IENS)="" IENS=$$IENS
;
;=== Preserve the error stack so that errors are not recorded
I FLAGS["C" N RAERROR
;
;=== Unless overridden by the caller, determine
;=== if the field value is required
D:$G(REQUIRED)=""
. ;--- .01 fields are required
. I FIELD=.01,'LSTPRM S REQUIRED=1 Q
. ;--- Ignore missing required values if the flag is set
. I $G(RAMISC("FLAGS"))["F" S REQUIRED=0 Q
. ;--- Check the parameter definition
. S TMP=+$P(PRMDEF,U,4)
. S REQUIRED=$S(TMP>0:+$P($G(RAMSPSDEFS("R")),U,TMP),1:0)
;
;=== If the API is called in "list" mode, check if the parameter
; list is provided. If it is not but the values are required
; for the new exam status, check if the corresponding multiple
;=== has any records already.
I LSTPRM S RC=0 D:$D(@PNODE)<10 Q $S(RC<0:RC,1:$D(@PNODE)>0)
. N ROOT
. ;--- Check for data deletion request
. I $D(@PNODE)#10 D Q
. . ;--- Deletion of required data is not allowed
. . I REQUIRED S RC=$$IPVE^RAERR(PNODE) Q
. . ;--- Mark the multiple for deletion
. . K RAFDA(FILE) S RAFDA(FILE)=""
. ;--- Check if the multiple field has any records
. Q:'REQUIRED
. S TMP=","_RAFDA("RAIENS"),ROOT=$$ROOT^DILFD(FILE,TMP,1)
. I ROOT="" S RC=$$ERROR^RAERR(-50,,FILE,TMP) Q
. S:$O(@ROOT@(0))'>0 RC=$$ERROR^RAERR(-8,,PNODE)
;
;=== If the parameter is not provided but the value is required
; for the new exam status, check if the corresponding field
;=== has a non-empty value already.
I '$D(@PNODE) S RC=0 D:REQUIRED Q $S(RC<0:RC,1:0)
. ;--- If the IENS starts with a placeholder, then there is no data
. S TMP=$P($G(IENS),",")
. I 'TMP!(+TMP'=TMP) S RC=$$ERROR^RAERR(-8,,PNODE) Q
. ;--- Word processing field
. I TYPE["W" D Q
. . N I,RABUF
. . S TMP=$$GET1^DIQ(FILE,IENS,FIELD,,"RABUF","RAMSG")
. . I $G(DIERR) S RC=$$DBS^RAERR("RAMSG",-9,FILE,IENS) Q
. . S I=0,RC=1
. . F S I=$O(RABUF(I)) Q:I'>0 I RABUF(I)'?." " S RC=0 Q
. . S:RC RC=$$ERROR^RAERR(-8,,PNODE)
. ;--- Other field types
. S TMP=$$GET1^DIQ(FILE,IENS,FIELD,"I",,"RAMSG")
. I $G(DIERR) S RC=$$DBS^RAERR("RAMSG",-9,FILE,IENS) Q
. S:TMP="" RC=$$ERROR^RAERR(-8,,PNODE)
;
;=== Validate the word-processing parameter
I TYPE["W" S RC=0 D Q $S(RC<0:RC,1:1)
. N I
. ;--- Check for data deletion request
. I $D(@PNODE)<10 D Q
. . I REQUIRED!(@PNODE'?.1"@") S RC=$$IPVE^RAERR(PNODE) Q
. . S RAFDA(FILE,IENS,FIELD)="@"
. ;--- Check if the value is not empty
. S I=0,RC=1
. F S I=$O(@PNODE@(I)) Q:I'>0 I @PNODE@(I)'?." " S RC=0 Q
. I RC S RC=$$IPVE^RAERR(-8,,PNODE) Q
. S RAFDA(FILE,IENS,FIELD)=PNODE
;
;=== Pre-process the parameter value according to the field type.
;=== Deletion of required field values is never allowed.
S VALUE=$P($G(@PNODE),U)
I VALUE'?.1"@" D
. ;--- Pre-process the parameter value according to the field type
. I TYPE["P" S VALUE=$$VI(VALUE) Q
. I TYPE["D" S VALUE=$$FMTE^XLFDT(VALUE) Q
E Q:REQUIRED $$IPVE^RAERR(PNODE)
;
;=== Let the FileMan validate the parameter value
D VAL^DIE(FILE,IENS,FIELD,"F",VALUE,.RARES,"RAFDA","RAMSG")
Q:$G(DIERR) $$DBS^RAERR("RAMSG",-9)
Q $S(RARES="^":$$IPVE^RAERR(PNODE),1:1)
;
;+++++ RETURNS PSEUDO-EXTERNAL VALUE OF THE IEN
VI(IEN) ;
Q $S(IEN?.1"@":IEN,1:"`"_IEN)
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRAMAGU09 8235 printed Oct 16, 2024@18:37:41 Page 2
RAMAGU09 ;HCIOFO/SG - ORDERS/EXAMS API (RAMISC VALIDATION) ; 2/24/09 3:10pm
+1 ;;5.0;Radiology/Nuclear Medicine;**90**;Mar 16, 1998;Build 20
+2 ;
+3 ;
+4 ; NOTE: All entry points in this routine are internal ones. Do not
+5 ; call it from outside of routines that validate miscellaneous
+6 ; exam parameters (^RAMAGU08, ^RAMAGU10, ^RAMAGU14, etc.).
+7 ;
+8 QUIT
+9 ;
+10 ;+++++ CHECKS THE FIELD VALUE
+11 ;
+12 ; PNODE Name of the parameter
+13 ; VALUE Parameter value
+14 ;
+15 ; FILE File number
+16 ; FIELD Field number
+17 ;
+18 ; [[.]IENS] IENS of the record. If this parameter is not defined
+19 ; or empty, a new IENS is automatically generated by
+20 ; the $$IENS^RAMAGU09.
+21 ;
+22 ; [REQUIRED] If this parameter is defined and not zero, then "@"
+23 ; or an empty string (deletion) are not allowed.
+24 ;
+25 ; Input variables:
+26 ; RAFDA
+27 ;
+28 ; Output variables:
+29 ; RAFDA
+30 ;
+31 ; Return values:
+32 ; <0 Error descriptor (see $$ERROR^RAERR)
+33 ; 0 Ok
+34 ;
CHECKFLD(PNODE,VALUE,FILE,FIELD,IENS,REQUIRED) ;
+1 NEW RAMSG,RESULT
+2 IF $GET(REQUIRED)
if VALUE?.1"@"
QUIT $$IPVE^RAERR(PNODE)
+3 if $GET(IENS)=""
SET IENS=$$IENS
+4 DO VAL^DIE(FILE,IENS,FIELD,"F",VALUE,.RESULT,"RAFDA","RAMSG")
+5 if $GET(DIERR)
QUIT $$DBS^RAERR("RAMSG",-9)
+6 QUIT $SELECT(RESULT="^":$$IPVE^RAERR(PNODE),1:0)
+7 ;
+8 ;+++++ GENERATES IENS FOR ADDING A RECORD TO A MULTIPLE
+9 ;
+10 ; Input variables:
+11 ; RAFDA
+12 ;
+13 ; Output variables:
+14 ; RAFDA
+15 ;
IENS() ;
+1 SET RAFDA("RACNT")=$GET(RAFDA("RACNT"))+1
+2 QUIT "+"_RAFDA("RACNT")_","_RAFDA("RAIENS")
+3 ;
+4 ;+++++ VALIDATES EXAM CATEGORY SPECIFIC PARAMETERS
+5 ;
+6 ; RACAT Exam category
+7 ;
+8 ; Input variables:
+9 ; RAIENS, RAMISC
+10 ;
+11 ; Output variables:
+12 ; RAFDA, RAMISC
+13 ;
+14 ; Return values:
+15 ; <0 Error code
+16 ; 0 Parameters are valid
+17 ;
VALECPRM(RACAT) ;
+1 NEW ERRCNT,PNODE,RC,TMP
+2 SET (ERRCNT,RC)=0
+3 ;---
+4 ;--- Inpatient
IF RACAT="I"
Begin DoDot:1
+5 ;--- Bedsection
+6 SET PNODE=$NAME(RAMISC("BEDSECT"))
+7 IF $DATA(@PNODE)#10
Begin DoDot:2
+8 SET TMP=$$VI($PIECE(@PNODE,U))
+9 if $$CHECKFLD(PNODE,TMP,70.03,19,RAIENS)<0
SET ERRCNT=ERRCNT+1
End DoDot:2
+10 ;--- Service
+11 SET PNODE=$NAME(RAMISC("SERVICE"))
+12 IF $DATA(@PNODE)#10
Begin DoDot:2
+13 SET TMP=$$VI($PIECE(@PNODE,U))
+14 if $$CHECKFLD(PNODE,TMP,70.03,7,RAIENS)<0
SET ERRCNT=ERRCNT+1
End DoDot:2
+15 ;--- Ward
+16 SET PNODE=$NAME(RAMISC("WARD"))
+17 IF $DATA(@PNODE)#10
Begin DoDot:2
+18 SET TMP=$$VI($PIECE(@PNODE,U))
+19 if $$CHECKFLD(PNODE,TMP,70.03,6,RAIENS)<0
SET ERRCNT=ERRCNT+1
End DoDot:2
+20 ;---
+21 KILL RAMISC("PRINCLIN")
End DoDot:1
+22 ;--- Other categories
IF '$TEST
Begin DoDot:1
+23 ;--- Principal Clinic
+24 SET PNODE=$NAME(RAMISC("PRINCLIN"))
+25 IF $DATA(@PNODE)#10
SET RC=0
Begin DoDot:2
+26 SET TMP=$$VI($PIECE(@PNODE,U))
+27 if $$CHECKFLD(PNODE,TMP,70.03,8,RAIENS,1)<0
SET ERRCNT=ERRCNT+1
End DoDot:2
+28 ;---
+29 FOR I="BEDSECT","SERVICE","WARD"
KILL RAMISC(I)
End DoDot:1
+30 ;---
+31 QUIT $SELECT(ERRCNT>0:-11,1:0)
+32 ;
+33 ;+++++ VALIDATES THE PARAMETER
+34 ;
+35 ; NAME Parameter name
+36 ;
+37 ; [SEQ] Sequential number of the parameter value. If this
+38 ; parameter is greater than 0, then the parameter
+39 ; value is loaded from the @NODE@(NAME,SEQ) node.
+40 ; Otherwise, the parameter value is loaded from the
+41 ; @NODE@(NAME) node.
+42 ;
+43 ; [[.]IENS] IENS of the record. If this parameter is not defined
+44 ; or empty, a new IENS is automatically generated by
+45 ; the $$IENS^RAMAGU09.
+46 ;
+47 ; [NODE] Base node in the RAMISC arrays. By default
+48 ; ($G(NODE)=""), the RAMISC variable is assumed.
+49 ;
+50 ; [FLAGS] Flags that control the execution (can be combined):
+51 ;
+52 ; C Perform the checks but do not record errors.
+53 ;
+54 ; O If this flag is defined, then the validated
+55 ; parameter is considered 'optional' regardless
+56 ; of requirements stored in the RAMSPSDEFS.
+57 ;
+58 ; R If this flag is defined, then the validated
+59 ; parameter is considered 'required' regardless
+60 ; of requirements stored in the RAMSPSDEFS.
+61 ;
+62 ; Input variables:
+63 ; RAFDA, RAMISC, RAMSPSDEFS
+64 ;
+65 ; Output variables:
+66 ; RAFDA
+67 ;
+68 ; Return values:
+69 ; <0 Error descriptor (see $$ERROR^RAERR)
+70 ; 0 Ok (parameter is not defined)
+71 ; >0 Ok (parameter is defined)
+72 ;
VALPRM(NAME,SEQ,IENS,NODE,FLAGS) ;
+1 NEW FILE,FIELD,LSTPRM,PNODE,PRMDEF,RAMSG,RARES,RC,REQUIRED,TMP,TYPE,VALUE
+2 if $GET(NODE)=""
SET NODE="RAMISC"
+3 SET PNODE=$SELECT($GET(SEQ)>0:$NAME(@NODE@(NAME,SEQ)),1:$NAME(@NODE@(NAME)))
+4 ;
+5 ;=== Check the flags
+6 SET FLAGS=$GET(FLAGS)
SET TMP=0
+7 if FLAGS["O"
SET REQUIRED=0
SET TMP=TMP+1
+8 if FLAGS["R"
SET REQUIRED=1
SET TMP=TMP+1
+9 if TMP>1
QUIT $$IPVE^RAERR("FLAGS")
+10 ;
+11 ;=== Get the parameter definition
+12 SET PRMDEF=$GET(RAMSPSDEFS("N",NAME))
+13 SET FILE=+$PIECE(PRMDEF,U)
SET FIELD=+$PIECE(PRMDEF,U,2)
SET TYPE=$PIECE(PRMDEF,U,3)
+14 ; "List" mode
SET LSTPRM=(TYPE["M")&($GET(SEQ)'>0)
+15 if (FILE'>0)!('LSTPRM&(FIELD'>0))
QUIT $$ERROR^RAERR(-58,,NAME)
+16 if $GET(IENS)=""
SET IENS=$$IENS
+17 ;
+18 ;=== Preserve the error stack so that errors are not recorded
+19 IF FLAGS["C"
NEW RAERROR
+20 ;
+21 ;=== Unless overridden by the caller, determine
+22 ;=== if the field value is required
+23 if $GET(REQUIRED)=""
Begin DoDot:1
+24 ;--- .01 fields are required
+25 IF FIELD=.01
IF 'LSTPRM
SET REQUIRED=1
QUIT
+26 ;--- Ignore missing required values if the flag is set
+27 IF $GET(RAMISC("FLAGS"))["F"
SET REQUIRED=0
QUIT
+28 ;--- Check the parameter definition
+29 SET TMP=+$PIECE(PRMDEF,U,4)
+30 SET REQUIRED=$SELECT(TMP>0:+$PIECE($GET(RAMSPSDEFS("R")),U,TMP),1:0)
End DoDot:1
+31 ;
+32 ;=== If the API is called in "list" mode, check if the parameter
+33 ; list is provided. If it is not but the values are required
+34 ; for the new exam status, check if the corresponding multiple
+35 ;=== has any records already.
+36 IF LSTPRM
SET RC=0
if $DATA(@PNODE)<10
Begin DoDot:1
+37 NEW ROOT
+38 ;--- Check for data deletion request
+39 IF $DATA(@PNODE)#10
Begin DoDot:2
+40 ;--- Deletion of required data is not allowed
+41 IF REQUIRED
SET RC=$$IPVE^RAERR(PNODE)
QUIT
+42 ;--- Mark the multiple for deletion
+43 KILL RAFDA(FILE)
SET RAFDA(FILE)=""
End DoDot:2
QUIT
+44 ;--- Check if the multiple field has any records
+45 if 'REQUIRED
QUIT
+46 SET TMP=","_RAFDA("RAIENS")
SET ROOT=$$ROOT^DILFD(FILE,TMP,1)
+47 IF ROOT=""
SET RC=$$ERROR^RAERR(-50,,FILE,TMP)
QUIT
+48 if $ORDER(@ROOT@(0))'>0
SET RC=$$ERROR^RAERR(-8,,PNODE)
End DoDot:1
QUIT $SELECT(RC<0:RC,1:$DATA(@PNODE)>0)
+49 ;
+50 ;=== If the parameter is not provided but the value is required
+51 ; for the new exam status, check if the corresponding field
+52 ;=== has a non-empty value already.
+53 IF '$DATA(@PNODE)
SET RC=0
if REQUIRED
Begin DoDot:1
+54 ;--- If the IENS starts with a placeholder, then there is no data
+55 SET TMP=$PIECE($GET(IENS),",")
+56 IF 'TMP!(+TMP'=TMP)
SET RC=$$ERROR^RAERR(-8,,PNODE)
QUIT
+57 ;--- Word processing field
+58 IF TYPE["W"
Begin DoDot:2
+59 NEW I,RABUF
+60 SET TMP=$$GET1^DIQ(FILE,IENS,FIELD,,"RABUF","RAMSG")
+61 IF $GET(DIERR)
SET RC=$$DBS^RAERR("RAMSG",-9,FILE,IENS)
QUIT
+62 SET I=0
SET RC=1
+63 FOR
SET I=$ORDER(RABUF(I))
if I'>0
QUIT
IF RABUF(I)'?." "
SET RC=0
QUIT
+64 if RC
SET RC=$$ERROR^RAERR(-8,,PNODE)
End DoDot:2
QUIT
+65 ;--- Other field types
+66 SET TMP=$$GET1^DIQ(FILE,IENS,FIELD,"I",,"RAMSG")
+67 IF $GET(DIERR)
SET RC=$$DBS^RAERR("RAMSG",-9,FILE,IENS)
QUIT
+68 if TMP=""
SET RC=$$ERROR^RAERR(-8,,PNODE)
End DoDot:1
QUIT $SELECT(RC<0:RC,1:0)
+69 ;
+70 ;=== Validate the word-processing parameter
+71 IF TYPE["W"
SET RC=0
Begin DoDot:1
+72 NEW I
+73 ;--- Check for data deletion request
+74 IF $DATA(@PNODE)<10
Begin DoDot:2
+75 IF REQUIRED!(@PNODE'?.1"@")
SET RC=$$IPVE^RAERR(PNODE)
QUIT
+76 SET RAFDA(FILE,IENS,FIELD)="@"
End DoDot:2
QUIT
+77 ;--- Check if the value is not empty
+78 SET I=0
SET RC=1
+79 FOR
SET I=$ORDER(@PNODE@(I))
if I'>0
QUIT
IF @PNODE@(I)'?." "
SET RC=0
QUIT
+80 IF RC
SET RC=$$IPVE^RAERR(-8,,PNODE)
QUIT
+81 SET RAFDA(FILE,IENS,FIELD)=PNODE
End DoDot:1
QUIT $SELECT(RC<0:RC,1:1)
+82 ;
+83 ;=== Pre-process the parameter value according to the field type.
+84 ;=== Deletion of required field values is never allowed.
+85 SET VALUE=$PIECE($GET(@PNODE),U)
+86 IF VALUE'?.1"@"
Begin DoDot:1
+87 ;--- Pre-process the parameter value according to the field type
+88 IF TYPE["P"
SET VALUE=$$VI(VALUE)
QUIT
+89 IF TYPE["D"
SET VALUE=$$FMTE^XLFDT(VALUE)
QUIT
End DoDot:1
+90 IF '$TEST
if REQUIRED
QUIT $$IPVE^RAERR(PNODE)
+91 ;
+92 ;=== Let the FileMan validate the parameter value
+93 DO VAL^DIE(FILE,IENS,FIELD,"F",VALUE,.RARES,"RAFDA","RAMSG")
+94 if $GET(DIERR)
QUIT $$DBS^RAERR("RAMSG",-9)
+95 QUIT $SELECT(RARES="^":$$IPVE^RAERR(PNODE),1:1)
+96 ;
+97 ;+++++ RETURNS PSEUDO-EXTERNAL VALUE OF THE IEN
VI(IEN) ;
+1 QUIT $SELECT(IEN?.1"@":IEN,1:"`"_IEN)
