Return to DICU1.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

DICU1	;SEA/TOAD-VA FileMan: Lookup Tools, Get IDs ;11/4/94  08:33 ;
	;;21.0;VA FileMan;;Dec 28, 1994
	;Per VHA Directive 10-93-142, this routine should not be modified.
	
IDENTS(DIFILE,DIFIELD,DIROOT,DIDS,DIWRITE,DIDENT)	
	; ENTRY POINT--return array of identifiers and code to build them
	; proc, DIDENT by reference
	N DICODE,DICRSR,DIDEF,DIEFROM,DIETO
	N DINODE,DIOUTI,DIPIECE,DISTORE,DITYPE,DIUSEKEY
	S DIUSEKEY=DIFIELD'=.01!(DIFILE'=$G(DIFILE("INDEX"),DIFILE))
	S DIDENT=DIUSEKEY*.01
	I DIDS'="" S DICRSR=1
	F  D  Q:DIDENT=""!$G(DIERR)
	. I 'DIUSEKEY D
	. . I DIDS'="" S DIDENT=$P(DIDS,";",DICRSR),DICRSR=DICRSR+1 Q
	. . S DIDENT=$O(^DD(DIFILE,0,"ID",DIDENT)) Q
	. I DIUSEKEY S DIUSEKEY=0
	. I DIDENT="" S DIOUTI=1 D  Q:DIOUTI
	. . Q:DIDS=""
	. . S DIDS=""
	. . S DIDENT=$O(^DD(DIFILE,0,"ID"," "),-1),DIDENT=$O(^(DIDENT))
	. . S DIOUTI=DIDENT=""
	. . Q
	. I DIDS="",DIFIELD=DIDENT,DIFILE=DIFILE("INDEX") Q
