Return to DIDU2.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIDU2.m, revision 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: