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

XTIDTRM.m

Go to the documentation of this file. 
  1. XTIDTRM ;BPFO/JRP - API set for VUID-Term/Concepts in VistA ;05/16/2008
  1.  ;;7.3;TOOLKIT;**111**;Apr 25, 1995;Build 2
  1.  ; Per VHA Directive 2004-038, this routine should not be modified.
  1.  ; IA #5078 governs the APIs in this routine
  1.  ; IA #5067 allows this routine to check and traverse ^DD(.
  1.  ;
  1. SETRPLC(FILE,IEN,RPLCMNT) ; Set replacement term
  1.  N NEXTFILE,NEXTROOT,XTFDA,XTMSG
  1.  I RPLCMNT="" S RPLCMNT="@"
  1.  S NEXTFILE=$$PTR2FILE(FILE)
  1.  I 'NEXTFILE Q 0
  1.  I NEXTFILE=FILE,IEN=RPLCMNT Q 0  ; Don't store ptr to self
  1.  S NEXTROOT=$$ROOT^DILFD(NEXTFILE,"",1)
  1.  I NEXTROOT="" Q 0
  1.  I RPLCMNT'="@",'$D(@NEXTROOT@(RPLCMNT)) Q 0
  1.  S XTFDA(FILE,IEN_",",99.97)=RPLCMNT
  1.  D FILE^DIE("","XTFDA","XTMSG")
  1.  I $D(XTMSG) Q 0
  1.  Q 1
  1.  ;
  1. GETRPLC(FILE,IEN) ; Get replacement term
  1.  N NEXTIEN,NEXTFILE
  1.  S NEXTFILE=$$PTR2FILE(FILE)
  1.  I 'NEXTFILE Q IEN_";"_FILE
  1.  S NEXTIEN=$$PTR2IEN(FILE,IEN)
  1.  I 'NEXTIEN Q IEN_";"_FILE
  1.  Q NEXTIEN_";"_NEXTFILE
  1.  ;
  1. RPLCMNT(FILE,IEN) ; Follow pointer trail until it ends
  1.  N NEXTIEN,NEXTFILE
  1.  S NEXTFILE=$$PTR2FILE(FILE)
  1.  I 'NEXTFILE Q IEN_";"_FILE
  1.  S NEXTIEN=$$PTR2IEN(FILE,IEN)
  1.  I 'NEXTIEN Q IEN_";"_FILE
  1.  I NEXTFILE=FILE,NEXTIEN=IEN Q IEN_";"_FILE  ; Trail leads back to self
  1.  Q $$RPLCMNT(NEXTFILE,NEXTIEN)
  1.  ;
  1. RPLCVALS(FILE,IEN,FIELD,FLAGS,OUTARR) ; Return inherited values for entry
  1.  N RPLCMNT,XTMSG
  1.  S RPLCMNT=$$RPLCMNT(FILE,IEN)
  1.  I RPLCMNT="" Q ""
  1.  D GETS^DIQ(+$P(RPLCMNT,";",2),+RPLCMNT_",",FIELD,FLAGS,OUTARR,"XTMSG")
  1.  I $D(XTMSG) K @OUTARR
  1.  Q RPLCMNT
  1.  ;
  1. RPLCTRL(FILE,IEN,DRCTN,OUTARR) ; Return replacement trail for entry
  1.  N NEXTIEN,NEXTFILE,RPLCMNT,TERMREF,SCRAP,NEXTROOT
  1.  S DRCTN=$S($G(DRCTN)="":"F",DRCTN="*":"FB",1:DRCTN)
  1.  S TERMREF=IEN_";"_FILE
  1.  I DRCTN["F" D
  1.  . S NEXTFILE=$$PTR2FILE(FILE)
  1.  . I 'NEXTFILE D  Q
  1.  . . S @OUTARR@("BY",TERMREF)=""
  1.  . S NEXTIEN=$$PTR2IEN(FILE,IEN)
  1.  . I 'NEXTIEN D  Q
  1.  . . S @OUTARR@("BY",TERMREF)=""
  1.  . S RPLCMNT=NEXTIEN_";"_NEXTFILE
  1.  . Q:$D(@OUTARR@("BY",TERMREF))
  1.  . S @OUTARR@("BY",TERMREF)=RPLCMNT
  1.  . S @OUTARR@("FOR",RPLCMNT,TERMREF)=""
  1.  . S SCRAP=$$RPLCTRL(NEXTFILE,NEXTIEN,DRCTN,OUTARR)
  1.  I DRCTN["B" D
  1.  . S NEXTFILE=""
  1.  . F  S NEXTFILE=$O(^DD(FILE,0,"PT",NEXTFILE)) Q:'NEXTFILE  D
  1.  . . Q:'$D(^DD(FILE,0,"PT",NEXTFILE,99.97))
  1.  . . S NEXTROOT=$$ROOT^DILFD(NEXTFILE,"",1)
  1.  . . Q:NEXTROOT=""
  1.  . . S NEXTIEN=""
  1.  . . F  S NEXTIEN=$O(@NEXTROOT@("AREPLACETERM",IEN,NEXTIEN)) Q:'NEXTIEN  D
  1.  . . . S RPLCMNT=NEXTIEN_";"_NEXTFILE
  1.  . . . Q:$D(@OUTARR@("BY",RPLCMNT))
  1.  . . . S @OUTARR@("BY",RPLCMNT)=TERMREF
  1.  . . . S @OUTARR@("FOR",TERMREF,RPLCMNT)=""
  1.  . . . S SCRAP=$$RPLCTRL(NEXTFILE,NEXTIEN,DRCTN,OUTARR)
  1.  Q $$RPLCMNT(FILE,IEN)
  1.  ;
  1. RPLCLST(FILE,IEN,DRCTN,STATDATE,STATHST,OUTARR) ; Return replacement list for entry
  1.  N NEXTIEN,NEXTFILE,RPLCMNT,TERMREF,SCRAP,NEXTROOT,COUNTER
  1.  S DRCTN=$S($G(DRCTN)="":"F",DRCTN="*":"FB",1:DRCTN)
  1.  S STATDATE=$S($G(STATDATE)="":$$NOW^XLFDT(),1:STATDATE)
  1.  S STATHST=+$G(STATHST)
  1.  S TERMREF=IEN_";"_FILE
  1.  I DRCTN["F" D
  1.  . S NEXTFILE=$$PTR2FILE(FILE)
  1.  . I 'NEXTFILE D  Q
  1.  . . S SCRAP=$$GETSTAT^XTID(FILE,.01,IEN_",",STATDATE)
  1.  . . S COUNTER=1+$O(@OUTARR@("INDEX"),-1)
  1.  . . S @OUTARR@(COUNTER)=TERMREF_U_$P(SCRAP,U,1)
  1.  . . S @OUTARR@("INDEX",TERMREF)=COUNTER
  1.  . . D STATHIST(FILE,IEN,$NAME(@OUTARR@(COUNTER)))
  1.  . S NEXTIEN=$$PTR2IEN(FILE,IEN)
  1.  . I 'NEXTIEN D  Q
  1.  . . S SCRAP=$$GETSTAT^XTID(FILE,.01,IEN_",",STATDATE)
  1.  . . S COUNTER=1+$O(@OUTARR@("INDEX"),-1)
  1.  . . S @OUTARR@(COUNTER)=TERMREF_U_$P(SCRAP,U,1)
  1.  . . S @OUTARR@("INDEX",TERMREF)=COUNTER
  1.  . . D STATHIST(FILE,IEN,$NAME(@OUTARR@(COUNTER)))
  1.  . S RPLCMNT=NEXTIEN_";"_NEXTFILE
  1.  . Q:$D(@OUTARR@("INDEX",TERMREF))
  1.  . S SCRAP=$$GETSTAT^XTID(FILE,.01,IEN_",",STATDATE)
  1.  . S COUNTER=1+$O(@OUTARR@("INDEX"),-1)
  1.  . S @OUTARR@(COUNTER)=TERMREF_U_$P(SCRAP,U,1)
  1.  . S @OUTARR@("INDEX",TERMREF)=COUNTER
  1.  . D STATHIST(FILE,IEN,$NAME(@OUTARR@(COUNTER)))
  1.  . S SCRAP=$$RPLCLST(NEXTFILE,NEXTIEN,DRCTN,STATDATE,STATHST,OUTARR)
  1.  I DRCTN["B" D
  1.  . S NEXTFILE=""
  1.  . F  S NEXTFILE=$O(^DD(FILE,0,"PT",NEXTFILE)) Q:'NEXTFILE  D
  1.  . . Q:'$D(^DD(FILE,0,"PT",NEXTFILE,99.97))
  1.  . . S NEXTROOT=$$ROOT^DILFD(NEXTFILE,"",1)
  1.  . . Q:NEXTROOT=""
  1.  . . S NEXTIEN=""
  1.  . . F  S NEXTIEN=$O(@NEXTROOT@("AREPLACETERM",IEN,NEXTIEN)) Q:'NEXTIEN  D
  1.  . . . S RPLCMNT=NEXTIEN_";"_NEXTFILE
  1.  . . . Q:$D(@OUTARR@("INDEX",RPLCMNT))
  1.  . . . S SCRAP=$$GETSTAT^XTID(NEXTFILE,.01,NEXTIEN_",",STATDATE)
  1.  . . . S COUNTER=1+$O(@OUTARR@("INDEX"),-1)
  1.  . . . S @OUTARR@(COUNTER)=RPLCMNT_U_$P(SCRAP,U,1)
  1.  . . . S @OUTARR@("INDEX",RPLCMNT)=COUNTER
  1.  . . . D STATHIST(NEXTFILE,NEXTIEN,$NAME(@OUTARR@(COUNTER)))
  1.  . . . S SCRAP=$$RPLCLST(NEXTFILE,NEXTIEN,DRCTN,STATDATE,STATHST,OUTARR)
  1.  Q $$RPLCMNT(FILE,IEN)
  1.  ;
  1. STATHIST(FILE,IEN,OUTARR) ; Return status history for entry
  1.  N SUBFILE,XTHIST,XTMSG,ID,STATDATE
  1.  S SUBFILE=$$SUBFILE(FILE,99.991)
  1.  Q:'SUBFILE
  1.  D LIST^DIC(SUBFILE,","_IEN_",",".01;.02","I","*","","","","","","XTHIST","XTMSG")
  1.  I $D(XTMSG) Q 0
  1.  S ID=0
  1.  F  S ID=$O(XTHIST("DILIST","ID",ID)) Q:'ID  D
  1.  . S STATDATE=$G(XTHIST("DILIST","ID",ID,.01))
  1.  . Q:'STATDATE
  1.  . S @OUTARR@(STATDATE)=$G(XTHIST("DILIST","ID",ID,.02))
  1.  Q
  1.  ;
  1. PTR2FILE(FILE) ; Return file number that field points to
  1.  N OTHER,XTMSG
  1.  S OTHER=$$GET1^DID(FILE,99.97,"","SPECIFIER","","XTMSG")
  1.  I $D(XTMSG) Q 0
  1.  Q +$P(OTHER,"P",2)
  1.  ;
  1. PTR2IEN(FILE,PTR) ; Return entry that field points to
  1.  N VALUE,XTMSG
  1.  S VALUE=$$GET1^DIQ(FILE,PTR_",",99.97,"I","","XTMSG")
  1.  I $D(XTMSG) Q 0
  1.  Q VALUE
  1.  ;
  1. SUBFILE(FILE,FIELD) ; Return subfile number for a multiple
  1.  N VALUE,XTMSG
  1.  S VALUE=$$GET1^DID(FILE,FIELD,"","SPECIFIER","","XTMSG")
  1.  I $D(XTMSG) Q 0
  1.  Q +VALUE