Return to DIEF.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Initial commit

DIEF	;SFISC/DPC-FILER DRIVER ;11/9/94  13:10
	;;21.0;VA FileMan;;Dec 28, 1994
	;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
	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,"ISKEO") 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 I DIEFNOLK D:$D(DIEFLOCK) UNLOCK G OUT
	D DRIVER
	I $D(DIEFLOCK) D UNLOCK
	I DIEFFLAG'["S",'$G(DIERR) K @DIEFAR
OUT	I $G(DIEFOUT)]"" D CALLOUT^DIEFU(DIEFOUT)
	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 DIEFDAS=""
	. F  S DIEFDAS=$O(@DIEFAR@(DIEFF,DIEFDAS)) Q:DIEFDAS=""  D  Q:DIEFNOLK
	. . I '$$GOODIEN(DIEFDAS) S DIEFNOLK=1 Q
	. . N DIEFDA D DA^DIEFU(DIEFDAS,.DIEFDA)
	. . S DIEFLCKS=DIEFLCKS+1
	. . S DIEFLOCK(DIEFLCKS)=$$ROOT^DIQGU(DIEFF,.DIEFDA)_DIEFDA_")"
	. . L +@DIEFLOCK(DIEFLCKS):1 E  D
	. . . 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
DRIVER	;
	S DIEFF=""
	F  S DIEFF=$O(@DIEFAR@(DIEFF)) Q:DIEFF=""  D
	. I DIEFFLAG'["K",'$$VFILE^DIEFU(DIEFF,"D") Q
	. S DIEFDAS=""
	. F  S DIEFDAS=$O(@DIEFAR@(DIEFF,DIEFDAS)) Q:DIEFDAS=""  D
	. . S DIEFIEN=DIEFDAS
	. . I ($E(DIEFIEN)="?"!($E(DIEFIEN)="+")),$G(DIEFADAR)]"" S DIEFIEN=$$ADDCONV^DIEF1(DIEFIEN,DIEFADAR)
	. . I '$$GOODIEN(DIEFIEN) Q
	. . N DA,I,DEPTH,D
	. . S DEPTH=$L(DIEFIEN,",")-1
	. . F I=1:1:DEPTH S D="D"_(DEPTH-I) N @D S (DA(I-1),@D)=$P(DIEFIEN,",",I)
	. . S DA=DA(0) K DA(0)
	. . I '$$VENTRY^DIEFU(DIEFF,DIEFIEN,"D") Q
	. . 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" D VAL Q:$D(DIEFNG)
	. . . I DIEFFLD=.01,"@"[DIEFNVAL D PT01DEL Q
	. . . S DIEFSPOT=" " D GLRF^DIOU(DIEFF,DIEFFLD,.DIEFNODE,.DIEFSPOT)
	. . . I DIEFNODE'=$G(DIEFCNOD) D:DOREPL REPLACE S DIEFCNOD=DIEFNODE D RETRIEVE
	. . . I DIEFNVAL="@" S DIEFNVAL=""
	. . . D PUTDATA^DIEF1 Q:$D(DIEFNG)
	. . . I DIEFNVAL'=$G(DIEFOVAL) D XRFAUD
	. . D REPLACE:DOREPL K DIEFCNOD
	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 DIK S DIK=$$ROOT^DIQGU(DIEFF,.DA) D ^DIK
	I DIEFECNT'=$G(DIERR) D HKERR^DILIBF(DIEFF,DIEFIEN,DIEFFLD,"cross reference")
	Q
VAL	;
	N DIEFTYPE,DIEFINT
	D DTYP^DIOU(DIEFF,DIEFFLD,.DIEFTYPE) Q:DIEFTYPE=5
	D VAL^DIEV(DIEFF,DIEFIEN,DIEFFLD,"",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 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 D AUDIT^DIET
	Q
	;
GOODIEN(DIEFIEN)	;
	I '+DIEFIEN!($E(DIEFIEN,$L(DIEFIEN))'=",") D  Q 0
	. D BLD^DIALOG(203,"IENS","IENS")
	Q 1