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

DICU.m

Go to the documentation of this file.
  1. DICU ;SEA/TOAD-VA FileMan: Lookup Utilities ;12APR2008
  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. REQIDS(DIFILE,DITARGET) ;
  1. ; return REQUIRED IDENTIFIERS file attribute
  1. ; DIFILE = file#, DITARGET = target array
  1. N DIATTRBT S DIATTRBT="REQUIRED IDENTIFIERS"
  1. S @DITARGET@(DIATTRBT,.01)=""
  1. N DIFIELD
  1. S DIFIELD=0 F S DIFIELD=$O(^DD(DIFILE,0,"ID",DIFIELD)) Q:'DIFIELD D
  1. . I $D(^DD(DIFILE,"RQ",DIFIELD)) S @DITARGET@(DIATTRBT,DIFIELD)=""
  1. Q
  1. ;
  1. RID(DIFILE) ;
  1. ; return a string listing a file's required identifiers
  1. ; DIFILE = file#
  1. N DILIST S DILIST=".01"
  1. N DID S DID="" F S DID=$O(^DD(DIFILE,0,"ID",DID)) Q:'DID D
  1. . I $D(^DD(DIFILE,"RQ",DID)) S DILIST=DILIST_U_DID
  1. Q DILIST
  1. ;
  1. RECALL(DIFILE,DIEN,DIUSER) ;
  1. RECALLX ; input from DILFD
  1. ;
  1. ; ENTRY POINT--save a user's selection for use with space-bar recall
  1. ; procedure, all passed by value
  1. ;
  1. I '$D(DIQUIET) N DIQUIET S DIQUIET=1
  1. I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
  1. N DICLERR S DICLERR=$G(DIERR) K DIERR
  1. ;
  1. 30 S DIFILE=$G(DIFILE)
  1. I +DIFILE'=DIFILE!(DIFILE<0) D ERR(202,"","","","file") Q
  1. S DIEN=$G(DIEN) I DIEN="" S DIEN=","
  1. I '$$IEN^DIDU1(DIEN) D ERR(202,"","","","IEN string") Q
  1. S DIUSER=+$G(DIUSER)
  1. ;
  1. 32 N DIOROOT,DIOUT S DIOUT=0 D I DIOUT Q
  1. . I '$D(^DD(DIFILE)) D ERR(401,DIFILE) S DIOUT=1 Q
  1. . S DIOROOT=$$ROOT^DILFD(DIFILE,DIEN,"Q")
  1. . I DIOROOT'?1"^"1.7AN1"(".ANP,DIOROOT'?1"^%".7AN1"(".ANP D Q ;JIM SELF --ALLOW LC GLOBAL NAMES
  1. . . D ERR(402,DIFILE,"","","","","",DIOROOT) S DIOUT=1
  1. S ^DISV(DIUSER,$E(DIOROOT,1,28))=$E(DIOROOT,29,$L(DIOROOT))_+DIEN
  1. I DICLERR'=""!$G(DIERR) D
  1. . S DIERR=$G(DIERR)+DICLERR_U_($P($G(DIERR),U,2)+$P(DICLERR,U,2))
  1. Q
  1. ;
  1. FILE(DIFILE,DIDA,DIFLAGS,DIROOT) ;
  1. ; entry point -- given a root, calculate the file # and DA
  1. ; DO NOT USE UNTIL $QS & $QL AVAILABLE
  1. N DIGLOBAL I $G(DIFLAGS)'["O" S DIGLOBAL=DIROOT
  1. E S DIGLOBAL=$$CREF^DIQGU(DIROOT),DIROOT=DIGLOBAL
  1. S DIFILE=+$P($G(@DIGLOBAL@(0)),U,2),DIDA=""
  1. N DA,DIENTRY S DA=1,DIENTRY=0
  1. ;
  1. LOOP N DICHAR,DIL,DILEAD,DIQL,DIQS,DIQSL F D Q:'DIQL
  1. .
  1. STRIP .
  1. . ; S DIQL=$QL(DIGLOBAL) Q:'DIQL
  1. . ; S DIQS=$QS(DIGLOBAL,DIQL)
  1. . N DIQSL S DIQSL=$L(DIQS)+1 I +DIQS'=DIQS S DIQSL=DIQSL+2
  1. . S DIL=$L(DIGLOBAL),DILEAD=DIL-DIQSL
  1. . S $E(DIGLOBAL,DILEAD+1,DIL-1)=""
  1. . S DICHAR=$E(DIGLOBAL,DILEAD)
  1. . I DICHAR="," S $E(DIGLOBAL,DILEAD)=""
  1. . E I DICHAR="(" S $E(DIGLOBAL,DILEAD,DILEAD+1)=""
  1. . E S DIGLOBAL="ERROR: "_DIGLOBAL,DIQL=0
  1. .
  1. ENTRY . I DIENTRY D
  1. . . S DIFILE(DA)=+$P($G(@DIGLOBAL@(0)),U,2)
  1. . . S DIROOT(DA)=DIGLOBAL
  1. . . S DIDA(DA)=DIQS,DA=DA+1
  1. . S DIENTRY='DIENTRY
  1. Q
  1. ;
  1. ERR(DIERN,DIFILE,DIIENS,DIFIELD,DI1,DI2,DI3,DIROOT) ;
  1. ;
  1. ; error logging procedure
  1. ; RECALL
  1. ;
  1. N DIPE,DI
  1. F DI="FILE","IENS","FIELD",1:1:3,"ROOT" S DIPE(DI)=$G(@("DI"_DI))
  1. D BLD^DIALOG(DIERN,.DIPE,.DIPE)
  1. S DIERR=$G(DIERR)+DICLERR_U_($P($G(DIERR),U,2)+$P(DICLERR,U,2))
  1. Q