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

XTIDSET.m

Go to the documentation of this file.
  1. XTIDSET ;OAKCIOFO/JLG - SET OF CODES CONTEXT ;04/25/2005 15:12
  1. ;;7.3;TOOLKIT;**93**;Apr 25, 1995
  1. Q
  1. ; Context implementation for "set of codes"
  1. ; CTX and TERM are passed by ref in all calls
  1. CONTEXT(TFILE,TFIELD,CTX) ; set up Context for "set of codes" type
  1. ; called from CONTEXT^XTIDCTX(TFILE,TFIELD,CTX)
  1. ; returns a valid new CTX array
  1. S TFILE=+$G(TFILE),TFIELD=$G(TFIELD)
  1. Q:'TFILE!($D(CTX))
  1. S CTX("TYPE")="SET"
  1. S CTX("TERM FILE#")=TFILE
  1. S CTX("TERM FIELD#")=TFIELD
  1. ; the default source file
  1. S CTX("SOURCE FILE#")=8985.1
  1. ; TERMSTATUS 99.991, EFFECTIVE DATE/TIME subfile
  1. S CTX("TERMSTATUS SUBFILE#")=8985.11
  1. Q
  1. ;
  1. VALIDREF(CTX,TIREF) ; validate the term, internal ref
  1. ; test TIREF is a valid value in set of codes
  1. Q:'$D(CTX)!($G(TIREF)']"") 0
  1. ; as requested by DS, no need for this restrictive validation
  1. ; as some terms to be filed in "set of codes" kernel file
  1. ; may not yet exist in their original file.
  1. ;Q $$MEMBER(CTX("TERM FILE#"),CTX("TERM FIELD#"),TIREF)
  1. Q 1
  1. ;
  1. FINDTERM(CTX,TIREF,TERM) ; find term in given context
  1. ; called from FINDTERM^XTIDCTX(CTX,TIREF,TERM)
  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=$$GETIENS($G(TIREF))
  1. Q:IENS']""
  1. D GETTERM^XTIDCTX(.CTX,CTX("SOURCE FILE#"),IENS,.TERM)
  1. Q
  1. ;
  1. NEWTERM(CTX,TIREF,VUID) ; create new term index entry
  1. ; called from NEWTERM^XTIDCTX(CTX,TIREF,VUID,TERM)
  1. ; D UPDATE^DIE(FLAGS,FDA_ROOT,IEN_ROOT,MSG_ROOT)
  1. N DIERR,FILE,SFILE,FLAGS,MASTER,MSG,MYFDA,MYIEN,SUCCESS
  1. S TIREF=$G(TIREF),VUID=+$G(VUID)
  1. Q:'$D(CTX)!($D(TERM))!('VUID) 0
  1. Q:'$$VALIDREF(.CTX,TIREF) 0
  1. S SUCCESS=0,FLAGS="KS"
  1. S MASTER=1
  1. I $$DUPLMSTR^XTIDTERM(CTX("TERM FILE#"),CTX("TERM FIELD#"),VUID) D
  1. . S MASTER=0
  1. S FILE=CTX("SOURCE FILE#")
  1. S SFILE=CTX("TERMSTATUS SUBFILE#")
  1. S MYFDA(FILE,"+1,",.01)=CTX("TERM FILE#")
  1. S MYFDA(FILE,"+1,",.02)=CTX("TERM FIELD#")
  1. S MYFDA(FILE,"+1,",.03)=TIREF
  1. S MYFDA(FILE,"+1,",99.99)=VUID
  1. S MYFDA(FILE,"+1,",99.98)=MASTER
  1. D UPDATE^DIE(FLAGS,"MYFDA","MYIEN","MSG")
  1. S:'$D(MSG("DIERR")) SUCCESS=1
  1. ; success, build TERM and return
  1. Q SUCCESS
  1. ;
  1. SRCHTRMS(CTX,VUID,XTSARR,MASTER) ; search term index entries
  1. ; called from SEARCH^XTIDCTX(CTX,VUID,XTCARR,MASTER)
  1. N DIERR,FILE,XTC,FIELD
  1. S VUID=$G(VUID),MASTER=+$G(MASTER)
  1. Q:$G(CTX("TYPE"))'="SET"!('VUID)
  1. S FILE=$G(CTX("TERM FILE#"))
  1. S FIELD=$G(CTX("TERM FIELD#"))
  1. ; search in ^XTID(8985.1,"C",VUID,FILE,FIELD,FLAG,IEN)=""
  1. Q:'$D(^XTID(8985.1,"C",VUID))
  1. M XTC=^XTID(8985.1,"C",VUID)
  1. ; search everywhere
  1. I FILE="" D Q
  1. . F S FILE=$O(XTC(FILE)) Q:'FILE D L1
  1. ;
  1. I FILE,FIELD="" D L1 Q
  1. I FILE,FIELD D L2 Q
  1. ;
  1. Q
  1. ;
  1. L1 ;
  1. N FIELD
  1. S FIELD="" F S FIELD=$O(XTC(FILE,FIELD)) Q:'FIELD D L2
  1. Q
  1. ;
  1. L2 ;
  1. N IEN,MSTR,IREF,STATUS
  1. S MSTR="" F S MSTR=$O(XTC(FILE,FIELD,MSTR)) Q:MSTR="" D
  1. . S IEN=0 F S IEN=$O(XTC(FILE,FIELD,MSTR,IEN)) Q:'IEN D
  1. . . I MASTER,MSTR=0 Q
  1. . . S IREF=$P($G(^XTID(8985.1,IEN,0)),"^",3)
  1. . . S STATUS=$$GETSTAT^XTID(FILE,FIELD,IREF,"")
  1. . . S STATUS=STATUS_"^"_MSTR
  1. . . D ADDTARRY^XTIDCTX(XTSARR,FILE,FIELD,IREF,STATUS)
  1. . ;
  1. ;
  1. Q
  1. ;
  1. GETIENS(TIREF) ; find term's ien/IENS
  1. ; find term entry and return IENS
  1. ; $$FIND1^DIC(FILE,IENS,FLAGS,[.]VALUE,[.]INDEXES,.SCREEN,MSG_ROOT)
  1. N DIERR,FILE,FLAGS,INDEXES,MSG,RIEN,VALUE
  1. S FILE=CTX("SOURCE FILE#"),FLAGS="KQX",INDEXES="",RIEN=""
  1. S VALUE(1)=CTX("TERM FILE#")
  1. S VALUE(2)=CTX("TERM FIELD#")
  1. S VALUE(3)=TIREF
  1. ; get record IEN
  1. ;S RIEN=$$FIND1^DIC(FILE,"",FLAGS,.VALUE,INDEXES,"","MSG")
  1. S RIEN=$O(^XTID(FILE,"B",VALUE(1),VALUE(2),VALUE(3),0))
  1. Q:RIEN RIEN_","
  1. Q RIEN
  1. ;
  1. MEMBER(FILE,FIELD,VALUE) ; valid member in "set of codes"?
  1. ; validate VALUE for this FIELD
  1. ; for validation purposes only, RESULT not used
  1. ; D VAL^DIE(FILE,IENS,FIELD,FLAGS,VALUE,.RESULT,FDA_ROOT,MSG_ROOT)
  1. N DIERR,FLAGS,IENS,MSG,RESULT,SUCCESS
  1. S SUCCESS=0
  1. S FLAGS="U",IENS="+1,"
  1. D VAL^DIE(CTX("TERM FILE#"),IENS,CTX("TERM FIELD#"),FLAGS,VALUE,.RESULT,"","MSG")
  1. S:'$D(MSG("DIERR")) SUCCESS=1
  1. Q SUCCESS
  1. ;