185 lines
6.8 KiB
Mathematica
185 lines
6.8 KiB
Mathematica
DIEF ;SFISC/DPC-FILER DRIVER ;11:15 AM 25 Feb 2002
|
|
;;22.0;VA FileMan;**1,11,101**;Mar 30, 1999
|
|
;Per VHA Directive 10-93-142, this routine should not be modified.
|
|
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 ;
|
|
;I '$D(^DD(DIEFF,0,"UP")) D 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)
|
|
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
|
|
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
|