1 | DIDU2 ;SEA/TOAD-VA FileMan: DD Tools, Header Nodes ;1:17 PM 12 Jan 2001
|
---|
2 | ;;22.0;VA FileMan;**72**;Mar 30, 1999
|
---|
3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
---|
4 | ;
|
---|
5 | HEADER(DIFILE,DIENS,DIMSGA) ;
|
---|
6 | ;ENTRY POINT--return the value a file's Header Node should have
|
---|
7 | ;extrinsic function, DIENS passed by reference
|
---|
8 | I '$D(DIQUIET) N DIQUIET S DIQUIET=1
|
---|
9 | I '$D(DIFM) N DIFM S DIFM=1 D INIZE^DIEFU
|
---|
10 | N DIROOT D HINPUT(.DIFILE,.DIENS,.DIMSGA,.DIROOT) I $G(DIERR) D Q ""
|
---|
11 | . D CLOSE
|
---|
12 | N DIHEADER S DIHEADER=$$PIECES12(DIFILE,DIROOT) I $G(DIERR) D Q ""
|
---|
13 | . D CLOSE
|
---|
14 | N DIRECENT S DIRECENT=$O(@DIROOT@(" "),-1) I DIRECENT="" S DIRECENT=0
|
---|
15 | N DICOUNT,DIRECORD S DIRECORD=0
|
---|
16 | F DICOUNT=0:1 S DIRECORD=$O(@DIROOT@(DIRECORD)) Q:'DIRECORD I DICOUNT>10000 S DICOUNT=$P($G(@DIROOT@(0)),U,4) Q
|
---|
17 | Q DIHEADER_U_DIRECENT_U_DICOUNT
|
---|
18 | ;
|
---|
19 | HINPUT(DIFILE,DIENS,DIMSGA,DIROOT) ;
|
---|
20 | ;evaluate input variables for HEADER call
|
---|
21 | I $G(DIMSGA)'="" D
|
---|
22 | . K @DIMSGA@("DIERR"),@DIMSGA@("DIHELP"),@DIMSGA@("DIMSG")
|
---|
23 | S DIFILE=$G(DIFILE) I DIFILE="" D ERR(202,"","","","FILE") Q
|
---|
24 | I $G(^DD(DIFILE,.01,0))="" D Q
|
---|
25 | . I '$D(^DD(DIFILE)) D ERR(401,DIFILE) Q
|
---|
26 | . I '$D(^DD(DIFILE,.01)) D ERR(406,DIFILE) Q
|
---|
27 | . E D ERR(502,DIFILE,"",.01)
|
---|
28 | S DIENS=$G(DIENS) I DIENS="" S DIENS=","
|
---|
29 | I '$$IEN^DIDU1(DIENS) D Q
|
---|
30 | . I '$$IEN^DIDU1(DIENS_",") D ERR(202,"","","","IENS") Q
|
---|
31 | . E D ERR(304,"",DIENS)
|
---|
32 | S DIROOT=$G(DIFILE("ROOT")) I DIROOT="" D
|
---|
33 | . S DIROOT=$$ROOT^DILFD(DIFILE,DIENS,1,1) Q:DIROOT'=""!$G(DIERR)
|
---|
34 | . I '$D(^DD(DIFILE)) D ERR(401,DIFILE) Q
|
---|
35 | . E D ERR(402,DIFILE,DIENS)
|
---|
36 | Q
|
---|
37 | ;
|
---|
38 | PIECES12(DIFILE,DIROOT) ;
|
---|
39 | ;return pieces 1 & 2 of the Header node
|
---|
40 | N DIPIECE1,DIPIECE2
|
---|
41 | N DINAME S DINAME=$O(^DD(DIFILE,0,"NM","")) I DINAME="" D Q ""
|
---|
42 | . D ERR(408,DIFILE)
|
---|
43 | N DIPARENT S DIPARENT=$G(^DD(DIFILE,0,"UP"))
|
---|
44 | ;
|
---|
45 | P1 I DIPARENT'="" D ;subfile
|
---|
46 | . S DIPIECE1=""
|
---|
47 | . I $P(^DD(DIFILE,.01,0),U,2)["W" D Q
|
---|
48 | . . D ERR(407,DIFILE)
|
---|
49 | . N DIFIELD S DIFIELD=$O(^DD(DIPARENT,"B",DINAME,""))
|
---|
50 | . I DIFIELD="" D Q
|
---|
51 | . . D ERR(501,DIFILE,"","",DINAME)
|
---|
52 | . N DINODE S DINODE=$G(^DD(DIPARENT,DIFIELD,0)) I DINODE="" D Q
|
---|
53 | . . D ERR(502,DIFILE,"",DIFIELD)
|
---|
54 | . S DIPIECE2=$P(DINODE,U,2) I DIPIECE2="" D Q
|
---|
55 | . . D ERR(502,DIFILE,"",DIFIELD)
|
---|
56 | ;
|
---|
57 | P2 E D ;root file
|
---|
58 | . S DIPIECE1=DINAME
|
---|
59 | . S DIPIECE2=DIFILE_$$CODES(DIFILE,DIROOT) I $G(DIERR) Q
|
---|
60 | I $G(DIERR) Q ""
|
---|
61 | Q DIPIECE1_U_DIPIECE2
|
---|
62 | ;
|
---|
63 | CODES(DIFILE,DIROOT) ;
|
---|
64 | ;collect the file characteristics codes
|
---|
65 | N DIFIELD S DIFIELD=$P($G(^DD(DIFILE,.01,0)),U,2) I DIFIELD="" D Q ""
|
---|
66 | . I '$D(^DD(DIFILE,.01)) D ERR(501,DIFILE,"","",.01) Q
|
---|
67 | . E D ERR(510,DIFILE,"",DIFIELD)
|
---|
68 | N DICODES S DICODES=""
|
---|
69 | N DITYPE F DITYPE="D","S","P","V" I DIFIELD[DITYPE S DICODES=DITYPE Q
|
---|
70 | I $D(^DD(DIFILE,0,"ID")) S DICODES=DICODES_"I"
|
---|
71 | I $D(^DD(DIFILE,0,"SCR"))#2 S DICODES=DICODES_"s"
|
---|
72 | N DINODE S DINODE=$G(@DIROOT@(0))
|
---|
73 | I $P(DINODE,U,2)["A" S DICODES=DICODES_"A"
|
---|
74 | I $P(DINODE,U,2)["O" S DICODES=DICODES_"O"
|
---|
75 | Q DICODES
|
---|
76 | ;
|
---|
77 | CLOSE D CALLOUT^DIEFU($G(DIMSGA)):$G(DIMSGA)'="" Q
|
---|
78 | ;
|
---|
79 | ERR(DIERN,DIFILE,DIIENS,DIFIELD,DI1,DI2,DI3) ;
|
---|
80 | ;log an error
|
---|
81 | N DIPE
|
---|
82 | N DI F DI="FILE","IENS","FIELD",1:1:3 S DIPE(DI)=$G(@("DI"_DI))
|
---|
83 | D BLD^DIALOG(DIERN,.DIPE,.DIPE)
|
---|
84 | Q
|
---|