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

DIDU.m

Go to the documentation of this file.
  1. DIDU ;SEA/TOAD - VA FileMan: DD Tools, External Format ;5NOV2012
  1. ;;22.2;VA FileMan;**2**;Jan 05, 2016;Build 139
  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. EXTERNAL(DIFILE,DIFIELD,DIFLAGS,DINTERNL,DIMSGA) ;
  1. ;DIFLAGS Flags (to control output transforms on pointers)
  1. ; ("F"=execute first output transform, "L"=execute last output transform, "i"=return internal value of field at end of pointer chain,
  1. ; "h"=return external value but don't execute output transform).
  1. ;
  1. ; convert a value from internal to external format
  1. ; used all over lookup routines
  1. ;
  1. XTRNLX ;
  1. ;
  1. ; support for documented entry point $$EXTERNAL^DILFD
  1. ; branch from DILFD or DIQGU
  1. ;
  1. E1 ; set up DBS environment variables
  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. E2 ; handle bad input variables
  1. ;
  1. I $G(DINTERNL)="" Q ""
  1. S DIMSGA=$G(DIMSGA)
  1. S DIFLAGS=$G(DIFLAGS)
  1. I DIFLAGS'?.1(1"F",1"L",1"U",1"i",1"h",1"A") D ERR(DIMSGA,301,"","","",DIFLAGS) Q ""
  1. I $G(DIFIELD)'>0 D ERR(DIMSGA,202,"","","","FIELD") Q ""
  1. ;
  1. E3 ; get field definition and type, handle bad file or field
  1. ;
  1. I $G(DIFILE)<0 D ERR(DIMSGA,202,"","","","FILE") Q ""
  1. N DINODE S DINODE=$G(^DD(DIFILE,DIFIELD,0))
  1. I DINODE="" D Q ""
  1. . I '$D(^DD(DIFILE)) D ERR(DIMSGA,401,DIFILE)
  1. . E D ERR(DIMSGA,501,DIFILE,"",DIFIELD,DIFIELD)
  1. N DITYPE S DITYPE=$P(DINODE,U,2)
  1. ;
  1. E4 ; initialize loop control, transform code, pointer chain window,
  1. ; pointer file info, and resolved value variables
  1. ;
  1. N DICHAIN,DIDONE,DIOUT S (DICHAIN,DIDONE,DIOUT)=0
  1. N DIXFORM S DIXFORM=""
  1. N DINEXT,DIPREV,DIPREVF S (DINEXT,DIPREV,DIPREVF)=""
  1. N DIEN,DIHEAD,DIROOT S DIEN=""
  1. N DIEXTRNL S DIEXTRNL=""
  1. ;
  1. E5 ; handle output transforms (see docs for effects of flags)
  1. ; under right conditions, execute output transform on value & quit
  1. ;
  1. F D I DIDONE!$G(DIERR)!DIOUT Q
  1. . I DIFLAGS["U",DIXFORM'="",DITYPE'["P",DITYPE'["V" S DITYPE=DITYPE_"O"
  1. TYPE . I DITYPE["O"!(DITYPE["t"),DIFLAGS'["i",DIFLAGS'["h" D I DIDONE!$G(DIERR) Q
  1. . . I DIFLAGS["F",DICHAIN Q
  1. . . I DIFLAGS["L",DITYPE["P"!(DITYPE["V") Q
  1. . . I DIXFORM=""!(DIFLAGS'["U") S DIXFORM=$G(^DD(DIFILE,DIFIELD,2)) I DITYPE["t" S DIXFORM=$$OUTPUT^DIETLIBF
  1. . . I DIXFORM="" Q
  1. . . I DIFLAGS["U",DITYPE["P"!(DITYPE["V") Q
  1. . . N Y S Y=DINTERNL X DIXFORM
  1. . . I $G(DIERR) D ERR^DICF4(120,DIFILE,DIEN,"","Output Transform") Q
  1. . . S DIEXTRNL=Y,DIDONE=1
  1. .
  1. E6 . ; continue with loop only for pointers or variable pointers
  1. .
  1. . I DITYPE S DIOUT=1 Q
  1. . I DITYPE'["P",DITYPE'["V" S DIOUT=1 Q
  1. .
  1. E7 . ; if the value's not numeric, it's not valid; note that throughout
  1. . ; module we return two different errors depending on whether the
  1. . ; value passed in is bad, or one found in the pointer chain is
  1. .
  1. . I 'DINTERNL D Q
  1. . . I 'DICHAIN D ERR(DIMSGA,330,"","","",DINTERNL,"pointer") Q
  1. . . D ERR(DIMSGA,630,DIFILE,"",DIFIELD,DIEN,DINTERNL,"pointer")
  1. .
  1. E8 . ; get pointed to file's root and #
  1. .
  1. . I DITYPE["P" S DIROOT=$P(DINODE,U,3),DINEXT=+$P($P(DINODE,U,2),"P",2) D Q:$G(DIERR)
  1. . . I DIROOT="DIC(.2," S DINEXT=.2
  1. . . I 'DINEXT!(DIROOT="") D ERR(DIMSGA,537,DIFILE,,DIFIELD)
  1. . . Q
  1. . I DITYPE["V" S DIROOT=$P(DINTERNL,";",2),DINEXT="" D Q:$G(DIERR)
  1. . . I DIROOT="" D ERR(DIMSGA,348,,,,DINTERNL) Q
  1. . . S DIHEAD=$G(@(U_DIROOT_"0)"))
  1. . . I DIHEAD="" D Q
  1. . . . D HEADER(DIFILE,DIEN,DIFIELD,DITYPE,DICHAIN,DINTERNL,DINEXT)
  1. . . S DINEXT=+$P(DIHEAD,U,2) I 'DINEXT D Q
  1. . . . D ERR(DIMSGA,404,"","","",$$CREF^DILF(U_DIROOT))
  1. .
  1. E9 . ; ensure pointed to data file exists, and advance file #s
  1. .
  1. . I '$D(@(U_DIROOT_"+DINTERNL)")) D Q
  1. . . N DI S DI="pointer to File #"
  1. . . I 'DICHAIN D ERR(DIMSGA,330,"","","",DINTERNL,DI_DINEXT) Q
  1. . . D ERR(DIMSGA,630,DIFILE,DIFIELD,"",DIEN,DINTERNL,DI_DINEXT)
  1. . S DIPREV=DIFILE,DIFILE=DINEXT
  1. .
  1. E10 . ; advance pointer value, file characteristics, & pointer window
  1. . ; ensure pointed to record exists, & its .01 has a DD
  1. . ; set flag that we are now in the pointer chain
  1. .
  1. . S DIEN=+DINTERNL
  1. . S DINTERNL=$P($G(^(DIEN,0)),U) ;***** Naked *****
  1. . I DINTERNL="" D ERR(DIMSGA,603,DIFILE,"",.01,DIEN) Q
  1. . S DINODE=$G(^DD(DIFILE,.01,0))
  1. . S DITYPE=$P(DINODE,U,2)
  1. . I DITYPE="" D ERR(DIMSGA,510,DIFILE,"",.01) Q
  1. . S DIPREVF=DIFIELD,DIFIELD=.01
  1. . S DICHAIN=1
  1. . S:DIFILE=.2 DIDONE=1 Q
  1. ;
  1. E11 ; exit if we executed an output transform or ran into an error
  1. ;
  1. ; Special "i" flag returns internal value at end of pointer chain
  1. I DIFLAGS["i" Q DINTERNL
  1. I DIFILE=.2 Q DINTERNL
  1. I DIDONE Q DIEXTRNL
  1. I $G(DIERR) Q ""
  1. ;
  1. E12 ; handle illegal data types (pointers, word processings, and multiples)
  1. ;
  1. I DITYPE["C" D ERRPTR("Computed") Q ""
  1. I DITYPE["W" D ERRPTR("Word Processing") Q ""
  1. I DITYPE S DITYPE=$P($G(^DD(+DITYPE,.01,0)),U,2) D Q ""
  1. . I DITYPE["W" D ERRPTR("Word Processing") Q
  1. . D ERRPTR("Multiple") Q
  1. ;
  1. E13 ; handle sets of codes
  1. ;
  1. I DITYPE["S" D Q DIEXTRNL
  1. . N DICODES S DICODES=$P(DINODE,U,3)
  1. . N DISTART S DISTART=$F(";"_DICODES,";"_DINTERNL_":")
  1. . I 'DISTART S DIEXTRNL="" D Q
  1. . . I 'DICHAIN D ERR(DIMSGA,730,DIFILE,"",DIFIELD,DINTERNL,"code") Q
  1. . . D ERR(DIMSGA,630,DIFILE,DIFIELD,"",DIEN,DINTERNL,"code")
  1. SET . S DISTART=DINTERNL D PARSET^DIQ(DICODES,.DISTART) S DIEXTRNL=DISTART
  1. ;
  1. E14 ; handle dates, and return all others as they are
  1. ;
  1. I DITYPE["D",DINTERNL D Q DIEXTRNL
  1. . S DIEXTRNL=$$DATE^DIUTL(DINTERNL) ;**CCO/NI
  1. . I DIEXTRNL'="" Q
  1. . I 'DICHAIN D ERR(DIMSGA,330,"","","",DINTERNL,"date") Q
  1. . D ERR(DIMSGA,630,DIFILE,"",DIFIELD,DIEN,DINTERNL,"date")
  1. I DICLERR'=""!$G(DIERR) D
  1. . S DIERR=$G(DIERR)+DICLERR_U_($P($G(DIERR),U,2)+$P(DICLERR,U,2))
  1. Q DINTERNL
  1. ;
  1. ;
  1. ; pick a header error and log it
  1. ; EXTERNAL
  1. ;
  1. I DITYPE["P" D ; pointer
  1. . I 'DINEXT!'$D(^DD(DINEXT)) D ERR(DIMSGA,537,DIFILE,"",DIFIELD) Q
  1. . D ERR(DIMSGA,403,DINEXT)
  1. ;
  1. E D ; variable pointer
  1. . I DICHAIN D ERR(DIMSGA,648,DIFILE,"",DIFIELD,DIEN,DINTERNL) Q
  1. . D ERR(DIMSGA,348,"","","",DINTERNL)
  1. Q
  1. ;
  1. ERR(DIMSGA,DIERN,DIFILE,DIIENS,DIFIELD,DI1,DI2,DI3) ;
  1. ;
  1. ; error logging procedure
  1. ; EXTERNAL
  1. ;
  1. I $G(DIFLAGS)["A",$$ALLOW(DIERN) S DIDONE=1 Q
  1. N DIPE,DI F DI="FILE","IENS","FIELD",1:1:3 S DIPE(DI)=$G(@("DI"_DI))
  1. D BLD^DIALOG(DIERN,.DIPE,.DIPE,DIMSGA,"F")
  1. S DIERR=$G(DIERR)+DICLERR_U_($P($G(DIERR),U,2)+$P(DICLERR,U,2))
  1. Q
  1. ;
  1. ERRPTR(DITYPE) ;
  1. ;
  1. ; error logging shell for errors 520 & 537
  1. ; EXTERNAL
  1. ;
  1. I DICHAIN D ERR(DIMSGA,537,DIPREV,"",DIPREVF) Q
  1. D ERR(DIMSGA,520,DIFILE,"",DIFIELD,DITYPE)
  1. Q
  1. ;
  1. ALLOW(X) ;If ALLOW appears, do not call erroneous data an error
  1. N I,T F I=3:1 S T=$T(ALLOW+I) Q:T?.P I T[X Q:T'["ALLOW" K T Q
  1. Q '$D(T)
  1. ; 202 The input parameter that identifies the |1
  1. ; 301 The passed flag(s) '|1|' are unknown or in
  1. ; 330 The value '|1|' is not a valid |2|. ALLOW
  1. ; 348 The passed value '|1|' points to a file th
  1. ; 401 File #|FILE| does not exist.
  1. ; 403 File #|FILE| lacks a Header Node.
  1. ; 404 The File Header node of the file stored at
  1. ; 501 File #|FILE| does not contain a field |1|.
  1. ; 510 The data type for Field #|FIELD| in File #
  1. ; 520 A |1| field cannot be processed by this ut
  1. ; 537 Field #|FIELD| in File #|FILE| has a corru
  1. ; 603 Entry #|1| in File #|FILE| lacks the requi
  1. ; 630 In Entry #|1| of File #|FILE|, the value ' ALLOW
  1. ; 648 In Entry #|1| of File #|FILE|, the value '
  1. ; 730 The value '|1|' is not a valid |2| accordi ALLOW
  1. ;