Annotation of freem_fileman/DIDU.m, revision 1.1.1.1
1.1 snw 1: DIDU ;SEA/TOAD-VA FileMan: DD Tools, Format ;12/1/94 16:35
2: ;;21.0;VA FileMan;;Dec 28, 1994
3: ;Per VHA Directive 10-93-142, this routine should not be modified.
4:
5: EXTERNAL(DIFILE,DIFIELD,DIFLAGS,DINTERNL,DIMSGA)
6: XTRNLX ; Branch from DILFD or DIQGU
7: ; ENTRY POINT--convert DINTERNL to external format
8: ; func, all passed by value
9: I '$D(DIQUIET) N DIQUIET S DIQUIET=1
10: I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
11: INPUT
12: I $G(DINTERNL)="" Q ""
13: S DIMSGA=$G(DIMSGA) I DIMSGA'="" D
14: . K @DIMSGA@("DIERR"),@DIMSGA@("DIHELP"),@DIMSGA@("DIMSG")
15: S DIFILE=$G(DIFILE)
16: I DIFILE'>0 D ERR(DIMSGA,202,"","","","FILE") Q ""
17: S DIFLAGS=$G(DIFLAGS)
18: I DIFLAGS'?.1(1"F",1"L",1"U") D ERR(DIMSGA,301,"","","",DIFLAGS) Q ""
19: S DIFIELD=$G(DIFIELD)
20: I DIFIELD'>0 D ERR(DIMSGA,202,"","","","FIELD") Q ""
21: PREP
22: N DICHAIN,DIDONE,DIEN,DIEXTRNL
23: N DIHEAD,DINEXT,DINODE,DIOUT,DIROOT,DITYPE,DIXFORM
24: S DICHAIN=0,DIDONE=0,DIEN="",DIEXTRNL=""
25: S DIHEAD="",DINEXT="",DIOUT=0,DIXFORM=""
26: N DIPREV S DIPREV=""
27: N DIPREVF S DIPREVF=""
28: I '$D(^DD(DIFILE)) D ERR(DIMSGA,401,DIFILE) Q ""
29: S DINODE=$G(^DD(DIFILE,DIFIELD,0))
30: I DINODE="" D ERR(DIMSGA,501,DIFILE,"",DIFIELD,DIFIELD) Q ""
31: S DITYPE=$P(DINODE,U,2)
32: RESOLVE
33: F D I DIDONE!$G(DIERR)!DIOUT Q
34: XFORM .
35: . I DIFLAGS["U",DIXFORM'="",DITYPE'["P",DITYPE'["V" S DITYPE=DITYPE_"O"
36: . I DITYPE["O" D I DIDONE!$G(DIERR) Q
37: . . I DIFLAGS["F",DICHAIN Q
38: . . I DIFLAGS["L",DITYPE["P"!(DITYPE["V") Q
39: . . I DIXFORM=""!(DIFLAGS'["U") S DIXFORM=$G(^DD(DIFILE,DIFIELD,2))
40: . . I DIXFORM="" Q
41: . . I DIFLAGS["U",DITYPE["P"!(DITYPE["V") Q
42: . . N Y S Y=DINTERNL
43: . . X DIXFORM
44: . . I $G(DIERR) D ERR^DICF6(120,DIFILE,DIEN,"","Output Transform") Q
45: . . S DIEXTRNL=Y
46: . . S DIDONE=1
47: CHAIN .
48: . I DITYPE S DIOUT=1 Q
49: . I DITYPE'["P",DITYPE'["V" S DIOUT=1 Q
50: . I 'DINTERNL D Q
51: . . I 'DICHAIN D ERR(DIMSGA,330,"","","",DINTERNL,"pointer") Q
52: . . D ERR(DIMSGA,630,DIFILE,"",DIFIELD,DIEN,DINTERNL,"pointer")
53: . I DITYPE["P" S DIROOT=$P(DINODE,U,3),DINEXT=+$P($P(DINODE,U,2),"P",2)
54: . I DITYPE["V" S DIROOT=$P(DINTERNL,";",2),DINEXT=""
55: 10 . S DIHEAD=$G(@(U_DIROOT_"0)")) ;***** Naked Set *****
56: . I DIHEAD="" D Q
57: . . D HEADER(DIFILE,DIEN,DIFIELD,DITYPE,DICHAIN,DINTERNL,DINEXT)
58: . I DITYPE["V" S DINEXT=$P(DIHEAD,U,2) I +DINEXT'=DINEXT D Q
59: . . D ERR(DIMSGA,404,"","","",$$CREF^DILF(U_DIROOT))
60: . I '$D(^(+DINTERNL)) D Q ;***** Naked *****
61: . . N DI S DI="pointer to File #"
62: . . I 'DICHAIN D ERR(DIMSGA,330,"","","",DINTERNL,DI_DINEXT) Q
63: . . D ERR(DIMSGA,630,DIFILE,DIFIELD,"",DIEN,DINTERNL,DI_DINEXT)
64: 20 . S DIEN=+DINTERNL
65: . S DIPREV=DIFILE,DIFILE=DINEXT
66: . S DINTERNL=$P($G(^(DIEN,0)),U) ;***** Naked *****
67: . I DINTERNL="" D ERR(DIMSGA,603,DIFILE,"",.01,DIEN) Q
68: . S DINODE=$G(^DD(DIFILE,.01,0))
69: . S DITYPE=$P(DINODE,U,2)
70: 30 . I DITYPE="" D ERR(DIMSGA,510,DIFILE,"",.01) Q
71: . S DIPREVF=DIFIELD,DIFIELD=.01
72: . S DICHAIN=1
73: I DIDONE Q DIEXTRNL
74: BAD
75: I $G(DIERR) Q ""
76: I DITYPE["C" D ERRPTR("Computed") Q ""
77: I DITYPE["W" D ERRPTR("Word Processing") Q ""
78: I DITYPE S DITYPE=$P($G(^DD(+DITYPE,.01,0)),U,2) D Q ""
79: . I DITYPE["W" D ERRPTR("Word Processing") Q
80: . D ERRPTR("Multiple") Q
81: CODES
82: I DITYPE["S" D Q DIEXTRNL
83: . N DICODES S DICODES=";"_$P(DINODE,U,3)
84: . N DISTART S DISTART=$F(DICODES,";"_DINTERNL_":")
85: . I 'DISTART S DIEXTRNL="" D Q
86: . . I 'DICHAIN D ERR(DIMSGA,730,DIFILE,"",DIFIELD,DINTERNL,"code") Q
87: . . D ERR(DIMSGA,630,DIFILE,DIFIELD,"",DIEN,DINTERNL,"code")
88: . S DIEXTRNL=$P($E(DICODES,DISTART,$L(DICODES)),";")
89: OTHER
90: I DITYPE["D",DINTERNL D Q DIEXTRNL
91: . S DIEXTRNL=$$FMTE^DILIBF(DINTERNL,"1U")
92: . I DIEXTRNL'="" Q
93: . I 'DICHAIN D ERR(DIMSGA,330,"","","",DINTERNL,"date") Q
94: . D ERR(DIMSGA,630,DIFILE,"",DIFIELD,DIEN,DINTERNL,"date")
95: Q DINTERNL
96:
97: HEADER(DIFILE,DIEN,DIFIELD,DITYPE,DICHAIN,DINTERNL,DINEXT)
98: ; CHAIN--pick a header error and log it
99: ; proc, all by val
100: I DITYPE["P" D Q
101: . I 'DINEXT!'$D(^DD(DINEXT)) D ERR(DIMSGA,537,DIFILE,"",DIFIELD) Q
102: . D ERR(DIMSGA,403,DINEXT)
103: ; otherwise, it's a variable pointer
104: I DICHAIN D ERR(DIMSGA,648,DIFILE,"",DIFIELD,DIEN,DINTERNL) Q
105: D ERR(DIMSGA,348,"","","",DINTERNL)
106: Q
107:
108: ERR(DIMSGA,DIERN,DIFILE,DIIENS,DIFIELD,DI1,DI2,DI3)
109: ; error logging procedure
110: N DIPE
111: N DI F DI="FILE","IENS","FIELD",1:1:3 S DIPE(DI)=$G(@("DI"_DI))
112: D BLD^DIALOG(DIERN,.DIPE,.DIPE,DIMSGA,"F")
113: Q
114:
115: ERRPTR(DITYPE)
116: ; error logging shell for errors 520 & 537
117: I DICHAIN D ERR(DIMSGA,537,DIPREV,"",DIPREVF) Q
118: D ERR(DIMSGA,520,DIFILE,"",DIFIELD,DITYPE)
119: Q
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to DIDU.m CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Coherent Logic Development] / freem_fileman