- DIEF1 ;SFISC/DPC-FILER UTILITIES ;22MAR2006
- ;;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.
- ;
- LOAD(DIEFF,DIEFDAS,DIEFFLD,DIEFFLG,DIEFVAL,DIEFAR,DIEFOUT) ;
- LOADX ;
- N DIEFIEN
- I '$D(DIQUIET) N DIQUIET S DIQUIET=1
- I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
- I $G(DIEFDAS)']"" D BLD^DIALOG(202,"IENS","IENS") G OUT
- I $E(DIEFDAS,$L(DIEFDAS))="," S DIEFIEN=DIEFDAS
- E S DIEFIEN=$$IEN^DIEFU(.DIEFDAS)
- I '$$VROOT^DIEFU(DIEFAR) G OUT
- I '$$VFILE^DIEFU(DIEFF,"D") G OUT
- S DIEFFLD=$$CHKFLD^DIEFU(DIEFF,DIEFFLD) G:'DIEFFLD OUT
- I $G(DIEFFLG)["R",'$$VENTRY^DIEFU(DIEFF,DIEFIEN,"D") G OUT
- S @DIEFAR@(DIEFF,DIEFIEN,DIEFFLD)=DIEFVAL
- OUT I $G(DIEFOUT)]"" D CALLOUT^DIEFU(DIEFOUT)
- Q
- ;
- FLDNUM(DIEFF,DIEFFDNM) ;
- FLDNUMX ;
- I '$D(DIQUIET) N DIQUIET S DIQUIET=1
- I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
- I '$$VFILE^DIEFU(DIEFF,"D") Q 0
- N DIEFFNUM
- I $D(^DD(DIEFF,"B",DIEFFDNM)) D Q DIEFFNUM
- . S DIEFFNUM=$O(^DD(DIEFF,"B",DIEFFDNM,""))
- . I $O(^DD(DIEFF,"B",DIEFFDNM,DIEFFNUM)) N P S P(1)=DIEFFDNM,P("FILE")=DIEFF D BLD^DIALOG(505,.P,.P) S DIEFFNUM=0
- N P S P("FILE")=DIEFF,P(1)=DIEFFDNM D BLD^DIALOG(501,.P,.P)
- Q 0
- ;
- ADDCONV(DIEFIEN,DIEFADAR) ;
- N I,DIEFNIEN,P
- F I=1:1:$L(DIEFIEN,",")-1 D
- . S P=$P(DIEFIEN,",",I)
- . I P,$E(P)'="+" Q
- . S DIEFNIEN=@DIEFADAR@($TR(P,"+?"))
- . S $P(DIEFIEN,",",I)=DIEFNIEN
- Q DIEFIEN
- ;
- PUTDATA ;CODE TO ACTUALLY PUT THE DATA INTO THE NODE BEING EDITED. ALSO SAVES ORIGINAL VALUES. CALLED FROM DIEF.
- I +DIEFSPOT D
- . I DIEFNVAL[U D Q
- . . S DIEFNG=1
- . . N INT,EXT
- . . S INT(1)=$$FLDNM^DIEFU(DIEFF,DIEFFLD),INT(2)=$$FILENM^DIEFU(DIEFF),EXT("FILE")=DIEFF,EXT("FIELD")=DIEFFLD
- . . D BLD^DIALOG(714,.INT,.EXT)
- . S DIEFOVAL=$P(DIEFFVAL,"^",DIEFSPOT)
- . S $P(DIEFFVAL,"^",DIEFSPOT)=DIEFNVAL,DOREPL=1
- E I $E(DIEFSPOT)="E" D
- . N FR,TO,OLEN,NLEN
- . S FR=$P($P(DIEFSPOT,"E",2),",",1),TO=$P(DIEFSPOT,",",2)
- . S NLEN=$L(DIEFNVAL)
- . I NLEN-1>(TO-FR) D Q
- . . S DIEFNG=1
- . . N INT,EXT
- . . S INT(1)=$$FLDNM^DIEFU(DIEFF,DIEFFLD),INT(2)=$$FILENM^DIEFU(DIEFF),EXT("FILE")=DIEFF,EXT("FIELD")=DIEFFLD
- . . D BLD^DIALOG(716,.INT,.EXT)
- . S DIEFOVAL=$E(DIEFFVAL,FR,TO),OLEN=$L(DIEFOVAL)
- . I $E(DIEFFVAL,TO+1,999)="" S $E(DIEFFVAL,FR,TO)=DIEFNVAL
- . E S $E(DIEFFVAL,FR,TO)=DIEFNVAL_$J("",$S(OLEN>NLEN:OLEN-NLEN,1:0))
- . S DOREPL=1
- E I DIEFSPOT=0 D
- . I $P($G(^DD(+$P(^DD(DIEFF,DIEFFLD,0),U,2),.01,0)),U,2)["W" D
- . . I '$$VROOT^DIEFU(DIEFNVAL) Q
- . . D PUTWP^DIEFW(DIEFFLAG,DIEFNVAL,DIEFNODE)
- . E D
- . . N INT,EXT
- . . S (INT(1),EXT(1))="MULTIPLE",EXT("FILE")=DIEFF,EXT("FIELD")=DIEFFLD
- . . D BLD^DIALOG(520,.INT,.EXT)
- . . S DIEFNG=1
- E I DIEFSPOT=" " D
- . N INT,EXT
- . S (INT(1),EXT(1))="COMPUTED",EXT("FILE")=DIEFF,EXT("FIELD")=DIEFFLD
- . D BLD^DIALOG(520,.INT,.EXT)
- . S DIEFNG=1
- Q
- ;
- LOCK ;
- S (DIEFNOLK,DIEFLCKS)=0,DIEFF=""
- F S DIEFF=$O(@DIEFAR@(DIEFF)) Q:DIEFF="" D Q:DIEFNOLK
- . I '$$VFILE^DIEFU(DIEFF,"D") S DIEFNOLK=1 Q
- . S DIEFFREF=$$FROOTDA^DIKCU(DIEFF,"D",.DIEFLEV) Q:DIEFFREF=""
- . S DIEFDAS=""
- . F S DIEFDAS=$O(@DIEFAR@(DIEFF,DIEFDAS)) Q:DIEFDAS="" D Q:DIEFNOLK
- . . N DA
- . . I '$$GOODIEN^DIEF(DIEFF,DIEFDAS,DIEFLEV,.DA,"D") S DIEFNOLK=1 Q
- . . S DIEFLCKS=DIEFLCKS+1
- . . S DIEFLOCK(DIEFLCKS)=$NA(@DIEFFREF@(DA))
- . . D LOCK^DILF(DIEFLOCK(DIEFLCKS)) E D ;**147
- . . . S DIEFNOLK=1
- . . . N E S E("FILE")=DIEFF,E("IENS")=DIEFDAS D BLD^DIALOG(110,"",.E)
- Q
- UNLOCK ;
- N I
- F I=1:1:DIEFLCKS L -@DIEFLOCK(I)
- Q
- ;
- RESTORE(DIKEY,DIEFTMP) ;Restore key fields to pre-edited values
- ;DIKEY(rFile#,key#,iens) = "" : if key is not unique
- ; = n : if key fields not assigned a value
- ;DIKEY(rFile#,key#,iens,file,field) = levdiff : set if field not
- ; assigned a value
- N DIEFDA,DIEKK,DIRFIL,DIFIL,DIFLD,DIFLDI,DIIENS,DIIENSA,DIOLD,DILEVD
- K DIEFDA
- ;
- ;Loop through root files and keys in DIKEY
- S DIRFIL=0 F S DIRFIL=$O(DIKEY(DIRFIL)) Q:'DIRFIL D
- . S DIEKK=0 F S DIEKK=$O(DIKEY(DIRFIL,DIEKK)) Q:'DIEKK D
- .. Q:$D(^DD("KEY",DIEKK,0))[0
- .. ;
- .. ;Get fields in key
- .. K DIFLD
- .. S DIFLDI=0 F S DIFLDI=$O(^DD("KEY",DIEKK,2,DIFLDI)) Q:'DIFLDI D
- ... S DIFLD=$P($G(^DD("KEY",DIEKK,2,DIFLDI,0)),U),DIFIL=$P($G(^(0)),U,2)
- ... Q:'DIFLD!'DIFIL
- ... S DIFLD(DIFIL,DIFLD)=""
- .. ;
- .. ;Loop through records in DIKEY
- .. S DIIENS=" " S DIIENS=$O(DIKEY(DIRFIL,DIEKK,DIIENS)) Q:DIIENS="" D
- ... ;
- ... ;Generate error if key is not unique
- ... D:DIKEY(DIRFIL,DIEKK,DIIENS)="" ERR740^DIEVK1(DIRFIL,DIEKK,DIIENS)
- ... ;
- ... ;Loop through files/fields in key
- ... S DIFIL=0 F S DIFIL=$O(DIFLD(DIFIL)) Q:'DIFIL D
- .... S DIFLD=0 F S DIFLD=$O(DIFLD(DIFIL,DIFLD)) Q:'DIFLD D
- ..... Q:$D(^DD(DIFIL,DIFLD,0))[0
- ..... ;
- ..... ;Generate error if key field not assigned a value
- ..... I $D(DIKEY(DIRFIL,DIEKK,DIIENS,DIFIL,DIFLD))#2 D
- ...... S (DILEVD,DIFLD(DIFIL,DIFLD))=+DIKEY(DIRFIL,DIEKK,DIIENS,DIFIL,DIFLD)
- ...... D ERR744^DIEVK1(DIFIL,DIFLD,DIEKK,$P(DIIENS,",",DILEVD+1,999))
- ..... ;
- ..... ;Set the FDA to restore the field to original value
- ..... S DILEVD=DIFLD(DIFIL,DIFLD)
- ..... S:DILEVD="" (DILEVD,DIFLD(DIFIL,DIFLD))=$$FLEVDIFF^DIKCU(DIRFIL,DIFIL)
- ..... S DIIENSA=$P(DIIENS,",",DILEVD+1,999)
- ..... Q:$D(@DIEFTMP@("V",DIFIL,DIIENSA,DIFLD,"O"))[0 S DIOLD=^("O")
- ..... S DIEFDA(DIFIL,DIIENS,DIFLD)=DIOLD
- ;
- D:$D(DIEFDA) FILE^DIEF("U","DIEFDA")
- Q
- ;
- SKEYCHK(DIEFF,DIEFFLD,DIEFNVAL,DA,DIEFIEN,DIEFFXR) ;Check simple key
- N DIEFKEY,DIEFK,DIEFKCHK
- Q:'$D(^DD("KEY","F",DIEFF,DIEFFLD)) 1
- I DIEFNVAL="" D NKEY(DIEFF,DIEFFLD,DIEFIEN) Q 0
- Q:'$D(DIEFFXR) 1
- S @DIEFTMP@("V",DIEFF,DIEFIEN,DIEFFLD,"N")=DIEFNVAL
- S DIEFKCHK=$$KEYCHK^DIKK2(DIEFF,.DA,DIEFFLD,"DIEFFXR",DIEFIEN,"DIEFKEY","N")
- K @DIEFTMP@("V",DIEFF,DIEFIEN,DIEFFLD,"N")
- Q:DIEFKCHK 1
- S DIEFK=0 F S DIEFK=$O(DIEFKEY(DIEFF,DIEFIEN,"K",DIEFK)) Q:'DIEFK D ERR740^DIEVK1(DIEFF,DIEFK,DIEFIEN)
- Q 0
- ;
- NKEY(DIEFF,DIEFFLD,DIEFIEN) ;Generate error message #742
- N DIEFK
- S DIEFK=0 F S DIEFK=$O(^DD("KEY","F",DIEFF,DIEFFLD,DIEFK)) Q:'DIEFK D
- . S DIEFK(DIEFK)=""
- S DIEFK=0 F S DIEFK=$O(DIEFK(DIEFK)) Q:'DIEFK D ERR742^DIEVK1(DIEFF,DIEFFLD,DIEFK,DIEFIEN)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIEF1 6455 printed Feb 19, 2025@00:13:22 Page 2
- DIEF1 ;SFISC/DPC-FILER UTILITIES ;22MAR2006
- +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 ;
- LOAD(DIEFF,DIEFDAS,DIEFFLD,DIEFFLG,DIEFVAL,DIEFAR,DIEFOUT) ;
- LOADX ;
- +1 NEW DIEFIEN
- +2 IF '$DATA(DIQUIET)
- NEW DIQUIET
- SET DIQUIET=1
- +3 IF '$DATA(DIFM)
- NEW DIFM
- SET DIFM=1
- DO INIZE^DIEFU
- +4 IF $GET(DIEFDAS)']""
- DO BLD^DIALOG(202,"IENS","IENS")
- GOTO OUT
- +5 IF $EXTRACT(DIEFDAS,$LENGTH(DIEFDAS))=","
- SET DIEFIEN=DIEFDAS
- +6 IF '$TEST
- SET DIEFIEN=$$IEN^DIEFU(.DIEFDAS)
- +7 IF '$$VROOT^DIEFU(DIEFAR)
- GOTO OUT
- +8 IF '$$VFILE^DIEFU(DIEFF,"D")
- GOTO OUT
- +9 SET DIEFFLD=$$CHKFLD^DIEFU(DIEFF,DIEFFLD)
- if 'DIEFFLD
- GOTO OUT
- +10 IF $GET(DIEFFLG)["R"
- IF '$$VENTRY^DIEFU(DIEFF,DIEFIEN,"D")
- GOTO OUT
- +11 SET @DIEFAR@(DIEFF,DIEFIEN,DIEFFLD)=DIEFVAL
- OUT IF $GET(DIEFOUT)]""
- DO CALLOUT^DIEFU(DIEFOUT)
- +1 QUIT
- +2 ;
- FLDNUM(DIEFF,DIEFFDNM) ;
- FLDNUMX ;
- +1 IF '$DATA(DIQUIET)
- NEW DIQUIET
- SET DIQUIET=1
- +2 IF '$DATA(DIFM)
- NEW DIFM
- SET DIFM=1
- DO INIZE^DIEFU
- +3 IF '$$VFILE^DIEFU(DIEFF,"D")
- QUIT 0
- +4 NEW DIEFFNUM
- +5 IF $DATA(^DD(DIEFF,"B",DIEFFDNM))
- Begin DoDot:1
- +6 SET DIEFFNUM=$ORDER(^DD(DIEFF,"B",DIEFFDNM,""))
- +7 IF $ORDER(^DD(DIEFF,"B",DIEFFDNM,DIEFFNUM))
- NEW P
- SET P(1)=DIEFFDNM
- SET P("FILE")=DIEFF
- DO BLD^DIALOG(505,.P,.P)
- SET DIEFFNUM=0
- End DoDot:1
- QUIT DIEFFNUM
- +8 NEW P
- SET P("FILE")=DIEFF
- SET P(1)=DIEFFDNM
- DO BLD^DIALOG(501,.P,.P)
- +9 QUIT 0
- +10 ;
- ADDCONV(DIEFIEN,DIEFADAR) ;
- +1 NEW I,DIEFNIEN,P
- +2 FOR I=1:1:$LENGTH(DIEFIEN,",")-1
- Begin DoDot:1
- +3 SET P=$PIECE(DIEFIEN,",",I)
- +4 IF P
- IF $EXTRACT(P)'="+"
- QUIT
- +5 SET DIEFNIEN=@DIEFADAR@($TRANSLATE(P,"+?"))
- +6 SET $PIECE(DIEFIEN,",",I)=DIEFNIEN
- End DoDot:1
- +7 QUIT DIEFIEN
- +8 ;
- PUTDATA ;CODE TO ACTUALLY PUT THE DATA INTO THE NODE BEING EDITED. ALSO SAVES ORIGINAL VALUES. CALLED FROM DIEF.
- +1 IF +DIEFSPOT
- Begin DoDot:1
- +2 IF DIEFNVAL[U
- Begin DoDot:2
- +3 SET DIEFNG=1
- +4 NEW INT,EXT
- +5 SET INT(1)=$$FLDNM^DIEFU(DIEFF,DIEFFLD)
- SET INT(2)=$$FILENM^DIEFU(DIEFF)
- SET EXT("FILE")=DIEFF
- SET EXT("FIELD")=DIEFFLD
- +6 DO BLD^DIALOG(714,.INT,.EXT)
- End DoDot:2
- QUIT
- +7 SET DIEFOVAL=$PIECE(DIEFFVAL,"^",DIEFSPOT)
- +8 SET $PIECE(DIEFFVAL,"^",DIEFSPOT)=DIEFNVAL
- SET DOREPL=1
- End DoDot:1
- +9 IF '$TEST
- IF $EXTRACT(DIEFSPOT)="E"
- Begin DoDot:1
- +10 NEW FR,TO,OLEN,NLEN
- +11 SET FR=$PIECE($PIECE(DIEFSPOT,"E",2),",",1)
- SET TO=$PIECE(DIEFSPOT,",",2)
- +12 SET NLEN=$LENGTH(DIEFNVAL)
- +13 IF NLEN-1>(TO-FR)
- Begin DoDot:2
- +14 SET DIEFNG=1
- +15 NEW INT,EXT
- +16 SET INT(1)=$$FLDNM^DIEFU(DIEFF,DIEFFLD)
- SET INT(2)=$$FILENM^DIEFU(DIEFF)
- SET EXT("FILE")=DIEFF
- SET EXT("FIELD")=DIEFFLD
- +17 DO BLD^DIALOG(716,.INT,.EXT)
- End DoDot:2
- QUIT
- +18 SET DIEFOVAL=$EXTRACT(DIEFFVAL,FR,TO)
- SET OLEN=$LENGTH(DIEFOVAL)
- +19 IF $EXTRACT(DIEFFVAL,TO+1,999)=""
- SET $EXTRACT(DIEFFVAL,FR,TO)=DIEFNVAL
- +20 IF '$TEST
- SET $EXTRACT(DIEFFVAL,FR,TO)=DIEFNVAL_$JUSTIFY("",$SELECT(OLEN>NLEN:OLEN-NLEN,1:0))
- +21 SET DOREPL=1
- End DoDot:1
- +22 IF '$TEST
- IF DIEFSPOT=0
- Begin DoDot:1
- +23 IF $PIECE($GET(^DD(+$PIECE(^DD(DIEFF,DIEFFLD,0),U,2),.01,0)),U,2)["W"
- Begin DoDot:2
- +24 IF '$$VROOT^DIEFU(DIEFNVAL)
- QUIT
- +25 DO PUTWP^DIEFW(DIEFFLAG,DIEFNVAL,DIEFNODE)
- End DoDot:2
- +26 IF '$TEST
- Begin DoDot:2
- +27 NEW INT,EXT
- +28 SET (INT(1),EXT(1))="MULTIPLE"
- SET EXT("FILE")=DIEFF
- SET EXT("FIELD")=DIEFFLD
- +29 DO BLD^DIALOG(520,.INT,.EXT)
- +30 SET DIEFNG=1
- End DoDot:2
- End DoDot:1
- +31 IF '$TEST
- IF DIEFSPOT=" "
- Begin DoDot:1
- +32 NEW INT,EXT
- +33 SET (INT(1),EXT(1))="COMPUTED"
- SET EXT("FILE")=DIEFF
- SET EXT("FIELD")=DIEFFLD
- +34 DO BLD^DIALOG(520,.INT,.EXT)
- +35 SET DIEFNG=1
- End DoDot:1
- +36 QUIT
- +37 ;
- LOCK ;
- +1 SET (DIEFNOLK,DIEFLCKS)=0
- SET DIEFF=""
- +2 FOR
- SET DIEFF=$ORDER(@DIEFAR@(DIEFF))
- if DIEFF=""
- QUIT
- Begin DoDot:1
- +3 IF '$$VFILE^DIEFU(DIEFF,"D")
- SET DIEFNOLK=1
- QUIT
- +4 SET DIEFFREF=$$FROOTDA^DIKCU(DIEFF,"D",.DIEFLEV)
- if DIEFFREF=""
- QUIT
- +5 SET DIEFDAS=""
- +6 FOR
- SET DIEFDAS=$ORDER(@DIEFAR@(DIEFF,DIEFDAS))
- if DIEFDAS=""
- QUIT
- Begin DoDot:2
- +7 NEW DA
- +8 IF '$$GOODIEN^DIEF(DIEFF,DIEFDAS,DIEFLEV,.DA,"D")
- SET DIEFNOLK=1
- QUIT
- +9 SET DIEFLCKS=DIEFLCKS+1
- +10 SET DIEFLOCK(DIEFLCKS)=$NAME(@DIEFFREF@(DA))
- +11 ;**147
- DO LOCK^DILF(DIEFLOCK(DIEFLCKS))
- IF '$TEST
- Begin DoDot:3
- +12 SET DIEFNOLK=1
- +13 NEW E
- SET E("FILE")=DIEFF
- SET E("IENS")=DIEFDAS
- DO BLD^DIALOG(110,"",.E)
- End DoDot:3
- End DoDot:2
- if DIEFNOLK
- QUIT
- End DoDot:1
- if DIEFNOLK
- QUIT
- +14 QUIT
- UNLOCK ;
- +1 NEW I
- +2 FOR I=1:1:DIEFLCKS
- LOCK -@DIEFLOCK(I)
- +3 QUIT
- +4 ;
- RESTORE(DIKEY,DIEFTMP) ;Restore key fields to pre-edited values
- +1 ;DIKEY(rFile#,key#,iens) = "" : if key is not unique
- +2 ; = n : if key fields not assigned a value
- +3 ;DIKEY(rFile#,key#,iens,file,field) = levdiff : set if field not
- +4 ; assigned a value
- +5 NEW DIEFDA,DIEKK,DIRFIL,DIFIL,DIFLD,DIFLDI,DIIENS,DIIENSA,DIOLD,DILEVD
- +6 KILL DIEFDA
- +7 ;
- +8 ;Loop through root files and keys in DIKEY
- +9 SET DIRFIL=0
- FOR
- SET DIRFIL=$ORDER(DIKEY(DIRFIL))
- if 'DIRFIL
- QUIT
- Begin DoDot:1
- +10 SET DIEKK=0
- FOR
- SET DIEKK=$ORDER(DIKEY(DIRFIL,DIEKK))
- if 'DIEKK
- QUIT
- Begin DoDot:2
- +11 if $DATA(^DD("KEY",DIEKK,0))[0
- QUIT
- +12 ;
- +13 ;Get fields in key
- +14 KILL DIFLD
- +15 SET DIFLDI=0
- FOR
- SET DIFLDI=$ORDER(^DD("KEY",DIEKK,2,DIFLDI))
- if 'DIFLDI
- QUIT
- Begin DoDot:3
- +16 SET DIFLD=$PIECE($GET(^DD("KEY",DIEKK,2,DIFLDI,0)),U)
- SET DIFIL=$PIECE($GET(^(0)),U,2)
- +17 if 'DIFLD!'DIFIL
- QUIT
- +18 SET DIFLD(DIFIL,DIFLD)=""
- End DoDot:3
- +19 ;
- +20 ;Loop through records in DIKEY
- +21 SET DIIENS=" "
- SET DIIENS=$ORDER(DIKEY(DIRFIL,DIEKK,DIIENS))
- if DIIENS=""
- QUIT
- Begin DoDot:3
- +22 ;
- +23 ;Generate error if key is not unique
- +24 if DIKEY(DIRFIL,DIEKK,DIIENS)=""
- DO ERR740^DIEVK1(DIRFIL,DIEKK,DIIENS)
- +25 ;
- +26 ;Loop through files/fields in key
- +27 SET DIFIL=0
- FOR
- SET DIFIL=$ORDER(DIFLD(DIFIL))
- if 'DIFIL
- QUIT
- Begin DoDot:4
- +28 SET DIFLD=0
- FOR
- SET DIFLD=$ORDER(DIFLD(DIFIL,DIFLD))
- if 'DIFLD
- QUIT
- Begin DoDot:5
- +29 if $DATA(^DD(DIFIL,DIFLD,0))[0
- QUIT
- +30 ;
- +31 ;Generate error if key field not assigned a value
- +32 IF $DATA(DIKEY(DIRFIL,DIEKK,DIIENS,DIFIL,DIFLD))#2
- Begin DoDot:6
- +33 SET (DILEVD,DIFLD(DIFIL,DIFLD))=+DIKEY(DIRFIL,DIEKK,DIIENS,DIFIL,DIFLD)
- +34 DO ERR744^DIEVK1(DIFIL,DIFLD,DIEKK,$PIECE(DIIENS,",",DILEVD+1,999))
- End DoDot:6
- +35 ;
- +36 ;Set the FDA to restore the field to original value
- +37 SET DILEVD=DIFLD(DIFIL,DIFLD)
- +38 if DILEVD=""
- SET (DILEVD,DIFLD(DIFIL,DIFLD))=$$FLEVDIFF^DIKCU(DIRFIL,DIFIL)
- +39 SET DIIENSA=$PIECE(DIIENS,",",DILEVD+1,999)
- +40 if $DATA(@DIEFTMP@("V",DIFIL,DIIENSA,DIFLD,"O"))[0
- QUIT
- SET DIOLD=^("O")
- +41 SET DIEFDA(DIFIL,DIIENS,DIFLD)=DIOLD
- End DoDot:5
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +42 ;
- +43 if $DATA(DIEFDA)
- DO FILE^DIEF("U","DIEFDA")
- +44 QUIT
- +45 ;
- SKEYCHK(DIEFF,DIEFFLD,DIEFNVAL,DA,DIEFIEN,DIEFFXR) ;Check simple key
- +1 NEW DIEFKEY,DIEFK,DIEFKCHK
- +2 if '$DATA(^DD("KEY","F",DIEFF,DIEFFLD))
- QUIT 1
- +3 IF DIEFNVAL=""
- DO NKEY(DIEFF,DIEFFLD,DIEFIEN)
- QUIT 0
- +4 if '$DATA(DIEFFXR)
- QUIT 1
- +5 SET @DIEFTMP@("V",DIEFF,DIEFIEN,DIEFFLD,"N")=DIEFNVAL
- +6 SET DIEFKCHK=$$KEYCHK^DIKK2(DIEFF,.DA,DIEFFLD,"DIEFFXR",DIEFIEN,"DIEFKEY","N")
- +7 KILL @DIEFTMP@("V",DIEFF,DIEFIEN,DIEFFLD,"N")
- +8 if DIEFKCHK
- QUIT 1
- +9 SET DIEFK=0
- FOR
- SET DIEFK=$ORDER(DIEFKEY(DIEFF,DIEFIEN,"K",DIEFK))
- if 'DIEFK
- QUIT
- DO ERR740^DIEVK1(DIEFF,DIEFK,DIEFIEN)
- +10 QUIT 0
- +11 ;
- NKEY(DIEFF,DIEFFLD,DIEFIEN) ;Generate error message #742
- +1 NEW DIEFK
- +2 SET DIEFK=0
- FOR
- SET DIEFK=$ORDER(^DD("KEY","F",DIEFF,DIEFFLD,DIEFK))
- if 'DIEFK
- QUIT
- Begin DoDot:1
- +3 SET DIEFK(DIEFK)=""
- End DoDot:1
- +4 SET DIEFK=0
- FOR
- SET DIEFK=$ORDER(DIEFK(DIEFK))
- if 'DIEFK
- QUIT
- DO ERR742^DIEVK1(DIEFF,DIEFFLD,DIEFK,DIEFIEN)
- +5 QUIT