DICU11 ;SEA/TOAD,SF/TKW-VA FileMan: Lookup Tools, Get IDs & Index ;11/5/99  15:13
 ;;22.0;VA FileMan;**17**;Mar 30, 1999
 ;Per VHA Directive 10-93-142, this routine should not be modified.
 ;
 ; Routines called from DICU1
 ;
THROW(DIFLAGS,DIDENT,DIDS,DICRSR,DICOUNT,DIDEFALT,DINDEX,DICF2) ;
 ;
 ; Build code into DIDENT array to get external field values
 ; for indexed fields.
 ;
T1 N DIFORMAT D GETFORM(.DIDENT,.DIFORMAT,.DIDS,.DICOUNT)
 I DIFORMAT="" S DIFORMAT=DIDEFALT
 N DIEXP,DISUB,DISUB0,DIMAP S DISUB0=$S(DIDENT["IX":0,1:DIDENT)
 F DISUB=1:1:DINDEX("#") D
 . S DIEXP="DINDEX(DISUB)"
 . I DIFORMAT="I",DIFLAGS[3,"VP"[DINDEX(DISUB,"TYPE") D
 . . I DISUB>1 S DIEXP="DIVAL" Q
 . . Q:'$D(DINDEX("ROOTCNG",1))
 . . S DIEXP="$G(@DINDEX(1,""ROOT"")@(DINDEX(1)))" Q
 . I DIFORMAT="E",$G(DINDEX(DISUB,"GETEXT")) D
 . . I DISUB>1,DIFLAGS[4,"VP"[DINDEX(DISUB,"TYPE") S DIEXP="DINDEX(DISUB,""EXT"")" Q
 . . I DINDEX(DISUB,"GETEXT")=3 S DIEXP="$$TRANOUT(DISUB,"_DIEXP_")" Q
 . . S:DINDEX(DISUB,"GETEXT")=2 DIEXP="DIVAL"
 . . S DIEXP=$$FORMAT(DIDENT,DIEXP,0,DIFORMAT,DIDEFALT,DIFLAGS)
 . . I DINDEX="B" S DIEXP="$S('$D(DIMNEM):"_DIEXP_",1:DINDEX(DISUB))"
 . . Q
 . I $G(DICF2) S DIDENT(DICRSR,DISUB0,DISUB,DIFORMAT)=DIEXP Q
 . I DIFLAGS["P" S DICRSR=DICRSR+1
 . S DIDENT(DICRSR,DISUB0,DISUB,DIFORMAT)=DIEXP
 . S DIMAP="IX("_DISUB_")" S:DIFORMAT="I" DIMAP=DIMAP_"I"
 . I DIFLAGS["P" S $P(DIDENT(-3),U,DICRSR)=DIMAP Q
 . I DIDENT'=-2 S DIDENT(-3,0,DISUB,DIMAP)=""
 Q
 ;
GETFORM(DIDENT,DIFORMAT,DIDS,DICOUNT) ;
 ; Strip E or I off specifier and set into DIFORMAT
 N DILENGTH S DILENGTH=$L(DIDENT)
 S DIFORMAT=$E(DIDENT,DILENGTH)
 I $TR(DIFORMAT,"EI")="" D
 . N DIFIRST S DIFIRST=$E(DIDENT,DILENGTH-1) I $TR(DIFIRST,"EI")="" D  Q
 . . S $E(DIDENT,DILENGTH-1)="",$P(DIDS,";",DICOUNT)=DIDENT
 . . S DIFORMAT=DIFIRST,DICOUNT=DICOUNT-1
 . . S $E(DIDENT,DILENGTH-1)=""
 . S $E(DIDENT,DILENGTH)=""
 E  S DIFORMAT=""
 Q
 ;
FORMAT(DIFIELD,DICODE,DIUSEKEY,DIFORMAT,DIDEFALT,DIFLAGS) ;
 ; Format fetch code to return either internal or external
 N DIFILE S DIFILE="DIFILE"
 I DIFIELD'>0 S DIFILE="DINDEX(DISUB,""FILE"")",DIFIELD="DINDEX(DISUB,""FIELD"")"
 I DIFORMAT="E" D
 . N F S F="""""" I DIFLAGS["h" S F="""h"""
 . S DICODE="$$EXTERNAL^DIDU("_DIFILE_","_DIFIELD_","_F_","_DICODE_")"
 Q DICODE
 ;
WRITEID(DIFILE,DIDENT,DICRSR) ;
 ; WRITE Identifiers Loop: add WRITE identifiers to output processor:
 ; for WRITE IDs we save the code as is
 ;
 N DICODE
 S DIDENT=$O(^DD(DIFILE,0,"ID"," "),-1),DIDENT=$O(^(DIDENT))
 F  Q:DIDENT=""  D  S DIDENT=$O(^DD(DIFILE,0,"ID",DIDENT))
 . S DICODE=$G(^DD(DIFILE,0,"ID",DIDENT)) Q:DICODE=""
 . I DIFLAGS["P" S DICRSR=DICRSR+1
 . S DIDENT(DICRSR,DIDENT,0)="N DIMSG "_DICODE
 . S:DIFLAGS["P" $P(DIDENT(-3),U,DICRSR)="WID("_DIDENT_")" Q
 Q
 ;