- 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 Jan 18, 2025@03:42:14 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 ;