| [613] | 1 | DIDU ;SEA/TOAD-VA FileMan: DD Tools, External Format ;6/15/00 13:29
|
|---|
| 2 | ;;22.0;VA FileMan;**31,48**;Mar 30, 1999
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;11960;7754722;5858;
|
|---|
| 5 | ;
|
|---|
| 6 | EXTERNAL(DIFILE,DIFIELD,DIFLAGS,DINTERNL,DIMSGA) ;
|
|---|
| 7 | ;
|
|---|
| 8 | ; convert a value from internal to external format
|
|---|
| 9 | ; used all over lookup routines
|
|---|
| 10 | ;
|
|---|
| 11 | XTRNLX ;
|
|---|
| 12 | ;
|
|---|
| 13 | ; support for documented entry point $$EXTERNAL^DILFD
|
|---|
| 14 | ; branch from DILFD or DIQGU
|
|---|
| 15 | ;
|
|---|
| 16 | E1 ; set up DBS environment variables
|
|---|
| 17 | ;
|
|---|
| 18 | I '$D(DIQUIET) N DIQUIET S DIQUIET=1
|
|---|
| 19 | I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
|
|---|
| 20 | N DICLERR S DICLERR=$G(DIERR) K DIERR
|
|---|
| 21 | ;
|
|---|
| 22 | E2 ; handle bad input variables
|
|---|
| 23 | ;
|
|---|
| 24 | I $G(DINTERNL)="" Q ""
|
|---|
| 25 | S DIMSGA=$G(DIMSGA)
|
|---|
| 26 | S DIFLAGS=$G(DIFLAGS)
|
|---|
| 27 | I DIFLAGS'?.1(1"F",1"L",1"U",1"i",1"h") D ERR(DIMSGA,301,"","","",DIFLAGS) Q ""
|
|---|
| 28 | I $G(DIFIELD)'>0 D ERR(DIMSGA,202,"","","","FIELD") Q ""
|
|---|
| 29 | ;
|
|---|
| 30 | E3 ; get field definition and type, handle bad file or field
|
|---|
| 31 | ;
|
|---|
| 32 | I $G(DIFILE)<0 D ERR(DIMSGA,202,"","","","FILE") Q ""
|
|---|
| 33 | N DINODE S DINODE=$G(^DD(DIFILE,DIFIELD,0))
|
|---|
| 34 | I DINODE="" D Q ""
|
|---|
| 35 | . I '$D(^DD(DIFILE)) D ERR(DIMSGA,401,DIFILE)
|
|---|
| 36 | . E D ERR(DIMSGA,501,DIFILE,"",DIFIELD,DIFIELD)
|
|---|
| 37 | N DITYPE S DITYPE=$P(DINODE,U,2)
|
|---|
| 38 | ;
|
|---|
| 39 | E4 ; initialize loop control, transform code, pointer chain window,
|
|---|
| 40 | ; pointer file info, and resolved value variables
|
|---|
| 41 | ;
|
|---|
| 42 | N DICHAIN,DIDONE,DIOUT S (DICHAIN,DIDONE,DIOUT)=0
|
|---|
| 43 | N DIXFORM S DIXFORM=""
|
|---|
| 44 | N DINEXT,DIPREV,DIPREVF S (DINEXT,DIPREV,DIPREVF)=""
|
|---|
| 45 | N DIEN,DIHEAD,DIROOT S DIEN=""
|
|---|
| 46 | N DIEXTRNL S DIEXTRNL=""
|
|---|
| 47 | ;
|
|---|
| 48 | E5 ; handle output transforms (see docs for effects of flags)
|
|---|
| 49 | ; under right conditions, execute output transform on value & quit
|
|---|
| 50 | ;
|
|---|
| 51 | F D I DIDONE!$G(DIERR)!DIOUT Q
|
|---|
| 52 | . I DIFLAGS["U",DIXFORM'="",DITYPE'["P",DITYPE'["V" S DITYPE=DITYPE_"O"
|
|---|
| 53 | . I DITYPE["O",DIFLAGS'["i",DIFLAGS'["h" D I DIDONE!$G(DIERR) Q
|
|---|
| 54 | . . I DIFLAGS["F",DICHAIN Q
|
|---|
| 55 | . . I DIFLAGS["L",DITYPE["P"!(DITYPE["V") Q
|
|---|
| 56 | . . I DIXFORM=""!(DIFLAGS'["U") S DIXFORM=$G(^DD(DIFILE,DIFIELD,2))
|
|---|
| 57 | . . I DIXFORM="" Q
|
|---|
| 58 | . . I DIFLAGS["U",DITYPE["P"!(DITYPE["V") Q
|
|---|
| 59 | . . N Y S Y=DINTERNL X DIXFORM
|
|---|
| 60 | . . I $G(DIERR) D ERR^DICF4(120,DIFILE,DIEN,"","Output Transform") Q
|
|---|
| 61 | . . S DIEXTRNL=Y,DIDONE=1
|
|---|
| 62 | .
|
|---|
| 63 | E6 . ; continue with loop only for pointers or variable pointers
|
|---|
| 64 | .
|
|---|
| 65 | . I DITYPE S DIOUT=1 Q
|
|---|
| 66 | . I DITYPE'["P",DITYPE'["V" S DIOUT=1 Q
|
|---|
| 67 | .
|
|---|
| 68 | E7 . ; if the value's not numeric, it's not valid; note that throughout
|
|---|
| 69 | . ; module we return two different errors depending on whether the
|
|---|
| 70 | . ; value passed in is bad, or one found in the pointer chain is
|
|---|
| 71 | .
|
|---|
| 72 | . I 'DINTERNL D Q
|
|---|
| 73 | . . I 'DICHAIN D ERR(DIMSGA,330,"","","",DINTERNL,"pointer") Q
|
|---|
| 74 | . . D ERR(DIMSGA,630,DIFILE,"",DIFIELD,DIEN,DINTERNL,"pointer")
|
|---|
| 75 | .
|
|---|
| 76 | E8 . ; get pointed to file's root and #
|
|---|
| 77 | .
|
|---|
| 78 | . I DITYPE["P" S DIROOT=$P(DINODE,U,3),DINEXT=+$P($P(DINODE,U,2),"P",2) D Q:$G(DIERR)
|
|---|
| 79 | . . I DIROOT="DIC(.2," S DINEXT=.2
|
|---|
| 80 | . . I 'DINEXT!(DIROOT="") D ERR(DIMSGA,537,DIFILE,,DIFIELD)
|
|---|
| 81 | . . Q
|
|---|
| 82 | . I DITYPE["V" S DIROOT=$P(DINTERNL,";",2),DINEXT="" D Q:$G(DIERR)
|
|---|
| 83 | . . I DIROOT="" D ERR(DIMSGA,348,,,,DINTERNL) Q
|
|---|
| 84 | . . S DIHEAD=$G(@(U_DIROOT_"0)"))
|
|---|
| 85 | . . I DIHEAD="" D Q
|
|---|
| 86 | . . . D HEADER(DIFILE,DIEN,DIFIELD,DITYPE,DICHAIN,DINTERNL,DINEXT)
|
|---|
| 87 | . . S DINEXT=+$P(DIHEAD,U,2) I 'DINEXT D Q
|
|---|
| 88 | . . . D ERR(DIMSGA,404,"","","",$$CREF^DILF(U_DIROOT))
|
|---|
| 89 | .
|
|---|
| 90 | E9 . ; ensure pointed to data file exists, and advance file #s
|
|---|
| 91 | .
|
|---|
| 92 | . I '$D(@(U_DIROOT_"+DINTERNL)")) D Q
|
|---|
| 93 | . . N DI S DI="pointer to File #"
|
|---|
| 94 | . . I 'DICHAIN D ERR(DIMSGA,330,"","","",DINTERNL,DI_DINEXT) Q
|
|---|
| 95 | . . D ERR(DIMSGA,630,DIFILE,DIFIELD,"",DIEN,DINTERNL,DI_DINEXT)
|
|---|
| 96 | . S DIPREV=DIFILE,DIFILE=DINEXT
|
|---|
| 97 | .
|
|---|
| 98 | E10 . ; advance pointer value, file characteristics, & pointer window
|
|---|
| 99 | . ; ensure pointed to record exists, & its .01 has a DD
|
|---|
| 100 | . ; set flag that we are now in the pointer chain
|
|---|
| 101 | .
|
|---|
| 102 | . S DIEN=+DINTERNL
|
|---|
| 103 | . S DINTERNL=$P($G(^(DIEN,0)),U) ;***** Naked *****
|
|---|
| 104 | . I DINTERNL="" D ERR(DIMSGA,603,DIFILE,"",.01,DIEN) Q
|
|---|
| 105 | . S DINODE=$G(^DD(DIFILE,.01,0))
|
|---|
| 106 | . S DITYPE=$P(DINODE,U,2)
|
|---|
| 107 | . I DITYPE="" D ERR(DIMSGA,510,DIFILE,"",.01) Q
|
|---|
| 108 | . S DIPREVF=DIFIELD,DIFIELD=.01
|
|---|
| 109 | . S DICHAIN=1
|
|---|
| 110 | . S:DIFILE=.2 DIDONE=1 Q
|
|---|
| 111 | ;
|
|---|
| 112 | E11 ; exit if we executed an output transform or ran into an error
|
|---|
| 113 | ;
|
|---|
| 114 | ; Special "i" flag returns internal value at end of pointer chain
|
|---|
| 115 | I DIFLAGS["i" Q DINTERNL
|
|---|
| 116 | I DIFILE=.2 Q DINTERNL
|
|---|
| 117 | I DIDONE Q DIEXTRNL
|
|---|
| 118 | I $G(DIERR) Q ""
|
|---|
| 119 | ;
|
|---|
| 120 | E12 ; handle illegal data types (pointers, word processings, and multiples)
|
|---|
| 121 | ;
|
|---|
| 122 | I DITYPE["C" D ERRPTR("Computed") Q ""
|
|---|
| 123 | I DITYPE["W" D ERRPTR("Word Processing") Q ""
|
|---|
| 124 | I DITYPE S DITYPE=$P($G(^DD(+DITYPE,.01,0)),U,2) D Q ""
|
|---|
| 125 | . I DITYPE["W" D ERRPTR("Word Processing") Q
|
|---|
| 126 | . D ERRPTR("Multiple") Q
|
|---|
| 127 | ;
|
|---|
| 128 | E13 ; handle sets of codes
|
|---|
| 129 | ;
|
|---|
| 130 | I DITYPE["S" D Q DIEXTRNL
|
|---|
| 131 | . N DICODES S DICODES=";"_$P(DINODE,U,3)
|
|---|
| 132 | . N DISTART S DISTART=$F(DICODES,";"_DINTERNL_":")
|
|---|
| 133 | . I 'DISTART S DIEXTRNL="" D Q
|
|---|
| 134 | . . I 'DICHAIN D ERR(DIMSGA,730,DIFILE,"",DIFIELD,DINTERNL,"code") Q
|
|---|
| 135 | . . D ERR(DIMSGA,630,DIFILE,DIFIELD,"",DIEN,DINTERNL,"code")
|
|---|
| 136 | . S DIEXTRNL=$P($E(DICODES,DISTART,$L(DICODES)),";")
|
|---|
| 137 | ;
|
|---|
| 138 | E14 ; handle dates, and return all others as they are
|
|---|
| 139 | ;
|
|---|
| 140 | I DITYPE["D",DINTERNL D Q DIEXTRNL
|
|---|
| 141 | . S DIEXTRNL=$$FMTE^DILIBF(DINTERNL,"1U")
|
|---|
| 142 | . I DIEXTRNL'="" Q
|
|---|
| 143 | . I 'DICHAIN D ERR(DIMSGA,330,"","","",DINTERNL,"date") Q
|
|---|
| 144 | . D ERR(DIMSGA,630,DIFILE,"",DIFIELD,DIEN,DINTERNL,"date")
|
|---|
| 145 | I DICLERR'=""!$G(DIERR) D
|
|---|
| 146 | . S DIERR=$G(DIERR)+DICLERR_U_($P($G(DIERR),U,2)+$P(DICLERR,U,2))
|
|---|
| 147 | Q DINTERNL
|
|---|
| 148 | ;
|
|---|
| 149 | HEADER(DIFILE,DIEN,DIFIELD,DITYPE,DICHAIN,DINTERNL,DINEXT) ;
|
|---|
| 150 | ;
|
|---|
| 151 | ; pick a header error and log it
|
|---|
| 152 | ; EXTERNAL
|
|---|
| 153 | ;
|
|---|
| 154 | I DITYPE["P" D ; pointer
|
|---|
| 155 | . I 'DINEXT!'$D(^DD(DINEXT)) D ERR(DIMSGA,537,DIFILE,"",DIFIELD) Q
|
|---|
| 156 | . D ERR(DIMSGA,403,DINEXT)
|
|---|
| 157 | ;
|
|---|
| 158 | E D ; variable pointer
|
|---|
| 159 | . I DICHAIN D ERR(DIMSGA,648,DIFILE,"",DIFIELD,DIEN,DINTERNL) Q
|
|---|
| 160 | . D ERR(DIMSGA,348,"","","",DINTERNL)
|
|---|
| 161 | Q
|
|---|
| 162 | ;
|
|---|
| 163 | ERR(DIMSGA,DIERN,DIFILE,DIIENS,DIFIELD,DI1,DI2,DI3) ;
|
|---|
| 164 | ;
|
|---|
| 165 | ; error logging procedure
|
|---|
| 166 | ; EXTERNAL
|
|---|
| 167 | ;
|
|---|
| 168 | N DIPE,DI F DI="FILE","IENS","FIELD",1:1:3 S DIPE(DI)=$G(@("DI"_DI))
|
|---|
| 169 | D BLD^DIALOG(DIERN,.DIPE,.DIPE,DIMSGA,"F")
|
|---|
| 170 | S DIERR=$G(DIERR)+DICLERR_U_($P($G(DIERR),U,2)+$P(DICLERR,U,2))
|
|---|
| 171 | Q
|
|---|
| 172 | ;
|
|---|
| 173 | ERRPTR(DITYPE) ;
|
|---|
| 174 | ;
|
|---|
| 175 | ; error logging shell for errors 520 & 537
|
|---|
| 176 | ; EXTERNAL
|
|---|
| 177 | ;
|
|---|
| 178 | I DICHAIN D ERR(DIMSGA,537,DIPREV,"",DIPREVF) Q
|
|---|
| 179 | D ERR(DIMSGA,520,DIFILE,"",DIFIELD,DITYPE)
|
|---|
| 180 | Q
|
|---|
| 181 | ;
|
|---|
| 182 | ; 202 The input parameter that identifies the |1
|
|---|
| 183 | ; 301 The passed flag(s) '|1|' are unknown or in
|
|---|
| 184 | ; 330 The value '|1|' is not a valid |2|.
|
|---|
| 185 | ; 348 The passed value '|1|' points to a file th
|
|---|
| 186 | ; 401 File #|FILE| does not exist.
|
|---|
| 187 | ; 403 File #|FILE| lacks a Header Node.
|
|---|
| 188 | ; 404 The File Header node of the file stored at
|
|---|
| 189 | ; 501 File #|FILE| does not contain a field |1|.
|
|---|
| 190 | ; 510 The data type for Field #|FIELD| in File #
|
|---|
| 191 | ; 520 A |1| field cannot be processed by this ut
|
|---|
| 192 | ; 537 Field #|FIELD| in File #|FILE| has a corru
|
|---|
| 193 | ; 603 Entry #|1| in File #|FILE| lacks the requi
|
|---|
| 194 | ; 630 In Entry #|1| of File #|FILE|, the value '
|
|---|
| 195 | ; 648 In Entry #|1| of File #|FILE|, the value '
|
|---|
| 196 | ; 730 The value '|1|' is not a valid |2| accordi
|
|---|
| 197 | ;
|
|---|
