DIEF1 ;SFISC/DPC-FILER UTILITIES ;22MAR2006
;;22.0;VA FileMan;**11,147**;Mar 30, 1999
;Per VHA Directive 10-93-142, this routine should not be modified.
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
DIEF1 ;SFISC/DPC-FILER UTILITIES ;22MAR2006
+1 ;;22.0;VA FileMan;**11,147**;Mar 30, 1999
+2 ;Per VHA Directive 10-93-142, this routine should not be modified.
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
