- 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 Feb 19, 2025@00:07:36 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 ;