Return to DICU1.m CVS log

Up to [Coherent Logic Development] / freem_fileman

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