| 1 | DICU11 ;SEA/TOAD,SF/TKW-VA FileMan: Lookup Tools, Get IDs & Index ;11/5/99 15:13
|
|---|
| 2 | ;;22.0;VA FileMan;**17**;Mar 30, 1999
|
|---|
| 3 | ;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | ; Routines called from DICU1
|
|---|
| 6 | ;
|
|---|
| 7 | THROW(DIFLAGS,DIDENT,DIDS,DICRSR,DICOUNT,DIDEFALT,DINDEX,DICF2) ;
|
|---|
| 8 | ;
|
|---|
| 9 | ; Build code into DIDENT array to get external field values
|
|---|
| 10 | ; for indexed fields.
|
|---|
| 11 | ;
|
|---|
| 12 | T1 N DIFORMAT D GETFORM(.DIDENT,.DIFORMAT,.DIDS,.DICOUNT)
|
|---|
| 13 | I DIFORMAT="" S DIFORMAT=DIDEFALT
|
|---|
| 14 | N DIEXP,DISUB,DISUB0,DIMAP S DISUB0=$S(DIDENT["IX":0,1:DIDENT)
|
|---|
| 15 | F DISUB=1:1:DINDEX("#") D
|
|---|
| 16 | . S DIEXP="DINDEX(DISUB)"
|
|---|
| 17 | . I DIFORMAT="I",DIFLAGS[3,"VP"[DINDEX(DISUB,"TYPE") D
|
|---|
| 18 | . . I DISUB>1 S DIEXP="DIVAL" Q
|
|---|
| 19 | . . Q:'$D(DINDEX("ROOTCNG",1))
|
|---|
| 20 | . . S DIEXP="$G(@DINDEX(1,""ROOT"")@(DINDEX(1)))" Q
|
|---|
| 21 | . I DIFORMAT="E",$G(DINDEX(DISUB,"GETEXT")) D
|
|---|
| 22 | . . I DISUB>1,DIFLAGS[4,"VP"[DINDEX(DISUB,"TYPE") S DIEXP="DINDEX(DISUB,""EXT"")" Q
|
|---|
| 23 | . . I DINDEX(DISUB,"GETEXT")=3 S DIEXP="$$TRANOUT(DISUB,"_DIEXP_")" Q
|
|---|
| 24 | . . S:DINDEX(DISUB,"GETEXT")=2 DIEXP="DIVAL"
|
|---|
| 25 | . . S DIEXP=$$FORMAT(DIDENT,DIEXP,0,DIFORMAT,DIDEFALT,DIFLAGS)
|
|---|
| 26 | . . I DINDEX="B" S DIEXP="$S('$D(DIMNEM):"_DIEXP_",1:DINDEX(DISUB))"
|
|---|
| 27 | . . Q
|
|---|
| 28 | . I $G(DICF2) S DIDENT(DICRSR,DISUB0,DISUB,DIFORMAT)=DIEXP Q
|
|---|
| 29 | . I DIFLAGS["P" S DICRSR=DICRSR+1
|
|---|
| 30 | . S DIDENT(DICRSR,DISUB0,DISUB,DIFORMAT)=DIEXP
|
|---|
| 31 | . S DIMAP="IX("_DISUB_")" S:DIFORMAT="I" DIMAP=DIMAP_"I"
|
|---|
| 32 | . I DIFLAGS["P" S $P(DIDENT(-3),U,DICRSR)=DIMAP Q
|
|---|
| 33 | . I DIDENT'=-2 S DIDENT(-3,0,DISUB,DIMAP)=""
|
|---|
| 34 | Q
|
|---|
| 35 | ;
|
|---|
| 36 | GETFORM(DIDENT,DIFORMAT,DIDS,DICOUNT) ;
|
|---|
| 37 | ; Strip E or I off specifier and set into DIFORMAT
|
|---|
| 38 | N DILENGTH S DILENGTH=$L(DIDENT)
|
|---|
| 39 | S DIFORMAT=$E(DIDENT,DILENGTH)
|
|---|
| 40 | I $TR(DIFORMAT,"EI")="" D
|
|---|
| 41 | . N DIFIRST S DIFIRST=$E(DIDENT,DILENGTH-1) I $TR(DIFIRST,"EI")="" D Q
|
|---|
| 42 | . . S $E(DIDENT,DILENGTH-1)="",$P(DIDS,";",DICOUNT)=DIDENT
|
|---|
| 43 | . . S DIFORMAT=DIFIRST,DICOUNT=DICOUNT-1
|
|---|
| 44 | . . S $E(DIDENT,DILENGTH-1)=""
|
|---|
| 45 | . S $E(DIDENT,DILENGTH)=""
|
|---|
| 46 | E S DIFORMAT=""
|
|---|
| 47 | Q
|
|---|
| 48 | ;
|
|---|
| 49 | FORMAT(DIFIELD,DICODE,DIUSEKEY,DIFORMAT,DIDEFALT,DIFLAGS) ;
|
|---|
| 50 | ; Format fetch code to return either internal or external
|
|---|
| 51 | N DIFILE S DIFILE="DIFILE"
|
|---|
| 52 | I DIFIELD'>0 S DIFILE="DINDEX(DISUB,""FILE"")",DIFIELD="DINDEX(DISUB,""FIELD"")"
|
|---|
| 53 | I DIFORMAT="E" D
|
|---|
| 54 | . N F S F="""""" I DIFLAGS["h" S F="""h"""
|
|---|
| 55 | . S DICODE="$$EXTERNAL^DIDU("_DIFILE_","_DIFIELD_","_F_","_DICODE_")"
|
|---|
| 56 | Q DICODE
|
|---|
| 57 | ;
|
|---|
| 58 | WRITEID(DIFILE,DIDENT,DICRSR) ;
|
|---|
| 59 | ; WRITE Identifiers Loop: add WRITE identifiers to output processor:
|
|---|
| 60 | ; for WRITE IDs we save the code as is
|
|---|
| 61 | ;
|
|---|
| 62 | N DICODE
|
|---|
| 63 | S DIDENT=$O(^DD(DIFILE,0,"ID"," "),-1),DIDENT=$O(^(DIDENT))
|
|---|
| 64 | F Q:DIDENT="" D S DIDENT=$O(^DD(DIFILE,0,"ID",DIDENT))
|
|---|
| 65 | . S DICODE=$G(^DD(DIFILE,0,"ID",DIDENT)) Q:DICODE=""
|
|---|
| 66 | . I DIFLAGS["P" S DICRSR=DICRSR+1
|
|---|
| 67 | . S DIDENT(DICRSR,DIDENT,0)="N DIMSG "_DICODE
|
|---|
| 68 | . S:DIFLAGS["P" $P(DIDENT(-3),U,DICRSR)="WID("_DIDENT_")" Q
|
|---|
| 69 | Q
|
|---|
| 70 | ;
|
|---|
