SDES2VALUTIL ;ALB/BWF - SDES2 VALIDATION UTILITY ;JUL 28, 2023
;;5.3;Scheduling;**853,861,866**;Aug 13, 1993;Build 22
;;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
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 7221 printed Apr 09, 2024@21:48:43 Page 2
SDES2VALUTIL ;ALB/BWF - SDES2 VALIDATION UTILITY ;JUL 28, 2023
+1 ;;5.3;Scheduling;**853,861,866**;Aug 13, 1993;Build 22
+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
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
