Return to DICU2.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DICU2	;SEA/TOAD-VA FileMan: Lookup Tools, Return IDs ;11/3/94  16:05 ;
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: 	
    5: IDS(DIFILE,DIEN,DIFLAGS,DIVALUE,DIROOT,DINDEX,DICOUNT,DIDENT,DIOUTPUT)	;
    6: 	;ENTRY POINT--add en entry's identifiers to a list
    7: 	;proc, DIEN, DINDEX, & DIDENT by reference
    8: 	N DICODE,DID,DIDT,DIDVAL,DIOUT
    9: 	S DID="",DIOUT=0 F  D  Q:DIOUT!$G(DIERR)
   10: 	. S DID=$O(DIDENT(DID))
   11: 	. I DID="" S DIOUT=1 Q
   12: 	. I DID D
   13: 	. . S @("DIDVAL="_DIDENT(DID))
   14: 	. . S DIDT=DIDENT(DID,"TYPE")
   15: 	. . S DICODE=$G(DIDENT(DID,"CODE"))
   16: 	. . I DIFLAGS'[1 S DIDVAL=$$FORMAT(DIFILE,DID,"I",DIDVAL,DIDT,DICODE)
   17: 	. . S @DIOUTPUT@("ID",DICOUNT,DID)=DIDVAL
   18: I1	. E  D
   19: 	. . N %,D,DIC,X,Y,Y1
   20: 	. . S D=DINDEX
   21: 	. . S DIC=DIROOT("O")
   22: 	. . S DIC(0)=$TR(DIFLAGS,"fglpqtuv1")
   23: 	. . S X=DIVALUE
   24: 	. . M Y=DIEN S Y=$P(DIEN,",")
   25: 	. . S Y1=$G(@DIROOT@(+DIEN,0)),Y1=DIEN
   26: 	. . X DIDENT(DID) ;***** NAKED *****
   27: 	. . I $G(DIERR) D
   28: 	. . . N DICONTXT I DID="ZZZ ID" S DICONTXT="Identifier parameter"
   29: 	. . . E  S DICONTXT="MUMPS Identifier"
   30: 	. . . D ERR^DICF6(120,DIFILE,DIEN,"",DICONTXT)
   31: 	I '$G(DIERR) M @DIOUTPUT@("ID","WRITE",DICOUNT)=^TMP("DIMSG",$J)
   32: 	K ^TMP("DIMSG",$J)
   33: 	Q
   34: 	
   35: FORMAT(DIFILE,DIFIELD,DIFLAG,DIVALUE,DITYPE,DICODE,DIENTRY)	;
   36: 	I DIVALUE="" Q ""
   37: 	I DITYPE="D" Q $$EXTERNAL^DILFD(DIFILE,DIFIELD,"",DIVALUE)
   38: 	I DITYPE="S" Q $$EXTERNAL^DILFD(DIFILE,DIFIELD,"",DIVALUE)
   39: 	I DITYPE'["P",DITYPE'["V",DITYPE'["O" Q DIVALUE
   40: 	I DIFLAG="I" Q $$EXTERNAL^DIDU(DIFILE,DIFIELD,"",DIVALUE)
   41: 	Q DIVALUE_"  "_$$EXTERNAL^DIDU(DIFILE,DIFIELD,"",DIVALUE)
   42: