Return to DIDU2.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DIDU2	;SEA/TOAD-VA FileMan: DD Tools, Header Nodes ;10/21/94  12:08 ;
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    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 DICOUNT=0,DIRECORD=0
   16: 	F  S DIRECORD=$O(@DIROOT@(DIRECORD)) Q:'DIRECORD  S DICOUNT=DICOUNT+1
   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 DINODE["A" S DICODES=DICODES_"A"
   74: 	I DINODE["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
   85: