XTID1 ;OAKCIOFO/JLG - Implementation of API set in XTID ;12/12/2008 15:12
;;7.3;TOOLKIT;**93,108**;Apr 25, 1995;Build 3
;Per VHA Directive 2004-038, this routine should not be modified
; Reference to $$SCREEN^HDISVF01 supported by IA #4640
Q
GETVUID ;
; called from GETVUID^XTID(TFILE,TFIELD,TIREF)
N CTX,TERM,VUID
S TFILE=+$G(TFILE),TFIELD=+$G(TFIELD),TIREF=$G(TIREF)
S:'TFIELD TFIELD=.01
D CONTEXT^XTIDCTX(TFILE,TFIELD,.CTX)
Q:'$D(CTX) "0^invalid combination of FILE/FIELD"
D FINDTERM^XTIDCTX(.CTX,TIREF,.TERM)
Q:'$D(TERM) "0^TERM IREF doesn't exist in this FILE/FIELD context"
S VUID=$$GETVUID^XTIDTERM(.TERM)
Q:'$G(VUID) "0^TERM index did not contain VUID value"
Q VUID
;
GETSTAT ;
; called from GETSTAT^XTID(TFILE,TFIELD,TIREF,TDATE)
N CTX,STATUS,TERM
S TFILE=+$G(TFILE),TFIELD=+$G(TFIELD),TIREF=$G(TIREF)
S:'$G(TDATE) TDATE=$$NOW^XLFDT
S:'TFIELD TFIELD=.01
D CONTEXT^XTIDCTX(TFILE,TFIELD,.CTX)
Q:'$D(CTX) "^invalid combination of FILE/FIELD"
D FINDTERM^XTIDCTX(.CTX,TIREF,.TERM)
Q:'$D(TERM) "^TERM IREF doesn't exist in this FILE/FIELD context"
S STATUS=""
S STATUS=$$GETSTAT^XTIDTERM(.TERM,TDATE)
Q:STATUS']"" ""
Q STATUS
;
GETMASTR ;
; called from GETMASTR^XTID(TFILE,TFIELD,TIREF)
N CTX,TERM,MASTR
S TFILE=+$G(TFILE),TFIELD=+$G(TFIELD),TIREF=$G(TIREF)
S:'TFIELD TFIELD=.01
D CONTEXT^XTIDCTX(TFILE,TFIELD,.CTX)
Q:'$D(CTX) "0^invalid combination of FILE/FIELD"
D FINDTERM^XTIDCTX(.CTX,TIREF,.TERM)
Q:'$D(TERM) "0^TERM IREF doesn't exist in this FILE/FIELD context"
S MASTR=""
S MASTR=$$GETMASTR^XTIDTERM(.TERM)
Q:MASTR']"" ""
Q MASTR
;
SETVUID ;
; called from SETVUID^XTID(TFILE,TFIELD,TIREF,TVUID)
N CTX,TERM,SUCCESS,OLDVUID
S TFILE=+$G(TFILE),TFIELD=+$G(TFIELD),TIREF=$G(TIREF),TVUID=$G(TVUID)
S:'TFIELD TFIELD=.01
S SUCCESS=0
D CONTEXT^XTIDCTX(TFILE,TFIELD,.CTX)
Q:'$D(CTX) "0^invalid combination of FILE/FIELD"
Q:'$$VALIDREF^XTIDCTX(.CTX,TIREF) "0^TERM IREF doesn't exist in this FILE/FIELD context"
D FINDTERM^XTIDCTX(.CTX,TIREF,.TERM)
;
; create new term index entry in "set of codes" not in "tables"
I '$D(TERM) S SUCCESS=$$NEWTERM^XTIDCTX(.CTX,TIREF,TVUID) Q SUCCESS
;
; TERM exists
; existing entries with empty VUID-related data
; determine existing value of VUID
S OLDVUID=$$GETVUID^XTIDTERM(.TERM)
I OLDVUID S SUCCESS=$$RPLVUID(OLDVUID,TVUID) Q SUCCESS
; 'OLDVUID
; set VUID for the first time for existing entry
S SUCCESS=$$NEWVUID()
Q SUCCESS
;
SETSTAT ;
; called from SETSTAT^XTID(TFILE,TFIELD,TIREF,TSTAT,TDATE)
N CTX,TERM
S TFILE=+$G(TFILE),TFIELD=+$G(TFIELD),TIREF=$G(TIREF),TSTAT=+$G(TSTAT)
S:'$G(TDATE) TDATE=$$NOW^XLFDT
S:'TFIELD TFIELD=.01
D CONTEXT^XTIDCTX(TFILE,TFIELD,.CTX)
Q:'$D(CTX) "0^invalid combination of FILE/FIELD"
D FINDTERM^XTIDCTX(.CTX,TIREF,.TERM)
Q:'$D(TERM) "0^TERM IREF doesn't exist in this FILE/FIELD context"
Q:'$$GETVUID^XTIDTERM(.TERM) "0^VUID value must exist before setting STATUS info"
Q:'$$SETSTAT^XTIDTERM(.TERM,TSTAT,TDATE) "0^unable to set status for the term index"
Q 1
;
SETMASTR ;
; called from SETMASTR^XTID(TFILE,TFIELD,TIREF,TMASTER)
; constraint: only one entry could be master for given
; reference term, must check success after setting master
N CTX,TERM,NEWMASTR
S TFILE=+$G(TFILE),TFIELD=+$G(TFIELD),TIREF=$G(TIREF)
S TMASTER=+$G(TMASTER)
S:'TFIELD TFIELD=.01
D CONTEXT^XTIDCTX(TFILE,TFIELD,.CTX)
Q:'$D(CTX) "0^invalid combination of FILE/FIELD"
D FINDTERM^XTIDCTX(.CTX,TIREF,.TERM)
Q:'$D(TERM) "0^TERM IREF doesn't exist in this FILE/FIELD context"
Q:'$$GETVUID^XTIDTERM(.TERM) "0^VUID value must exist before setting master flag"
Q:'$$SETMASTR^XTIDTERM(.TERM,TMASTER) "0^unable to set master flag for the term index"
; check success based on constraint
S NEWMASTR=$$GETMASTR^XTID(TFILE,TFIELD,TIREF)
Q:NEWMASTR'=TMASTER "0^pre-existing master entry"
Q 1
;
GETIREF ;
; called from GETIREF^XTID(TFILE,TFIELD,TVUID,TARRAY,TMASTER)
N CTX,TERM
S TFILE=+$G(TFILE),TFIELD=$G(TFIELD),TVUID=$G(TVUID)
S TMASTER=+$G(TMASTER)
Q:$G(TARRAY)']""
D CONTEXT^XTIDCTX(TFILE,TFIELD,.CTX)
I '$D(CTX) S @TARRAY@("ERROR")="invalid FILE/FIELD combination" Q
S @TARRAY=0
D SRCHTRMS^XTIDCTX(.CTX,TVUID,TARRAY,TMASTER)
Q
;
SCREEN ;
; called from SCREEN^XTID(TFILE,TFIELD,TIREF,TDATE,TCACHE)
N ACTIVE,CACHED,SCREEN,STATUS
S:'$G(TDATE) TDATE=$$NOW^XLFDT
S TFILE=+$G(TFILE),CACHED=$D(TCACHE(TFILE)) ; cache at file level
; screen based on HDI API, use cached value on subsequent calls for same file
I 'CACHED D
. S SCREEN=$$SCREEN^HDISVF01(TFILE,+$G(TFIELD),TDATE)
. S TCACHE(TFILE)=SCREEN
E S SCREEN=TCACHE(TFILE)
Q:'SCREEN SCREEN
; screen based on status in XTID API
S STATUS=$$GETSTAT^XTID(TFILE,+$G(TFIELD),$G(TIREF),TDATE)
S ACTIVE=$P(STATUS,"^",1)
S SCREEN=$SELECT(ACTIVE:0,1:1)
Q SCREEN
;
RPLVUID(OLDV,NEWV) ;
; called from SETVUID(TFILE,TFIELD,TIREF,TVUID)
; existing TERM index entry with VUID value
N SUCCESS S SUCCESS=1
I OLDV=NEWV Q SUCCESS
; replace existing VUID value
I '$$SETVUID^XTIDTERM(.TERM,NEWV) D Q SUCCESS
. S SUCCESS="0^unable to replace VUID value to existing term entry" Q
;
Q SUCCESS
;
NEWVUID() ;
; called from SETVUID(TFILE,TFIELD,TIREF,TVUID)
; set VUID value to existing TERM entry
; for the first time
N MASTER,SUCCESS
S SUCCESS=1,MASTER=1
I '$$SETVUID^XTIDTERM(.TERM,TVUID) D Q SUCCESS
. S SUCCESS="0^unable to add VUID value to existing term entry"
;
; set master=1 default, will be overridden if duplicate master
I '$$SETMASTR^XTIDTERM(.TERM,MASTER) D Q SUCCESS
. S SUCCESS="0^unable to add MASTER VUID value to existing term entry"
;
Q SUCCESS
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXTID1 5738 printed Oct 16, 2024@18:41:42 Page 2
XTID1 ;OAKCIOFO/JLG - Implementation of API set in XTID ;12/12/2008 15:12
+1 ;;7.3;TOOLKIT;**93,108**;Apr 25, 1995;Build 3
+2 ;Per VHA Directive 2004-038, this routine should not be modified
+3 ; Reference to $$SCREEN^HDISVF01 supported by IA #4640
+4 QUIT
GETVUID ;
+1 ; called from GETVUID^XTID(TFILE,TFIELD,TIREF)
+2 NEW CTX,TERM,VUID
+3 SET TFILE=+$GET(TFILE)
SET TFIELD=+$GET(TFIELD)
SET TIREF=$GET(TIREF)
+4 if 'TFIELD
SET TFIELD=.01
+5 DO CONTEXT^XTIDCTX(TFILE,TFIELD,.CTX)
+6 if '$DATA(CTX)
QUIT "0^invalid combination of FILE/FIELD"
+7 DO FINDTERM^XTIDCTX(.CTX,TIREF,.TERM)
+8 if '$DATA(TERM)
QUIT "0^TERM IREF doesn't exist in this FILE/FIELD context"
+9 SET VUID=$$GETVUID^XTIDTERM(.TERM)
+10 if '$GET(VUID)
QUIT "0^TERM index did not contain VUID value"
+11 QUIT VUID
+12 ;
GETSTAT ;
+1 ; called from GETSTAT^XTID(TFILE,TFIELD,TIREF,TDATE)
+2 NEW CTX,STATUS,TERM
+3 SET TFILE=+$GET(TFILE)
SET TFIELD=+$GET(TFIELD)
SET TIREF=$GET(TIREF)
+4 if '$GET(TDATE)
SET TDATE=$$NOW^XLFDT
+5 if 'TFIELD
SET TFIELD=.01
+6 DO CONTEXT^XTIDCTX(TFILE,TFIELD,.CTX)
+7 if '$DATA(CTX)
QUIT "^invalid combination of FILE/FIELD"
+8 DO FINDTERM^XTIDCTX(.CTX,TIREF,.TERM)
+9 if '$DATA(TERM)
QUIT "^TERM IREF doesn't exist in this FILE/FIELD context"
+10 SET STATUS=""
+11 SET STATUS=$$GETSTAT^XTIDTERM(.TERM,TDATE)
+12 if STATUS']""
QUIT ""
+13 QUIT STATUS
+14 ;
GETMASTR ;
+1 ; called from GETMASTR^XTID(TFILE,TFIELD,TIREF)
+2 NEW CTX,TERM,MASTR
+3 SET TFILE=+$GET(TFILE)
SET TFIELD=+$GET(TFIELD)
SET TIREF=$GET(TIREF)
+4 if 'TFIELD
SET TFIELD=.01
+5 DO CONTEXT^XTIDCTX(TFILE,TFIELD,.CTX)
+6 if '$DATA(CTX)
QUIT "0^invalid combination of FILE/FIELD"
+7 DO FINDTERM^XTIDCTX(.CTX,TIREF,.TERM)
+8 if '$DATA(TERM)
QUIT "0^TERM IREF doesn't exist in this FILE/FIELD context"
+9 SET MASTR=""
+10 SET MASTR=$$GETMASTR^XTIDTERM(.TERM)
+11 if MASTR']""
QUIT ""
+12 QUIT MASTR
+13 ;
SETVUID ;
+1 ; called from SETVUID^XTID(TFILE,TFIELD,TIREF,TVUID)
+2 NEW CTX,TERM,SUCCESS,OLDVUID
+3 SET TFILE=+$GET(TFILE)
SET TFIELD=+$GET(TFIELD)
SET TIREF=$GET(TIREF)
SET TVUID=$GET(TVUID)
+4 if 'TFIELD
SET TFIELD=.01
+5 SET SUCCESS=0
+6 DO CONTEXT^XTIDCTX(TFILE,TFIELD,.CTX)
+7 if '$DATA(CTX)
QUIT "0^invalid combination of FILE/FIELD"
+8 if '$$VALIDREF^XTIDCTX(.CTX,TIREF)
QUIT "0^TERM IREF doesn't exist in this FILE/FIELD context"
+9 DO FINDTERM^XTIDCTX(.CTX,TIREF,.TERM)
+10 ;
+11 ; create new term index entry in "set of codes" not in "tables"
+12 IF '$DATA(TERM)
SET SUCCESS=$$NEWTERM^XTIDCTX(.CTX,TIREF,TVUID)
QUIT SUCCESS
+13 ;
+14 ; TERM exists
+15 ; existing entries with empty VUID-related data
+16 ; determine existing value of VUID
+17 SET OLDVUID=$$GETVUID^XTIDTERM(.TERM)
+18 IF OLDVUID
SET SUCCESS=$$RPLVUID(OLDVUID,TVUID)
QUIT SUCCESS
+19 ; 'OLDVUID
+20 ; set VUID for the first time for existing entry
+21 SET SUCCESS=$$NEWVUID()
+22 QUIT SUCCESS
+23 ;
SETSTAT ;
+1 ; called from SETSTAT^XTID(TFILE,TFIELD,TIREF,TSTAT,TDATE)
+2 NEW CTX,TERM
+3 SET TFILE=+$GET(TFILE)
SET TFIELD=+$GET(TFIELD)
SET TIREF=$GET(TIREF)
SET TSTAT=+$GET(TSTAT)
+4 if '$GET(TDATE)
SET TDATE=$$NOW^XLFDT
+5 if 'TFIELD
SET TFIELD=.01
+6 DO CONTEXT^XTIDCTX(TFILE,TFIELD,.CTX)
+7 if '$DATA(CTX)
QUIT "0^invalid combination of FILE/FIELD"
+8 DO FINDTERM^XTIDCTX(.CTX,TIREF,.TERM)
+9 if '$DATA(TERM)
QUIT "0^TERM IREF doesn't exist in this FILE/FIELD context"
+10 if '$$GETVUID^XTIDTERM(.TERM)
QUIT "0^VUID value must exist before setting STATUS info"
+11 if '$$SETSTAT^XTIDTERM(.TERM,TSTAT,TDATE)
QUIT "0^unable to set status for the term index"
+12 QUIT 1
+13 ;
SETMASTR ;
+1 ; called from SETMASTR^XTID(TFILE,TFIELD,TIREF,TMASTER)
+2 ; constraint: only one entry could be master for given
+3 ; reference term, must check success after setting master
+4 NEW CTX,TERM,NEWMASTR
+5 SET TFILE=+$GET(TFILE)
SET TFIELD=+$GET(TFIELD)
SET TIREF=$GET(TIREF)
+6 SET TMASTER=+$GET(TMASTER)
+7 if 'TFIELD
SET TFIELD=.01
+8 DO CONTEXT^XTIDCTX(TFILE,TFIELD,.CTX)
+9 if '$DATA(CTX)
QUIT "0^invalid combination of FILE/FIELD"
+10 DO FINDTERM^XTIDCTX(.CTX,TIREF,.TERM)
+11 if '$DATA(TERM)
QUIT "0^TERM IREF doesn't exist in this FILE/FIELD context"
+12 if '$$GETVUID^XTIDTERM(.TERM)
QUIT "0^VUID value must exist before setting master flag"
+13 if '$$SETMASTR^XTIDTERM(.TERM,TMASTER)
QUIT "0^unable to set master flag for the term index"
+14 ; check success based on constraint
+15 SET NEWMASTR=$$GETMASTR^XTID(TFILE,TFIELD,TIREF)
+16 if NEWMASTR'=TMASTER
QUIT "0^pre-existing master entry"
+17 QUIT 1
+18 ;
GETIREF ;
+1 ; called from GETIREF^XTID(TFILE,TFIELD,TVUID,TARRAY,TMASTER)
+2 NEW CTX,TERM
+3 SET TFILE=+$GET(TFILE)
SET TFIELD=$GET(TFIELD)
SET TVUID=$GET(TVUID)
+4 SET TMASTER=+$GET(TMASTER)
+5 if $GET(TARRAY)']""
QUIT
+6 DO CONTEXT^XTIDCTX(TFILE,TFIELD,.CTX)
+7 IF '$DATA(CTX)
SET @TARRAY@("ERROR")="invalid FILE/FIELD combination"
QUIT
+8 SET @TARRAY=0
+9 DO SRCHTRMS^XTIDCTX(.CTX,TVUID,TARRAY,TMASTER)
+10 QUIT
+11 ;
SCREEN ;
+1 ; called from SCREEN^XTID(TFILE,TFIELD,TIREF,TDATE,TCACHE)
+2 NEW ACTIVE,CACHED,SCREEN,STATUS
+3 if '$GET(TDATE)
SET TDATE=$$NOW^XLFDT
+4 ; cache at file level
SET TFILE=+$GET(TFILE)
SET CACHED=$DATA(TCACHE(TFILE))
+5 ; screen based on HDI API, use cached value on subsequent calls for same file
+6 IF 'CACHED
Begin DoDot:1
+7 SET SCREEN=$$SCREEN^HDISVF01(TFILE,+$GET(TFIELD),TDATE)
+8 SET TCACHE(TFILE)=SCREEN
End DoDot:1
+9 IF '$TEST
SET SCREEN=TCACHE(TFILE)
+10 if 'SCREEN
QUIT SCREEN
+11 ; screen based on status in XTID API
+12 SET STATUS=$$GETSTAT^XTID(TFILE,+$GET(TFIELD),$GET(TIREF),TDATE)
+13 SET ACTIVE=$PIECE(STATUS,"^",1)
+14 SET SCREEN=$SELECT(ACTIVE:0,1:1)
+15 QUIT SCREEN
+16 ;
RPLVUID(OLDV,NEWV) ;
+1 ; called from SETVUID(TFILE,TFIELD,TIREF,TVUID)
+2 ; existing TERM index entry with VUID value
+3 NEW SUCCESS
SET SUCCESS=1
+4 IF OLDV=NEWV
QUIT SUCCESS
+5 ; replace existing VUID value
+6 IF '$$SETVUID^XTIDTERM(.TERM,NEWV)
Begin DoDot:1
+7 SET SUCCESS="0^unable to replace VUID value to existing term entry"
QUIT
End DoDot:1
QUIT SUCCESS
+8 ;
+9 QUIT SUCCESS
+10 ;
NEWVUID() ;
+1 ; called from SETVUID(TFILE,TFIELD,TIREF,TVUID)
+2 ; set VUID value to existing TERM entry
+3 ; for the first time
+4 NEW MASTER,SUCCESS
+5 SET SUCCESS=1
SET MASTER=1
+6 IF '$$SETVUID^XTIDTERM(.TERM,TVUID)
Begin DoDot:1
+7 SET SUCCESS="0^unable to add VUID value to existing term entry"
End DoDot:1
QUIT SUCCESS
+8 ;
+9 ; set master=1 default, will be overridden if duplicate master
+10 IF '$$SETMASTR^XTIDTERM(.TERM,MASTER)
Begin DoDot:1
+11 SET SUCCESS="0^unable to add MASTER VUID value to existing term entry"
End DoDot:1
QUIT SUCCESS
+12 ;
+13 QUIT SUCCESS
+14 ;
