Return to DICU2.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

DICU2	;SEA/TOAD-VA FileMan: Lookup Tools, Return IDs ;11/3/94  16:05 ;
	;;21.0;VA FileMan;;Dec 28, 1994
	;Per VHA Directive 10-93-142, this routine should not be modified.
	
IDS(DIFILE,DIEN,DIFLAGS,DIVALUE,DIROOT,DINDEX,DICOUNT,DIDENT,DIOUTPUT)	;
	;ENTRY POINT--add en entry's identifiers to a list
	;proc, DIEN, DINDEX, & DIDENT by reference
	N DICODE,DID,DIDT,DIDVAL,DIOUT
	S DID="",DIOUT=0 F  D  Q:DIOUT!$G(DIERR)
	. S DID=$O(DIDENT(DID))
	. I DID="" S DIOUT=1 Q
	. I DID D
	. . S @("DIDVAL="_DIDENT(DID))
	. . S DIDT=DIDENT(DID,"TYPE")
	. . S DICODE=$G(DIDENT(DID,"CODE"))
	. . I DIFLAGS'[1 S DIDVAL=$$FORMAT(DIFILE,DID,"I",DIDVAL,DIDT,DICODE)
	. . S @DIOUTPUT@("ID",DICOUNT,DID)=DIDVAL
I1	. E  D
	. . N %,D,DIC,X,Y,Y1
	. . S D=DINDEX
	. . S DIC=DIROOT("O")
	. . S DIC(0)=$TR(DIFLAGS,"fglpqtuv1")
	. . S X=DIVALUE
	. . M Y=DIEN S Y=$P(DIEN,",")
	. . S Y1=$G(@DIROOT@(+DIEN,0)),Y1=DIEN
	. . X DIDENT(DID) ;***** NAKED *****
	. . I $G(DIERR) D
	. . . N DICONTXT I DID="ZZZ ID" S DICONTXT="Identifier parameter"
	. . . E  S DICONTXT="MUMPS Identifier"
	. . . D ERR^DICF6(120,DIFILE,DIEN,"",DICONTXT)
	I '$G(DIERR) M @DIOUTPUT@("ID","WRITE",DICOUNT)=^TMP("DIMSG",$J)
	K ^TMP("DIMSG",$J)
	Q
	
FORMAT(DIFILE,DIFIELD,DIFLAG,DIVALUE,DITYPE,DICODE,DIENTRY)	;
	I DIVALUE="" Q ""
	I DITYPE="D" Q $$EXTERNAL^DILFD(DIFILE,DIFIELD,"",DIVALUE)
	I DITYPE="S" Q $$EXTERNAL^DILFD(DIFILE,DIFIELD,"",DIVALUE)
	I DITYPE'["P",DITYPE'["V",DITYPE'["O" Q DIVALUE
	I DIFLAG="I" Q $$EXTERNAL^DIDU(DIFILE,DIFIELD,"",DIVALUE)
	Q DIVALUE_"  "_$$EXTERNAL^DIDU(DIFILE,DIFIELD,"",DIVALUE)