XTIDTERM ;OAKCIOFO/JLG - TERM/CONCEPT index entry ;03/18/2005 15:12
;;7.3;TOOLKIT;**93**;Apr 25, 1995
Q
; encapsulates a term/concept index entry for both
; "set of codes" and "table" indexes
; it interfaces through FileMan
; TERM is by reference and is in FDA format + CTX data
; only exceptions are $$GETSTAT and $$SETSTAT
; FDA format is left for convenience but future
; implementations might customize it.
; TERM is passed by ref in all calls
GETVUID(TERM) ; return VUID value
;
N FILE,IENS
Q:'$D(TERM)
S FILE=TERM("CTX","SOURCE FILE#")
S IENS=$O(TERM(FILE,""))
Q $G(TERM(FILE,IENS,"VUID","I"))
;
GETMASTR(TERM) ; return MASTER VUID value
;
N FILE,IENS
Q:'$D(TERM)
S FILE=TERM("CTX","SOURCE FILE#")
S IENS=$O(TERM(FILE,""))
Q $G(TERM(FILE,IENS,"MASTER ENTRY FOR VUID","I"))
;
GETSTAT(TERM,DATE) ; return MASTER VUID value
;
N FILE,SFILE,IENS,STATUS
Q:'$D(TERM)
S:'$G(DATE) DATE=$$NOW^XLFDT
S FILE=TERM("CTX","SOURCE FILE#")
S SFILE=TERM("CTX","TERMSTATUS SUBFILE#")
S IENS=","_$O(TERM(FILE,""))
S STATUS=$$FINDSTAT(SFILE,IENS,DATE)
;I 'STATUS Q "^status not found for given date/time"
Q $P(STATUS,"^",2,4)
;
SETVUID(TERM,VUID) ; set new VUID to existing TERM
;
N DIERR,FLAGS,FILE,IENS,MSG,MYFDA,SUCCESS
S VUID=$G(VUID)
Q:'$D(TERM)!('VUID) 0
; check constraints first
Q:$$CNSTR1() 0
S SUCCESS=0,FLAGS="KS"
S FILE=TERM("CTX","SOURCE FILE#")
S IENS=$O(TERM(+FILE,""))
Q:IENS']"" SUCCESS
S MYFDA(FILE,IENS,99.99)=VUID
D FILE^DIE(FLAGS,"MYFDA","MSG")
I '$D(MSG("DIERR")) D
. S SUCCESS=1
. ; update the cached TERM array
. S TERM(FILE,IENS,"VUID","I")=VUID
;
Q SUCCESS
;
SETMASTR(TERM,MVUID) ; set MASTER ENTRY flag to existing TERM
;
N DIERR,FLAGS,FILE,IENS,MSG,MYFDA,SUCCESS
S MVUID=+$G(MVUID)
Q:'$D(TERM) 0
; check constraints first and override VUID flag
I MVUID,$$CNSTR2() S MVUID=0
S FILE=TERM("CTX","SOURCE FILE#")
S IENS=$O(TERM(+FILE,""))
Q:IENS']"" 0
S SUCCESS=0,FLAGS="KS"
S MYFDA(FILE,IENS,99.98)=MVUID
D FILE^DIE(FLAGS,"MYFDA","MSG")
I '$D(MSG("DIERR")) D
. S SUCCESS=1
. ; update the cached TERM array
. S TERM(FILE,IENS,"MASTER ENTRY FOR VUID","I")=MVUID
;
Q SUCCESS
;
SETSTAT(TERM,STATUS,DATE) ; set status
; set status and date for the given term
N DIERR,FLAGS,FILE,SFILE,MYFDA,MSG,SUCCESS,IENS
S STATUS=$G(STATUS),DATE=$G(DATE)
Q:'$D(TERM)!(STATUS']"") 0
S SUCCESS=0,FLAGS="KS"
S STATUS=+$G(STATUS)
S:'$G(DATE) DATE=$$NOW^XLFDT
S FILE=TERM("CTX","SOURCE FILE#")
S SFILE=TERM("CTX","TERMSTATUS SUBFILE#")
S IENS="?+1,"_$O(TERM(FILE,""))
S MYFDA(SFILE,IENS,.01)=DATE
S MYFDA(SFILE,IENS,.02)=STATUS
D UPDATE^DIE(FLAGS,"MYFDA","","MSG")
S:'$D(MSG("DIERR")) SUCCESS=1
Q SUCCESS
;
FINDSTAT(FILE,IENS,DATE) ; find status info
; find status of term for given DATE
; D LIST^DIC(FILE,IENS,FIELDS,FLAGS,NUMBER,[.]FROM,[.]PART,INDEX,[.]SCREEN,IDENTIFIER,TARGET_ROOT,MSG_ROOT)
N DIERR,FIELDS,FLAGS,FROM,MSG,MYSTAT,NUMBER,STATUS
S STATUS="^^^"
S:'$G(DATE) DATE=$$NOW^XLFDT
S FROM=DATE+.000001
S FIELDS="@;.01IE;.02IE",FLAGS="B",NUMBER=1
D LIST^DIC(FILE,IENS,FIELDS,FLAGS,NUMBER,FROM,"","","","","MYSTAT","MSG")
Q:$D(MSG("DIERR")) STATUS
I $D(MYSTAT("DILIST","ID",1)) D
. N ESTAT,IDATE,IENSTAT,ISTAT
. S IENSTAT=$G(MYSTAT("DILIST",2,1))
. S ISTAT=$G(MYSTAT("DILIST","ID",1,.02,"I"))
. S ESTAT=$G(MYSTAT("DILIST","ID",1,.02,"E"))
. S IDATE=$G(MYSTAT("DILIST","ID",1,.01,"I"))
. S STATUS=IENSTAT_"^"_ISTAT_"^"_IDATE_"^"_ESTAT
;
Q STATUS
;
DUPLMSTR(FILE,FIELD,TVUID) ; check duplicates
; used to determine existence of duplicate
; entries with the same VUID and master flag
; can potentially use this from DD trigger
N XTTARR,DUPL
S DUPL=0
D GETIREF^XTID(FILE,FIELD,TVUID,"XTTARR",1)
I +$G(XTTARR) S DUPL=1
Q DUPL
;
CNSTR1() ; check constraints when setting VUID
; called from SETVUID()
; only one MASTER ENTRY FOR VUID can exist
N CONSTR,DUPL,MFLAG,TFILE,TFIELD
S CONSTR=1
S MFLAG=$$GETMASTR(.TERM)
Q:'MFLAG 'CONSTR ; no constraint
S TFILE=TERM("CTX","TERM FILE#")
S TFIELD=TERM("CTX","TERM FIELD#")
S DUPL=$$DUPLMSTR(TFILE,TFIELD,VUID)
Q:'DUPL 'CONSTR ; no constraint
Q CONSTR ; constrained
;
CNSTR2() ; check constraints when setting MASTER ENTRY flag
; called from SETMASTR()
; only one MASTER ENTRY FOR VUID can exist
N CONSTR,DUPL,MFLAG,TFILE,TFIELD,TVUID
S CONSTR=1
S MFLAG=$$GETMASTR(.TERM)
Q:MFLAG 'CONSTR ; TERM is already MASTER
S TFILE=TERM("CTX","TERM FILE#")
S TFIELD=TERM("CTX","TERM FIELD#")
S TVUID=$$GETVUID(.TERM)
S DUPL=$$DUPLMSTR(TFILE,TFIELD,TVUID)
Q:'DUPL 'CONSTR ; no constraint
Q CONSTR ; constrained
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXTIDTERM 4727 printed Oct 16, 2024@18:41:46 Page 2
XTIDTERM ;OAKCIOFO/JLG - TERM/CONCEPT index entry ;03/18/2005 15:12
+1 ;;7.3;TOOLKIT;**93**;Apr 25, 1995
+2 QUIT
+3 ; encapsulates a term/concept index entry for both
+4 ; "set of codes" and "table" indexes
+5 ; it interfaces through FileMan
+6 ; TERM is by reference and is in FDA format + CTX data
+7 ; only exceptions are $$GETSTAT and $$SETSTAT
+8 ; FDA format is left for convenience but future
+9 ; implementations might customize it.
+10 ; TERM is passed by ref in all calls
GETVUID(TERM) ; return VUID value
+1 ;
+2 NEW FILE,IENS
+3 if '$DATA(TERM)
QUIT
+4 SET FILE=TERM("CTX","SOURCE FILE#")
+5 SET IENS=$ORDER(TERM(FILE,""))
+6 QUIT $GET(TERM(FILE,IENS,"VUID","I"))
+7 ;
GETMASTR(TERM) ; return MASTER VUID value
+1 ;
+2 NEW FILE,IENS
+3 if '$DATA(TERM)
QUIT
+4 SET FILE=TERM("CTX","SOURCE FILE#")
+5 SET IENS=$ORDER(TERM(FILE,""))
+6 QUIT $GET(TERM(FILE,IENS,"MASTER ENTRY FOR VUID","I"))
+7 ;
GETSTAT(TERM,DATE) ; return MASTER VUID value
+1 ;
+2 NEW FILE,SFILE,IENS,STATUS
+3 if '$DATA(TERM)
QUIT
+4 if '$GET(DATE)
SET DATE=$$NOW^XLFDT
+5 SET FILE=TERM("CTX","SOURCE FILE#")
+6 SET SFILE=TERM("CTX","TERMSTATUS SUBFILE#")
+7 SET IENS=","_$ORDER(TERM(FILE,""))
+8 SET STATUS=$$FINDSTAT(SFILE,IENS,DATE)
+9 ;I 'STATUS Q "^status not found for given date/time"
+10 QUIT $PIECE(STATUS,"^",2,4)
+11 ;
SETVUID(TERM,VUID) ; set new VUID to existing TERM
+1 ;
+2 NEW DIERR,FLAGS,FILE,IENS,MSG,MYFDA,SUCCESS
+3 SET VUID=$GET(VUID)
+4 if '$DATA(TERM)!('VUID)
QUIT 0
+5 ; check constraints first
+6 if $$CNSTR1()
QUIT 0
+7 SET SUCCESS=0
SET FLAGS="KS"
+8 SET FILE=TERM("CTX","SOURCE FILE#")
+9 SET IENS=$ORDER(TERM(+FILE,""))
+10 if IENS']""
QUIT SUCCESS
+11 SET MYFDA(FILE,IENS,99.99)=VUID
+12 DO FILE^DIE(FLAGS,"MYFDA","MSG")
+13 IF '$DATA(MSG("DIERR"))
Begin DoDot:1
+14 SET SUCCESS=1
+15 ; update the cached TERM array
+16 SET TERM(FILE,IENS,"VUID","I")=VUID
End DoDot:1
+17 ;
+18 QUIT SUCCESS
+19 ;
SETMASTR(TERM,MVUID) ; set MASTER ENTRY flag to existing TERM
+1 ;
+2 NEW DIERR,FLAGS,FILE,IENS,MSG,MYFDA,SUCCESS
+3 SET MVUID=+$GET(MVUID)
+4 if '$DATA(TERM)
QUIT 0
+5 ; check constraints first and override VUID flag
+6 IF MVUID
IF $$CNSTR2()
SET MVUID=0
+7 SET FILE=TERM("CTX","SOURCE FILE#")
+8 SET IENS=$ORDER(TERM(+FILE,""))
+9 if IENS']""
QUIT 0
+10 SET SUCCESS=0
SET FLAGS="KS"
+11 SET MYFDA(FILE,IENS,99.98)=MVUID
+12 DO FILE^DIE(FLAGS,"MYFDA","MSG")
+13 IF '$DATA(MSG("DIERR"))
Begin DoDot:1
+14 SET SUCCESS=1
+15 ; update the cached TERM array
+16 SET TERM(FILE,IENS,"MASTER ENTRY FOR VUID","I")=MVUID
End DoDot:1
+17 ;
+18 QUIT SUCCESS
+19 ;
SETSTAT(TERM,STATUS,DATE) ; set status
+1 ; set status and date for the given term
+2 NEW DIERR,FLAGS,FILE,SFILE,MYFDA,MSG,SUCCESS,IENS
+3 SET STATUS=$GET(STATUS)
SET DATE=$GET(DATE)
+4 if '$DATA(TERM)!(STATUS']"")
QUIT 0
+5 SET SUCCESS=0
SET FLAGS="KS"
+6 SET STATUS=+$GET(STATUS)
+7 if '$GET(DATE)
SET DATE=$$NOW^XLFDT
+8 SET FILE=TERM("CTX","SOURCE FILE#")
+9 SET SFILE=TERM("CTX","TERMSTATUS SUBFILE#")
+10 SET IENS="?+1,"_$ORDER(TERM(FILE,""))
+11 SET MYFDA(SFILE,IENS,.01)=DATE
+12 SET MYFDA(SFILE,IENS,.02)=STATUS
+13 DO UPDATE^DIE(FLAGS,"MYFDA","","MSG")
+14 if '$DATA(MSG("DIERR"))
SET SUCCESS=1
+15 QUIT SUCCESS
+16 ;
FINDSTAT(FILE,IENS,DATE) ; find status info
+1 ; find status of term for given DATE
+2 ; D LIST^DIC(FILE,IENS,FIELDS,FLAGS,NUMBER,[.]FROM,[.]PART,INDEX,[.]SCREEN,IDENTIFIER,TARGET_ROOT,MSG_ROOT)
+3 NEW DIERR,FIELDS,FLAGS,FROM,MSG,MYSTAT,NUMBER,STATUS
+4 SET STATUS="^^^"
+5 if '$GET(DATE)
SET DATE=$$NOW^XLFDT
+6 SET FROM=DATE+.000001
+7 SET FIELDS="@;.01IE;.02IE"
SET FLAGS="B"
SET NUMBER=1
+8 DO LIST^DIC(FILE,IENS,FIELDS,FLAGS,NUMBER,FROM,"","","","","MYSTAT","MSG")
+9 if $DATA(MSG("DIERR"))
QUIT STATUS
+10 IF $DATA(MYSTAT("DILIST","ID",1))
Begin DoDot:1
+11 NEW ESTAT,IDATE,IENSTAT,ISTAT
+12 SET IENSTAT=$GET(MYSTAT("DILIST",2,1))
+13 SET ISTAT=$GET(MYSTAT("DILIST","ID",1,.02,"I"))
+14 SET ESTAT=$GET(MYSTAT("DILIST","ID",1,.02,"E"))
+15 SET IDATE=$GET(MYSTAT("DILIST","ID",1,.01,"I"))
+16 SET STATUS=IENSTAT_"^"_ISTAT_"^"_IDATE_"^"_ESTAT
End DoDot:1
+17 ;
+18 QUIT STATUS
+19 ;
DUPLMSTR(FILE,FIELD,TVUID) ; check duplicates
+1 ; used to determine existence of duplicate
+2 ; entries with the same VUID and master flag
+3 ; can potentially use this from DD trigger
+4 NEW XTTARR,DUPL
+5 SET DUPL=0
+6 DO GETIREF^XTID(FILE,FIELD,TVUID,"XTTARR",1)
+7 IF +$GET(XTTARR)
SET DUPL=1
+8 QUIT DUPL
+9 ;
CNSTR1() ; check constraints when setting VUID
+1 ; called from SETVUID()
+2 ; only one MASTER ENTRY FOR VUID can exist
+3 NEW CONSTR,DUPL,MFLAG,TFILE,TFIELD
+4 SET CONSTR=1
+5 SET MFLAG=$$GETMASTR(.TERM)
+6 ; no constraint
if 'MFLAG
QUIT 'CONSTR
+7 SET TFILE=TERM("CTX","TERM FILE#")
+8 SET TFIELD=TERM("CTX","TERM FIELD#")
+9 SET DUPL=$$DUPLMSTR(TFILE,TFIELD,VUID)
+10 ; no constraint
if 'DUPL
QUIT 'CONSTR
+11 ; constrained
QUIT CONSTR
+12 ;
CNSTR2() ; check constraints when setting MASTER ENTRY flag
+1 ; called from SETMASTR()
+2 ; only one MASTER ENTRY FOR VUID can exist
+3 NEW CONSTR,DUPL,MFLAG,TFILE,TFIELD,TVUID
+4 SET CONSTR=1
+5 SET MFLAG=$$GETMASTR(.TERM)
+6 ; TERM is already MASTER
if MFLAG
QUIT 'CONSTR
+7 SET TFILE=TERM("CTX","TERM FILE#")
+8 SET TFIELD=TERM("CTX","TERM FIELD#")
+9 SET TVUID=$$GETVUID(.TERM)
+10 SET DUPL=$$DUPLMSTR(TFILE,TFIELD,TVUID)
+11 ; no constraint
if 'DUPL
QUIT 'CONSTR
+12 ; constrained
QUIT CONSTR
+13 ;