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

XTIDTBL.m

Go to the documentation of this file.
  1. XTIDTBL ;OAKCIOFO/JLG - TABLE CONTEXT ;04/21/2005 15:12
  1. ;;7.3;TOOLKIT;**93**;Apr 25, 1995
  1. Q
  1. ; Context implementation for "table"
  1. ; CTX and TERM are passed by ref in all calls
  1. CONTEXT(TFILE,TFIELD,CTX) ; set up Context for "table" type
  1. ; called from CONTEXT^XTIDCTX(TFILE,TFIELD,CTX)
  1. ; returns a valid new CTX array
  1. N SUBFILE
  1. S TFILE=+$G(TFILE)
  1. Q:'TFILE!($D(CTX))
  1. ; determine the subfile for the multi-valued field
  1. ; 99.991, EFFECTIVE DATE/TIME
  1. S SUBFILE=$$GETSUBF(TFILE,99.991)
  1. Q:'SUBFILE
  1. S CTX("TYPE")="TABLE"
  1. S CTX("TERM FILE#")=TFILE
  1. S CTX("TERM FIELD#")=.01
  1. S CTX("SOURCE FILE#")=TFILE
  1. S CTX("TERMSTATUS SUBFILE#")=SUBFILE
  1. Q
  1. ;
  1. VALIDREF(CTX,TIREF) ; validate the term, internal ref
  1. ; test TIREF is a valid value in given context (table)
  1. ; TIREF must be in IENS form, but will be checked
  1. ; later as VDUI related data is retrieved
  1. ; would be nice if we can do an earlier check
  1. ; based on IENS and the CTX("SOURCE FILE#")
  1. N VALID
  1. Q:'$D(CTX)!($G(TIREF)']"") 0
  1. S VALID=TIREF?.(.N1",")
  1. Q VALID
  1. ;
  1. FINDTERM(CTX,TIREF,TERM) ; find term
  1. ; called from FINDTERM^XTIDCTX(CTX,TIREF,TERM)
  1. ; find term for given term IREF
  1. ; return TERM data as new TERM array
  1. N IENS
  1. Q:'$D(CTX)!($D(TERM))
  1. Q:'$$VALIDREF(.CTX,$G(TIREF))
  1. S IENS=$G(TIREF)
  1. Q:IENS']""
  1. D GETTERM^XTIDCTX(.CTX,CTX("SOURCE FILE#"),IENS,.TERM)
  1. Q
  1. ;
  1. SRCHTRMS(CTX,VUID,XTTBARR,MASTER) ; search term index entries
  1. ; called from SEARCH^XTIDCTX(CTX,VUID,ARRAY,MASTER)
  1. ; FIND^DIC(FILE,IENS,FIELDS,FLAGS,[.]VALUE,NUMBER,[.]INDEXES,
  1. ; [.]SCREEN,IDENTIFIER,TARGET_ROOT,MSG_ROOT)
  1. N DIERR,FILE,TFILE,INDEXES,MSG,RIEN,VALUE,FLAGS,TARG,MSG,NUMFND
  1. N FIELDS,SCREEN
  1. S VUID=$G(VUID),MASTER=+$G(MASTER)
  1. Q:$G(CTX("TYPE"))'="TABLE"!('VUID)
  1. S FILE=CTX("SOURCE FILE#"),INDEXES="AVUID",FLAGS="QX"
  1. S FIELDS="@;99.98I"
  1. S VALUE(1)=VUID
  1. S SCREEN="" I MASTER S SCREEN="I $P(^(""VUID""),""^"",2)"
  1. ; get entries
  1. D FIND^DIC(FILE,"",FIELDS,FLAGS,.VALUE,"",INDEXES,SCREEN,"","TARG","MSG")
  1. Q:$D(MSG("DIERR"))
  1. S NUMFND=+$G(TARG("DILIST",0))
  1. I NUMFND D ; found entries
  1. . N ITM,TEMP
  1. . M TEMP=TARG("DILIST",2)
  1. . M TEMP=TARG("DILIST","ID")
  1. . F ITM=1:1:NUMFND D
  1. . . N STATUS,IENS
  1. . . S IENS=TEMP(ITM)_","
  1. . . S STATUS=$$GETSTAT^XTID(CTX("TERM FILE#"),CTX("TERM FIELD#"),IENS,"")
  1. . . S STATUS=STATUS_"^"_TEMP(ITM,99.98)
  1. . . D ADDTARRY^XTIDCTX(XTTBARR,CTX("TERM FILE#"),CTX("TERM FIELD#"),IENS,STATUS)
  1. . ;
  1. ;
  1. Q
  1. ;
  1. GETSUBF(FILE,MFIELD) ; get subfile #
  1. ; get subfile for the given file and multiple-valued field
  1. N DIERR,ATTR,SUBFILE
  1. S SUBFILE=""
  1. D FIELD^DID(FILE,MFIELD,"","MULTIPLE-VALUED;SPECIFIER;TYPE","ATTR")
  1. I ATTR("MULTIPLE-VALUED")=1,ATTR("TYPE")'="WORD-PROCESSING" D
  1. . S SUBFILE=+$G(ATTR("SPECIFIER"))
  1. ;
  1. Q SUBFILE
  1. ;