XTIDTBL ;OAKCIOFO/JLG - TABLE CONTEXT ;04/21/2005 15:12
;;7.3;TOOLKIT;**93**;Apr 25, 1995
Q
; Context implementation for "table"
; CTX and TERM are passed by ref in all calls
CONTEXT(TFILE,TFIELD,CTX) ; set up Context for "table" type
; called from CONTEXT^XTIDCTX(TFILE,TFIELD,CTX)
; returns a valid new CTX array
N SUBFILE
S TFILE=+$G(TFILE)
Q:'TFILE!($D(CTX))
; determine the subfile for the multi-valued field
; 99.991, EFFECTIVE DATE/TIME
S SUBFILE=$$GETSUBF(TFILE,99.991)
Q:'SUBFILE
S CTX("TYPE")="TABLE"
S CTX("TERM FILE#")=TFILE
S CTX("TERM FIELD#")=.01
S CTX("SOURCE FILE#")=TFILE
S CTX("TERMSTATUS SUBFILE#")=SUBFILE
Q
;
VALIDREF(CTX,TIREF) ; validate the term, internal ref
; test TIREF is a valid value in given context (table)
; TIREF must be in IENS form, but will be checked
; later as VDUI related data is retrieved
; would be nice if we can do an earlier check
; based on IENS and the CTX("SOURCE FILE#")
N VALID
Q:'$D(CTX)!($G(TIREF)']"") 0
S VALID=TIREF?.(.N1",")
Q VALID
;
FINDTERM(CTX,TIREF,TERM) ; find term
; called from FINDTERM^XTIDCTX(CTX,TIREF,TERM)
; find term for given term IREF
; return TERM data as new TERM array
N IENS
Q:'$D(CTX)!($D(TERM))
Q:'$$VALIDREF(.CTX,$G(TIREF))
S IENS=$G(TIREF)
Q:IENS']""
D GETTERM^XTIDCTX(.CTX,CTX("SOURCE FILE#"),IENS,.TERM)
Q
;
SRCHTRMS(CTX,VUID,XTTBARR,MASTER) ; search term index entries
; called from SEARCH^XTIDCTX(CTX,VUID,ARRAY,MASTER)
; FIND^DIC(FILE,IENS,FIELDS,FLAGS,[.]VALUE,NUMBER,[.]INDEXES,
; [.]SCREEN,IDENTIFIER,TARGET_ROOT,MSG_ROOT)
N DIERR,FILE,TFILE,INDEXES,MSG,RIEN,VALUE,FLAGS,TARG,MSG,NUMFND
N FIELDS,SCREEN
S VUID=$G(VUID),MASTER=+$G(MASTER)
Q:$G(CTX("TYPE"))'="TABLE"!('VUID)
S FILE=CTX("SOURCE FILE#"),INDEXES="AVUID",FLAGS="QX"
S FIELDS="@;99.98I"
S VALUE(1)=VUID
S SCREEN="" I MASTER S SCREEN="I $P(^(""VUID""),""^"",2)"
; get entries
D FIND^DIC(FILE,"",FIELDS,FLAGS,.VALUE,"",INDEXES,SCREEN,"","TARG","MSG")
Q:$D(MSG("DIERR"))
S NUMFND=+$G(TARG("DILIST",0))
I NUMFND D ; found entries
. N ITM,TEMP
. M TEMP=TARG("DILIST",2)
. M TEMP=TARG("DILIST","ID")
. F ITM=1:1:NUMFND D
. . N STATUS,IENS
. . S IENS=TEMP(ITM)_","
. . S STATUS=$$GETSTAT^XTID(CTX("TERM FILE#"),CTX("TERM FIELD#"),IENS,"")
. . S STATUS=STATUS_"^"_TEMP(ITM,99.98)
. . D ADDTARRY^XTIDCTX(XTTBARR,CTX("TERM FILE#"),CTX("TERM FIELD#"),IENS,STATUS)
. ;
;
Q
;
GETSUBF(FILE,MFIELD) ; get subfile #
; get subfile for the given file and multiple-valued field
N DIERR,ATTR,SUBFILE
S SUBFILE=""
D FIELD^DID(FILE,MFIELD,"","MULTIPLE-VALUED;SPECIFIER;TYPE","ATTR")
I ATTR("MULTIPLE-VALUED")=1,ATTR("TYPE")'="WORD-PROCESSING" D
. S SUBFILE=+$G(ATTR("SPECIFIER"))
;
Q SUBFILE
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXTIDTBL 2802 printed Oct 16, 2024@18:41:45 Page 2
XTIDTBL ;OAKCIOFO/JLG - TABLE CONTEXT ;04/21/2005 15:12
+1 ;;7.3;TOOLKIT;**93**;Apr 25, 1995
+2 QUIT
+3 ; Context implementation for "table"
+4 ; CTX and TERM are passed by ref in all calls
CONTEXT(TFILE,TFIELD,CTX) ; set up Context for "table" type
+1 ; called from CONTEXT^XTIDCTX(TFILE,TFIELD,CTX)
+2 ; returns a valid new CTX array
+3 NEW SUBFILE
+4 SET TFILE=+$GET(TFILE)
+5 if 'TFILE!($DATA(CTX))
QUIT
+6 ; determine the subfile for the multi-valued field
+7 ; 99.991, EFFECTIVE DATE/TIME
+8 SET SUBFILE=$$GETSUBF(TFILE,99.991)
+9 if 'SUBFILE
QUIT
+10 SET CTX("TYPE")="TABLE"
+11 SET CTX("TERM FILE#")=TFILE
+12 SET CTX("TERM FIELD#")=.01
+13 SET CTX("SOURCE FILE#")=TFILE
+14 SET CTX("TERMSTATUS SUBFILE#")=SUBFILE
+15 QUIT
+16 ;
VALIDREF(CTX,TIREF) ; validate the term, internal ref
+1 ; test TIREF is a valid value in given context (table)
+2 ; TIREF must be in IENS form, but will be checked
+3 ; later as VDUI related data is retrieved
+4 ; would be nice if we can do an earlier check
+5 ; based on IENS and the CTX("SOURCE FILE#")
+6 NEW VALID
+7 if '$DATA(CTX)!($GET(TIREF)']"")
QUIT 0
+8 SET VALID=TIREF?.(.N1",")
+9 QUIT VALID
+10 ;
FINDTERM(CTX,TIREF,TERM) ; find term
+1 ; called from FINDTERM^XTIDCTX(CTX,TIREF,TERM)
+2 ; find term for given term IREF
+3 ; return TERM data as new TERM array
+4 NEW IENS
+5 if '$DATA(CTX)!($DATA(TERM))
QUIT
+6 if '$$VALIDREF(.CTX,$GET(TIREF))
QUIT
+7 SET IENS=$GET(TIREF)
+8 if IENS']""
QUIT
+9 DO GETTERM^XTIDCTX(.CTX,CTX("SOURCE FILE#"),IENS,.TERM)
+10 QUIT
+11 ;
SRCHTRMS(CTX,VUID,XTTBARR,MASTER) ; search term index entries
+1 ; called from SEARCH^XTIDCTX(CTX,VUID,ARRAY,MASTER)
+2 ; FIND^DIC(FILE,IENS,FIELDS,FLAGS,[.]VALUE,NUMBER,[.]INDEXES,
+3 ; [.]SCREEN,IDENTIFIER,TARGET_ROOT,MSG_ROOT)
+4 NEW DIERR,FILE,TFILE,INDEXES,MSG,RIEN,VALUE,FLAGS,TARG,MSG,NUMFND
+5 NEW FIELDS,SCREEN
+6 SET VUID=$GET(VUID)
SET MASTER=+$GET(MASTER)
+7 if $GET(CTX("TYPE"))'="TABLE"!('VUID)
QUIT
+8 SET FILE=CTX("SOURCE FILE#")
SET INDEXES="AVUID"
SET FLAGS="QX"
+9 SET FIELDS="@;99.98I"
+10 SET VALUE(1)=VUID
+11 SET SCREEN=""
IF MASTER
SET SCREEN="I $P(^(""VUID""),""^"",2)"
+12 ; get entries
+13 DO FIND^DIC(FILE,"",FIELDS,FLAGS,.VALUE,"",INDEXES,SCREEN,"","TARG","MSG")
+14 if $DATA(MSG("DIERR"))
QUIT
+15 SET NUMFND=+$GET(TARG("DILIST",0))
+16 ; found entries
IF NUMFND
Begin DoDot:1
+17 NEW ITM,TEMP
+18 MERGE TEMP=TARG("DILIST",2)
+19 MERGE TEMP=TARG("DILIST","ID")
+20 FOR ITM=1:1:NUMFND
Begin DoDot:2
+21 NEW STATUS,IENS
+22 SET IENS=TEMP(ITM)_","
+23 SET STATUS=$$GETSTAT^XTID(CTX("TERM FILE#"),CTX("TERM FIELD#"),IENS,"")
+24 SET STATUS=STATUS_"^"_TEMP(ITM,99.98)
+25 DO ADDTARRY^XTIDCTX(XTTBARR,CTX("TERM FILE#"),CTX("TERM FIELD#"),IENS,STATUS)
End DoDot:2
+26 ;
End DoDot:1
+27 ;
+28 QUIT
+29 ;
GETSUBF(FILE,MFIELD) ; get subfile #
+1 ; get subfile for the given file and multiple-valued field
+2 NEW DIERR,ATTR,SUBFILE
+3 SET SUBFILE=""
+4 DO FIELD^DID(FILE,MFIELD,"","MULTIPLE-VALUED;SPECIFIER;TYPE","ATTR")
+5 IF ATTR("MULTIPLE-VALUED")=1
IF ATTR("TYPE")'="WORD-PROCESSING"
Begin DoDot:1
+6 SET SUBFILE=+$GET(ATTR("SPECIFIER"))
End DoDot:1
+7 ;
+8 QUIT SUBFILE
+9 ;
