DIEVS.m

DIEVS ;SFIRMFO/DPC-BATCH VALIDATION ;2:03 PM  21 Jul 2000

 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42

 ;;Per VA Directive 6402, this routine should not be modified.

 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.

 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.

 ;;Licensed under the terms of the Apache License, Version 2.0.

 ;

 ;;

VALS(DIVSFLAG,DIVSEFDA,DIVSIFDA,DIVSMSG) ;

VALSX ;

 N DIVSFILE,DIVSIENS,DIVSFLD,DIVSVAL,DIVSNFLG,DIVSANS,DIVSTYPE

 I '$D(DIQUIET) N DIQUIET S DIQUIET=1

 I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU

 S DIVSFLAG=$G(DIVSFLAG) I '$$VERFLG^DIEFU(DIVSFLAG,"KRU") G OUT

 S DIVSEFDA=$G(DIVSEFDA) I '$$VROOT^DIEFU(DIVSEFDA) G OUT

 S DIVSIFDA=$G(DIVSIFDA) I '$$VROOT^DIEFU(DIVSIFDA) G OUT

 I DIVSIFDA=""!(DIVSIFDA=DIVSEFDA) D BLD^DIALOG(313) G OUT

 S DIVSNFLG=$E("R",DIVSFLAG["R")_"FU"

 N DIVSNG S DIVSNG=0

 S DIVSFILE=""

 F  S DIVSFILE=$O(@DIVSEFDA@(DIVSFILE)) Q:DIVSFILE=""  D

 . S DIVSIENS=""

 . F  S DIVSIENS=$O(@DIVSEFDA@(DIVSFILE,DIVSIENS)) Q:DIVSIENS=""  D

 . . S DIVSFLD=""

 . . F  S DIVSFLD=$O(@DIVSEFDA@(DIVSFILE,DIVSIENS,DIVSFLD)) Q:DIVSFLD=""  D

 . . . S DIVSVAL=@DIVSEFDA@(DIVSFILE,DIVSIENS,DIVSFLD)

 . . . ;Quit if field is w-p -- no validation.

 . . . D DTYP^DIOU(DIVSFILE,DIVSFLD,.DIVSTYPE)

 . . . I DIVSTYPE=5 S @DIVSIFDA@(DIVSFILE,DIVSIENS,DIVSFLD)=DIVSVAL Q

 . . . D VAL^DIEV(DIVSFILE,DIVSIENS,DIVSFLD,DIVSNFLG,DIVSVAL,.DIVSANS,DIVSIFDA)

 . . . I DIVSANS=U S @DIVSIFDA@(DIVSFILE,DIVSIENS,DIVSFLD)=U,DIVSNG=1

 ;Now do Key Validation

 I DIVSFLAG'["U" S DIVSNG='$$KEYVAL^DIEVK($E("K",DIVSFLAG["K"),DIVSIFDA)

OUT I $G(DIVSMSG)]"" D CALLOUT^DIEFU(DIVSMSG)

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---DIEVS   1661     printed  Apr 09, 2024@21:47:42                                                                                                                                                                                                       Page 2

DIEVS     ;SFIRMFO/DPC-BATCH VALIDATION ;2:03 PM  21 Jul 2000

 +1       ;;22.2;VA FileMan;;Jan 05, 2016;Build 42

 +2       ;;Per VA Directive 6402, this routine should not be modified.

 +3       ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.

 +4       ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.

 +5       ;;Licensed under the terms of the Apache License, Version 2.0.

 +6       ;

 +7       ;;

VALS(DIVSFLAG,DIVSEFDA,DIVSIFDA,DIVSMSG) ;

VALSX     ;

 +1        NEW DIVSFILE,DIVSIENS,DIVSFLD,DIVSVAL,DIVSNFLG,DIVSANS,DIVSTYPE

 +2        IF '$DATA(DIQUIET)

               NEW DIQUIET

               SET DIQUIET=1

 +3        IF '$DATA(DIFM)

               NEW DIFM

               SET DIFM=1

               DO INIZE^DIEFU

 +4        SET DIVSFLAG=$GET(DIVSFLAG)

           IF '$$VERFLG^DIEFU(DIVSFLAG,"KRU")

               GOTO OUT

 +5        SET DIVSEFDA=$GET(DIVSEFDA)

           IF '$$VROOT^DIEFU(DIVSEFDA)

               GOTO OUT

 +6        SET DIVSIFDA=$GET(DIVSIFDA)

           IF '$$VROOT^DIEFU(DIVSIFDA)

               GOTO OUT

 +7        IF DIVSIFDA=""!(DIVSIFDA=DIVSEFDA)

               DO BLD^DIALOG(313)

               GOTO OUT

 +8        SET DIVSNFLG=$EXTRACT("R",DIVSFLAG["R")_"FU"

 +9        NEW DIVSNG

           SET DIVSNG=0

 +10       SET DIVSFILE=""

 +11       FOR 

               SET DIVSFILE=$ORDER(@DIVSEFDA@(DIVSFILE))

               if DIVSFILE=""

                   QUIT 

               Begin DoDot:1

 +12               SET DIVSIENS=""

 +13               FOR 

                       SET DIVSIENS=$ORDER(@DIVSEFDA@(DIVSFILE,DIVSIENS))

                       if DIVSIENS=""

                           QUIT 

                       Begin DoDot:2

 +14                       SET DIVSFLD=""

 +15                       FOR 

                               SET DIVSFLD=$ORDER(@DIVSEFDA@(DIVSFILE,DIVSIENS,DIVSFLD))

                               if DIVSFLD=""

                                   QUIT 

                               Begin DoDot:3

 +16                               SET DIVSVAL=@DIVSEFDA@(DIVSFILE,DIVSIENS,DIVSFLD)

 +17      ;Quit if field is w-p -- no validation.

 +18                               DO DTYP^DIOU(DIVSFILE,DIVSFLD,.DIVSTYPE)

 +19                               IF DIVSTYPE=5

                                       SET @DIVSIFDA@(DIVSFILE,DIVSIENS,DIVSFLD)=DIVSVAL

                                       QUIT 

 +20                               DO VAL^DIEV(DIVSFILE,DIVSIENS,DIVSFLD,DIVSNFLG,DIVSVAL,.DIVSANS,DIVSIFDA)

 +21                               IF DIVSANS=U

                                       SET @DIVSIFDA@(DIVSFILE,DIVSIENS,DIVSFLD)=U

                                       SET DIVSNG=1

                               End DoDot:3

                       End DoDot:2

               End DoDot:1

 +22      ;Now do Key Validation

 +23       IF DIVSFLAG'["U"

               SET DIVSNG='$$KEYVAL^DIEVK($EXTRACT("K",DIVSFLAG["K"),DIVSIFDA)

OUT        IF $GET(DIVSMSG)]""

               DO CALLOUT^DIEFU(DIVSMSG)

 +1        QUIT