Return to DICU1.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DICU1.m, revision 1.1

1.1     ! snw         1: DICU1  ;SEA/TOAD-VA FileMan: Lookup Tools, Get IDs ;11/4/94  08:33 ;
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        
        !             5: IDENTS(DIFILE,DIFIELD,DIROOT,DIDS,DIWRITE,DIDENT)      
        !             6:        ; ENTRY POINT--return array of identifiers and code to build them
        !             7:        ; proc, DIDENT by reference
        !             8:        N DICODE,DICRSR,DIDEF,DIEFROM,DIETO
        !             9:        N DINODE,DIOUTI,DIPIECE,DISTORE,DITYPE,DIUSEKEY
        !            10:        S DIUSEKEY=DIFIELD'=.01!(DIFILE'=$G(DIFILE("INDEX"),DIFILE))
        !            11:        S DIDENT=DIUSEKEY*.01
        !            12:        I DIDS'="" S DICRSR=1
        !            13:        F  D  Q:DIDENT=""!$G(DIERR)
        !            14:        . I 'DIUSEKEY D
        !            15:        . . I DIDS'="" S DIDENT=$P(DIDS,";",DICRSR),DICRSR=DICRSR+1 Q
        !            16:        . . S DIDENT=$O(^DD(DIFILE,0,"ID",DIDENT)) Q
        !            17:        . I DIUSEKEY S DIUSEKEY=0
        !            18:        . I DIDENT="" S DIOUTI=1 D  Q:DIOUTI
        !            19:        . . Q:DIDS=""
        !            20:        . . S DIDS=""
        !            21:        . . S DIDENT=$O(^DD(DIFILE,0,"ID"," "),-1),DIDENT=$O(^(DIDENT))
        !            22:        . . S DIOUTI=DIDENT=""
        !            23:        . . Q
        !            24:        . I DIDS="",DIFIELD=DIDENT,DIFILE=DIFILE("INDEX") Q
        !            25: IDFIELD        .
        !            26:        . I DIDENT D  Q:$G(DIERR)
        !            27:        . . S DINODE=$G(^DD(DIFILE,0,"ID",DIDENT))
        !            28:        . . I DIDS="",DINODE="W """"" Q
        !            29:        . . D GET(DIFILE,DIDENT,.DIDEF,.DICODE)
        !            30:        . . Q:$G(DIERR)
        !            31:        . . S DITYPE=$P(DIDEF,U,2)
        !            32:        . . I DIDEF="" Q
        !            33:        . . S DIDENT(DIDENT)=DICODE
        !            34:        . . I DITYPE["D" S DITYPE="D"
        !            35:        . . E  I DITYPE["S" S DITYPE="S"
        !            36:        . . S DIDENT(DIDENT,"TYPE")=DITYPE
        !            37:        . . I DITYPE["S" S DIDENT(DIDENT,"CODE")=";"_$P(DIDEF,U,3)
        !            38:        . . Q
        !            39: IDWRITE        .
        !            40:        . E  D
        !            41:        . . S DICODE=$G(^DD(DIFILE,0,"ID",DIDENT))
        !            42:        . . I DICODE'="" S DIDENT(DIDENT)="N DIMSG "_DICODE
        !            43:        . . Q
        !            44:        . Q
        !            45:        Q:$G(DIERR)
        !            46:        I DIWRITE'="" S DIDENT("ZZZ ID")="N DIMSG "_DIWRITE
        !            47:        Q
        !            48:        
        !            49: GET(DIFILE,DIFIELD,DIDEF,DICODE)       
        !            50:        N DINODE,DIPIECE,DISTORE,DIEFROM,DIETO
        !            51:        I DIFIELD=.001 S DICODE="DIEN",DIDEF="" Q
        !            52:        S DIDEF=$G(^DD(DIFILE,DIFIELD,0))
        !            53:        I DIDEF="" D ERR(501,DIFILE,"","",DIFIELD) Q
        !            54:        
        !            55: G1     N DITYPE S DITYPE=$P(DIDEF,U,2)
        !            56:        I DITYPE["C"!DITYPE D  Q
        !            57:        . I DITYPE["C" S DITYPE="Computed"
        !            58:        . E  D
        !            59:        . . I $P($G(^DD(+DITYPE,.01,0)),U,2)["W" S DITYPE="Word-processing"
        !            60:        . . E  S DITYPE="Multiple"
        !            61:        . D ERR(520,DIFILE,"",DIFIELD,DITYPE)
        !            62:        
        !            63: G2     S DISTORE=$P(DIDEF,U,4)
        !            64:        S DINODE=$P(DISTORE,";")
        !            65:        S DIPIECE=$P(DISTORE,";",2)
        !            66:        I DINODE="",$P(DIPIECE,"E")'="",'DIPIECE S (DICODE,DIDEF)="" Q
        !            67:        S DINODE="$G(@DIROOT@(+DIEN,"""_DINODE_"""))"
        !            68:        I DIPIECE S DICODE="$P("_DINODE_",U,"_DIPIECE_")"
        !            69:        E  D
        !            70:        . S DIEFROM=$P($E(DIPIECE,2,9999),",")
        !            71:        . S DIETO=$P(DIPIECE,",",2)
        !            72:        . S DICODE="$E("_DINODE_","_DIEFROM_","_DIETO_")"
        !            73:        Q
        !            74:        
        !            75: INDEX(DIFILE,DINDEX,DIROOT)    
        !            76:        ; lookup data on a file's index
        !            77:        S DINDEX("CODE")=""
        !            78:        S DINDEX("FIELD")=""
        !            79:        S DINDEX("TYPE")=""
        !            80:        S DIFILE("INDEX")=$O(^DD(DIFILE,0,"IX",DINDEX,""))
        !            81:        I DIFILE("INDEX") D
        !            82:        . S DINDEX("FIELD")=$O(^DD(DIFILE,0,"IX",DINDEX,DIFILE("INDEX"),""))
        !            83: I1     I DINDEX("FIELD") N DIXNODE D
        !            84:        . N DIXGET
        !            85:        . D GET(DIFILE("INDEX"),DINDEX("FIELD"),.DIXNODE,.DIXGET)
        !            86:        . S DINDEX("GET")=DIXGET
        !            87:        . S DINDEX("TYPE")=$P(DIXNODE,U,2)
        !            88:        I DINDEX("TYPE")["D" S DINDEX("TYPE")="D"
        !            89:        I DINDEX("TYPE")["S" D
        !            90:        . S DINDEX("TYPE")="S"
        !            91:        . S DINDEX("CODE")=";"_$P(DIXNODE,U,3)
        !            92:        S DINDEX("NODE")=DIXNODE
        !            93:        I DINDEX("TYPE")["P" D
        !            94:        . S DINDEX("TYPE")="P"
        !            95:        . S DINDEX("PTR")=+$P($P(DIXNODE,U,2),"P",2)
        !            96:        Q
        !            97:        
        !            98: BOTH(DIFILE,DIFLAGS,DIROOT,DINDEX,DIFIELDS,DIWRITE,DIDENT)     
        !            99:        ; IXANDID^DICL--get index and identifier info
        !           100:        D INDEX(.DIFILE,.DINDEX,DIROOT) Q:$G(DIERR)
        !           101:        Q:DIFLAGS["f"
        !           102:        D IDENTS(.DIFILE,DINDEX("FIELD"),DIROOT,DIFIELDS,DIWRITE,.DIDENT)
        !           103:        Q
        !           104:        
        !           105: ERR(DIERN,DIFILE,DIENS,DIFIELD,DI1)    
        !           106:        N DIPE
        !           107:        S DIPE("FILE")=$G(DIFILE)
        !           108:        S DIPE("IEN")=$G(DIENS)
        !           109:        S DIPE("FIELD")=$G(DIFIELD)
        !           110:        S DIPE(1)=$G(DI1)
        !           111:        D BLD^DIALOG(DIERN,.DIPE,.DIPE)
        !           112:        Q
        !           113:        
        !           114:        
        !           115: FIELD(DIFILE,DIFIELD,DINDEX)   
        !           116:        ; return code to fetch field value prior to screen execution
        !           117:        I DIFIELD=.01 Q "DIKEY"
        !           118:        N DISTORE S DISTORE=$P(DINDEX(0,"DEF"),U,4)
        !           119:        N DINODE S DINODE=$P(DISTORE,";")
        !           120:        N DIPIECE S DIPIECE=$P(DISTORE,";",2)
        !           121:        I 'DINODE,$P(DIPIECE,"E")'="",'DIPIECE Q "X"
        !           122:        I DINODE=0 S DINODE="DINODE"
        !           123:        E  S DINODE="$G(@DIROOT@(+DIEN,"""_DINODE_"""))"
        !           124:        N DICODE I DIPIECE S DICODE="$P("_DINODE_",U,"_DIPIECE_")"
        !           125:        E  D
        !           126:        . N DIEFROM S DIEFROM=$P($E(DIPIECE,2,9999),",")
        !           127:        . N DIETO S DIETO=$P(DIPIECE,",",2)
        !           128:        . S DICODE="$E("_DINODE_","_DIEFROM_","_DIETO_")"
        !           129:        Q DICODE