Annotation of freem_fileman/DICU2.m, revision 1.1.1.1
1.1 snw 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:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>