IDFIELD	.
	. I DIDENT D  Q:$G(DIERR)
	. . S DINODE=$G(^DD(DIFILE,0,"ID",DIDENT))
	. . I DIDS="",DINODE="W """"" Q
	. . D GET(DIFILE,DIDENT,.DIDEF,.DICODE)
	. . Q:$G(DIERR)
	. . S DITYPE=$P(DIDEF,U,2)
	. . I DIDEF="" Q
	. . S DIDENT(DIDENT)=DICODE
	. . I DITYPE["D" S DITYPE="D"
	. . E  I DITYPE["S" S DITYPE="S"
	. . S DIDENT(DIDENT,"TYPE")=DITYPE
	. . I DITYPE["S" S DIDENT(DIDENT,"CODE")=";"_$P(DIDEF,U,3)
	. . Q
IDWRITE	.
	. E  D
	. . S DICODE=$G(^DD(DIFILE,0,"ID",DIDENT))
	. . I DICODE'="" S DIDENT(DIDENT)="N DIMSG "_DICODE
	. . Q
	. Q
	Q:$G(DIERR)
	I DIWRITE'="" S DIDENT("ZZZ ID")="N DIMSG "_DIWRITE
	Q
	
GET(DIFILE,DIFIELD,DIDEF,DICODE)	
	N DINODE,DIPIECE,DISTORE,DIEFROM,DIETO
	I DIFIELD=.001 S DICODE="DIEN",DIDEF="" Q
	S DIDEF=$G(^DD(DIFILE,DIFIELD,0))
	I DIDEF="" D ERR(501,DIFILE,"","",DIFIELD) Q
	
G1	N DITYPE S DITYPE=$P(DIDEF,U,2)
	I DITYPE["C"!DITYPE D  Q
	. I DITYPE["C" S DITYPE="Computed"
	. E  D
	. . I $P($G(^DD(+DITYPE,.01,0)),U,2)["W" S DITYPE="Word-processing"
	. . E  S DITYPE="Multiple"
	. D ERR(520,DIFILE,"",DIFIELD,DITYPE)
	
G2	S DISTORE=$P(DIDEF,U,4)
	S DINODE=$P(DISTORE,";")
	S DIPIECE=$P(DISTORE,";",2)
	I DINODE="",$P(DIPIECE,"E")'="",'DIPIECE S (DICODE,DIDEF)="" Q
	S DINODE="$G(@DIROOT@(+DIEN,"""_DINODE_"""))"
	I DIPIECE S DICODE="$P("_DINODE_",U,"_DIPIECE_")"
	E  D
	. S DIEFROM=$P($E(DIPIECE,2,9999),",")
	. S DIETO=$P(DIPIECE,",",2)
	. S DICODE="$E("_DINODE_","_DIEFROM_","_DIETO_")"
	Q
	
INDEX(DIFILE,DINDEX,DIROOT)	
	; lookup data on a file's index
	S DINDEX("CODE")=""
	S DINDEX("FIELD")=""
	S DINDEX("TYPE")=""
	S DIFILE("INDEX")=$O(^DD(DIFILE,0,"IX",DINDEX,""))
	I DIFILE("INDEX") D
	. S DINDEX("FIELD")=$O(^DD(DIFILE,0,"IX",DINDEX,DIFILE("INDEX"),""))
I1	I DINDEX("FIELD") N DIXNODE D
	. N DIXGET
	. D GET(DIFILE("INDEX"),DINDEX("FIELD"),.DIXNODE,.DIXGET)
	. S DINDEX("GET")=DIXGET
	. S DINDEX("TYPE")=$P(DIXNODE,U,2)
	I DINDEX("TYPE")["D" S DINDEX("TYPE")="D"
	I DINDEX("TYPE")["S" D
	. S DINDEX("TYPE")="S"
	. S DINDEX("CODE")=";"_$P(DIXNODE,U,3)
	S DINDEX("NODE")=DIXNODE
	I DINDEX("TYPE")["P" D
	. S DINDEX("TYPE")="P"
	. S DINDEX("PTR")=+$P($P(DIXNODE,U,2),"P",2)
	Q
	
BOTH(DIFILE,DIFLAGS,DIROOT,DINDEX,DIFIELDS,DIWRITE,DIDENT)	
	; IXANDID^DICL--get index and identifier info
	D INDEX(.DIFILE,.DINDEX,DIROOT) Q:$G(DIERR)
	Q:DIFLAGS["f"
	D IDENTS(.DIFILE,DINDEX("FIELD"),DIROOT,DIFIELDS,DIWRITE,.DIDENT)
	Q
	
ERR(DIERN,DIFILE,DIENS,DIFIELD,DI1)	
	N DIPE
	S DIPE("FILE")=$G(DIFILE)
	S DIPE("IEN")=$G(DIENS)
	S DIPE("FIELD")=$G(DIFIELD)
	S DIPE(1)=$G(DI1)
	D BLD^DIALOG(DIERN,.DIPE,.DIPE)
	Q
	
	
FIELD(DIFILE,DIFIELD,DINDEX)	
	; return code to fetch field value prior to screen execution
	I DIFIELD=.01 Q "DIKEY"
	N DISTORE S DISTORE=$P(DINDEX(0,"DEF"),U,4)
	N DINODE S DINODE=$P(DISTORE,";")
	N DIPIECE S DIPIECE=$P(DISTORE,";",2)
	I 'DINODE,$P(DIPIECE,"E")'="",'DIPIECE Q "X"
	I DINODE=0 S DINODE="DINODE"
	E  S DINODE="$G(@DIROOT@(+DIEN,"""_DINODE_"""))"
	N DICODE I DIPIECE S DICODE="$P("_DINODE_",U,"_DIPIECE_")"
	E  D
	. N DIEFROM S DIEFROM=$P($E(DIPIECE,2,9999),",")
	. N DIETO S DIETO=$P(DIPIECE,",",2)
	. S DICODE="$E("_DINODE_","_DIEFROM_","_DIETO_")"
	Q DICODE