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)