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>