- 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 Jan 18, 2025@03:45:35 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 ;;