Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDES2VALUTIL

SDES2VALUTIL.m

Go to the documentation of this file.
  1. SDES2VALUTIL ;ALB/BWF - SDES2 VALIDATION UTILITY ;JUL 28, 2023
  1. ;;5.3;Scheduling;**853,861,866,885**;Aug 13, 1993;Build 5
  1. ;;Per VHA Directive 6402, this routine should not be modified
  1. ;
  1. Q
  1. ; VALRETURN - 1 for success, 0 for failure
  1. ; FILE - File Manager file number
  1. ; FIELD - File Manager field number
  1. ; VALUE - input value, either text or numeric value - value will be checked against the input transform
  1. ; REQUIRED - (1 for required, otherwise, not required)
  1. ; CANDELETE - (1 - deletion allowed, otherwise, deletion is not allowed)
  1. ; MISSINGERRID - Error ID from the SDEC ERROR CODES file (409.93) - overrides defualt missing error
  1. ; INVALIDERRID - Error ID from the SDEC ERROR CODES file (409.93) - overrides default invalid error
  1. ; DELERRID - Error ID from teh SDEC ERRRO CODES file (409.93) - overrides default delete error
  1. ; MISSERRTEXT - Error text to add to the returned 'MISSING' error
  1. ; INVALERRTEXT - Error text to add to the returned 'INVALID' error
  1. ; DELERRTEXT - Error text to add to the returned 'DELETE' error
  1. ;
  1. VALFILEIEN(VALRETURN,ERRORS,FILENUM,VALUE,REQUIRED,CANDELETE,MISSINGERRID,INVALIDERRID,DELERRID,MISSERRTEXT,INVALERRTEXT,DELERRTEXT) ;
  1. N FDATA,FILERR,GLOBALROOT,FERR,ERRLOOP,ERRTEXT
  1. K VALRETURN
  1. S VALRETURN=0
  1. I '$L($G(FILENUM)) Q
  1. I $G(REQUIRED),$G(VALUE)="@" D Q
  1. .I $G(DELERRID) D ERRLOG^SDES2JSON(.ERRORS,DELERRID,$G(DELERRTEXT)) Q
  1. .D ERRLOG^SDES2JSON(.ERRORS,52,"This field cannot be deleted.")
  1. I $G(CANDELETE),($G(VALUE)="@"!($G(VALUE)="")) S VALRETURN=1 Q
  1. D FILE^DID(FILENUM,,"GLOBAL NAME;NAME","FDATA","FERR")
  1. I $D(FERR) D Q
  1. .S ERRLOOP=0 F S ERRLOOP=$O(FERR("DIERR",1,"TEXT",ERRLOOP)) Q:'ERRLOOP D
  1. ..S ERRTEXT=$G(FERR("DIERR",1,"TEXT",ERRLOOP))
  1. ..D ERRLOG^SDES2JSON(.ERRORS,52,ERRTEXT) Q
  1. I $G(REQUIRED),$G(VALUE)="" D Q
  1. .I $G(MISSINGERRID) D ERRLOG^SDES2JSON(.ERRORS,MISSINGERRID,$G(MISSERRTEXT)) Q
  1. .D ERRLOG^SDES2JSON(.ERRORS,52,"Missing IEN for file: "_$G(FDATA("NAME")))
  1. ; if we get to this point and the field is not required, quit, no need to check the global
  1. I '$G(REQUIRED),$G(VALUE)="" S VALRETURN=1 Q
  1. ; force the value to a string in the event there are alpha-numeric characters in VALUE
  1. S VALUE=""""_VALUE_""""
  1. S GLOBALROOT=$G(FDATA("GLOBAL NAME"))
  1. S GLOBALROOT=GLOBALROOT_VALUE_")"
  1. I '$D(@GLOBALROOT@(0)) D Q
  1. .I $G(INVALIDERRID) D ERRLOG^SDES2JSON(.ERRORS,INVALIDERRID,$G(INVALERRTEXT)) Q
  1. .D ERRLOG^SDES2JSON(.ERRORS,52,"Invalid IEN for file:"_$G(FDATA("NAME"))_": "_VALUE)
  1. S VALRETURN=1
  1. Q
  1. ;
  1. ; VALRETURN - return array
  1. ; VALRETURN= 1 - valid, 0 - not valid
  1. ; VALRETURN(FILENUMBER, FIELD NUMBER,"I")=INTERNAL FILEMAN VALUE
  1. ; VALRETURN(FILENUMBER, FIELD NUMBER,"E")=EXTERNAL FILEMAN VALUE
  1. ; ERRORS - error array contains errors
  1. ; FILE - File Manager file number
  1. ; FIELD - File Manager field number
  1. ; VALUE - input value, either text or numeric value - value will be checked against the input transform
  1. ; REQUIRED - (1 for required, otherwise, not required)
  1. ; CANDELETE - (1 - deletion allowed, otherwise, deletion is not allowed)
  1. ; MISSINGERRID - Error ID from the SDEC ERROR CODES file (409.93)
  1. ; INVALIDERRID - Error ID from the SDEC ERROR CODES file (409.93)
  1. ; DELERRID - Error ID from teh SDEC ERRRO CODES file (409.93) - overrides default delete error
  1. ; MISSERRTEXT - Error text to add to the returned 'MISSING' error
  1. ; INVALERRTEXT - Error text to add to the returned 'INVALID' error
  1. ; DELERRTEXT - Error text to add to the returned 'DELETE' error
  1. ;
  1. VALFIELD(VALRETURN,ERRORS,FILE,FLD,VALUE,REQUIRED,CANDELETE,MISSINGERRID,INVALIDERRID,DELERRID,MISSERRTEXT,INVALERRTEXT,DELERRTEXT) ;
  1. N RESULTS,VALERR,FMERRNUM,FMERRTEXT,LABEL,INPUTCHK,FLDINFO,FERR,ITERR,I,CHKVAL,INPUTCHK
  1. K VALRETURN
  1. S VALRETURN=0
  1. I $G(FILE)=""!($G(FLD)="") D ERRLOG^SDES2JSON(.ERRORS,52,"Invalid file or field.") Q
  1. ; not a valid DD reference
  1. I '$D(^DD(FILE,FLD)) D ERRLOG^SDES2JSON(.ERRORS,52,"Invalid file or field.") Q
  1. D FIELD^DID(FILE,FLD,"","LABEL;INPUT TRANSFORM","FLDINFO","FERR")
  1. I $D(FERR) D ERRLOG^SDES2JSON(.ERRORS,52,"A problem occured finding the field definition.") Q
  1. S INPUTCHK=$G(FLDINFO("INPUT TRANSFORM"))
  1. I INPUTCHK["DA" D ERRLOG^SDES2JSON(.ERRORS,52,"Cannot validate fields where the input transform requires DA.") Q
  1. F I=1:1:9 D
  1. .S CHKVAL="D"_I
  1. .I INPUTCHK[CHKVAL S ITERR=1
  1. I $G(ITERR) D ERRLOG^SDES2JSON(.ERRORS,52,"Cannot validate fields that require D0, D1, D2, etc.") Q
  1. I INPUTCHK["$$"!(INPUTCHK["D:")!(INPUTCHK[" D ") D ERRLOG^SDES2JSON(.ERRORS,52,"Cannot validate fields that call additional functions.") Q
  1. I INPUTCHK["D ",$P(INPUTCHK,"D ",2)["^" D ERRLOG^SDES2JSON(.ERRORS,52,"Cannot validate fields that call additional functions.") Q
  1. I $D(^DD(FILE,FLD,12.1)) D ERRLOG^SDES2JSON(.ERRORS,52,"Cannot validate fields that contain screening logic.") Q
  1. I $D(^DD(FILE,FLD,2))!($D(^DD(FILE,FLD,2.1))) D ERRLOG^SDES2JSON(.ERRORS,52,"Cannot validate fields containing Output transform logic.") Q
  1. S LABEL=$G(FLDINFO("LABEL"))
  1. I $G(VALUE)["^" D ERRLOG^SDES2JSON(.ERRORS,52,"Input containing '^' is prohibited.") Q
  1. ; calling function wants this field to be required.
  1. I $G(REQUIRED),$G(VALUE)="" D Q
  1. .I $G(MISSINGERRID) D ERRLOG^SDES2JSON(.ERRORS,MISSINGERRID,$G(MISSERRTEXT)) Q
  1. .D ERRLOG^SDES2JSON(.ERRORS,52,"Missing required value for field: "_LABEL_" (#"_FLD_")")
  1. I '$G(REQUIRED),$G(VALUE)="" S VALRETURN=1 Q
  1. ;
  1. ; if calling application indicates 'required' and '@' is passed, produce an error.
  1. I $G(REQUIRED),$G(VALUE)="@" D ERRLOG^SDES2JSON(.ERRORS,229,$S($L($G(DELERRTEXT)):DELERRTEXT,1:LABEL)) Q
  1. I '$G(CANDELETE),(VALUE="@"!(VALUE="")) D Q
  1. .I $G(DELERRID) D ERRLOG^SDES2JSON(.ERRORS,DELERRID,$G(DELERRTEXT)) Q
  1. .D ERRLOG^SDES2JSON(.ERRORS,52,"This field cannot be deleted: "_LABEL_" (#"_FLD_")")
  1. ; for non-required fields, if this is '@' or "", quit, no need to check further
  1. I $G(CANDELETE),($G(VALUE)="@"!($G(VALUE)="")) S VALRETURN=1 Q
  1. ;
  1. D CHK^DIE(FILE,FLD,"E",VALUE,.RESULTS,"VALERR")
  1. I $D(VALERR) D Q
  1. .I $G(INVALIDERRID) D ERRLOG^SDES2JSON(.ERRORS,INVALIDERRID,$G(INVALERRTEXT)) Q
  1. .S FMERRNUM=0 F S FMERRNUM=$O(VALERR("DIERR",FMERRNUM)) Q:'FMERRNUM D
  1. ..S FMERRTEXT=$G(VALERR("DIERR",FMERRNUM,"TEXT",1))
  1. ..D ERRLOG^SDES2JSON(.ERRORS,52,FMERRTEXT)
  1. D SETRETURN(.VALRETURN,FILE,FLD,$G(RESULTS),$G(RESULTS(0)))
  1. Q
  1. ; validate number is within given range LOW to HIGH
  1. VALNUMBERRNG(VALRETURN,ERRORS,INPUTVALUE,LOW,HIGH,ISREQUIRED,MISSINGERRID,INVALIDERRID) ;
  1. K VALRETURN
  1. S VALRETURN=0
  1. I $G(ISREQUIRED),$G(INPUTVALUE)="" D Q
  1. .I $G(MISSINGERRID) D ERRLOG^SDES2JSON(.ERRORS,MISSINGERRID) Q
  1. .D ERRLOG^SDES2JSON(.ERRORS,52,"Missing numeric input.")
  1. I '$G(ISREQUIRED),$G(INPUTVALUE)="" Q
  1. I INPUTVALUE<LOW!(INPUTVALUE>HIGH) D Q
  1. .I $G(INVALIDERRID) D ERRLOG^SDES2JSON(.ERRORS,INVALIDERRID) Q
  1. .D ERRLOG^SDES2JSON(.ERRORS,52,"Number must be between "_LOW_"-"_HIGH)
  1. D SETRETURN(.VALRETURN)
  1. Q
  1. VALBOOLEAN(VRET,ERRORS,FILE,FIELD,VALUE,ISREQUIRED,CANDELETE,MISSINGERRID,INVALIDERRID,DELERRID) ;
  1. N RETURN,VALERR,LABEL,FLDINFO,FERR
  1. K VRET
  1. S VRET=0,VALUE=$G(VALUE)
  1. I $G(FILE)=""!($G(FIELD)="") D ERRLOG^SDES2JSON(.ERRORS,52,"Invalid file or field.") Q
  1. ; not a valid DD reference
  1. I '$D(^DD(FILE,FIELD)) D ERRLOG^SDES2JSON(.ERRORS,52,"Invalid file or field.") Q
  1. D FIELD^DID(FILE,FIELD,"","LABEL;INPUT TRANSFORM;TYPE","FLDINFO","FERR")
  1. I $D(FERR) D ERRLOG^SDES2JSON(.ERRORS,52,"A problem occured finding the field definition.") Q
  1. I $G(FLDINFO("TYPE"))'="BOOLEAN" D ERRLOG^SDES2JSON(.ERRORS,52,"Field is not a boolean field. Cannot validate.") Q
  1. I $G(VALUE)["^" D ERRLOG^SDES2JSON(.ERRORS,52,"Input containing '^' is prohibited.") Q
  1. S LABEL=$G(FLDINFO("LABEL"))
  1. I '$G(CANDELETE),(VALUE="@"!(VALUE="")) D Q
  1. .I $G(DELERRID) D ERRLOG^SDES2JSON(.ERRORS,DELERRID) Q
  1. .D ERRLOG^SDES2JSON(.ERRORS,52,"This field cannot be deleted: "_LABEL_" (#"_FIELD_")")
  1. I '$G(ISREQUIRED),$G(VALUE)="" S VRET=1 Q
  1. I $G(ISREQUIRED),VALUE="" D Q
  1. .D ERRLOG^SDES2JSON(.ERRORS,52,"Missing required value for field: "_LABEL_" (#"_FIELD_")")
  1. ; valid boolean value
  1. I VALUE="Y"!(VALUE="YES")!(VALUE=1) D SETRETURN(.VRET,FILE,FIELD,1,"YES") Q
  1. I VALUE="N"!(VALUE="NO")!(VALUE=0) D SETRETURN(.VRET,FILE,FIELD,0,"NO") Q
  1. ; invalid boolean value
  1. I $G(INVALIDERRID) D ERRLOG^SDES2JSON(.ERRORS,INVALIDERRID) Q
  1. D ERRLOG^SDES2JSON(.ERRORS,52,"Invalid value for field: "_LABEL_" (#"_FIELD_")")
  1. Q
  1. SETRETURN(VALRETURN,FILE,FLD,INTERNALVAL,EXTERNALVAL) ;
  1. S VALRETURN=1
  1. Q:'$D(FILE)!('$D(FLD))
  1. I $L($G(INTERNALVAL)) S VALRETURN(FILE,FLD,"I")=INTERNALVAL
  1. I $L($G(EXTERNALVAL)) S VALRETURN(FILE,FLD,"E")=EXTERNALVAL
  1. Q