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 ---[H[J[2J[HDIEVS 1661 printed Nov 22, 2024@17:57:20 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
