File:  [Coherent Logic Development] / freem_fileman / USER / DIEF.m
Revision 1.1: download - view: text, annotated - select for diffs
Mon Apr 28 14:13:20 2025 UTC (3 months ago) by snw
Branches: MAIN
CVS tags: HEAD
Restructure repository

    1: DIEF	;SFISC/DPC-FILER DRIVER ;11/9/94  13:10
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: FILE(DIEFFLAG,DIEFAR,DIEFOUT,DIEFADAR)	;
    5: FILEX	;
    6: 	N DIEFF,DIEFCNOD,DIEFNODE,DIEFSPOT,DIEFDAS,DIEFIEN,DIEFRFLD,DIEFFLD,DIEFFVAL,DIEFOVAL,DIEFNVAL,DIEFTSRC,DIEFLOCK,DIEFECNT
    7: 	S DIEFFLAG=$G(DIEFFLAG)
    8: 	I '$D(DIQUIET) N DIQUIET S DIQUIET=1
    9: 	I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
   10: 	I '$$VERFLG^DIEFU(DIEFFLAG,"ISKEO") G OUT
   11: 	I '$$VROOT^DIEFU(DIEFAR) G OUT
   12: 	I '($D(@DIEFAR)\10) D BLD^DIALOG(305,DIEFAR,DIEFAR) G OUT
   13: 	I DIEFFLAG["K" N DIEFNOLK,DIEFLCKS D LOCK I DIEFNOLK D:$D(DIEFLOCK) UNLOCK G OUT
   14: 	D DRIVER
   15: 	I $D(DIEFLOCK) D UNLOCK
   16: 	I DIEFFLAG'["S",'$G(DIERR) K @DIEFAR
   17: OUT	I $G(DIEFOUT)]"" D CALLOUT^DIEFU(DIEFOUT)
   18: 	Q
   19: LOCK	;
   20: 	S (DIEFNOLK,DIEFLCKS)=0,DIEFF=""
   21: 	F  S DIEFF=$O(@DIEFAR@(DIEFF)) Q:DIEFF=""  D  Q:DIEFNOLK
   22: 	. I '$$VFILE^DIEFU(DIEFF,"D") S DIEFNOLK=1 Q
   23: 	. S DIEFDAS=""
   24: 	. F  S DIEFDAS=$O(@DIEFAR@(DIEFF,DIEFDAS)) Q:DIEFDAS=""  D  Q:DIEFNOLK
   25: 	. . I '$$GOODIEN(DIEFDAS) S DIEFNOLK=1 Q
   26: 	. . N DIEFDA D DA^DIEFU(DIEFDAS,.DIEFDA)
   27: 	. . S DIEFLCKS=DIEFLCKS+1
   28: 	. . S DIEFLOCK(DIEFLCKS)=$$ROOT^DIQGU(DIEFF,.DIEFDA)_DIEFDA_")"
   29: 	. . L +@DIEFLOCK(DIEFLCKS):1 E  D
   30: 	. . . S DIEFNOLK=1
   31: 	. . . N E S E("FILE")=DIEFF,E("IENS")=DIEFDAS D BLD^DIALOG(110,"",.E)
   32: 	Q
   33: UNLOCK	;
   34: 	N I
   35: 	F I=1:1:DIEFLCKS L -@DIEFLOCK(I)
   36: 	Q
   37: DRIVER	;
   38: 	S DIEFF=""
   39: 	F  S DIEFF=$O(@DIEFAR@(DIEFF)) Q:DIEFF=""  D
   40: 	. I DIEFFLAG'["K",'$$VFILE^DIEFU(DIEFF,"D") Q
   41: 	. S DIEFDAS=""
   42: 	. F  S DIEFDAS=$O(@DIEFAR@(DIEFF,DIEFDAS)) Q:DIEFDAS=""  D
   43: 	. . S DIEFIEN=DIEFDAS
   44: 	. . I ($E(DIEFIEN)="?"!($E(DIEFIEN)="+")),$G(DIEFADAR)]"" S DIEFIEN=$$ADDCONV^DIEF1(DIEFIEN,DIEFADAR)
   45: 	. . I '$$GOODIEN(DIEFIEN) Q
   46: 	. . N DA,I,DEPTH,D
   47: 	. . S DEPTH=$L(DIEFIEN,",")-1
   48: 	. . F I=1:1:DEPTH S D="D"_(DEPTH-I) N @D S (DA(I-1),@D)=$P(DIEFIEN,",",I)
   49: 	. . S DA=DA(0) K DA(0)
   50: 	. . I '$$VENTRY^DIEFU(DIEFF,DIEFIEN,"D") Q
   51: 	. . N DOREPL S DIEFRFLD="",DOREPL=0
   52: 	. . F  S DIEFRFLD=$O(@DIEFAR@(DIEFF,DIEFDAS,DIEFRFLD)) Q:DIEFRFLD=""  D 
   53: 	. . . N DIEFNG
   54: 	. . . S DIEFFLD=$$CHKFLD^DIEFU(DIEFF,DIEFRFLD) I 'DIEFFLD Q
   55: 	. . . I DIEFFLD=.001 D BLD^DIALOG(520,".001",".001") Q
   56: 	. . . S DIEFNVAL=@DIEFAR@(DIEFF,DIEFDAS,DIEFRFLD)
   57: 	. . . I DIEFFLAG["E" D VAL Q:$D(DIEFNG)
   58: 	. . . I DIEFFLD=.01,"@"[DIEFNVAL D PT01DEL Q
   59: 	. . . S DIEFSPOT=" " D GLRF^DIOU(DIEFF,DIEFFLD,.DIEFNODE,.DIEFSPOT)
   60: 	. . . I DIEFNODE'=$G(DIEFCNOD) D:DOREPL REPLACE S DIEFCNOD=DIEFNODE D RETRIEVE
   61: 	. . . I DIEFNVAL="@" S DIEFNVAL=""
   62: 	. . . D PUTDATA^DIEF1 Q:$D(DIEFNG)
   63: 	. . . I DIEFNVAL'=$G(DIEFOVAL) D XRFAUD
   64: 	. . D REPLACE:DOREPL K DIEFCNOD
   65: 	Q
   66: PT01DEL	;
   67: 	I '$D(^DD(DIEFF,0,"UP")) D  Q
   68: 	. N INT,EXT
   69: 	. S INT(1)=$$FLDNM^DIEFU(DIEFF,DIEFFLD),INT(2)=$$FILENM^DIEFU(DIEFF),EXT("FILE")=DIEFF,EXT("FIELD")=DIEFFLD
   70: 	. D BLD^DIALOG(712,.INT,.EXT)
   71: 	S DIEFECNT=$G(DIERR)
   72: 	N DIK S DIK=$$ROOT^DIQGU(DIEFF,.DA) D ^DIK
   73: 	I DIEFECNT'=$G(DIERR) D HKERR^DILIBF(DIEFF,DIEFIEN,DIEFFLD,"cross reference")
   74: 	Q
   75: VAL	;
   76: 	N DIEFTYPE,DIEFINT
   77: 	D DTYP^DIOU(DIEFF,DIEFFLD,.DIEFTYPE) Q:DIEFTYPE=5
   78: 	D VAL^DIEV(DIEFF,DIEFIEN,DIEFFLD,"",DIEFNVAL,.DIEFINT)
   79: 	I DIEFINT'=U S DIEFNVAL=DIEFINT Q
   80: 	S DIEFNG=1
   81: 	Q
   82: REPLACE	;
   83: 	S @DIEFCNOD=DIEFFVAL,DOREPL=0
   84: 	Q
   85: RETRIEVE	;
   86: 	S DIEFFVAL=$G(@DIEFCNOD)
   87: 	Q
   88: 	;
   89: XRFAUD	;
   90: 	I $D(^DD(DIEFF,"IX",DIEFFLD)) D REPLACE:$G(DOREPL),IX,RETRIEVE:$D(DOREPL)
   91: 	I $D(^DD(DIEFF,"AUDIT",DIEFFLD)) D AUDIT
   92: 	Q
   93: IX	;
   94: 	N X,DIEFSORK
   95: 	I DIEFOVAL'="" S DIEFSORK=2 D FIRE
   96: 	I "@"'[DIEFNVAL S DIEFSORK=1 D FIRE
   97: 	Q
   98: FIRE	;
   99: 	N DIEFI S DIEFI=0
  100: 	F  S DIEFI=$O(^DD(DIEFF,DIEFFLD,1,DIEFI)) Q:DIEFI=""  D
  101: 	. N I,Y,DIG,DIH,DIU,DIV,XMB,XMY
  102: 	. S X=$S(DIEFSORK=1:DIEFNVAL,1:DIEFOVAL)
  103: 	. N DIEFECNT S DIEFECNT=$G(DIERR)
  104: 	. X ^(DIEFI,DIEFSORK) ;Naked indicator set in For loop, FIRE+2
  105: 	. I DIEFECNT'=$G(DIERR) D HKERR^DILIBF(DIEFF,DIEFIEN,DIEFFLD,"cross reference")
  106: 	Q
  107: AUDIT	;
  108: 	N X,DP,DG,DIIX N DIANUM,C,Y
  109: 	S DP=DIEFF,DG=1
  110: 	I DIEFOVAL]"" S X=DIEFOVAL,DIIX="2^"_DIEFFLD D AUDIT^DIET
  111: 	I "@"'[DIEFNVAL,(DIEFOVAL]""!(^DD(DIEFF,DIEFFLD,"AUDIT")'="e")) S X=DIEFNVAL,DIIX="3^"_DIEFFLD D AUDIT^DIET
  112: 	Q
  113: 	;
  114: GOODIEN(DIEFIEN)	;
  115: 	I '+DIEFIEN!($E(DIEFIEN,$L(DIEFIEN))'=",") D  Q 0
  116: 	. D BLD^DIALOG(203,"IENS","IENS")
  117: 	Q 1

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>