source: WorldVistAEHR/trunk/r/VA_FILEMAN-ARJT-DI-DD-DM-DT-%DT-%RCR/DIDU2.m@ 1476

Last change on this file since 1476 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 3.0 KB
Line 
1DIDU2 ;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 ;
5HEADER(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 ;
19HINPUT(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 ;
38PIECES12(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 ;
45P1 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 ;
57P2 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 ;
63CODES(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 ;
77CLOSE D CALLOUT^DIEFU($G(DIMSGA)):$G(DIMSGA)'="" Q
78 ;
79ERR(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
Note: See TracBrowser for help on using the repository browser.