Return to DICU1.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    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