DIAC ;SFISC/YJK-FILE ACCESS CHECK ;3/18/99 12:59
;;22.2;VA FileMan;;Jan 05, 2016;Build 42
;;Per VA Directive 6402, this routine should not be modified.
;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
;;Licensed under the terms of the Apache License, Version 2.0.
;
EN Q:'$D(DIAC)!'$D(DIFILE)
I '$D(^DIC(DIFILE,0))#2 S (DIAC,%)=0 Q
I DUZ(0)="@" S (DIAC,%)=1 Q
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
K A1 S %=DIAC Q
;
CK I $S($D(^VA(200,"AFOF")):1,1:$D(^DIC(3,"AFOF"))) D FOF Q
I '$D(^DIC(DIFILE,0,DIAC)) S DIAC=1 Q
S %=^(DIAC) I %="" S DIAC=1 Q
F A1=1:1:$L(%) I DUZ(0)[$E(%,A1) S DIAC=1 Q
I 'DIAC S DIAC=0
Q
;
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
Q
;
;;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDIAC 913 printed Dec 13, 2024@02:44:36 Page 2
DIAC ;SFISC/YJK-FILE ACCESS CHECK ;3/18/99 12:59
+1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
+4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
+5 ;;Licensed under the terms of the Apache License, Version 2.0.
+6 ;
EN if '$DATA(DIAC)!'$DATA(DIFILE)
QUIT
+1 IF '$DATA(^DIC(DIFILE,0))#2
SET (DIAC,%)=0
QUIT
+2 IF DUZ(0)="@"
SET (DIAC,%)=1
QUIT
+3 SET A1=$SELECT(DIAC="DD":2,DIAC="DEL":3,DIAC="LAYGO":4,DIAC="RD":5,DIAC="WR":6,DIAC="AUDIT":7,1:0)
if A1
DO CK
+4 KILL A1
SET %=DIAC
QUIT
+5 ;
CK IF $SELECT($DATA(^VA(200,"AFOF")):1,1:$DATA(^DIC(3,"AFOF")))
DO FOF
QUIT
+1 IF '$DATA(^DIC(DIFILE,0,DIAC))
SET DIAC=1
QUIT
+2 SET %=^(DIAC)
IF %=""
SET DIAC=1
QUIT
+3 FOR A1=1:1:$LENGTH(%)
IF DUZ(0)[$EXTRACT(%,A1)
SET DIAC=1
QUIT
+4 IF 'DIAC
SET DIAC=0
+5 QUIT
+6 ;
FOF SET DIAC=0
IF $SELECT($DATA(^VA(200,DUZ,"FOF",DIFILE,0)):1,1:$DATA(^DIC(3,DUZ,"FOF",DIFILE,0)))
IF $PIECE(^(0),U,A1)
SET DIAC=1
+1 QUIT
+2 ;
+3 ;;
