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

    1: DIAC	;SFISC/YJK-FILE ACCESS CHECK ;9/14/94  10:00
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: 	;
    5: EN	Q:'$D(DIAC)!'$D(DIFILE)  I DUZ(0)="@" S (DIAC,%)=1 Q
    6: 	S A1=$S(DIAC="DD":2,DIAC="DEL":3,DIAC="LAYGO":4,DIAC="RD":5,DIAC="WR":6,DIAC="AUDIT":7,1:0) D:A1 CK
    7: 	K A1 S %=DIAC Q
    8: 	;
    9: CK	I $S($D(^VA(200,"AFOF")):1,1:$D(^DIC(3,"AFOF"))) D FOF Q
   10: 	I '$D(^DIC(DIFILE,0,DIAC)) S DIAC=1 Q
   11: 	S %=^(DIAC) I %="" S DIAC=1 Q
   12: 	F A1=1:1:$L(%) I DUZ(0)[$E(%,A1) S DIAC=1 Q
   13: 	I 'DIAC S DIAC=0
   14: 	Q
   15: 	;
   16: FOF	S DIAC=0 I $S($D(^VA(200,DUZ,"FOF",DIFILE,0)):1,1:$D(^DIC(3,DUZ,"FOF",DIFILE,0))),$P(^(0),U,A1) S DIAC=1
   17: 	Q
   18: 	;
   19: 	;;

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