XTIDSET ;OAKCIOFO/JLG - SET OF CODES CONTEXT ;04/25/2005 15:12
;;7.3;TOOLKIT;**93**;Apr 25, 1995
Q
; Context implementation for "set of codes"
; CTX and TERM are passed by ref in all calls
CONTEXT(TFILE,TFIELD,CTX) ; set up Context for "set of codes" type
; called from CONTEXT^XTIDCTX(TFILE,TFIELD,CTX)
; returns a valid new CTX array
S TFILE=+$G(TFILE),TFIELD=$G(TFIELD)
Q:'TFILE!($D(CTX))
S CTX("TYPE")="SET"
S CTX("TERM FILE#")=TFILE
S CTX("TERM FIELD#")=TFIELD
; the default source file
S CTX("SOURCE FILE#")=8985.1
; TERMSTATUS 99.991, EFFECTIVE DATE/TIME subfile
S CTX("TERMSTATUS SUBFILE#")=8985.11
Q
;
VALIDREF(CTX,TIREF) ; validate the term, internal ref
; test TIREF is a valid value in set of codes
Q:'$D(CTX)!($G(TIREF)']"") 0
; as requested by DS, no need for this restrictive validation
; as some terms to be filed in "set of codes" kernel file
; may not yet exist in their original file.
;Q $$MEMBER(CTX("TERM FILE#"),CTX("TERM FIELD#"),TIREF)
Q 1
;
FINDTERM(CTX,TIREF,TERM) ; find term in given context
; called from FINDTERM^XTIDCTX(CTX,TIREF,TERM)
; return TERM data as new TERM array
N IENS
Q:'$D(CTX)!($D(TERM))
Q:'$$VALIDREF(.CTX,$G(TIREF))
S IENS=$$GETIENS($G(TIREF))
Q:IENS']""
D GETTERM^XTIDCTX(.CTX,CTX("SOURCE FILE#"),IENS,.TERM)
Q
;
NEWTERM(CTX,TIREF,VUID) ; create new term index entry
; called from NEWTERM^XTIDCTX(CTX,TIREF,VUID,TERM)
; D UPDATE^DIE(FLAGS,FDA_ROOT,IEN_ROOT,MSG_ROOT)
N DIERR,FILE,SFILE,FLAGS,MASTER,MSG,MYFDA,MYIEN,SUCCESS
S TIREF=$G(TIREF),VUID=+$G(VUID)
Q:'$D(CTX)!($D(TERM))!('VUID) 0
Q:'$$VALIDREF(.CTX,TIREF) 0
S SUCCESS=0,FLAGS="KS"
S MASTER=1
I $$DUPLMSTR^XTIDTERM(CTX("TERM FILE#"),CTX("TERM FIELD#"),VUID) D
. S MASTER=0
S FILE=CTX("SOURCE FILE#")
S SFILE=CTX("TERMSTATUS SUBFILE#")
S MYFDA(FILE,"+1,",.01)=CTX("TERM FILE#")
S MYFDA(FILE,"+1,",.02)=CTX("TERM FIELD#")
S MYFDA(FILE,"+1,",.03)=TIREF
S MYFDA(FILE,"+1,",99.99)=VUID
S MYFDA(FILE,"+1,",99.98)=MASTER
D UPDATE^DIE(FLAGS,"MYFDA","MYIEN","MSG")
S:'$D(MSG("DIERR")) SUCCESS=1
; success, build TERM and return
Q SUCCESS
;
SRCHTRMS(CTX,VUID,XTSARR,MASTER) ; search term index entries
; called from SEARCH^XTIDCTX(CTX,VUID,XTCARR,MASTER)
N DIERR,FILE,XTC,FIELD
S VUID=$G(VUID),MASTER=+$G(MASTER)
Q:$G(CTX("TYPE"))'="SET"!('VUID)
S FILE=$G(CTX("TERM FILE#"))
S FIELD=$G(CTX("TERM FIELD#"))
; search in ^XTID(8985.1,"C",VUID,FILE,FIELD,FLAG,IEN)=""
Q:'$D(^XTID(8985.1,"C",VUID))
M XTC=^XTID(8985.1,"C",VUID)
; search everywhere
I FILE="" D Q
. F S FILE=$O(XTC(FILE)) Q:'FILE D L1
;
I FILE,FIELD="" D L1 Q
I FILE,FIELD D L2 Q
;
Q
;
L1 ;
N FIELD
S FIELD="" F S FIELD=$O(XTC(FILE,FIELD)) Q:'FIELD D L2
Q
;
L2 ;
N IEN,MSTR,IREF,STATUS
S MSTR="" F S MSTR=$O(XTC(FILE,FIELD,MSTR)) Q:MSTR="" D
. S IEN=0 F S IEN=$O(XTC(FILE,FIELD,MSTR,IEN)) Q:'IEN D
. . I MASTER,MSTR=0 Q
. . S IREF=$P($G(^XTID(8985.1,IEN,0)),"^",3)
. . S STATUS=$$GETSTAT^XTID(FILE,FIELD,IREF,"")
. . S STATUS=STATUS_"^"_MSTR
. . D ADDTARRY^XTIDCTX(XTSARR,FILE,FIELD,IREF,STATUS)
. ;
;
Q
;
GETIENS(TIREF) ; find term's ien/IENS
; find term entry and return IENS
; $$FIND1^DIC(FILE,IENS,FLAGS,[.]VALUE,[.]INDEXES,.SCREEN,MSG_ROOT)
N DIERR,FILE,FLAGS,INDEXES,MSG,RIEN,VALUE
S FILE=CTX("SOURCE FILE#"),FLAGS="KQX",INDEXES="",RIEN=""
S VALUE(1)=CTX("TERM FILE#")
S VALUE(2)=CTX("TERM FIELD#")
S VALUE(3)=TIREF
; get record IEN
;S RIEN=$$FIND1^DIC(FILE,"",FLAGS,.VALUE,INDEXES,"","MSG")
S RIEN=$O(^XTID(FILE,"B",VALUE(1),VALUE(2),VALUE(3),0))
Q:RIEN RIEN_","
Q RIEN
;
MEMBER(FILE,FIELD,VALUE) ; valid member in "set of codes"?
; validate VALUE for this FIELD
; for validation purposes only, RESULT not used
; D VAL^DIE(FILE,IENS,FIELD,FLAGS,VALUE,.RESULT,FDA_ROOT,MSG_ROOT)
N DIERR,FLAGS,IENS,MSG,RESULT,SUCCESS
S SUCCESS=0
S FLAGS="U",IENS="+1,"
D VAL^DIE(CTX("TERM FILE#"),IENS,CTX("TERM FIELD#"),FLAGS,VALUE,.RESULT,"","MSG")
S:'$D(MSG("DIERR")) SUCCESS=1
Q SUCCESS
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXTIDSET 4087 printed Dec 13, 2024@02:41:07 Page 2
XTIDSET ;OAKCIOFO/JLG - SET OF CODES CONTEXT ;04/25/2005 15:12
+1 ;;7.3;TOOLKIT;**93**;Apr 25, 1995
+2 QUIT
+3 ; Context implementation for "set of codes"
+4 ; CTX and TERM are passed by ref in all calls
CONTEXT(TFILE,TFIELD,CTX) ; set up Context for "set of codes" type
+1 ; called from CONTEXT^XTIDCTX(TFILE,TFIELD,CTX)
+2 ; returns a valid new CTX array
+3 SET TFILE=+$GET(TFILE)
SET TFIELD=$GET(TFIELD)
+4 if 'TFILE!($DATA(CTX))
QUIT
+5 SET CTX("TYPE")="SET"
+6 SET CTX("TERM FILE#")=TFILE
+7 SET CTX("TERM FIELD#")=TFIELD
+8 ; the default source file
+9 SET CTX("SOURCE FILE#")=8985.1
+10 ; TERMSTATUS 99.991, EFFECTIVE DATE/TIME subfile
+11 SET CTX("TERMSTATUS SUBFILE#")=8985.11
+12 QUIT
+13 ;
VALIDREF(CTX,TIREF) ; validate the term, internal ref
+1 ; test TIREF is a valid value in set of codes
+2 if '$DATA(CTX)!($GET(TIREF)']"")
QUIT 0
+3 ; as requested by DS, no need for this restrictive validation
+4 ; as some terms to be filed in "set of codes" kernel file
+5 ; may not yet exist in their original file.
+6 ;Q $$MEMBER(CTX("TERM FILE#"),CTX("TERM FIELD#"),TIREF)
+7 QUIT 1
+8 ;
FINDTERM(CTX,TIREF,TERM) ; find term in given context
+1 ; called from FINDTERM^XTIDCTX(CTX,TIREF,TERM)
+2 ; return TERM data as new TERM array
+3 NEW IENS
+4 if '$DATA(CTX)!($DATA(TERM))
QUIT
+5 if '$$VALIDREF(.CTX,$GET(TIREF))
QUIT
+6 SET IENS=$$GETIENS($GET(TIREF))
+7 if IENS']""
QUIT
+8 DO GETTERM^XTIDCTX(.CTX,CTX("SOURCE FILE#"),IENS,.TERM)
+9 QUIT
+10 ;
NEWTERM(CTX,TIREF,VUID) ; create new term index entry
+1 ; called from NEWTERM^XTIDCTX(CTX,TIREF,VUID,TERM)
+2 ; D UPDATE^DIE(FLAGS,FDA_ROOT,IEN_ROOT,MSG_ROOT)
+3 NEW DIERR,FILE,SFILE,FLAGS,MASTER,MSG,MYFDA,MYIEN,SUCCESS
+4 SET TIREF=$GET(TIREF)
SET VUID=+$GET(VUID)
+5 if '$DATA(CTX)!($DATA(TERM))!('VUID)
QUIT 0
+6 if '$$VALIDREF(.CTX,TIREF)
QUIT 0
+7 SET SUCCESS=0
SET FLAGS="KS"
+8 SET MASTER=1
+9 IF $$DUPLMSTR^XTIDTERM(CTX("TERM FILE#"),CTX("TERM FIELD#"),VUID)
Begin DoDot:1
+10 SET MASTER=0
End DoDot:1
+11 SET FILE=CTX("SOURCE FILE#")
+12 SET SFILE=CTX("TERMSTATUS SUBFILE#")
+13 SET MYFDA(FILE,"+1,",.01)=CTX("TERM FILE#")
+14 SET MYFDA(FILE,"+1,",.02)=CTX("TERM FIELD#")
+15 SET MYFDA(FILE,"+1,",.03)=TIREF
+16 SET MYFDA(FILE,"+1,",99.99)=VUID
+17 SET MYFDA(FILE,"+1,",99.98)=MASTER
+18 DO UPDATE^DIE(FLAGS,"MYFDA","MYIEN","MSG")
+19 if '$DATA(MSG("DIERR"))
SET SUCCESS=1
+20 ; success, build TERM and return
+21 QUIT SUCCESS
+22 ;
SRCHTRMS(CTX,VUID,XTSARR,MASTER) ; search term index entries
+1 ; called from SEARCH^XTIDCTX(CTX,VUID,XTCARR,MASTER)
+2 NEW DIERR,FILE,XTC,FIELD
+3 SET VUID=$GET(VUID)
SET MASTER=+$GET(MASTER)
+4 if $GET(CTX("TYPE"))'="SET"!('VUID)
QUIT
+5 SET FILE=$GET(CTX("TERM FILE#"))
+6 SET FIELD=$GET(CTX("TERM FIELD#"))
+7 ; search in ^XTID(8985.1,"C",VUID,FILE,FIELD,FLAG,IEN)=""
+8 if '$DATA(^XTID(8985.1,"C",VUID))
QUIT
+9 MERGE XTC=^XTID(8985.1,"C",VUID)
+10 ; search everywhere
+11 IF FILE=""
Begin DoDot:1
+12 FOR
SET FILE=$ORDER(XTC(FILE))
if 'FILE
QUIT
DO L1
End DoDot:1
QUIT
+13 ;
+14 IF FILE
IF FIELD=""
DO L1
QUIT
+15 IF FILE
IF FIELD
DO L2
QUIT
+16 ;
+17 QUIT
+18 ;
L1 ;
+1 NEW FIELD
+2 SET FIELD=""
FOR
SET FIELD=$ORDER(XTC(FILE,FIELD))
if 'FIELD
QUIT
DO L2
+3 QUIT
+4 ;
L2 ;
+1 NEW IEN,MSTR,IREF,STATUS
+2 SET MSTR=""
FOR
SET MSTR=$ORDER(XTC(FILE,FIELD,MSTR))
if MSTR=""
QUIT
Begin DoDot:1
+3 SET IEN=0
FOR
SET IEN=$ORDER(XTC(FILE,FIELD,MSTR,IEN))
if 'IEN
QUIT
Begin DoDot:2
+4 IF MASTER
IF MSTR=0
QUIT
+5 SET IREF=$PIECE($GET(^XTID(8985.1,IEN,0)),"^",3)
+6 SET STATUS=$$GETSTAT^XTID(FILE,FIELD,IREF,"")
+7 SET STATUS=STATUS_"^"_MSTR
+8 DO ADDTARRY^XTIDCTX(XTSARR,FILE,FIELD,IREF,STATUS)
End DoDot:2
+9 ;
End DoDot:1
+10 ;
+11 QUIT
+12 ;
GETIENS(TIREF) ; find term's ien/IENS
+1 ; find term entry and return IENS
+2 ; $$FIND1^DIC(FILE,IENS,FLAGS,[.]VALUE,[.]INDEXES,.SCREEN,MSG_ROOT)
+3 NEW DIERR,FILE,FLAGS,INDEXES,MSG,RIEN,VALUE
+4 SET FILE=CTX("SOURCE FILE#")
SET FLAGS="KQX"
SET INDEXES=""
SET RIEN=""
+5 SET VALUE(1)=CTX("TERM FILE#")
+6 SET VALUE(2)=CTX("TERM FIELD#")
+7 SET VALUE(3)=TIREF
+8 ; get record IEN
+9 ;S RIEN=$$FIND1^DIC(FILE,"",FLAGS,.VALUE,INDEXES,"","MSG")
+10 SET RIEN=$ORDER(^XTID(FILE,"B",VALUE(1),VALUE(2),VALUE(3),0))
+11 if RIEN
QUIT RIEN_","
+12 QUIT RIEN
+13 ;
MEMBER(FILE,FIELD,VALUE) ; valid member in "set of codes"?
+1 ; validate VALUE for this FIELD
+2 ; for validation purposes only, RESULT not used
+3 ; D VAL^DIE(FILE,IENS,FIELD,FLAGS,VALUE,.RESULT,FDA_ROOT,MSG_ROOT)
+4 NEW DIERR,FLAGS,IENS,MSG,RESULT,SUCCESS
+5 SET SUCCESS=0
+6 SET FLAGS="U"
SET IENS="+1,"
+7 DO VAL^DIE(CTX("TERM FILE#"),IENS,CTX("TERM FIELD#"),FLAGS,VALUE,.RESULT,"","MSG")
+8 if '$DATA(MSG("DIERR"))
SET SUCCESS=1
+9 QUIT SUCCESS
+10 ;
