Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XTID1

XTID1.m

Go to the documentation of this file. 
  1. 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
  1.  ;Per VHA Directive 2004-038, this routine should not be modified
  1.  ; Reference to $$SCREEN^HDISVF01 supported by IA #4640
  1.  Q
  1. GETVUID ;
  1.  ; called from GETVUID^XTID(TFILE,TFIELD,TIREF)
  1.  N CTX,TERM,VUID
  1.  S TFILE=+$G(TFILE),TFIELD=+$G(TFIELD),TIREF=$G(TIREF)
  1.  S:'TFIELD TFIELD=.01
  1.  D CONTEXT^XTIDCTX(TFILE,TFIELD,.CTX)
  1.  Q:'$D(CTX) "0^invalid combination of FILE/FIELD"
  1.  D FINDTERM^XTIDCTX(.CTX,TIREF,.TERM)
  1.  Q:'$D(TERM) "0^TERM IREF doesn't exist in this FILE/FIELD context"
  1.  S VUID=$$GETVUID^XTIDTERM(.TERM)
  1.  Q:'$G(VUID) "0^TERM index did not contain VUID value"
  1.  Q VUID
  1.  ;
  1. GETSTAT ;
  1.  ; called from GETSTAT^XTID(TFILE,TFIELD,TIREF,TDATE)
  1.  N CTX,STATUS,TERM
  1.  S TFILE=+$G(TFILE),TFIELD=+$G(TFIELD),TIREF=$G(TIREF)
  1.  S:'$G(TDATE) TDATE=$$NOW^XLFDT
  1.  S:'TFIELD TFIELD=.01
  1.  D CONTEXT^XTIDCTX(TFILE,TFIELD,.CTX)
  1.  Q:'$D(CTX) "^invalid combination of FILE/FIELD"
  1.  D FINDTERM^XTIDCTX(.CTX,TIREF,.TERM)
  1.  Q:'$D(TERM) "^TERM IREF doesn't exist in this FILE/FIELD context"
  1.  S STATUS=""
  1.  S STATUS=$$GETSTAT^XTIDTERM(.TERM,TDATE)
  1.  Q:STATUS']"" ""
  1.  Q STATUS
  1.  ;
  1. GETMASTR ;
  1.  ; called from GETMASTR^XTID(TFILE,TFIELD,TIREF)
  1.  N CTX,TERM,MASTR
  1.  S TFILE=+$G(TFILE),TFIELD=+$G(TFIELD),TIREF=$G(TIREF)
  1.  S:'TFIELD TFIELD=.01
  1.  D CONTEXT^XTIDCTX(TFILE,TFIELD,.CTX)
  1.  Q:'$D(CTX) "0^invalid combination of FILE/FIELD"
  1.  D FINDTERM^XTIDCTX(.CTX,TIREF,.TERM)
  1.  Q:'$D(TERM) "0^TERM IREF doesn't exist in this FILE/FIELD context"
  1.  S MASTR=""
  1.  S MASTR=$$GETMASTR^XTIDTERM(.TERM)
  1.  Q:MASTR']"" ""
  1.  Q MASTR
  1.  ;
  1. SETVUID ;
  1.  ; called from SETVUID^XTID(TFILE,TFIELD,TIREF,TVUID)
  1.  N CTX,TERM,SUCCESS,OLDVUID
  1.  S TFILE=+$G(TFILE),TFIELD=+$G(TFIELD),TIREF=$G(TIREF),TVUID=$G(TVUID)
  1.  S:'TFIELD TFIELD=.01
  1.  S SUCCESS=0
  1.  D CONTEXT^XTIDCTX(TFILE,TFIELD,.CTX)
  1.  Q:'$D(CTX) "0^invalid combination of FILE/FIELD"
  1.  Q:'$$VALIDREF^XTIDCTX(.CTX,TIREF) "0^TERM IREF doesn't exist in this FILE/FIELD context"
  1.  D FINDTERM^XTIDCTX(.CTX,TIREF,.TERM)
  1.  ;
  1.  ; create new term index entry in "set of codes" not in "tables"
  1.  I '$D(TERM) S SUCCESS=$$NEWTERM^XTIDCTX(.CTX,TIREF,TVUID) Q SUCCESS
  1.  ;
  1.  ; TERM exists
  1.  ; existing entries with empty VUID-related data
  1.  ; determine existing value of VUID
  1.  S OLDVUID=$$GETVUID^XTIDTERM(.TERM)
  1.  I OLDVUID S SUCCESS=$$RPLVUID(OLDVUID,TVUID) Q SUCCESS
  1.  ; 'OLDVUID
  1.  ; set VUID for the first time for existing entry
  1.  S SUCCESS=$$NEWVUID()
  1.  Q SUCCESS
  1.  ;
  1. SETSTAT ;
  1.  ; called from SETSTAT^XTID(TFILE,TFIELD,TIREF,TSTAT,TDATE)
  1.  N CTX,TERM
  1.  S TFILE=+$G(TFILE),TFIELD=+$G(TFIELD),TIREF=$G(TIREF),TSTAT=+$G(TSTAT)
  1.  S:'$G(TDATE) TDATE=$$NOW^XLFDT
  1.  S:'TFIELD TFIELD=.01
  1.  D CONTEXT^XTIDCTX(TFILE,TFIELD,.CTX)
  1.  Q:'$D(CTX) "0^invalid combination of FILE/FIELD"
  1.  D FINDTERM^XTIDCTX(.CTX,TIREF,.TERM)
  1.  Q:'$D(TERM) "0^TERM IREF doesn't exist in this FILE/FIELD context"
  1.  Q:'$$GETVUID^XTIDTERM(.TERM) "0^VUID value must exist before setting STATUS info"
  1.  Q:'$$SETSTAT^XTIDTERM(.TERM,TSTAT,TDATE) "0^unable to set status for the term index"
  1.  Q 1
  1.  ;
  1. SETMASTR ;
  1.  ; called from SETMASTR^XTID(TFILE,TFIELD,TIREF,TMASTER)
  1.  ; constraint: only one entry could be master for given
  1.  ; reference term, must check success after setting master
  1.  N CTX,TERM,NEWMASTR
  1.  S TFILE=+$G(TFILE),TFIELD=+$G(TFIELD),TIREF=$G(TIREF)
  1.  S TMASTER=+$G(TMASTER)
  1.  S:'TFIELD TFIELD=.01
  1.  D CONTEXT^XTIDCTX(TFILE,TFIELD,.CTX)
  1.  Q:'$D(CTX) "0^invalid combination of FILE/FIELD"
  1.  D FINDTERM^XTIDCTX(.CTX,TIREF,.TERM)
  1.  Q:'$D(TERM) "0^TERM IREF doesn't exist in this FILE/FIELD context"
  1.  Q:'$$GETVUID^XTIDTERM(.TERM) "0^VUID value must exist before setting master flag"
  1.  Q:'$$SETMASTR^XTIDTERM(.TERM,TMASTER) "0^unable to set master flag for the term index"
  1.  ; check success based on constraint
  1.  S NEWMASTR=$$GETMASTR^XTID(TFILE,TFIELD,TIREF)
  1.  Q:NEWMASTR'=TMASTER "0^pre-existing master entry"
  1.  Q 1
  1.  ;
  1. GETIREF ; 
  1.  ; called from GETIREF^XTID(TFILE,TFIELD,TVUID,TARRAY,TMASTER)
  1.  N CTX,TERM
  1.  S TFILE=+$G(TFILE),TFIELD=$G(TFIELD),TVUID=$G(TVUID)
  1.  S TMASTER=+$G(TMASTER)
  1.  Q:$G(TARRAY)']""
  1.  D CONTEXT^XTIDCTX(TFILE,TFIELD,.CTX)
  1.  I '$D(CTX) S @TARRAY@("ERROR")="invalid FILE/FIELD combination" Q
  1.  S @TARRAY=0
  1.  D SRCHTRMS^XTIDCTX(.CTX,TVUID,TARRAY,TMASTER)
  1.  Q
  1.  ;
  1. SCREEN ;
  1.  ; called from SCREEN^XTID(TFILE,TFIELD,TIREF,TDATE,TCACHE)
  1.  N ACTIVE,CACHED,SCREEN,STATUS
  1.  S:'$G(TDATE) TDATE=$$NOW^XLFDT
  1.  S TFILE=+$G(TFILE),CACHED=$D(TCACHE(TFILE)) ; cache at file level
  1.  ; screen based on HDI API, use cached value on subsequent calls for same file
  1.  I 'CACHED  D
  1.  . S SCREEN=$$SCREEN^HDISVF01(TFILE,+$G(TFIELD),TDATE)
  1.  . S TCACHE(TFILE)=SCREEN
  1.  E  S SCREEN=TCACHE(TFILE)
  1.  Q:'SCREEN SCREEN
  1.  ; screen based on status in XTID API
  1.  S STATUS=$$GETSTAT^XTID(TFILE,+$G(TFIELD),$G(TIREF),TDATE)
  1.  S ACTIVE=$P(STATUS,"^",1)
  1.  S SCREEN=$SELECT(ACTIVE:0,1:1)
  1.  Q SCREEN
  1.  ;
  1. RPLVUID(OLDV,NEWV) ;
  1.  ; called from SETVUID(TFILE,TFIELD,TIREF,TVUID)
  1.  ; existing TERM index entry with VUID value
  1.  N SUCCESS S SUCCESS=1
  1.  I OLDV=NEWV Q SUCCESS
  1.  ; replace existing VUID value
  1.  I '$$SETVUID^XTIDTERM(.TERM,NEWV) D  Q SUCCESS
  1.  . S SUCCESS="0^unable to replace VUID value to existing term entry" Q
  1.  ;
  1.  Q SUCCESS
  1.  ;
  1. NEWVUID() ;
  1.  ; called from SETVUID(TFILE,TFIELD,TIREF,TVUID)
  1.  ; set VUID value to existing TERM entry
  1.  ; for the first time
  1.  N MASTER,SUCCESS
  1.  S SUCCESS=1,MASTER=1
  1.  I '$$SETVUID^XTIDTERM(.TERM,TVUID) D  Q SUCCESS
  1.  . S SUCCESS="0^unable to add VUID value to existing term entry"
  1.  ;
  1.  ; set master=1 default, will be overridden if duplicate master
  1.  I '$$SETMASTR^XTIDTERM(.TERM,MASTER) D  Q SUCCESS
  1.  . S SUCCESS="0^unable to add MASTER VUID value to existing term entry"
  1.  ;
  1.  Q SUCCESS
  1.  ;