Annotation of freem_fileman/DIEF.m, revision 1.1
1.1 ! snw 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>