Annotation of freem_fileman/DICU2.m, revision 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>