- DIEV ;SFISC/DPC-DATA VALIDATOR ;22SEP2009
- ;;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.
- ;
- VAL(DIEVF,DIEVIEN,DIEVFLD,DIEVFLG,DIEVAL,DIEVANS,DIEVFAR,DIOUTAR) ;
- VALX ;
- N DIEV0,DIEVP2,DA,D,I,C,G K DIEVANS
- I '$D(DIQUIET) N DIQUIET S DIQUIET=1
- I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
- S DIEVFLG=$G(DIEVFLG) I '$$VERFLG^DIEFU(DIEVFLG,"HFERYUK") G OUT
- D FLDVAL G:$G(DIEVAL)=U OUT
- IENS S G=$G(DIEVIEN) I G]"" S:G'?.E1"," G=G_"," S C=$L(G,",")-1 F I=1:1:C S D="D"_(C-I) N @D S @D=$P(G,",",I) I @D="" D BLD^DIALOG(308,$G(DIEVIEN)) G OUT
- S DIEVIEN=G D DA^DIEFU(G,.DA)
- D AUXVAL(DIEVF,DIEVIEN,DIEVFLD,DIEVFLG,DIEVAL,.DIEVANS,.DIEV0,.DIEVP2)
- I $G(DIEVANS)=U!("@"[DIEVAL) G OUT
- MINVAL ;
- D INT(DIEVF,DIEVFLD,DIEVFLG,DIEVAL,.DIEVANS,$G(DIEV0),$G(DIEVP2))
- I DIEVANS=U D ERR G OUT
- I DIEVFLG'["U",$G(DIEVIEN)'?."," D KEY(DIEVF,DIEVIEN,DIEVFLD,DIEVFLG,DIEVANS,.DIEVANS)
- OUT S DIEVANS=$G(DIEVANS,U)
- I DIEVFLG["F",DIEVANS'=U D FDA
- I $G(DIOUTAR)]"" D CALLOUT^DIEFU(DIOUTAR)
- Q
- ;
- FLDVAL ;
- N DIEVOUT S DIEVOUT=0
- I '$$VFILE^DIEFU(DIEVF,"D") S DIEVAL=U Q
- I '$$VFIELD^DIEFU(DIEVF,DIEVFLD,"D") S DIEVAL=U Q
- S DIEV0=^DD(DIEVF,DIEVFLD,0),DIEVP2=$P(DIEV0,U,2)
- D DTYPE
- I DIEVOUT=1 S DIEVAL=U
- Q
- ;
- AUXVAL(DIEVF,DIEVIEN,DIEVFLD,DIEVFLG,DIEVAL,DIEVANS,DIEV0,DIEVP2) ;
- N DIEVOUT S DIEVOUT=0
- I '$D(DIOVRD),$P($G(^DD($$FNO^DILIBF(DIEVF),0,"DI")),U,2)="Y",DIEVFLG'["Y" D G AUXERR
- . N INT,EXT S INT(1)=$$FILENM^DIEFU(DIEVF),EXT("FILE")=DIEVF
- . D BLD^DIALOG(405,.INT,.EXT)
- I $P(DIEV0,U,5,99)["DINUM","@"'[DIEVAL D G AUXERR
- . N EXT,INT S EXT("FILE")=DIEVF,EXT("FIELD")=DIEVFLD,(INT(1),EXT(1))="DINUMed"
- . D BLD^DIALOG(520,.INT,.EXT)
- I $E(DIEVAL)="?"!(DIEVP2["V"&(DIEVAL[".?")) N P S P(1)=DIEVF,P(2)=DIEVFLD D BLD^DIALOG(1610,"",.P) G AUXERR
- I DIEVFLG["R" G:'$$VENTRY^DIEFU(DIEVF,DIEVIEN,"D9") AUXERR
- I DIEVP2["I",$$DATA(DIEVF,DIEVFLD) N P S P("FIELD")=DIEVFLD,P("FILE")=DIEVF D BLD^DIALOG(710,.P,.P) G AUXERR
- I "@"[DIEVAL D DELETE G:DIEVOUT AUXERR Q
- I DIEVFLG["I" D
- . S DIEVANS=DIEVAL
- . I DIEVFLG["E" S DIEVANS(0)=$$EXTERNAL^DILFD(DIEVF,DIEVFLD,"",DIEVAL)
- Q
- AUXERR S DIEVANS=U
- Q
- ;
- DTYPE ;
- I DIEVP2 D S DIEVOUT=1 Q
- . N T,INT,EXT D DTYP^DIOU(DIEVF,DIEVFLD,.T)
- . I T=5 S INT(1)="word-processing",EXT("FIELD")=DIEVFLD,EXT("FILE")=DIEVF D BLD^DIALOG(520,.INT,.EXT) Q
- . S INT(1)="multi-valued",EXT("FIELD")=DIEVFLD,EXT("FILE")=DIEVF D BLD^DIALOG(520,.INT,.EXT)
- 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
- Q
- ;
- DELETE ;
- I $D(^DD(DIEVF,DIEVFLD,"DEL")) D
- . N DIEVECNT S DIEVECNT=$G(DIERR)
- . N I S I="" F S I=$O(^DD(DIEVF,DIEVFLD,"DEL",I)) Q:I="" X $G(^(I,0)) I S DIEVOUT=1
- . I DIEVECNT'=$G(DIERR) S DIEVOUT=1 D HKERR^DILIBF(DIEVF,$G(DIEVIEN),DIEVFLD,"DEL node")
- I DIEVP2["R" D
- . I DIEVFLD'=.01 S DIEVOUT=1 Q
- . I '$D(^DD(DIEVF,0,"UP")) Q
- . I $P($G(@$$ROOT^DILFD(DIEVF,DIEVIEN,1)@(0)),U,4)=1 S DIEVOUT=1
- I 'DIEVOUT,DIEVFLG'["U",DIEVFLD'=.01 D Q:DIEVOUT
- . N DIEVKEY
- . S DIEVKEY=0
- . F S DIEVKEY=$O(^DD("KEY","F",DIEVF,DIEVFLD,DIEVKEY)) Q:'DIEVKEY D
- . . Q:$D(^DD("KEY",DIEVKEY,0))[0
- . . D ERR742^DIEVK1(DIEVF,DIEVFLD,DIEVKEY,DIEVIEN)
- . . S DIEVOUT=1
- I 'DIEVOUT S DIEVANS="" S:DIEVFLG["E" DIEVANS(0)=""
- E D
- . N INT,EXT
- . S INT(1)=$$FLDNM^DIEFU(DIEVF,DIEVFLD),INT(2)=$$FILENM^DIEFU(DIEVF)
- . S EXT("FILE")=DIEVF,EXT("FIELD")=DIEVFLD
- . D BLD^DIALOG(712,.INT,.EXT)
- Q
- ;
- DATA(DIEVF,DIEVFLD) ;
- N DIEVNODE,DIEVSPOT,N S DIEVSPOT=" ",N=0
- D GLRF^DIOU(DIEVF,DIEVFLD,.DIEVNODE,.DIEVSPOT)
- I +DIEVSPOT D
- . I $P($G(@DIEVNODE),U,DIEVSPOT)'="" S N=1
- E I $E(DIEVSPOT)="E" D
- . N F,T
- . S F=$P($P(DIEVSPOT,"E",2),",",1),T=$P(DIEVSPOT,",",2)
- . I $TR($E($G(@DIEVNODE),F,T)," ")'="" S N=1
- Q N
- ;
- INT(%B1,%B2,DIEVFLG,X,DIEVANS,%B3,%B) ;
- N %A,%E,%C,DIR,DIC,Y,DIE,%J,%T,%BA,DP,DIFLD,DDH,%BU,%I,%K,DQ,DIFILE,C,DIEVECNT,DIRDINUM
- I $G(%B3)="" S %B3=^DD(%B1,%B2,0),%B=$P(%B3,U,2)
- I %B["V" D VP^DIEV1(%B1,%B2,DIEVFLG,X,%B3,.DIEVANS) Q
- I %B["N" D Q:$G(DIEVANS)=U
- . I $L($P(X,"."))>24 S DIEVANS=U Q
- I %B["S" S X=$$UP^DILIBF(X)
- S %A=%B1_","_%B2_",V",%E=0,DIR("V")="",%T=$E(%B1)
- S DIEVECNT=$G(DIERR)
- S:DIEVFLG["N" DIRDINUM=1 D 1^DIR1 ;input transform to 52,3 KILLs off "Y" variable!
- 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") K:$G(DIRDINUM) DINUM Q
- I %E S DIEVANS=U K:$G(DIRDINUM) DINUM Q
- S DIEVANS=$S(%B'["P":Y,1:$P(Y,U))
- I DIEVFLG["E" D
- . I %B["S"!(%B["D") S DIEVANS(0)=$P(Y(0),U)
- . E I %B["P" S DIEVANS(0)=Y(0,0)
- . E I %B["O" D
- . . S DIEVECNT=$G(DIERR)
- . . X $G(^DD(%B1,%B2,2))
- . . I DIEVECNT'=$G(DIERR) D HKERR^DILIBF(%B1,$G(DIEVIEN),%B2,"output transform") Q
- . . S DIEVANS(0)=Y
- . . Q
- . E S DIEVANS(0)=Y
- . Q
- Q
- ;
- KEY(DIEVF,DIEVIEN,DIEVFLD,DIEVFLG,DIEVAL,DIEVANS) ;checks Key integrity for a value
- N DIEVKEY,DIEVFDA S DIEVKEY=""
- S DIEVFDA(DIEVF,DIEVIEN,DIEVFLD)=DIEVAL
- I '$$KEYVAL^DIEVK($E("K",DIEVFLG["K"),"DIEVFDA") K DIEVANS S DIEVANS=U
- Q
- ;
- FDA ;
- I $G(DIEVFAR)="" D BLD^DIALOG(202,"FDA") Q
- D LOAD^DIEF1(DIEVF,DIEVIEN,DIEVFLD,"",DIEVANS,DIEVFAR)
- Q
- ;
- ERR ;
- N INT,EXT
- S INT(1)=$$FLDNM^DIEFU(DIEVF,DIEVFLD),INT(2)=$$FILENM^DIEFU(DIEVF),(INT(3),EXT(3))=DIEVAL
- S EXT("FILE")=DIEVF,EXT("FIELD")=DIEVFLD,EXT("IENS")=$G(DIEVIEN)
- D BLD^DIALOG(701,.INT,.EXT)
- I DIEVFLG["H" D GET^DIEH(DIEVF,"",DIEVFLD,"?b") ;DA() and D0,D1,etc. passed thru symbol table
- Q
- ;
- CHKX ;
- N DIEV0,DIEVP2 K DIEVANS
- I '$D(DIQUIET) N DIQUIET S DIQUIET=1
- I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
- S DIEVFLG=$G(DIEVFLG) I '$$VERFLG^DIEFU(DIEVFLG,"HEN") G OUT
- D FLDVAL I $G(DIEVAL)=U D OUT Q
- D MINVAL
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIEV 5986 printed Feb 19, 2025@00:13:36 Page 2
- DIEV ;SFISC/DPC-DATA VALIDATOR ;22SEP2009
- +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 ;
- VAL(DIEVF,DIEVIEN,DIEVFLD,DIEVFLG,DIEVAL,DIEVANS,DIEVFAR,DIOUTAR) ;
- VALX ;
- +1 NEW DIEV0,DIEVP2,DA,D,I,C,G
- KILL DIEVANS
- +2 IF '$DATA(DIQUIET)
- NEW DIQUIET
- SET DIQUIET=1
- +3 IF '$DATA(DIFM)
- NEW DIFM
- SET DIFM=1
- DO INIZE^DIEFU
- +4 SET DIEVFLG=$GET(DIEVFLG)
- IF '$$VERFLG^DIEFU(DIEVFLG,"HFERYUK")
- GOTO OUT
- +5 DO FLDVAL
- if $GET(DIEVAL)=U
- GOTO OUT
- IENS SET G=$GET(DIEVIEN)
- IF G]""
- if G'?.E1","
- SET G=G_","
- SET C=$LENGTH(G,",")-1
- FOR I=1:1:C
- SET D="D"_(C-I)
- NEW @D
- SET @D=$PIECE(G,",",I)
- IF @D=""
- DO BLD^DIALOG(308,$GET(DIEVIEN))
- GOTO OUT
- +1 SET DIEVIEN=G
- DO DA^DIEFU(G,.DA)
- +2 DO AUXVAL(DIEVF,DIEVIEN,DIEVFLD,DIEVFLG,DIEVAL,.DIEVANS,.DIEV0,.DIEVP2)
- +3 IF $GET(DIEVANS)=U!("@"[DIEVAL)
- GOTO OUT
- MINVAL ;
- +1 DO INT(DIEVF,DIEVFLD,DIEVFLG,DIEVAL,.DIEVANS,$GET(DIEV0),$GET(DIEVP2))
- +2 IF DIEVANS=U
- DO ERR
- GOTO OUT
- +3 IF DIEVFLG'["U"
- IF $GET(DIEVIEN)'?.","
- DO KEY(DIEVF,DIEVIEN,DIEVFLD,DIEVFLG,DIEVANS,.DIEVANS)
- OUT SET DIEVANS=$GET(DIEVANS,U)
- +1 IF DIEVFLG["F"
- IF DIEVANS'=U
- DO FDA
- +2 IF $GET(DIOUTAR)]""
- DO CALLOUT^DIEFU(DIOUTAR)
- +3 QUIT
- +4 ;
- FLDVAL ;
- +1 NEW DIEVOUT
- SET DIEVOUT=0
- +2 IF '$$VFILE^DIEFU(DIEVF,"D")
- SET DIEVAL=U
- QUIT
- +3 IF '$$VFIELD^DIEFU(DIEVF,DIEVFLD,"D")
- SET DIEVAL=U
- QUIT
- +4 SET DIEV0=^DD(DIEVF,DIEVFLD,0)
- SET DIEVP2=$PIECE(DIEV0,U,2)
- +5 DO DTYPE
- +6 IF DIEVOUT=1
- SET DIEVAL=U
- +7 QUIT
- +8 ;
- AUXVAL(DIEVF,DIEVIEN,DIEVFLD,DIEVFLG,DIEVAL,DIEVANS,DIEV0,DIEVP2) ;
- +1 NEW DIEVOUT
- SET DIEVOUT=0
- +2 IF '$DATA(DIOVRD)
- IF $PIECE($GET(^DD($$FNO^DILIBF(DIEVF),0,"DI")),U,2)="Y"
- IF DIEVFLG'["Y"
- Begin DoDot:1
- +3 NEW INT,EXT
- SET INT(1)=$$FILENM^DIEFU(DIEVF)
- SET EXT("FILE")=DIEVF
- +4 DO BLD^DIALOG(405,.INT,.EXT)
- End DoDot:1
- GOTO AUXERR
- +5 IF $PIECE(DIEV0,U,5,99)["DINUM"
- IF "@"'[DIEVAL
- Begin DoDot:1
- +6 NEW EXT,INT
- SET EXT("FILE")=DIEVF
- SET EXT("FIELD")=DIEVFLD
- SET (INT(1),EXT(1))="DINUMed"
- +7 DO BLD^DIALOG(520,.INT,.EXT)
- End DoDot:1
- GOTO AUXERR
- +8 IF $EXTRACT(DIEVAL)="?"!(DIEVP2["V"&(DIEVAL[".?"))
- NEW P
- SET P(1)=DIEVF
- SET P(2)=DIEVFLD
- DO BLD^DIALOG(1610,"",.P)
- GOTO AUXERR
- +9 IF DIEVFLG["R"
- if '$$VENTRY^DIEFU(DIEVF,DIEVIEN,"D9")
- GOTO AUXERR
- +10 IF DIEVP2["I"
- IF $$DATA(DIEVF,DIEVFLD)
- NEW P
- SET P("FIELD")=DIEVFLD
- SET P("FILE")=DIEVF
- DO BLD^DIALOG(710,.P,.P)
- GOTO AUXERR
- +11 IF "@"[DIEVAL
- DO DELETE
- if DIEVOUT
- GOTO AUXERR
- QUIT
- +12 IF DIEVFLG["I"
- Begin DoDot:1
- +13 SET DIEVANS=DIEVAL
- +14 IF DIEVFLG["E"
- SET DIEVANS(0)=$$EXTERNAL^DILFD(DIEVF,DIEVFLD,"",DIEVAL)
- End DoDot:1
- +15 QUIT
- AUXERR SET DIEVANS=U
- +1 QUIT
- +2 ;
- DTYPE ;
- +1 IF DIEVP2
- Begin DoDot:1
- +2 NEW T,INT,EXT
- DO DTYP^DIOU(DIEVF,DIEVFLD,.T)
- +3 IF T=5
- SET INT(1)="word-processing"
- SET EXT("FIELD")=DIEVFLD
- SET EXT("FILE")=DIEVF
- DO BLD^DIALOG(520,.INT,.EXT)
- QUIT
- +4 SET INT(1)="multi-valued"
- SET EXT("FIELD")=DIEVFLD
- SET EXT("FILE")=DIEVF
- DO BLD^DIALOG(520,.INT,.EXT)
- End DoDot:1
- SET DIEVOUT=1
- QUIT
- +5 IF DIEVP2["C"
- NEW INT,EXT
- SET INT(1)="computed"
- SET EXT("FIELD")=DIEVFLD
- SET EXT("FILE")=DIEVF
- DO BLD^DIALOG(520,.INT,.EXT)
- SET DIEVOUT=1
- QUIT
- +6 QUIT
- +7 ;
- DELETE ;
- +1 IF $DATA(^DD(DIEVF,DIEVFLD,"DEL"))
- Begin DoDot:1
- +2 NEW DIEVECNT
- SET DIEVECNT=$GET(DIERR)
- +3 NEW I
- SET I=""
- FOR
- SET I=$ORDER(^DD(DIEVF,DIEVFLD,"DEL",I))
- if I=""
- QUIT
- XECUTE $GET(^(I,0))
- IF $TEST
- SET DIEVOUT=1
- +4 IF DIEVECNT'=$GET(DIERR)
- SET DIEVOUT=1
- DO HKERR^DILIBF(DIEVF,$GET(DIEVIEN),DIEVFLD,"DEL node")
- End DoDot:1
- +5 IF DIEVP2["R"
- Begin DoDot:1
- +6 IF DIEVFLD'=.01
- SET DIEVOUT=1
- QUIT
- +7 IF '$DATA(^DD(DIEVF,0,"UP"))
- QUIT
- +8 IF $PIECE($GET(@$$ROOT^DILFD(DIEVF,DIEVIEN,1)@(0)),U,4)=1
- SET DIEVOUT=1
- End DoDot:1
- +9 IF 'DIEVOUT
- IF DIEVFLG'["U"
- IF DIEVFLD'=.01
- Begin DoDot:1
- +10 NEW DIEVKEY
- +11 SET DIEVKEY=0
- +12 FOR
- SET DIEVKEY=$ORDER(^DD("KEY","F",DIEVF,DIEVFLD,DIEVKEY))
- if 'DIEVKEY
- QUIT
- Begin DoDot:2
- +13 if $DATA(^DD("KEY",DIEVKEY,0))[0
- QUIT
- +14 DO ERR742^DIEVK1(DIEVF,DIEVFLD,DIEVKEY,DIEVIEN)
- +15 SET DIEVOUT=1
- End DoDot:2
- End DoDot:1
- if DIEVOUT
- QUIT
- +16 IF 'DIEVOUT
- SET DIEVANS=""
- if DIEVFLG["E"
- SET DIEVANS(0)=""
- +17 IF '$TEST
- Begin DoDot:1
- +18 NEW INT,EXT
- +19 SET INT(1)=$$FLDNM^DIEFU(DIEVF,DIEVFLD)
- SET INT(2)=$$FILENM^DIEFU(DIEVF)
- +20 SET EXT("FILE")=DIEVF
- SET EXT("FIELD")=DIEVFLD
- +21 DO BLD^DIALOG(712,.INT,.EXT)
- End DoDot:1
- +22 QUIT
- +23 ;
- DATA(DIEVF,DIEVFLD) ;
- +1 NEW DIEVNODE,DIEVSPOT,N
- SET DIEVSPOT=" "
- SET N=0
- +2 DO GLRF^DIOU(DIEVF,DIEVFLD,.DIEVNODE,.DIEVSPOT)
- +3 IF +DIEVSPOT
- Begin DoDot:1
- +4 IF $PIECE($GET(@DIEVNODE),U,DIEVSPOT)'=""
- SET N=1
- End DoDot:1
- +5 IF '$TEST
- IF $EXTRACT(DIEVSPOT)="E"
- Begin DoDot:1
- +6 NEW F,T
- +7 SET F=$PIECE($PIECE(DIEVSPOT,"E",2),",",1)
- SET T=$PIECE(DIEVSPOT,",",2)
- +8 IF $TRANSLATE($EXTRACT($GET(@DIEVNODE),F,T)," ")'=""
- SET N=1
- End DoDot:1
- +9 QUIT N
- +10 ;
- INT(%B1,%B2,DIEVFLG,X,DIEVANS,%B3,%B) ;
- +1 NEW %A,%E,%C,DIR,DIC,Y,DIE,%J,%T,%BA,DP,DIFLD,DDH,%BU,%I,%K,DQ,DIFILE,C,DIEVECNT,DIRDINUM
- +2 IF $GET(%B3)=""
- SET %B3=^DD(%B1,%B2,0)
- SET %B=$PIECE(%B3,U,2)
- +3 IF %B["V"
- DO VP^DIEV1(%B1,%B2,DIEVFLG,X,%B3,.DIEVANS)
- QUIT
- +4 IF %B["N"
- Begin DoDot:1
- +5 IF $LENGTH($PIECE(X,"."))>24
- SET DIEVANS=U
- QUIT
- End DoDot:1
- if $GET(DIEVANS)=U
- QUIT
- +6 IF %B["S"
- SET X=$$UP^DILIBF(X)
- +7 SET %A=%B1_","_%B2_",V"
- SET %E=0
- SET DIR("V")=""
- SET %T=$EXTRACT(%B1)
- +8 SET DIEVECNT=$GET(DIERR)
- +9 ;input transform to 52,3 KILLs off "Y" variable!
- if DIEVFLG["N"
- SET DIRDINUM=1
- DO 1^DIR1
- +10 IF DIEVECNT'=$GET(DIERR)
- SET DIEVANS=U
- DO HKERR^DILIBF(%B1,$GET(DIEVIEN),%B2,"screen on a pointer or set of codes or in an input transform")
- if $GET(DIRDINUM)
- KILL DINUM
- QUIT
- +11 IF %E
- SET DIEVANS=U
- if $GET(DIRDINUM)
- KILL DINUM
- QUIT
- +12 SET DIEVANS=$SELECT(%B'["P":Y,1:$PIECE(Y,U))
- +13 IF DIEVFLG["E"
- Begin DoDot:1
- +14 IF %B["S"!(%B["D")
- SET DIEVANS(0)=$PIECE(Y(0),U)
- +15 IF '$TEST
- IF %B["P"
- SET DIEVANS(0)=Y(0,0)
- +16 IF '$TEST
- IF %B["O"
- Begin DoDot:2
- +17 SET DIEVECNT=$GET(DIERR)
- +18 XECUTE $GET(^DD(%B1,%B2,2))
- +19 IF DIEVECNT'=$GET(DIERR)
- DO HKERR^DILIBF(%B1,$GET(DIEVIEN),%B2,"output transform")
- QUIT
- +20 SET DIEVANS(0)=Y
- +21 QUIT
- End DoDot:2
- +22 IF '$TEST
- SET DIEVANS(0)=Y
- +23 QUIT
- End DoDot:1
- +24 QUIT
- +25 ;
- KEY(DIEVF,DIEVIEN,DIEVFLD,DIEVFLG,DIEVAL,DIEVANS) ;checks Key integrity for a value
- +1 NEW DIEVKEY,DIEVFDA
- SET DIEVKEY=""
- +2 SET DIEVFDA(DIEVF,DIEVIEN,DIEVFLD)=DIEVAL
- +3 IF '$$KEYVAL^DIEVK($EXTRACT("K",DIEVFLG["K"),"DIEVFDA")
- KILL DIEVANS
- SET DIEVANS=U
- +4 QUIT
- +5 ;
- FDA ;
- +1 IF $GET(DIEVFAR)=""
- DO BLD^DIALOG(202,"FDA")
- QUIT
- +2 DO LOAD^DIEF1(DIEVF,DIEVIEN,DIEVFLD,"",DIEVANS,DIEVFAR)
- +3 QUIT
- +4 ;
- ERR ;
- +1 NEW INT,EXT
- +2 SET INT(1)=$$FLDNM^DIEFU(DIEVF,DIEVFLD)
- SET INT(2)=$$FILENM^DIEFU(DIEVF)
- SET (INT(3),EXT(3))=DIEVAL
- +3 SET EXT("FILE")=DIEVF
- SET EXT("FIELD")=DIEVFLD
- SET EXT("IENS")=$GET(DIEVIEN)
- +4 DO BLD^DIALOG(701,.INT,.EXT)
- +5 ;DA() and D0,D1,etc. passed thru symbol table
- IF DIEVFLG["H"
- DO GET^DIEH(DIEVF,"",DIEVFLD,"?b")
- +6 QUIT
- +7 ;
- CHKX ;
- +1 NEW DIEV0,DIEVP2
- KILL DIEVANS
- +2 IF '$DATA(DIQUIET)
- NEW DIQUIET
- SET DIQUIET=1
- +3 IF '$DATA(DIFM)
- NEW DIFM
- SET DIFM=1
- DO INIZE^DIEFU
- +4 SET DIEVFLG=$GET(DIEVFLG)
- IF '$$VERFLG^DIEFU(DIEVFLG,"HEN")
- GOTO OUT
- +5 DO FLDVAL
- IF $GET(DIEVAL)=U
- DO OUT
- QUIT
- +6 DO MINVAL
- +7 QUIT