DIEF ;SFISC/DPC-FILER DRIVER ;16FEB2007
;;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.
;
FILE(DIEFFLAG,DIEFAR,DIEFOUT,DIEFADAR) ;
FILEX ;
N DIEFF,DIEFCNOD,DIEFNODE,DIEFSPOT,DIEFDAS,DIEFIEN,DIEFRFLD,DIEFFLD,DIEFFVAL,DIEFOVAL,DIEFNVAL,DIEFTSRC,DIEFLOCK,DIEFECNT
N DIDATA,DIEFFLST,DIEFFREF,DIEFFXR,DIEFLEV,DIEFRLST,DIEFTMP,DIEFTREF
S DIEFFLAG=$G(DIEFFLAG)
I '$D(DIQUIET) N DIQUIET S DIQUIET=1
I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
I '$$VERFLG^DIEFU(DIEFFLAG,"ISKEOTU") G OUT
I DIEFFLAG["T",DIEFFLAG'["E" D BLD^DIALOG(301,DIEFFLAG,DIEFFLAG) G OUT
I '$$VROOT^DIEFU(DIEFAR) G OUT
I '($D(@DIEFAR)\10) D BLD^DIALOG(305,DIEFAR,DIEFAR) G OUT
I DIEFFLAG["K" N DIEFNOLK,DIEFLCKS D LOCK^DIEF1 I DIEFNOLK G OUT
;batch conversion to internal and key validation if requested.
I DIEFFLAG["T" S DIEFECNT=$G(DIERR) D G:DIEFECNT'=$G(DIERR) OUT
. S DIEFAR("INT")="^TMP($J,""DIEF"")"
. D VALS^DIEVS("R"_$E("U",DIEFFLAG["U"),DIEFAR,DIEFAR("INT"))
. S DIEFAR("EXT")=DIEFAR,DIEFAR=DIEFAR("INT")
S DIEFTMP=$$GETTMP^DIKC1("DIEF")
D DRIVER
OUT I $D(DIEFLOCK) D UNLOCK^DIEF1
I DIEFFLAG'["S",'$G(DIERR) K @$G(DIEFAR("EXT"),DIEFAR)
I $D(DIEFAR("INT")) K @DIEFAR("INT")
I $G(DIEFOUT)]"" D CALLOUT^DIEFU(DIEFOUT)
I $D(DIEFTMP) K @DIEFTMP
Q
DRIVER ;
S DIEFF=""
F S DIEFF=$O(@DIEFAR@(DIEFF)) Q:DIEFF="" D
. I DIEFFLAG'["K",'$$VFILE^DIEFU(DIEFF,"D") Q
. S DIEFFREF=$$FROOTDA^DIKCU(DIEFF,"D",.DIEFLEV,.DIEFTREF) Q:DIEFFREF=""
. S DIEFDAS=""
. F S DIEFDAS=$O(@DIEFAR@(DIEFF,DIEFDAS)) Q:DIEFDAS="" D
. . N D,I,DA,S,DIOPER
. . S DIEFIEN=DIEFDAS
. . I ($E(DIEFIEN)="?"!($E(DIEFIEN)="+")),$G(DIEFADAR)]"" D
. . . I $E(DIEFIEN)="+" S DIOPER="A"
. . . E I $E(DIEFIEN,1,2)="?+",@DIEFADAR@($TR($P(DIEFIEN,","),"?+"),0)="+" S DIOPER="A"
. . . S DIEFIEN=$$ADDCONV^DIEF1(DIEFIEN,DIEFADAR)
. . S S=" " F S S=$O(@DIEFTMP@("DEL",DIEFF,S)) Q:S="" I ","_DIEFIEN?@(".E1"","_S_"""") S DIEFDAS=$C(127) Q
. . Q:DIEFDAS=$C(127)
. . I DIEFFLAG'["K" Q:'$$GOODIEN(DIEFF,DIEFIEN,DIEFLEV,"","D")
. . F I=0:1:DIEFLEV S D="D"_(DIEFLEV-I) N @D S (DA(I),@D)=$P(DIEFIEN,",",I+1)
. . S DA=DA(0) K DA(0)
. . S DIDATA=$NA(@DIEFFREF@(DA))
. . Q:'$$VENTRY(DIEFF,DIEFIEN,"D"_$E(9,DIEFFLAG["E"),DIDATA,DIEFTREF)
. . N DOREPL S DIEFRFLD="",DOREPL=0
. . F S DIEFRFLD=$O(@DIEFAR@(DIEFF,DIEFDAS,DIEFRFLD)) Q:DIEFRFLD="" D
. . . N DIEFNG
. . . S DIEFFLD=$$CHKFLD^DIEFU(DIEFF,DIEFRFLD) I 'DIEFFLD Q
. . . I DIEFFLD=.001 D BLD^DIALOG(520,".001",".001") Q
. . . S DIEFNVAL=@DIEFAR@(DIEFF,DIEFDAS,DIEFRFLD)
. . . I DIEFFLAG["E",DIEFFLAG'["T" D VAL Q:$D(DIEFNG)
. . . I DIEFFLD=.01,"@"[DIEFNVAL D PT01DEL Q
. . . S DIEFSPOT=$P(^DD(DIEFF,DIEFFLD,0),U,4)
. . . S DIEFNODE=$NA(@DIDATA@($P(DIEFSPOT,";")))
. . . S DIEFSPOT=$P(DIEFSPOT,";",2)
. . . I DIEFNODE'=$G(DIEFCNOD) D:DOREPL REPLACE S DIEFCNOD=DIEFNODE D RETRIEVE
. . . I DIEFNVAL="@" S DIEFNVAL=""
. . . D LOADFLD^DIKC1(DIEFF,DIEFFLD,"KS","",$NA(@DIEFTMP@("V")),"DIEFFXR",$NA(@DIEFTMP@("R")),.DIEFFLST,.DIEFRLST)
. . . I DIEFFLAG'["T",DIEFFLAG'["U",'$$SKEYCHK^DIEF1(DIEFF,DIEFFLD,DIEFNVAL,.DA,DIEFIEN,.DIEFFXR) K DIEFFXR Q
. . . D PUTDATA^DIEF1 Q:$D(DIEFNG)
. . . I DIEFNVAL'=$G(DIEFOVAL) D XRFAUD,FIREFLD
. . D REPLACE:DOREPL K DIEFCNOD
. . D FIREREC
Q
PT01DEL ;
N DIEFERR
I DIEFNVAL="" F S DIEFERR=$O(^DD(DIEFF,.01,"DEL",$G(DIEFERR))) Q:DIEFERR="" I $D(^(DIEFERR,0)) X ^(0) I D G Q
. N INT,EXT
. S INT(1)=$$FLDNM^DIEFU(DIEFF,DIEFFLD),INT(2)=$$FILENM^DIEFU(DIEFF),EXT("FILE")=DIEFF,EXT("FIELD")=DIEFFLD
. D BLD^DIALOG(712,.INT,.EXT) ;"CANNOT BE DELETED"
S DIEFECNT=$G(DIERR)
N %,DIC,DIK S DIK=$$OREF^DILF($NA(@DIEFFREF)) D ^DIK
I DIEFECNT'=$G(DIERR) D HKERR^DILIBF(DIEFF,DIEFIEN,DIEFFLD,"cross reference")
N SB D SUBFILES^DIKCU(DIEFF,.SB) S SB(DIEFF)=""
S SB=0 F S SB=$O(SB(SB)) Q:'SB S @DIEFTMP@("DEL",SB,DIEFIEN)=""
S DIEFRFLD=$C(127),DOREPL=0
K @DIEFTMP@("R"),@DIEFTMP@("V")
Q Q
;
VAL ;
N DIEFTYPE,DIEFINT
D DTYP^DIOU(DIEFF,DIEFFLD,.DIEFTYPE) Q:DIEFTYPE=5
D VAL^DIEV(DIEFF,DIEFIEN,DIEFFLD,"U",DIEFNVAL,.DIEFINT)
I DIEFINT'=U S DIEFNVAL=DIEFINT Q
S DIEFNG=1
Q
REPLACE ;
S @DIEFCNOD=DIEFFVAL,DOREPL=0
Q
RETRIEVE ;
S DIEFFVAL=$G(@DIEFCNOD)
Q
;
XRFAUD ;
I $D(^DD(DIEFF,"IX",DIEFFLD)) D REPLACE:$G(DOREPL),IX,RETRIEVE:$D(DOREPL)
I $D(^DD(DIEFF,"AUDIT",DIEFFLD)) D AUDIT
Q
IX ;
N X,DIEFSORK
I DIEFOVAL'="" S DIEFSORK=2 D FIRE
I "@"'[DIEFNVAL S DIEFSORK=1 D FIRE
Q
FIRE ;
N DIEFI,DICRREC
S:$D(DIEFTMP) DICRREC="TRIG^DIEF"
S DIEFI=0
F S DIEFI=$O(^DD(DIEFF,DIEFFLD,1,DIEFI)) Q:DIEFI="" D
. N I,Y,DIG,DIH,DIU,DIV,XMB,XMY
. S X=$S(DIEFSORK=1:DIEFNVAL,1:DIEFOVAL)
. N DIEFECNT S DIEFECNT=$G(DIERR)
. X ^(DIEFI,DIEFSORK) ;Naked indicator set in For loop, FIRE+2
. I DIEFECNT'=$G(DIERR) D HKERR^DILIBF(DIEFF,DIEFIEN,DIEFFLD,"cross reference")
Q
AUDIT ;
N X,DP,DG,DIIX N DIANUM,C,Y
S DP=DIEFF,DG=1
I DIEFOVAL]"" S X=DIEFOVAL,DIIX="2^"_DIEFFLD D AUDIT^DIET
I "@"'[DIEFNVAL,(DIEFOVAL]""!(^DD(DIEFF,DIEFFLD,"AUDIT")'="e")) S X=DIEFNVAL,DIIX="3^"_DIEFFLD_$S(DIEFFLD=.01&(DIEFOVAL=""):"^A",1:"") D AUDIT^DIET
Q
;
FIREFLD ;Fire field-level xrefs
Q:'$D(DIEFTMP)
I $G(DIEFFLST)]""!($G(DIEFRLST)]"") D
. S:'$D(@DIEFTMP@("V",DIEFF,DIEFIEN,DIEFFLD,"O")) ^("O")=DIEFOVAL
;
I $G(DIEFFLST)]"" D
. D:$G(DOREPL) REPLACE
. D FIRE^DIKC(DIEFF,.DA,"KS","DIEFFXR","O","",$E("C",$G(DIOPER)="A"))
. D:$D(DOREPL) RETRIEVE
K DIEFFXR,DIEFFLST
Q
;
FIREREC ;Fire record-level xrefs
N DIKEY
D FIRE^DIKC(DIEFF,.DA,"KS",$NA(@DIEFTMP@("R")),"O^"_$S(DIEFFLAG'["T"&(DIEFFLAG'["U"):"^K^N",1:""),.DIKEY,$E("C",$G(DIOPER)="A"))
D:$D(DIKEY)>9 RESTORE^DIEF1(.DIKEY,DIEFTMP)
K @DIEFTMP@("R"),@DIEFTMP@("V")
Q
;
GOODIEN(DIEFF,DIEFIEN,DIEFLEV,DA,DIEFFLG) ;
N ERR,P K DA
I DIEFIEN[",,"!($E(DIEFIEN)=",") D Q 0
. D:$G(DIEFFLG)["D" ERR^DIKCU2(307,"",DIEFIEN)
I $E(DIEFIEN,$L(DIEFIEN))'="," D Q 0
. D:$G(DIEFFLG)["D" ERR^DIKCU2(304,"",DIEFIEN)
I $L(DIEFIEN,",")-2'=DIEFLEV D Q 0
. D:$G(DIEFFLG)["D" ERR^DIKCU2(205,"",DIEFIEN,"",DIEFF)
S ERR=0 F P=1:1:$L(DIEFIEN,",")-1 D Q:ERR
. S DA(P-1)=$P(DIEFIEN,",",P)
. I DA(P-1)'=+$P(DA(P-1),"E")!(DA(P-1)'>0) D
.. K DA S ERR=1 D:$G(DIEFFLG)["D" ERR^DIKCU2(308,"",DIEFIEN)
Q:ERR 0
S DA=DA(0) K DA(0)
Q 1
;
VENTRY(DIEFF,DIEFIEN,DIEFFLG,DIDATA,DIEFTREF) ;
S DIEFFLG=$G(DIEFFLG)
;
;Get root of (sub)record and top level file
I $G(DIDATA)=""!(DIEFFLG[9&($G(DIEFTREF)="")) D Q:$G(DIDATA)="" 0
. N DA,DIEFD,DIEFLEV
. S DIEFD=$E("D",DIEFFLG["D")
. S DIDATA=$$FROOTDA^DIKCU(DIEFF,DIEFD,.DIEFLEV,.DIEFTREF) Q:DIDATA=""
. I '$$GOODIEN(DIEFF,DIEFIEN,DIEFLEV,.DA,DIEFD) S DIDATA="" Q
. S DIDATA=$NA(@DIDATA@(DA))
;
;Check null .01
I $P($G(@DIDATA@(0)),U)="" D Q 0
. D:DIEFFLG["D" ERR^DIKCU2(601,DIEFF,DIEFIEN)
;
;Check -9 node
I DIEFFLG[9,$D(@DIEFTREF@($P(DIEFIEN,",",$L(DIEFIEN,",")-1),-9)) D Q 0
. D:DIEFFLG["D" ERR^DIKCU2(602,DIEFF,DIEFIEN)
;
Q 1
;
TRIG ;Called from trigger logic (from DICR via @DICRREC)
Q:'$D(DIEFTMP)
N DIEFRLST
D LOADFLD^DIKC1(DIH,DIG,"KS","",$NA(@DIEFTMP@("V")),"",$NA(@DIEFTMP@("R")),"",.DIEFRLST)
I $G(DIEFRLST)]"",'$D(@DIEFTMP@("V",DIH,DICRIENS,DIG,"O")) S ^("O")=DIU
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIEF 7476 printed Dec 13, 2024@02:47:07 Page 2
DIEF ;SFISC/DPC-FILER DRIVER ;16FEB2007
+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 ;
FILE(DIEFFLAG,DIEFAR,DIEFOUT,DIEFADAR) ;
FILEX ;
+1 NEW DIEFF,DIEFCNOD,DIEFNODE,DIEFSPOT,DIEFDAS,DIEFIEN,DIEFRFLD,DIEFFLD,DIEFFVAL,DIEFOVAL,DIEFNVAL,DIEFTSRC,DIEFLOCK,DIEFECNT
+2 NEW DIDATA,DIEFFLST,DIEFFREF,DIEFFXR,DIEFLEV,DIEFRLST,DIEFTMP,DIEFTREF
+3 SET DIEFFLAG=$GET(DIEFFLAG)
+4 IF '$DATA(DIQUIET)
NEW DIQUIET
SET DIQUIET=1
+5 IF '$DATA(DIFM)
NEW DIFM
SET DIFM=1
DO INIZE^DIEFU
+6 IF '$$VERFLG^DIEFU(DIEFFLAG,"ISKEOTU")
GOTO OUT
+7 IF DIEFFLAG["T"
IF DIEFFLAG'["E"
DO BLD^DIALOG(301,DIEFFLAG,DIEFFLAG)
GOTO OUT
+8 IF '$$VROOT^DIEFU(DIEFAR)
GOTO OUT
+9 IF '($DATA(@DIEFAR)\10)
DO BLD^DIALOG(305,DIEFAR,DIEFAR)
GOTO OUT
+10 IF DIEFFLAG["K"
NEW DIEFNOLK,DIEFLCKS
DO LOCK^DIEF1
IF DIEFNOLK
GOTO OUT
+11 ;batch conversion to internal and key validation if requested.
+12 IF DIEFFLAG["T"
SET DIEFECNT=$GET(DIERR)
Begin DoDot:1
+13 SET DIEFAR("INT")="^TMP($J,""DIEF"")"
+14 DO VALS^DIEVS("R"_$EXTRACT("U",DIEFFLAG["U"),DIEFAR,DIEFAR("INT"))
+15 SET DIEFAR("EXT")=DIEFAR
SET DIEFAR=DIEFAR("INT")
End DoDot:1
if DIEFECNT'=$GET(DIERR)
GOTO OUT
+16 SET DIEFTMP=$$GETTMP^DIKC1("DIEF")
+17 DO DRIVER
OUT IF $DATA(DIEFLOCK)
DO UNLOCK^DIEF1
+1 IF DIEFFLAG'["S"
IF '$GET(DIERR)
KILL @$GET(DIEFAR("EXT"),DIEFAR)
+2 IF $DATA(DIEFAR("INT"))
KILL @DIEFAR("INT")
+3 IF $GET(DIEFOUT)]""
DO CALLOUT^DIEFU(DIEFOUT)
+4 IF $DATA(DIEFTMP)
KILL @DIEFTMP
+5 QUIT
DRIVER ;
+1 SET DIEFF=""
+2 FOR
SET DIEFF=$ORDER(@DIEFAR@(DIEFF))
if DIEFF=""
QUIT
Begin DoDot:1
+3 IF DIEFFLAG'["K"
IF '$$VFILE^DIEFU(DIEFF,"D")
QUIT
+4 SET DIEFFREF=$$FROOTDA^DIKCU(DIEFF,"D",.DIEFLEV,.DIEFTREF)
if DIEFFREF=""
QUIT
+5 SET DIEFDAS=""
+6 FOR
SET DIEFDAS=$ORDER(@DIEFAR@(DIEFF,DIEFDAS))
if DIEFDAS=""
QUIT
Begin DoDot:2
+7 NEW D,I,DA,S,DIOPER
+8 SET DIEFIEN=DIEFDAS
+9 IF ($EXTRACT(DIEFIEN)="?"!($EXTRACT(DIEFIEN)="+"))
IF $GET(DIEFADAR)]""
Begin DoDot:3
+10 IF $EXTRACT(DIEFIEN)="+"
SET DIOPER="A"
+11 IF '$TEST
IF $EXTRACT(DIEFIEN,1,2)="?+"
IF @DIEFADAR@($TRANSLATE($PIECE(DIEFIEN,","),"?+"),0)="+"
SET DIOPER="A"
+12 SET DIEFIEN=$$ADDCONV^DIEF1(DIEFIEN,DIEFADAR)
End DoDot:3
+13 SET S=" "
FOR
SET S=$ORDER(@DIEFTMP@("DEL",DIEFF,S))
if S=""
QUIT
IF ","_DIEFIEN?@(".E1"","_S_"""")
SET DIEFDAS=$CHAR(127)
QUIT
+14 if DIEFDAS=$CHAR(127)
QUIT
+15 IF DIEFFLAG'["K"
if '$$GOODIEN(DIEFF,DIEFIEN,DIEFLEV,"","D")
QUIT
+16 FOR I=0:1:DIEFLEV
SET D="D"_(DIEFLEV-I)
NEW @D
SET (DA(I),@D)=$PIECE(DIEFIEN,",",I+1)
+17 SET DA=DA(0)
KILL DA(0)
+18 SET DIDATA=$NAME(@DIEFFREF@(DA))
+19 if '$$VENTRY(DIEFF,DIEFIEN,"D"_$EXTRACT(9,DIEFFLAG["E"),DIDATA,DIEFTREF)
QUIT
+20 NEW DOREPL
SET DIEFRFLD=""
SET DOREPL=0
+21 FOR
SET DIEFRFLD=$ORDER(@DIEFAR@(DIEFF,DIEFDAS,DIEFRFLD))
if DIEFRFLD=""
QUIT
Begin DoDot:3
+22 NEW DIEFNG
+23 SET DIEFFLD=$$CHKFLD^DIEFU(DIEFF,DIEFRFLD)
IF 'DIEFFLD
QUIT
+24 IF DIEFFLD=.001
DO BLD^DIALOG(520,".001",".001")
QUIT
+25 SET DIEFNVAL=@DIEFAR@(DIEFF,DIEFDAS,DIEFRFLD)
+26 IF DIEFFLAG["E"
IF DIEFFLAG'["T"
DO VAL
if $DATA(DIEFNG)
QUIT
+27 IF DIEFFLD=.01
IF "@"[DIEFNVAL
DO PT01DEL
QUIT
+28 SET DIEFSPOT=$PIECE(^DD(DIEFF,DIEFFLD,0),U,4)
+29 SET DIEFNODE=$NAME(@DIDATA@($PIECE(DIEFSPOT,";")))
+30 SET DIEFSPOT=$PIECE(DIEFSPOT,";",2)
+31 IF DIEFNODE'=$GET(DIEFCNOD)
if DOREPL
DO REPLACE
SET DIEFCNOD=DIEFNODE
DO RETRIEVE
+32 IF DIEFNVAL="@"
SET DIEFNVAL=""
+33 DO LOADFLD^DIKC1(DIEFF,DIEFFLD,"KS","",$NAME(@DIEFTMP@("V")),"DIEFFXR",$NAME(@DIEFTMP@("R")),.DIEFFLST,.DIEFRLST)
+34 IF DIEFFLAG'["T"
IF DIEFFLAG'["U"
IF '$$SKEYCHK^DIEF1(DIEFF,DIEFFLD,DIEFNVAL,.DA,DIEFIEN,.DIEFFXR)
KILL DIEFFXR
QUIT
+35 DO PUTDATA^DIEF1
if $DATA(DIEFNG)
QUIT
+36 IF DIEFNVAL'=$GET(DIEFOVAL)
DO XRFAUD
DO FIREFLD
End DoDot:3
+37 if DOREPL
DO REPLACE
KILL DIEFCNOD
+38 DO FIREREC
End DoDot:2
End DoDot:1
+39 QUIT
PT01DEL ;
+1 NEW DIEFERR
+2 IF DIEFNVAL=""
FOR
SET DIEFERR=$ORDER(^DD(DIEFF,.01,"DEL",$GET(DIEFERR)))
if DIEFERR=""
QUIT
IF $DATA(^(DIEFERR,0))
XECUTE ^(0)
IF $TEST
Begin DoDot:1
+3 NEW INT,EXT
+4 SET INT(1)=$$FLDNM^DIEFU(DIEFF,DIEFFLD)
SET INT(2)=$$FILENM^DIEFU(DIEFF)
SET EXT("FILE")=DIEFF
SET EXT("FIELD")=DIEFFLD
+5 ;"CANNOT BE DELETED"
DO BLD^DIALOG(712,.INT,.EXT)
End DoDot:1
GOTO Q
+6 SET DIEFECNT=$GET(DIERR)
+7 NEW %,DIC,DIK
SET DIK=$$OREF^DILF($NAME(@DIEFFREF))
DO ^DIK
+8 IF DIEFECNT'=$GET(DIERR)
DO HKERR^DILIBF(DIEFF,DIEFIEN,DIEFFLD,"cross reference")
+9 NEW SB
DO SUBFILES^DIKCU(DIEFF,.SB)
SET SB(DIEFF)=""
+10 SET SB=0
FOR
SET SB=$ORDER(SB(SB))
if 'SB
QUIT
SET @DIEFTMP@("DEL",SB,DIEFIEN)=""
+11 SET DIEFRFLD=$CHAR(127)
SET DOREPL=0
+12 KILL @DIEFTMP@("R"),@DIEFTMP@("V")
Q QUIT
+1 ;
VAL ;
+1 NEW DIEFTYPE,DIEFINT
+2 DO DTYP^DIOU(DIEFF,DIEFFLD,.DIEFTYPE)
if DIEFTYPE=5
QUIT
+3 DO VAL^DIEV(DIEFF,DIEFIEN,DIEFFLD,"U",DIEFNVAL,.DIEFINT)
+4 IF DIEFINT'=U
SET DIEFNVAL=DIEFINT
QUIT
+5 SET DIEFNG=1
+6 QUIT
REPLACE ;
+1 SET @DIEFCNOD=DIEFFVAL
SET DOREPL=0
+2 QUIT
RETRIEVE ;
+1 SET DIEFFVAL=$GET(@DIEFCNOD)
+2 QUIT
+3 ;
XRFAUD ;
+1 IF $DATA(^DD(DIEFF,"IX",DIEFFLD))
if $GET(DOREPL)
DO REPLACE
DO IX
if $DATA(DOREPL)
DO RETRIEVE
+2 IF $DATA(^DD(DIEFF,"AUDIT",DIEFFLD))
DO AUDIT
+3 QUIT
IX ;
+1 NEW X,DIEFSORK
+2 IF DIEFOVAL'=""
SET DIEFSORK=2
DO FIRE
+3 IF "@"'[DIEFNVAL
SET DIEFSORK=1
DO FIRE
+4 QUIT
FIRE ;
+1 NEW DIEFI,DICRREC
+2 if $DATA(DIEFTMP)
SET DICRREC="TRIG^DIEF"
+3 SET DIEFI=0
+4 FOR
SET DIEFI=$ORDER(^DD(DIEFF,DIEFFLD,1,DIEFI))
if DIEFI=""
QUIT
Begin DoDot:1
+5 NEW I,Y,DIG,DIH,DIU,DIV,XMB,XMY
+6 SET X=$SELECT(DIEFSORK=1:DIEFNVAL,1:DIEFOVAL)
+7 NEW DIEFECNT
SET DIEFECNT=$GET(DIERR)
+8 ;Naked indicator set in For loop, FIRE+2
XECUTE ^(DIEFI,DIEFSORK)
+9 IF DIEFECNT'=$GET(DIERR)
DO HKERR^DILIBF(DIEFF,DIEFIEN,DIEFFLD,"cross reference")
End DoDot:1
+10 QUIT
AUDIT ;
+1 NEW X,DP,DG,DIIX
NEW DIANUM,C,Y
+2 SET DP=DIEFF
SET DG=1
+3 IF DIEFOVAL]""
SET X=DIEFOVAL
SET DIIX="2^"_DIEFFLD
DO AUDIT^DIET
+4 IF "@"'[DIEFNVAL
IF (DIEFOVAL]""!(^DD(DIEFF,DIEFFLD,"AUDIT")'="e"))
SET X=DIEFNVAL
SET DIIX="3^"_DIEFFLD_$SELECT(DIEFFLD=.01&(DIEFOVAL=""):"^A",1:"")
DO AUDIT^DIET
+5 QUIT
+6 ;
FIREFLD ;Fire field-level xrefs
+1 if '$DATA(DIEFTMP)
QUIT
+2 IF $GET(DIEFFLST)]""!($GET(DIEFRLST)]"")
Begin DoDot:1
+3 if '$DATA(@DIEFTMP@("V",DIEFF,DIEFIEN,DIEFFLD,"O"))
SET ^("O")=DIEFOVAL
End DoDot:1
+4 ;
+5 IF $GET(DIEFFLST)]""
Begin DoDot:1
+6 if $GET(DOREPL)
DO REPLACE
+7 DO FIRE^DIKC(DIEFF,.DA,"KS","DIEFFXR","O","",$EXTRACT("C",$GET(DIOPER)="A"))
+8 if $DATA(DOREPL)
DO RETRIEVE
End DoDot:1
+9 KILL DIEFFXR,DIEFFLST
+10 QUIT
+11 ;
FIREREC ;Fire record-level xrefs
+1 NEW DIKEY
+2 DO FIRE^DIKC(DIEFF,.DA,"KS",$NAME(@DIEFTMP@("R")),"O^"_$SELECT(DIEFFLAG'["T"&(DIEFFLAG'["U"):"^K^N",1:""),.DIKEY,$EXTRACT("C",$GET(DIOPER)="A"))
+3 if $DATA(DIKEY)>9
DO RESTORE^DIEF1(.DIKEY,DIEFTMP)
+4 KILL @DIEFTMP@("R"),@DIEFTMP@("V")
+5 QUIT
+6 ;
GOODIEN(DIEFF,DIEFIEN,DIEFLEV,DA,DIEFFLG) ;
+1 NEW ERR,P
KILL DA
+2 IF DIEFIEN[",,"!($EXTRACT(DIEFIEN)=",")
Begin DoDot:1
+3 if $GET(DIEFFLG)["D"
DO ERR^DIKCU2(307,"",DIEFIEN)
End DoDot:1
QUIT 0
+4 IF $EXTRACT(DIEFIEN,$LENGTH(DIEFIEN))'=","
Begin DoDot:1
+5 if $GET(DIEFFLG)["D"
DO ERR^DIKCU2(304,"",DIEFIEN)
End DoDot:1
QUIT 0
+6 IF $LENGTH(DIEFIEN,",")-2'=DIEFLEV
Begin DoDot:1
+7 if $GET(DIEFFLG)["D"
DO ERR^DIKCU2(205,"",DIEFIEN,"",DIEFF)
End DoDot:1
QUIT 0
+8 SET ERR=0
FOR P=1:1:$LENGTH(DIEFIEN,",")-1
Begin DoDot:1
+9 SET DA(P-1)=$PIECE(DIEFIEN,",",P)
+10 IF DA(P-1)'=+$PIECE(DA(P-1),"E")!(DA(P-1)'>0)
Begin DoDot:2
+11 KILL DA
SET ERR=1
if $GET(DIEFFLG)["D"
DO ERR^DIKCU2(308,"",DIEFIEN)
End DoDot:2
End DoDot:1
if ERR
QUIT
+12 if ERR
QUIT 0
+13 SET DA=DA(0)
KILL DA(0)
+14 QUIT 1
+15 ;
VENTRY(DIEFF,DIEFIEN,DIEFFLG,DIDATA,DIEFTREF) ;
+1 SET DIEFFLG=$GET(DIEFFLG)
+2 ;
+3 ;Get root of (sub)record and top level file
+4 IF $GET(DIDATA)=""!(DIEFFLG[9&($GET(DIEFTREF)=""))
Begin DoDot:1
+5 NEW DA,DIEFD,DIEFLEV
+6 SET DIEFD=$EXTRACT("D",DIEFFLG["D")
+7 SET DIDATA=$$FROOTDA^DIKCU(DIEFF,DIEFD,.DIEFLEV,.DIEFTREF)
if DIDATA=""
QUIT
+8 IF '$$GOODIEN(DIEFF,DIEFIEN,DIEFLEV,.DA,DIEFD)
SET DIDATA=""
QUIT
+9 SET DIDATA=$NAME(@DIDATA@(DA))
End DoDot:1
if $GET(DIDATA)=""
QUIT 0
+10 ;
+11 ;Check null .01
+12 IF $PIECE($GET(@DIDATA@(0)),U)=""
Begin DoDot:1
+13 if DIEFFLG["D"
DO ERR^DIKCU2(601,DIEFF,DIEFIEN)
End DoDot:1
QUIT 0
+14 ;
+15 ;Check -9 node
+16 IF DIEFFLG[9
IF $DATA(@DIEFTREF@($PIECE(DIEFIEN,",",$LENGTH(DIEFIEN,",")-1),-9))
Begin DoDot:1
+17 if DIEFFLG["D"
DO ERR^DIKCU2(602,DIEFF,DIEFIEN)
End DoDot:1
QUIT 0
+18 ;
+19 QUIT 1
+20 ;
TRIG ;Called from trigger logic (from DICR via @DICRREC)
+1 if '$DATA(DIEFTMP)
QUIT
+2 NEW DIEFRLST
+3 DO LOADFLD^DIKC1(DIH,DIG,"KS","",$NAME(@DIEFTMP@("V")),"",$NAME(@DIEFTMP@("R")),"",.DIEFRLST)
+4 IF $GET(DIEFRLST)]""
IF '$DATA(@DIEFTMP@("V",DIH,DICRIENS,DIG,"O"))
SET ^("O")=DIU
+5 QUIT
