| 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
|
|---|
