Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DICU1

DICU1.m

Go to the documentation of this file. 
  1. DICU1 ;SEA/TOAD,SF/TKW-VA FileMan: Lookup Tools, Get IDs & Index ;9/9/98  09:02
  1.  ;;22.0;VA FileMan;;Mar 30, 1999
  1.  ;Per VHA Directive 10-93-142, this routine should not be modified.
  1.  ;
  1. IDENTS(DIFLAGS,DIFILE,DIDS,DIWRITE,DIDENT,DINDEX) ;
  1.  ; get definition of fields to return with each entry
  1.  ;
  1. ID1 ; prepare to build output processor:
  1.  ;
  1.  S DIDS=";"_DIDS_";"
  1.  I DIDS[";@;" S DIDS("@")=""
  1.  E  S:DIDS'[";-WID;" DIDS("WID")="" S:DIDS=";;" DIDS("FID")=""
  1.  N DICRSR,DICOUNT S (DICRSR,DICOUNT)=0
  1.  I DIFLAGS["P" S DICRSR=1,DIDENT(-3)="IEN"
  1.  N DIFORMAT,DIDEFALT S DIDEFALT=$S(DIFLAGS["I":"I",1:"E")
  1.  ;
  1. ID1A ; for Lister: add indexed fields to DIDENT array (to build 1 nodes)
  1.  ;
  1.  I DIFLAGS[3,DIFLAGS'["S",DIDS'[";-IX",'$D(DIDS("@")) D
  1.  . S DIDENT=-2,DIDENT(-2)=1
  1.  . D THROW^DICU11(DIFLAGS,.DIDENT,.DIDS,.DICRSR,.DICOUNT,DIDEFALT,.DINDEX)
  1.  . S DIDENT=0
  1.  ;
  1. ID2 ; decide whether to auto-include the .01 in the field list
  1.  ; will come out in 1 node for Lister, in "ID" nodes for Finder
  1.  ;
  1.  N DIUSEKEY S (DIUSEKEY,DIDENT)=0
  1.  I '$D(DIDS("@")),DIDS'[";-.01;",DIFLAGS'["S" D
  1.  . I DIFLAGS[4 S DIUSEKEY="1F" Q
  1.  . I DIDS[";.01;"!(DIDS[";.01E") Q
  1.  . S DIUSEKEY=1 N DISUB F DISUB=1:1:DINDEX("#") D  Q:'DIUSEKEY
  1.  . . Q:DINDEX(DISUB,"FIELD")'=.01
  1.  . . S DIUSEKEY=DINDEX(DISUB,"FILE")'=DIFILE
  1.  . Q
  1.  I DIUSEKEY S DIDENT(-2)=1,DIDENT=.01
  1.  N DICODE,DIDEF,DIEFROM,DIETO,DINODE,DIPIECE,DISTORE,DITYPE,DIFRMAT2
  1.  N DILENGTH,DIOUTI S DILENGTH=$L(DIDS,";"),DIOUTI=0
  1.  ;
  1. ID3 ; Process auto-included .01 field (if included) on first pass,
  1.  ; Start loop to process each field from DIFIELDS parameter
  1.  ; and Identifiers.
  1.  ;
  1.  F  D  Q:$G(DIERR)!DIOUTI
  1.  . S DIFORMAT=""
  1.  . I DIUSEKEY D  Q
  1.  . . D BLD S DIUSEKEY=$S(DIUSEKEY="1F":"F",1:0)
  1.  . . S:DIDENT=-2 DIDENT=.01 Q
  1.  . D  Q:'DIDENT
  1.  . . S DIUSEKEY=0
  1.  . . ; Find next Identifier
  1.  . . I $D(DIDS("FID")) D  Q
  1.  . . . S DIDENT=$O(^DD(DIFILE,0,"ID",DIDENT))
  1.  . . . I 'DIDENT K DIFRMAT2
  1.  . . . I DIDENT="" S:DIDS=";;" DIOUTI=1 K DIDS("FID")
  1.  . .
  1. ID4 . . ; Find next field in DIFIELDS input parameter.
  1.  . .
  1.  . . S DICOUNT=DICOUNT+1
  1.  . . S DIDENT=$P(DIDS,";",DICOUNT)
  1.  . . I DIDENT="",DICOUNT'<DILENGTH S DIOUTI=1
  1.  . .
  1. ID4A . . ; process IX specifier
  1.  . .
  1.  . . I DIDENT["IX" D  Q
  1.  . . . I $$BADIX(DIDENT) D ERR202 Q
  1.  . . . Q:DIDS[";-IX;"
  1.  . . . D THROW^DICU11(DIFLAGS,.DIDENT,.DIDS,.DICRSR,.DICOUNT,DIDEFALT,.DINDEX)
  1.  . .
  1. ID4B . . ; process FID, WID, and @ specifiers
  1.  . .
  1.  . . I DIDENT["FID" D  S DIDENT="" Q
  1.  . . . Q:DIDENT="-FID"!(DIDS[";-FID;")
  1.  . . . D GETFORM^DICU11(.DIDENT,.DIFRMAT2,.DIDS,.DICOUNT)
  1.  . . . S DIDS("FID")=1 Q
  1.  . . I DIDENT["WID" D  S DIDENT="" Q
  1.  . . . I DIDENT'="WID",DIDENT'="-WID" D ERR202 Q
  1.  . . . Q:DIDENT="-WID"!(DIDS[";-WID;")
  1.  . . . D WRITEID^DICU11(DIFILE,.DIDENT,.DICRSR) K DIDS("WID") Q
  1.  . . I DIDENT["@" D:DIDENT'="@" ERR202 Q
  1.  . . I 'DIDENT D:DIDENT'="" ERR202 Q
  1.  . .
  1. ID4C . . ; process field # specifiers from DIFIELDS parameter
  1.  . .
  1.  . . D GETFORM^DICU11(.DIDENT,.DIFORMAT,.DIDS,.DICOUNT)
  1.  .
  1.  . ; Here we quit if field is already in the DIDENT array.
  1.  . I DIDS=";;",DIFLAGS[4,DIUSEKEY'="F",DIDENT=.01 Q
  1.  . I DIDS=";;",DIFLAGS[3,DINDEX("FLIST")[("^"_DIDENT_"^") Q
  1.  .
  1. ID5 . ; for file IDs, we skip non-display IDs
  1.  .
  1.  . N DIPLUS S DIPLUS=+DIDENT
  1.  . N DILAST S DILAST=$P(DIDENT,DIPLUS,2,999)
  1.  . I DIDENT["-" D  Q
  1.  . . I DILAST'="" D ERR202 Q
  1.  . . I '$D(^DD(DIFILE,-DIPLUS)) D ERR(501,DIFILE,"","",-DIPLUS) Q
  1.  . E  I (DILAST'?.1"E".1"I")&(DILAST'?.1"I".1"E") D ERR202 Q
  1.  . Q:DIDS[(";-"_DIDENT_";")
  1.  . I $D(DIDS("FID")) D  I DINODE="W """"" Q
  1.  . . S DINODE=$G(^DD(DIFILE,0,"ID",DIDENT))
  1.  . I $G(DIFRMAT2)]"" S DIFORMAT=DIFRMAT2
  1.  . D BLD Q
  1.  ;
  1. ID6 ; Write Identifiers: add to output processor
  1.  ; ID Parameter: add ID parameter to output processor
  1.  ;
  1.  Q:$G(DIERR)
  1.  I $D(DIDS("WID")) D WRITEID^DICU11(DIFILE,.DIDENT,.DICRSR)
  1.  I DIWRITE'="" D
  1.  . S DIDENT="ZZZ ID" I DIFLAGS["P" S DICRSR=DICRSR+1
  1.  . S DIDENT(DICRSR,DIDENT,0)="N DIMSG "_DIWRITE
  1.  . S:DIFLAGS["P" $P(DIDENT(-3),U,DICRSR)="IDP" Q
  1.  Q
  1.  ;
  1. BLD ; get fetch code for value
  1.  D GET^DICUIX1(DIFILE,DIFILE,DIDENT,.DIDEF,.DICODE) Q:DIDEF=""!$G(DIERR)
  1.  I DIFORMAT="" S DIFORMAT=$S(DIUSEKEY="1F":"I",1:DIDEFALT)
  1.  D
  1.  . N DIVALUE S DIVALUE=DIDENT
  1.  . I DIUSEKEY'["F",$D(DIDS("FID")),DIDENT'=.01 S DIVALUE="FID("_DIVALUE_")"
  1.  . S:DIFORMAT="I" DIVALUE=DIVALUE_DIFORMAT
  1.  . I DIFLAGS["P" S $P(DIDENT(-3),U,(DICRSR+1))=DIVALUE Q
  1.  . Q:DIUSEKEY="1F"
  1.  . S DIDENT(-3,+DIDENT,DIVALUE)="" Q
  1. BLD1 ; set up format code and load with fetch code into DIDENT
  1.  N DIVALUE,DISUB S DIVALUE=DICODE,DISUB=0
  1.  S DITYPE=$P(DIDEF,U,2) I DITYPE'["C" D
  1.  . S DIVALUE=$$FORMAT^DICU11(DIDENT,DICODE,DIUSEKEY,DIFORMAT,DIDEFALT,DIFLAGS)
  1.  I DIUSEKEY="1F",DIDENT=.01 S DIDENT=-2,DISUB=.01
  1.  I DIFLAGS["P" S DICRSR=DICRSR+1
  1.  I DITYPE'["C" S DIDENT(DICRSR,DIDENT,DISUB,DIFORMAT)=DIVALUE Q
  1.  S DIDENT(DICRSR,DIDENT,0)=DIVALUE
  1.  S DIDENT(DICRSR,DIDENT,0,"TYPE")="C"
  1.  Q
  1.  ;
  1. ERR(DIERN,DIFILE,DIENS,DIFIELD,DI1) ;
  1.  ;
  1.  ; add an error to the message array
  1.  ; GET
  1.  ;
  1.  N DIPE
  1.  S DIPE("FILE")=$G(DIFILE)
  1.  S DIPE("IEN")=$G(DIENS)
  1.  S DIPE("FIELD")=$G(DIFIELD)
  1.  S DIPE(1)=$G(DI1)
  1.  D BLD^DIALOG(DIERN,.DIPE,.DIPE)
  1.  Q
  1.  ;
  1. ERR202 D ERR(202,"","","","FIELDS") Q
  1.  ;
  1. BADIX(DIDENT) ;
  1.  ;
  1.  N DIBAD S DIBAD=DIDENT'="IX"&(DIDENT'="-IX")&(DIDENT'?1"IX"1"E".1"I")
  1.  S DIBAD=DIDENT'?1"IX"1"I".1"E"&DIBAD
  1.  Q DIBAD
  1.  ;
  1.  ; 202   The input parameter that identifies the |1
  1.  ;