Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DIAC

DIAC.m

Go to the documentation of this file.
  1. DIAC ;SFISC/YJK-FILE ACCESS CHECK ;3/18/99 12:59
  1. ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
  1. ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
  1. ;;Licensed under the terms of the Apache License, Version 2.0.
  1. ;
  1. EN Q:'$D(DIAC)!'$D(DIFILE)
  1. I '$D(^DIC(DIFILE,0))#2 S (DIAC,%)=0 Q
  1. I DUZ(0)="@" S (DIAC,%)=1 Q
  1. 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
  1. K A1 S %=DIAC Q
  1. ;
  1. CK I $S($D(^VA(200,"AFOF")):1,1:$D(^DIC(3,"AFOF"))) D FOF Q
  1. I '$D(^DIC(DIFILE,0,DIAC)) S DIAC=1 Q
  1. S %=^(DIAC) I %="" S DIAC=1 Q
  1. F A1=1:1:$L(%) I DUZ(0)[$E(%,A1) S DIAC=1 Q
  1. I 'DIAC S DIAC=0
  1. Q
  1. ;
  1. 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
  1. Q
  1. ;
  1. ;;