- 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 Feb 19, 2025@00:13:21 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