- RAMAGU09 ;HCIOFO/SG - ORDERS/EXAMS API (RAMISC VALIDATION) ; Aug 15, 2024@09:35:50
- ;;5.0;Radiology/Nuclear Medicine;**90,219**;Mar 16, 1998;Build 1
- ;
- ;
- ; 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(PNODE) Q ;p219/KLM - INC34423845
- . 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 8266 printed Jan 18, 2025@03:38:06 Page 2
- RAMAGU09 ;HCIOFO/SG - ORDERS/EXAMS API (RAMISC VALIDATION) ; Aug 15, 2024@09:35:50
- +1 ;;5.0;Radiology/Nuclear Medicine;**90,219**;Mar 16, 1998;Build 1
- +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 ;p219/KLM - INC34423845
- IF RC
- SET RC=$$IPVE^RAERR(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)