Return to DIDU2.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIDU2.m, revision 1.1.1.1

1.1       snw         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: