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

TIUQRYL.m

Go to the documentation of this file.
  1. TIUQRYL ; SLC/JER - Library calls for Query ;11-OCT-2002 16:56
  1. ;;1.0;TEXT INTEGRATION UTILITIES;**150**;Jun 20, 1997
  1. RESOLVE(TIUY,DA,QRY,PATIENT) ; Resolve to external data
  1. N TIUR0,TIUR12,TIUR13,TIUR14,TIUR17,TIUR150
  1. N IDPARENT,DOC
  1. S TIUR0=$G(^TIU(8925,+DA,0)),TIUR12=$G(^TIU(8925,+DA,12))
  1. S TIUR13=$G(^TIU(8925,+DA,13)),TIUR14=$G(^(14)),TIUR17=$G(^(17))
  1. S TIUR150=$G(^TIU(8925,+DA,150))
  1. S IDPARENT=+$G(^TIU(8925,+DA,21))
  1. M @TIUY@("DOC:"_DA)=PATIENT
  1. S (DOC,@TIUY@("DOC:"_DA,"Document.Title"))=$$PNAME^TIULC1(+TIUR0)
  1. S:DOC="Addendum" @TIUY@("DOC:"_DA,"Document.Title")=DOC_" to "_$$PNAME^TIULC1(+$G(^TIU(8925,+$P(TIUR0,U,6),0)))
  1. ; ** If prefix becomes an issue, remove comments and finish implementation **
  1. ; If IDNotes (TIU*1.0*100) installed, use $$PREFIX^TIULA2 to evaluate
  1. ; which prefix to use:
  1. ; - keep prefix display in earlier CPRS versions and LM
  1. ; - omit in newer TreeView versions
  1. ;I $L($T(PREFIX^TIULA2)) D I 1
  1. ;. S PREFIX=$$PREFIX^TIULA2(DA,1) ; 1=include ID Child indicator
  1. ;. I PREFIX["<" S IDSORT=$$IDSORT^TIUSRVLO(DA)
  1. ;. I +$G(SHOWADD)=0 S DOC=PREFIX_DOC
  1. ; otherwise, only show addendum indicator (+)
  1. ; - keep prefix display in earlier CPRS versions and LM
  1. ; - omit in newer TreeView versions
  1. ;E D
  1. ;. I +$$HASADDEN^TIULC1(DA) S PREFIX="+ "
  1. ;. I +$G(SHOWADD)=0,(+$$HASADDEN^TIULC1(DA)) S DOC=PREFIX_DOC
  1. ;I +$$URGENCY^TIURM(+DA)=1 S DOC=$S(DOC["+":"*",1:"* ")_DOC
  1. ; **
  1. S @TIUY@("DOC:"_DA,"Document.Reference")=+TIUR13
  1. S @TIUY@("DOC:"_DA,"Document.Status")=$$LOWER^TIULS($P($G(^TIU(8925.6,+$P(TIUR0,U,5),0)),U))
  1. S @TIUY@("DOC:"_DA,"Document.Author")=$S(+$P(TIUR12,U,2):$$PERSNAME^TIULC1($P(TIUR12,U,2)),1:"")
  1. S @TIUY@("DOC:"_DA,"Document.Cosigner")=$S(+$P(TIUR12,U,8):$$PERSNAME^TIULC1($P(TIUR12,U,8)),1:"")
  1. Q
  1. ;
  1. SETDAD(TIUY,DA,QRY,PATIENT) ; Set parent in return array
  1. N DADA,TIUD0,TIUD21
  1. ; Exclude components
  1. Q:'+$$ISDOC(DA)
  1. S TIUD0=$G(^TIU(8925,DA,0)),TIUD21=$G(^(21))
  1. S DADA=$S(+$P(TIUD0,U,6):+$P(TIUD0,U,6),+TIUD21:+TIUD21,1:0)
  1. Q:+DADA'>0
  1. Q:+$D(@TIUY@("INDX",DADA))
  1. Q:+$D(^TIU(8925,DADA,0))=0
  1. D RESOLVE(TIUY,DADA,.QRY,.PATIENT)
  1. S @TIUY@("INDX",DADA)=""
  1. I +$G(SHOWADD) D SETKIDS(TIUY,DADA,.QRY,.PATIENT)
  1. I +$$HASDAD^TIUSRVLI(DADA) D SETDAD(TIUY,DADA,.QRY,.PATIENT)
  1. Q
  1. ;
  1. SETKIDS(TIUY,DA,QRY,PATIENT) ; Set children in return array
  1. N KIDA S KIDA=0
  1. ; Begin with addenda
  1. F S KIDA=$O(^TIU(8925,"DAD",DA,KIDA)) Q:+KIDA'>0 D
  1. . Q:'+$$ISDOC(KIDA)
  1. . Q:+$D(@TIUY@("INDX",KIDA))
  1. . D RESOLVE(TIUY,KIDA,.QRY,.PATIENT)
  1. . S @TIUY@("INDX",KIDA)=""
  1. ; Next do ID entries
  1. S KIDA=0
  1. F S KIDA=$O(^TIU(8925,"GDAD",DA,KIDA)) Q:+KIDA'>0 D
  1. . Q:+$D(@TIUY@("INDX",KIDA))
  1. . D RESOLVE(TIUY,KIDA,.QRY,.PATIENT)
  1. . S @TIUY@("INDX",KIDA)=""
  1. . I +$$HASKIDS^TIUSRVLI(KIDA) D SETKIDS(TIUY,KIDA,.QRY,.PATIENT)
  1. Q
  1. ISDOC(DA) ; Evaluate whether a given record is a document
  1. N TIUY,TIUTYP
  1. S TIUTYP=+$G(^TIU(8925,DA,0))
  1. S TIUY=$S($P($G(^TIU(8925.1,+TIUTYP,0)),U,4)="DOC":1,1:0)
  1. Q TIUY