File:  [Coherent Logic Development] / freem_fileman / USER / DIEV.m
Revision 1.1: download - view: text, annotated - select for diffs
Mon Apr 28 14:13:20 2025 UTC (3 months ago) by snw
Branches: MAIN
CVS tags: HEAD
Restructure repository

    1: DIEV	;SFISC/DPC-DATA VALIDATOR ;11/28/94  13:48
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: VAL(DIEVF,DIEVIEN,DIEVFLD,DIEVFLG,DIEVAL,DIEVANS,DIEVFAR,DIOUTAR)	;
    5: VALX	;
    6: 	N DIEV0,DIEVP2,DA,D,I,C K DIEVANS
    7: 	I '$D(DIQUIET) N DIQUIET S DIQUIET=1
    8: 	I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
    9: 	S DIEVFLG=$G(DIEVFLG) I '$$VERFLG^DIEFU(DIEVFLG,"HFERY") G OUT
   10: 	D FLDVAL G:$G(DIEVAL)=U OUT
   11: 	D DA^DIEFU(DIEVIEN,.DA)
   12: 	S C=$L(DIEVIEN,",")-1 F I=1:1:C S D="D"_(C-I) N @D S @D=$P(DIEVIEN,",",I)
   13: 	D AUXVAL(DIEVF,DIEVIEN,DIEVFLD,DIEVFLG,DIEVAL,.DIEVANS,.DIEV0,.DIEVP2)
   14: 	I $G(DIEVANS)=U!("@"[DIEVAL) G OUT
   15: MINVAL	;
   16: 	D INT(DIEVF,DIEVFLD,DIEVFLG,DIEVAL,.DIEVANS,$G(DIEV0),$G(DIEVP2))
   17: 	I DIEVANS=U D ERR
   18: OUT	S DIEVANS=$G(DIEVANS,U)
   19: 	I DIEVFLG["F",DIEVANS'=U D FDA
   20: 	I $G(DIOUTAR)]"" D CALLOUT^DIEFU(DIOUTAR)
   21: 	Q
   22: 	;
   23: FLDVAL	;
   24: 	N DIEVOUT S DIEVOUT=0
   25: 	I '$$VFILE^DIEFU(DIEVF,"D") S DIEVAL=U Q
   26: 	I '$$VFIELD^DIEFU(DIEVF,DIEVFLD,"D") S DIEVAL=U Q
   27: 	S DIEV0=^DD(DIEVF,DIEVFLD,0),DIEVP2=$P(DIEV0,U,2)
   28: 	D DTYPE
   29: 	I DIEVOUT=1 S DIEVAL=U
   30: 	Q
   31: 	;
   32: AUXVAL(DIEVF,DIEVIEN,DIEVFLD,DIEVFLG,DIEVAL,DIEVANS,DIEV0,DIEVP2)	;
   33: 	N DIEVOUT S DIEVOUT=0
   34: 	I '$D(DIOVRD),$P($G(^DD($$FNO^DILIBF(DIEVF),0,"DI")),U,2)="Y",DIEVFLG'["Y" D  G AUXERR
   35: 	. N INT,EXT S INT(1)=$$FILENM^DIEFU(DIEVF),EXT("FILE")=DIEVF
   36: 	. D BLD^DIALOG(405,.INT,.EXT)
   37: 	I $P(DIEV0,U,5,99)["DINUM","@"'[DIEVAL D  G AUXERR
   38: 	. N EXT,INT S EXT("FILE")=DIEVF,EXT("FIELD")=DIEVFLD,(INT(1),EXT(1))="DINUMed"
   39: 	. D BLD^DIALOG(520,.INT,.EXT)
   40: 	I $E(DIEVAL)="?"!(DIEVP2["V"&(DIEVAL[".?")) N P S P(1)=DIEVF,P(2)=DIEVFLD D BLD^DIALOG(1610,"",.P) G AUXERR
   41: 	I DIEVFLG["R" G:'$$VENTRY^DIEFU(DIEVF,DIEVIEN,"D9") AUXERR
   42: 	I DIEVP2["I",$$DATA(DIEVF,DIEVFLD) N P S P("FIELD")=DIEVFLD,P("FILE")=DIEVF D BLD^DIALOG(710,.P,.P) G AUXERR
   43: 	I "@"[DIEVAL D DELETE G:DIEVOUT AUXERR Q
   44: 	I DIEVFLG["I" D
   45: 	. S DIEVANS=DIEVAL
   46: 	. I DIEVFLG["E" S DIEVANS(0)=$$EXTERNAL^DIQGU(DIEVF,DIEVFLD,"",DIEVAL)
   47: 	Q
   48: AUXERR	S DIEVANS=U
   49: 	Q
   50: 	;
   51: DTYPE	;
   52: 	I DIEVP2 D  S DIEVOUT=1 Q
   53: 	. N T,INT,EXT D DTYP^DIOU(DIEVF,DIEVFLD,.T)
   54: 	. I T=5 S INT(1)="word-processing",EXT("FIELD")=DIEVFLD,EXT("FILE")=DIEVF D BLD^DIALOG(520,.INT,.EXT) Q
   55: 	. S INT(1)="multi-valued",EXT("FIELD")=DIEVFLD,EXT("FILE")=DIEVF D BLD^DIALOG(520,.INT,.EXT)
   56: 	I DIEVP2["C" N INT,EXT S INT(1)="computed",EXT("FIELD")=DIEVFLD,EXT("FILE")=DIEVF D BLD^DIALOG(520,.INT,.EXT) S DIEVOUT=1 Q
   57: 	Q
   58: 	;
   59: DELETE	;
   60: 	I $D(^DD(DIEVF,DIEVFLD,"DEL")) D
   61: 	. N DIEVECNT S DIEVECNT=$G(DIERR)
   62: 	. N I S I="" F  S I=$O(^DD(DIEVF,DIEVFLD,"DEL",I)) Q:I=""  X $G(^(I,0)) I  S DIEVOUT=1
   63: 	. I DIEVECNT'=$G(DIERR) S DIEVOUT=1 D HKERR^DILIBF(DIEVF,$G(DIEVIEN),DIEVFLD,"DEL node")
   64: 	I DIEVP2["R" D
   65: 	. I DIEVFLD'=.01 S DIEVOUT=1 Q
   66: 	. I '$D(^DD(DIEVF,0,"UP")) Q
   67: 	. I $P($G(@$$ROOT^DILFD(DIEVF,DIEVIEN,1)@(0)),U,4)=1 S DIEVOUT=1
   68: 	I 'DIEVOUT S DIEVANS="" S:DIEVFLG["E" DIEVANS(0)=""
   69: 	E  D
   70: 	. N INT,EXT
   71: 	. S INT(1)=$$FLDNM^DIEFU(DIEVF,DIEVFLD),INT(2)=$$FILENM^DIEFU(DIEVF)
   72: 	. S EXT("FILE")=DIEVF,EXT("FIELD")=DIEVFLD
   73: 	. D BLD^DIALOG(712,.INT,.EXT)
   74: 	Q
   75: 	;
   76: DATA(DIEVF,DIEVFLD)	;
   77: 	N DIEVNODE,DIEVSPOT,N S DIEVSPOT=" ",N=0
   78: 	D GLRF^DIOU(DIEVF,DIEVFLD,.DIEVNODE,.DIEVSPOT)
   79: 	I +DIEVSPOT D
   80: 	. I $P($G(@DIEVNODE),U,DIEVSPOT)'="" S N=1
   81: 	E  I $E(DIEVSPOT)="E" D
   82: 	. N F,T
   83: 	. S F=$P($P(DIEVSPOT,"E",2),",",1),T=$P(DIEVSPOT,",",2)
   84: 	. I $TR($E($G(@DIEVNODE),F,T)," ")'="" S N=1
   85: 	Q N
   86: 	;
   87: INT(%B1,%B2,DIEVFLG,X,DIEVANS,%B3,%B)	;
   88: 	N %A,%E,%C,DIR,DIC,Y,DIE,%J,%T,%BA,DP,DIFLD,DDH,%BU,%I,%K,DQ,DIFILE,C,DIEVECNT
   89: 	I $G(%B3)="" S %B3=^DD(%B1,%B2,0),%B=$P(%B3,U,2)
   90: 	I %B["V" D VP^DIEV1(%B1,%B2,DIEVFLG,X,%B3,.DIEVANS) Q
   91: 	I %B["N" D  Q:$G(DIEVANS)=U
   92: 	. I $L($P(X,"."))>24 S DIEVANS=U Q
   93: 	I %B["S" S X=$$UP^DILIBF(X)
   94: 	S %A=%B1_","_%B2_",V",%E=0,DIR("V")="",%T=$E(%B1)
   95: 	S DIEVECNT=$G(DIERR)
   96: 	D 1^DIR1
   97: 	I DIEVECNT'=$G(DIERR) S DIEVANS=U D HKERR^DILIBF(%B1,$G(DIEVIEN),%B2,"screen on a pointer or set of codes or in an input transform") Q
   98: 	I %E S DIEVANS=U Q
   99: 	S DIEVANS=$S(%B'["P":Y,1:$P(Y,U))
  100: 	I DIEVFLG["E" D
  101: 	. I %B["S"!(%B["D") S DIEVANS(0)=$P(Y(0),U)
  102: 	. E  I %B["P" S DIEVANS(0)=Y(0,0)
  103: 	. E  I %B["O" D
  104: 	. . S Y=X
  105: 	. . S DIEVECNT=$G(DIERR)
  106: 	. . X $G(^DD(%B1,%B2,2))
  107: 	. . I DIEVECNT'=$G(DIERR) D HKERR^DILIBF(%B1,$G(DIEVIEN),%B2,"output transform") Q
  108: 	. . S DIEVANS(0)=Y
  109: 	. . Q
  110: 	. E  S DIEVANS(0)=X
  111: 	. Q
  112: 	Q
  113: 	;
  114: FDA	;
  115: 	I $G(DIEVFAR)="" D BLD^DIALOG(202,"FDA") Q
  116: 	D LOAD^DIEF1(DIEVF,DIEVIEN,DIEVFLD,"",DIEVANS,DIEVFAR)
  117: 	Q
  118: 	;
  119: ERR	;
  120: 	N INT,EXT
  121: 	S INT(1)=$$FLDNM^DIEFU(DIEVF,DIEVFLD),INT(2)=$$FILENM^DIEFU(DIEVF),(INT(3),EXT(3))=DIEVAL
  122: 	S EXT("FILE")=DIEVF,EXT("FIELD")=DIEVFLD,EXT("IENS")=$G(DIEVIEN)
  123: 	D BLD^DIALOG(701,.INT,.EXT)
  124: 	I DIEVFLG["H" D GET^DIEH(DIEVF,"",DIEVFLD,"?b") ;DA() and D0,D1,etc. passed thru symbol table
  125: 	Q
  126: 	;
  127: CHKX	;
  128: 	N DIEV0,DIEVP2 K DIEVANS
  129: 	I '$D(DIQUIET) N DIQUIET S DIQUIET=1
  130: 	I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
  131: 	S DIEVFLG=$G(DIEVFLG) I '$$VERFLG^DIEFU(DIEVFLG,"HE") G OUT
  132: 	D FLDVAL I $G(DIEVAL)=U D OUT Q
  133: 	D MINVAL
  134: 	Q

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>