- SDES2VALUTIL ;ALB/BWF - SDES2 VALIDATION UTILITY ;JUL 28, 2023
- ;;5.3;Scheduling;**853,861,866,885**;Aug 13, 1993;Build 5
- ;;Per VHA Directive 6402, this routine should not be modified
- ;
- Q
- ; VALRETURN - 1 for success, 0 for failure
- ; FILE - File Manager file number
- ; FIELD - File Manager field number
- ; VALUE - input value, either text or numeric value - value will be checked against the input transform
- ; REQUIRED - (1 for required, otherwise, not required)
- ; CANDELETE - (1 - deletion allowed, otherwise, deletion is not allowed)
- ; MISSINGERRID - Error ID from the SDEC ERROR CODES file (409.93) - overrides defualt missing error
- ; INVALIDERRID - Error ID from the SDEC ERROR CODES file (409.93) - overrides default invalid error
- ; DELERRID - Error ID from teh SDEC ERRRO CODES file (409.93) - overrides default delete error
- ; MISSERRTEXT - Error text to add to the returned 'MISSING' error
- ; INVALERRTEXT - Error text to add to the returned 'INVALID' error
- ; DELERRTEXT - Error text to add to the returned 'DELETE' error
- ;
- VALFILEIEN(VALRETURN,ERRORS,FILENUM,VALUE,REQUIRED,CANDELETE,MISSINGERRID,INVALIDERRID,DELERRID,MISSERRTEXT,INVALERRTEXT,DELERRTEXT) ;
- N FDATA,FILERR,GLOBALROOT,FERR,ERRLOOP,ERRTEXT
- K VALRETURN
- S VALRETURN=0
- I '$L($G(FILENUM)) Q
- I $G(REQUIRED),$G(VALUE)="@" D Q
- .I $G(DELERRID) D ERRLOG^SDES2JSON(.ERRORS,DELERRID,$G(DELERRTEXT)) Q
- .D ERRLOG^SDES2JSON(.ERRORS,52,"This field cannot be deleted.")
- I $G(CANDELETE),($G(VALUE)="@"!($G(VALUE)="")) S VALRETURN=1 Q
- D FILE^DID(FILENUM,,"GLOBAL NAME;NAME","FDATA","FERR")
- I $D(FERR) D Q
- .S ERRLOOP=0 F S ERRLOOP=$O(FERR("DIERR",1,"TEXT",ERRLOOP)) Q:'ERRLOOP D
- ..S ERRTEXT=$G(FERR("DIERR",1,"TEXT",ERRLOOP))
- ..D ERRLOG^SDES2JSON(.ERRORS,52,ERRTEXT) Q
- I $G(REQUIRED),$G(VALUE)="" D Q
- .I $G(MISSINGERRID) D ERRLOG^SDES2JSON(.ERRORS,MISSINGERRID,$G(MISSERRTEXT)) Q
- .D ERRLOG^SDES2JSON(.ERRORS,52,"Missing IEN for file: "_$G(FDATA("NAME")))
- ; if we get to this point and the field is not required, quit, no need to check the global
- I '$G(REQUIRED),$G(VALUE)="" S VALRETURN=1 Q
- ; force the value to a string in the event there are alpha-numeric characters in VALUE
- S VALUE=""""_VALUE_""""
- S GLOBALROOT=$G(FDATA("GLOBAL NAME"))
- S GLOBALROOT=GLOBALROOT_VALUE_")"
- I '$D(@GLOBALROOT@(0)) D Q
- .I $G(INVALIDERRID) D ERRLOG^SDES2JSON(.ERRORS,INVALIDERRID,$G(INVALERRTEXT)) Q
- .D ERRLOG^SDES2JSON(.ERRORS,52,"Invalid IEN for file:"_$G(FDATA("NAME"))_": "_VALUE)
- S VALRETURN=1
- Q
- ;
- ; VALRETURN - return array
- ; VALRETURN= 1 - valid, 0 - not valid
- ; VALRETURN(FILENUMBER, FIELD NUMBER,"I")=INTERNAL FILEMAN VALUE
- ; VALRETURN(FILENUMBER, FIELD NUMBER,"E")=EXTERNAL FILEMAN VALUE
- ; ERRORS - error array contains errors
- ; FILE - File Manager file number
- ; FIELD - File Manager field number
- ; VALUE - input value, either text or numeric value - value will be checked against the input transform
- ; REQUIRED - (1 for required, otherwise, not required)
- ; CANDELETE - (1 - deletion allowed, otherwise, deletion is not allowed)
- ; MISSINGERRID - Error ID from the SDEC ERROR CODES file (409.93)
- ; INVALIDERRID - Error ID from the SDEC ERROR CODES file (409.93)
- ; DELERRID - Error ID from teh SDEC ERRRO CODES file (409.93) - overrides default delete error
- ; MISSERRTEXT - Error text to add to the returned 'MISSING' error
- ; INVALERRTEXT - Error text to add to the returned 'INVALID' error
- ; DELERRTEXT - Error text to add to the returned 'DELETE' error
- ;
- VALFIELD(VALRETURN,ERRORS,FILE,FLD,VALUE,REQUIRED,CANDELETE,MISSINGERRID,INVALIDERRID,DELERRID,MISSERRTEXT,INVALERRTEXT,DELERRTEXT) ;
- N RESULTS,VALERR,FMERRNUM,FMERRTEXT,LABEL,INPUTCHK,FLDINFO,FERR,ITERR,I,CHKVAL,INPUTCHK
- K VALRETURN
- S VALRETURN=0
- I $G(FILE)=""!($G(FLD)="") D ERRLOG^SDES2JSON(.ERRORS,52,"Invalid file or field.") Q
- ; not a valid DD reference
- I '$D(^DD(FILE,FLD)) D ERRLOG^SDES2JSON(.ERRORS,52,"Invalid file or field.") Q
- D FIELD^DID(FILE,FLD,"","LABEL;INPUT TRANSFORM","FLDINFO","FERR")
- I $D(FERR) D ERRLOG^SDES2JSON(.ERRORS,52,"A problem occured finding the field definition.") Q
- S INPUTCHK=$G(FLDINFO("INPUT TRANSFORM"))
- I INPUTCHK["DA" D ERRLOG^SDES2JSON(.ERRORS,52,"Cannot validate fields where the input transform requires DA.") Q
- F I=1:1:9 D
- .S CHKVAL="D"_I
- .I INPUTCHK[CHKVAL S ITERR=1
- I $G(ITERR) D ERRLOG^SDES2JSON(.ERRORS,52,"Cannot validate fields that require D0, D1, D2, etc.") Q
- I INPUTCHK["$$"!(INPUTCHK["D:")!(INPUTCHK[" D ") D ERRLOG^SDES2JSON(.ERRORS,52,"Cannot validate fields that call additional functions.") Q
- I INPUTCHK["D ",$P(INPUTCHK,"D ",2)["^" D ERRLOG^SDES2JSON(.ERRORS,52,"Cannot validate fields that call additional functions.") Q
- I $D(^DD(FILE,FLD,12.1)) D ERRLOG^SDES2JSON(.ERRORS,52,"Cannot validate fields that contain screening logic.") Q
- 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
- S LABEL=$G(FLDINFO("LABEL"))
- I $G(VALUE)["^" D ERRLOG^SDES2JSON(.ERRORS,52,"Input containing '^' is prohibited.") Q
- ; calling function wants this field to be required.
- I $G(REQUIRED),$G(VALUE)="" D Q
- .I $G(MISSINGERRID) D ERRLOG^SDES2JSON(.ERRORS,MISSINGERRID,$G(MISSERRTEXT)) Q
- .D ERRLOG^SDES2JSON(.ERRORS,52,"Missing required value for field: "_LABEL_" (#"_FLD_")")
- I '$G(REQUIRED),$G(VALUE)="" S VALRETURN=1 Q
- ;
- ; if calling application indicates 'required' and '@' is passed, produce an error.
- I $G(REQUIRED),$G(VALUE)="@" D ERRLOG^SDES2JSON(.ERRORS,229,$S($L($G(DELERRTEXT)):DELERRTEXT,1:LABEL)) Q
- I '$G(CANDELETE),(VALUE="@"!(VALUE="")) D Q
- .I $G(DELERRID) D ERRLOG^SDES2JSON(.ERRORS,DELERRID,$G(DELERRTEXT)) Q
- .D ERRLOG^SDES2JSON(.ERRORS,52,"This field cannot be deleted: "_LABEL_" (#"_FLD_")")
- ; for non-required fields, if this is '@' or "", quit, no need to check further
- I $G(CANDELETE),($G(VALUE)="@"!($G(VALUE)="")) S VALRETURN=1 Q
- ;
- D CHK^DIE(FILE,FLD,"E",VALUE,.RESULTS,"VALERR")
- I $D(VALERR) D Q
- .I $G(INVALIDERRID) D ERRLOG^SDES2JSON(.ERRORS,INVALIDERRID,$G(INVALERRTEXT)) Q
- .S FMERRNUM=0 F S FMERRNUM=$O(VALERR("DIERR",FMERRNUM)) Q:'FMERRNUM D
- ..S FMERRTEXT=$G(VALERR("DIERR",FMERRNUM,"TEXT",1))
- ..D ERRLOG^SDES2JSON(.ERRORS,52,FMERRTEXT)
- D SETRETURN(.VALRETURN,FILE,FLD,$G(RESULTS),$G(RESULTS(0)))
- Q
- ; validate number is within given range LOW to HIGH
- VALNUMBERRNG(VALRETURN,ERRORS,INPUTVALUE,LOW,HIGH,ISREQUIRED,MISSINGERRID,INVALIDERRID) ;
- K VALRETURN
- S VALRETURN=0
- I $G(ISREQUIRED),$G(INPUTVALUE)="" D Q
- .I $G(MISSINGERRID) D ERRLOG^SDES2JSON(.ERRORS,MISSINGERRID) Q
- .D ERRLOG^SDES2JSON(.ERRORS,52,"Missing numeric input.")
- I '$G(ISREQUIRED),$G(INPUTVALUE)="" Q
- I INPUTVALUE<LOW!(INPUTVALUE>HIGH) D Q
- .I $G(INVALIDERRID) D ERRLOG^SDES2JSON(.ERRORS,INVALIDERRID) Q
- .D ERRLOG^SDES2JSON(.ERRORS,52,"Number must be between "_LOW_"-"_HIGH)
- D SETRETURN(.VALRETURN)
- Q
- VALBOOLEAN(VRET,ERRORS,FILE,FIELD,VALUE,ISREQUIRED,CANDELETE,MISSINGERRID,INVALIDERRID,DELERRID) ;
- N RETURN,VALERR,LABEL,FLDINFO,FERR
- K VRET
- S VRET=0,VALUE=$G(VALUE)
- I $G(FILE)=""!($G(FIELD)="") D ERRLOG^SDES2JSON(.ERRORS,52,"Invalid file or field.") Q
- ; not a valid DD reference
- I '$D(^DD(FILE,FIELD)) D ERRLOG^SDES2JSON(.ERRORS,52,"Invalid file or field.") Q
- D FIELD^DID(FILE,FIELD,"","LABEL;INPUT TRANSFORM;TYPE","FLDINFO","FERR")
- I $D(FERR) D ERRLOG^SDES2JSON(.ERRORS,52,"A problem occured finding the field definition.") Q
- I $G(FLDINFO("TYPE"))'="BOOLEAN" D ERRLOG^SDES2JSON(.ERRORS,52,"Field is not a boolean field. Cannot validate.") Q
- I $G(VALUE)["^" D ERRLOG^SDES2JSON(.ERRORS,52,"Input containing '^' is prohibited.") Q
- S LABEL=$G(FLDINFO("LABEL"))
- I '$G(CANDELETE),(VALUE="@"!(VALUE="")) D Q
- .I $G(DELERRID) D ERRLOG^SDES2JSON(.ERRORS,DELERRID) Q
- .D ERRLOG^SDES2JSON(.ERRORS,52,"This field cannot be deleted: "_LABEL_" (#"_FIELD_")")
- I '$G(ISREQUIRED),$G(VALUE)="" S VRET=1 Q
- I $G(ISREQUIRED),VALUE="" D Q
- .D ERRLOG^SDES2JSON(.ERRORS,52,"Missing required value for field: "_LABEL_" (#"_FIELD_")")
- ; valid boolean value
- I VALUE="Y"!(VALUE="YES")!(VALUE=1) D SETRETURN(.VRET,FILE,FIELD,1,"YES") Q
- I VALUE="N"!(VALUE="NO")!(VALUE=0) D SETRETURN(.VRET,FILE,FIELD,0,"NO") Q
- ; invalid boolean value
- I $G(INVALIDERRID) D ERRLOG^SDES2JSON(.ERRORS,INVALIDERRID) Q
- D ERRLOG^SDES2JSON(.ERRORS,52,"Invalid value for field: "_LABEL_" (#"_FIELD_")")
- Q
- SETRETURN(VALRETURN,FILE,FLD,INTERNALVAL,EXTERNALVAL) ;
- S VALRETURN=1
- Q:'$D(FILE)!('$D(FLD))
- I $L($G(INTERNALVAL)) S VALRETURN(FILE,FLD,"I")=INTERNALVAL
- I $L($G(EXTERNALVAL)) S VALRETURN(FILE,FLD,"E")=EXTERNALVAL
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDES2VALUTIL 8726 printed Jan 18, 2025@03:56:05 Page 2
- SDES2VALUTIL ;ALB/BWF - SDES2 VALIDATION UTILITY ;JUL 28, 2023
- +1 ;;5.3;Scheduling;**853,861,866,885**;Aug 13, 1993;Build 5
- +2 ;;Per VHA Directive 6402, this routine should not be modified
- +3 ;
- +4 QUIT
- +5 ; VALRETURN - 1 for success, 0 for failure
- +6 ; FILE - File Manager file number
- +7 ; FIELD - File Manager field number
- +8 ; VALUE - input value, either text or numeric value - value will be checked against the input transform
- +9 ; REQUIRED - (1 for required, otherwise, not required)
- +10 ; CANDELETE - (1 - deletion allowed, otherwise, deletion is not allowed)
- +11 ; MISSINGERRID - Error ID from the SDEC ERROR CODES file (409.93) - overrides defualt missing error
- +12 ; INVALIDERRID - Error ID from the SDEC ERROR CODES file (409.93) - overrides default invalid error
- +13 ; DELERRID - Error ID from teh SDEC ERRRO CODES file (409.93) - overrides default delete error
- +14 ; MISSERRTEXT - Error text to add to the returned 'MISSING' error
- +15 ; INVALERRTEXT - Error text to add to the returned 'INVALID' error
- +16 ; DELERRTEXT - Error text to add to the returned 'DELETE' error
- +17 ;
- VALFILEIEN(VALRETURN,ERRORS,FILENUM,VALUE,REQUIRED,CANDELETE,MISSINGERRID,INVALIDERRID,DELERRID,MISSERRTEXT,INVALERRTEXT,DELERRTEXT) ;
- +1 NEW FDATA,FILERR,GLOBALROOT,FERR,ERRLOOP,ERRTEXT
- +2 KILL VALRETURN
- +3 SET VALRETURN=0
- +4 IF '$LENGTH($GET(FILENUM))
- QUIT
- +5 IF $GET(REQUIRED)
- IF $GET(VALUE)="@"
- Begin DoDot:1
- +6 IF $GET(DELERRID)
- DO ERRLOG^SDES2JSON(.ERRORS,DELERRID,$GET(DELERRTEXT))
- QUIT
- +7 DO ERRLOG^SDES2JSON(.ERRORS,52,"This field cannot be deleted.")
- End DoDot:1
- QUIT
- +8 IF $GET(CANDELETE)
- IF ($GET(VALUE)="@"!($GET(VALUE)=""))
- SET VALRETURN=1
- QUIT
- +9 DO FILE^DID(FILENUM,,"GLOBAL NAME;NAME","FDATA","FERR")
- +10 IF $DATA(FERR)
- Begin DoDot:1
- +11 SET ERRLOOP=0
- FOR
- SET ERRLOOP=$ORDER(FERR("DIERR",1,"TEXT",ERRLOOP))
- if 'ERRLOOP
- QUIT
- Begin DoDot:2
- +12 SET ERRTEXT=$GET(FERR("DIERR",1,"TEXT",ERRLOOP))
- +13 DO ERRLOG^SDES2JSON(.ERRORS,52,ERRTEXT)
- QUIT
- End DoDot:2
- End DoDot:1
- QUIT
- +14 IF $GET(REQUIRED)
- IF $GET(VALUE)=""
- Begin DoDot:1
- +15 IF $GET(MISSINGERRID)
- DO ERRLOG^SDES2JSON(.ERRORS,MISSINGERRID,$GET(MISSERRTEXT))
- QUIT
- +16 DO ERRLOG^SDES2JSON(.ERRORS,52,"Missing IEN for file: "_$GET(FDATA("NAME")))
- End DoDot:1
- QUIT
- +17 ; if we get to this point and the field is not required, quit, no need to check the global
- +18 IF '$GET(REQUIRED)
- IF $GET(VALUE)=""
- SET VALRETURN=1
- QUIT
- +19 ; force the value to a string in the event there are alpha-numeric characters in VALUE
- +20 SET VALUE=""""_VALUE_""""
- +21 SET GLOBALROOT=$GET(FDATA("GLOBAL NAME"))
- +22 SET GLOBALROOT=GLOBALROOT_VALUE_")"
- +23 IF '$DATA(@GLOBALROOT@(0))
- Begin DoDot:1
- +24 IF $GET(INVALIDERRID)
- DO ERRLOG^SDES2JSON(.ERRORS,INVALIDERRID,$GET(INVALERRTEXT))
- QUIT
- +25 DO ERRLOG^SDES2JSON(.ERRORS,52,"Invalid IEN for file:"_$GET(FDATA("NAME"))_": "_VALUE)
- End DoDot:1
- QUIT
- +26 SET VALRETURN=1
- +27 QUIT
- +28 ;
- +29 ; VALRETURN - return array
- +30 ; VALRETURN= 1 - valid, 0 - not valid
- +31 ; VALRETURN(FILENUMBER, FIELD NUMBER,"I")=INTERNAL FILEMAN VALUE
- +32 ; VALRETURN(FILENUMBER, FIELD NUMBER,"E")=EXTERNAL FILEMAN VALUE
- +33 ; ERRORS - error array contains errors
- +34 ; FILE - File Manager file number
- +35 ; FIELD - File Manager field number
- +36 ; VALUE - input value, either text or numeric value - value will be checked against the input transform
- +37 ; REQUIRED - (1 for required, otherwise, not required)
- +38 ; CANDELETE - (1 - deletion allowed, otherwise, deletion is not allowed)
- +39 ; MISSINGERRID - Error ID from the SDEC ERROR CODES file (409.93)
- +40 ; INVALIDERRID - Error ID from the SDEC ERROR CODES file (409.93)
- +41 ; DELERRID - Error ID from teh SDEC ERRRO CODES file (409.93) - overrides default delete error
- +42 ; MISSERRTEXT - Error text to add to the returned 'MISSING' error
- +43 ; INVALERRTEXT - Error text to add to the returned 'INVALID' error
- +44 ; DELERRTEXT - Error text to add to the returned 'DELETE' error
- +45 ;
- VALFIELD(VALRETURN,ERRORS,FILE,FLD,VALUE,REQUIRED,CANDELETE,MISSINGERRID,INVALIDERRID,DELERRID,MISSERRTEXT,INVALERRTEXT,DELERRTEXT) ;
- +1 NEW RESULTS,VALERR,FMERRNUM,FMERRTEXT,LABEL,INPUTCHK,FLDINFO,FERR,ITERR,I,CHKVAL,INPUTCHK
- +2 KILL VALRETURN
- +3 SET VALRETURN=0
- +4 IF $GET(FILE)=""!($GET(FLD)="")
- DO ERRLOG^SDES2JSON(.ERRORS,52,"Invalid file or field.")
- QUIT
- +5 ; not a valid DD reference
- +6 IF '$DATA(^DD(FILE,FLD))
- DO ERRLOG^SDES2JSON(.ERRORS,52,"Invalid file or field.")
- QUIT
- +7 DO FIELD^DID(FILE,FLD,"","LABEL;INPUT TRANSFORM","FLDINFO","FERR")
- +8 IF $DATA(FERR)
- DO ERRLOG^SDES2JSON(.ERRORS,52,"A problem occured finding the field definition.")
- QUIT
- +9 SET INPUTCHK=$GET(FLDINFO("INPUT TRANSFORM"))
- +10 IF INPUTCHK["DA"
- DO ERRLOG^SDES2JSON(.ERRORS,52,"Cannot validate fields where the input transform requires DA.")
- QUIT
- +11 FOR I=1:1:9
- Begin DoDot:1
- +12 SET CHKVAL="D"_I
- +13 IF INPUTCHK[CHKVAL
- SET ITERR=1
- End DoDot:1
- +14 IF $GET(ITERR)
- DO ERRLOG^SDES2JSON(.ERRORS,52,"Cannot validate fields that require D0, D1, D2, etc.")
- QUIT
- +15 IF INPUTCHK["$$"!(INPUTCHK["D:")!(INPUTCHK[" D ")
- DO ERRLOG^SDES2JSON(.ERRORS,52,"Cannot validate fields that call additional functions.")
- QUIT
- +16 IF INPUTCHK["D "
- IF $PIECE(INPUTCHK,"D ",2)["^"
- DO ERRLOG^SDES2JSON(.ERRORS,52,"Cannot validate fields that call additional functions.")
- QUIT
- +17 IF $DATA(^DD(FILE,FLD,12.1))
- DO ERRLOG^SDES2JSON(.ERRORS,52,"Cannot validate fields that contain screening logic.")
- QUIT
- +18 IF $DATA(^DD(FILE,FLD,2))!($DATA(^DD(FILE,FLD,2.1)))
- DO ERRLOG^SDES2JSON(.ERRORS,52,"Cannot validate fields containing Output transform logic.")
- QUIT
- +19 SET LABEL=$GET(FLDINFO("LABEL"))
- +20 IF $GET(VALUE)["^"
- DO ERRLOG^SDES2JSON(.ERRORS,52,"Input containing '^' is prohibited.")
- QUIT
- +21 ; calling function wants this field to be required.
- +22 IF $GET(REQUIRED)
- IF $GET(VALUE)=""
- Begin DoDot:1
- +23 IF $GET(MISSINGERRID)
- DO ERRLOG^SDES2JSON(.ERRORS,MISSINGERRID,$GET(MISSERRTEXT))
- QUIT
- +24 DO ERRLOG^SDES2JSON(.ERRORS,52,"Missing required value for field: "_LABEL_" (#"_FLD_")")
- End DoDot:1
- QUIT
- +25 IF '$GET(REQUIRED)
- IF $GET(VALUE)=""
- SET VALRETURN=1
- QUIT
- +26 ;
- +27 ; if calling application indicates 'required' and '@' is passed, produce an error.
- +28 IF $GET(REQUIRED)
- IF $GET(VALUE)="@"
- DO ERRLOG^SDES2JSON(.ERRORS,229,$SELECT($LENGTH($GET(DELERRTEXT)):DELERRTEXT,1:LABEL))
- QUIT
- +29 IF '$GET(CANDELETE)
- IF (VALUE="@"!(VALUE=""))
- Begin DoDot:1
- +30 IF $GET(DELERRID)
- DO ERRLOG^SDES2JSON(.ERRORS,DELERRID,$GET(DELERRTEXT))
- QUIT
- +31 DO ERRLOG^SDES2JSON(.ERRORS,52,"This field cannot be deleted: "_LABEL_" (#"_FLD_")")
- End DoDot:1
- QUIT
- +32 ; for non-required fields, if this is '@' or "", quit, no need to check further
- +33 IF $GET(CANDELETE)
- IF ($GET(VALUE)="@"!($GET(VALUE)=""))
- SET VALRETURN=1
- QUIT
- +34 ;
- +35 DO CHK^DIE(FILE,FLD,"E",VALUE,.RESULTS,"VALERR")
- +36 IF $DATA(VALERR)
- Begin DoDot:1
- +37 IF $GET(INVALIDERRID)
- DO ERRLOG^SDES2JSON(.ERRORS,INVALIDERRID,$GET(INVALERRTEXT))
- QUIT
- +38 SET FMERRNUM=0
- FOR
- SET FMERRNUM=$ORDER(VALERR("DIERR",FMERRNUM))
- if 'FMERRNUM
- QUIT
- Begin DoDot:2
- +39 SET FMERRTEXT=$GET(VALERR("DIERR",FMERRNUM,"TEXT",1))
- +40 DO ERRLOG^SDES2JSON(.ERRORS,52,FMERRTEXT)
- End DoDot:2
- End DoDot:1
- QUIT
- +41 DO SETRETURN(.VALRETURN,FILE,FLD,$GET(RESULTS),$GET(RESULTS(0)))
- +42 QUIT
- +43 ; validate number is within given range LOW to HIGH
- VALNUMBERRNG(VALRETURN,ERRORS,INPUTVALUE,LOW,HIGH,ISREQUIRED,MISSINGERRID,INVALIDERRID) ;
- +1 KILL VALRETURN
- +2 SET VALRETURN=0
- +3 IF $GET(ISREQUIRED)
- IF $GET(INPUTVALUE)=""
- Begin DoDot:1
- +4 IF $GET(MISSINGERRID)
- DO ERRLOG^SDES2JSON(.ERRORS,MISSINGERRID)
- QUIT
- +5 DO ERRLOG^SDES2JSON(.ERRORS,52,"Missing numeric input.")
- End DoDot:1
- QUIT
- +6 IF '$GET(ISREQUIRED)
- IF $GET(INPUTVALUE)=""
- QUIT
- +7 IF INPUTVALUE<LOW!(INPUTVALUE>HIGH)
- Begin DoDot:1
- +8 IF $GET(INVALIDERRID)
- DO ERRLOG^SDES2JSON(.ERRORS,INVALIDERRID)
- QUIT
- +9 DO ERRLOG^SDES2JSON(.ERRORS,52,"Number must be between "_LOW_"-"_HIGH)
- End DoDot:1
- QUIT
- +10 DO SETRETURN(.VALRETURN)
- +11 QUIT
- VALBOOLEAN(VRET,ERRORS,FILE,FIELD,VALUE,ISREQUIRED,CANDELETE,MISSINGERRID,INVALIDERRID,DELERRID) ;
- +1 NEW RETURN,VALERR,LABEL,FLDINFO,FERR
- +2 KILL VRET
- +3 SET VRET=0
- SET VALUE=$GET(VALUE)
- +4 IF $GET(FILE)=""!($GET(FIELD)="")
- DO ERRLOG^SDES2JSON(.ERRORS,52,"Invalid file or field.")
- QUIT
- +5 ; not a valid DD reference
- +6 IF '$DATA(^DD(FILE,FIELD))
- DO ERRLOG^SDES2JSON(.ERRORS,52,"Invalid file or field.")
- QUIT
- +7 DO FIELD^DID(FILE,FIELD,"","LABEL;INPUT TRANSFORM;TYPE","FLDINFO","FERR")
- +8 IF $DATA(FERR)
- DO ERRLOG^SDES2JSON(.ERRORS,52,"A problem occured finding the field definition.")
- QUIT
- +9 IF $GET(FLDINFO("TYPE"))'="BOOLEAN"
- DO ERRLOG^SDES2JSON(.ERRORS,52,"Field is not a boolean field. Cannot validate.")
- QUIT
- +10 IF $GET(VALUE)["^"
- DO ERRLOG^SDES2JSON(.ERRORS,52,"Input containing '^' is prohibited.")
- QUIT
- +11 SET LABEL=$GET(FLDINFO("LABEL"))
- +12 IF '$GET(CANDELETE)
- IF (VALUE="@"!(VALUE=""))
- Begin DoDot:1
- +13 IF $GET(DELERRID)
- DO ERRLOG^SDES2JSON(.ERRORS,DELERRID)
- QUIT
- +14 DO ERRLOG^SDES2JSON(.ERRORS,52,"This field cannot be deleted: "_LABEL_" (#"_FIELD_")")
- End DoDot:1
- QUIT
- +15 IF '$GET(ISREQUIRED)
- IF $GET(VALUE)=""
- SET VRET=1
- QUIT
- +16 IF $GET(ISREQUIRED)
- IF VALUE=""
- Begin DoDot:1
- +17 DO ERRLOG^SDES2JSON(.ERRORS,52,"Missing required value for field: "_LABEL_" (#"_FIELD_")")
- End DoDot:1
- QUIT
- +18 ; valid boolean value
- +19 IF VALUE="Y"!(VALUE="YES")!(VALUE=1)
- DO SETRETURN(.VRET,FILE,FIELD,1,"YES")
- QUIT
- +20 IF VALUE="N"!(VALUE="NO")!(VALUE=0)
- DO SETRETURN(.VRET,FILE,FIELD,0,"NO")
- QUIT
- +21 ; invalid boolean value
- +22 IF $GET(INVALIDERRID)
- DO ERRLOG^SDES2JSON(.ERRORS,INVALIDERRID)
- QUIT
- +23 DO ERRLOG^SDES2JSON(.ERRORS,52,"Invalid value for field: "_LABEL_" (#"_FIELD_")")
- +24 QUIT
- SETRETURN(VALRETURN,FILE,FLD,INTERNALVAL,EXTERNALVAL) ;
- +1 SET VALRETURN=1
- +2 if '$DATA(FILE)!('$DATA(FLD))
- QUIT
- +3 IF $LENGTH($GET(INTERNALVAL))
- SET VALRETURN(FILE,FLD,"I")=INTERNALVAL
- +4 IF $LENGTH($GET(EXTERNALVAL))
- SET VALRETURN(FILE,FLD,"E")=EXTERNALVAL
- +5 QUIT