TIUDD1 ; SLC/JER - XREFs for file 8925.1 ;19-OCT-2001 10:05:37 [7/28/04 9:08am]
 ;;1.0;TEXT INTEGRATION UTILITIES;**7,51,115,163**;Jun 20, 1997
SACL(X,FLD) ; Set logic for ACL cross-reference
 ; Called from fields .01 (NAME), .07 (STATUS), .03 (PRINT NAME),
 ; .02 (ABBREVIATION), and Subfield .01 of ITEM sub-file
 N TIUCLASS,TIUSTTS,TIUTTL
 I FLD=10.01 D
 . ; Include only TITLES in the index
 . I $P($G(^TIU(8925.1,+X,0)),U,4)'="DOC" Q
 . S TIUSTTS=$P($G(^TIU(8925.1,+X,0)),U,7)
 . ; Include only TEST or ACTIVE titles
 . I $S(TIUSTTS=10:0,TIUSTTS=11:0,1:1) Q
 . S TIUTTL=$P($G(^TIU(8925.1,+X,0)),U)
 . Q:TIUTTL']""
 . ; First build x-ref for Clinical Documents & Immediate descendents
 . S TIUCLASS=+$$CLINDOC^TIULC1(+X)
 . I TIUCLASS'>0 Q
 . S ^TIU(8925.1,"ACL",TIUCLASS,TIUTTL,+X)=""
 . S ^TIU(8925.1,"ACL",38,TIUTTL,+X)=""
 . D SACLKWIC(TIUTTL,TIUCLASS,+X)
 . ; Now build x-ref for document classes
 . S TIUCLASS=+$$DOCCLASS^TIULC1(+X)
 . I TIUCLASS'>0 Q
 . S ^TIU(8925.1,"ACL",TIUCLASS,TIUTTL,+X)=""
 . D SACLKWIC(TIUTTL,TIUCLASS,+X)
 ; For Abbreviation and Print Name fields, just set the Synonym subscript
 I $S(FLD=.02:1,FLD=.03:1,1:0) D  Q
 . N TIUDA
 . Q:X']""
 . S TIUDA=$S(+$G(DA(1)):+$G(DA(1)),1:+$G(DA))
 . I $P($G(^TIU(8925.1,+TIUDA,0)),U,4)'="DOC" Q
 . S TIUSTTS=$P($G(^TIU(8925.1,+TIUDA,0)),U,7)
 . ; Include only TEST or ACTIVE titles
 . I $S(TIUSTTS=10:0,TIUSTTS=11:0,1:1) Q
 . S TIUTTL=$P($G(^TIU(8925.1,+TIUDA,0)),U)
 . Q:TIUTTL']""
 . S X=$$UP^XLFSTR(X)
 . Q:X=TIUTTL
 . S TIUTTL=X_"  <"_TIUTTL_">"
 . ; First build x-ref for Clinical Documents & Immediate descendents
 . S TIUCLASS=+$$CLINDOC^TIULC1(+TIUDA)
 . I TIUCLASS'>0 Q
 . S ^TIU(8925.1,"ACL",TIUCLASS,TIUTTL,+TIUDA)=""
 . S ^TIU(8925.1,"ACL",38,TIUTTL,+TIUDA)=""
 . ; Now build x-ref for document classes
 . S TIUCLASS=+$$DOCCLASS^TIULC1(+TIUDA)
 . I TIUCLASS'>0 Q
 . S ^TIU(8925.1,"ACL",TIUCLASS,TIUTTL,+TIUDA)=""
 I FLD=.07 D  Q
 . N TIUDA
 . S TIUDA=$S(+$G(DA(1)):+$G(DA(1)),1:+$G(DA))
 . I $P($G(^TIU(8925.1,+TIUDA,0)),U,4)'="DOC" Q
 . S TIUSTTS=$P($G(^TIU(8925.1,+TIUDA,0)),U,7)
 . ; Include only TEST or ACTIVE titles
 . I $S(TIUSTTS=10:0,TIUSTTS=11:0,1:1) Q
 . S TIUTTL=$P($G(^TIU(8925.1,+TIUDA,0)),U)
 . Q:TIUTTL']""
 . ; First build x-ref for Clinical Documents & Immediate descendents
 . S TIUCLASS=+$$CLINDOC^TIULC1(+TIUDA)
 . I TIUCLASS'>0 Q
 . S ^TIU(8925.1,"ACL",TIUCLASS,TIUTTL,+TIUDA)=""
 . S ^TIU(8925.1,"ACL",38,TIUTTL,+TIUDA)=""
 . D SACLKWIC(TIUTTL,TIUCLASS,+TIUDA)
 . ; Now build x-ref for document classes
 . S TIUCLASS=+$$DOCCLASS^TIULC1(+TIUDA)
 . I TIUCLASS'>0 Q
 . S ^TIU(8925.1,"ACL",TIUCLASS,TIUTTL,+TIUDA)=""
 . D SACLKWIC(TIUTTL,TIUCLASS,+TIUDA)
 I FLD=.01 D
 . N TIUDA
 . S TIUDA=$S(+$G(DA(1)):+$G(DA(1)),1:+$G(DA))
 . I $P($G(^TIU(8925.1,+TIUDA,0)),U,4)'="DOC" Q
 . S TIUSTTS=$P($G(^TIU(8925.1,+TIUDA,0)),U,7)
 . ; Include only TEST or ACTIVE titles
 . I $S(TIUSTTS=10:0,TIUSTTS=11:0,1:1) Q
 . ; First build x-ref for Clinical Documents & Immediate descendents
 . S TIUCLASS=+$$CLINDOC^TIULC1(+TIUDA)
 . I TIUCLASS'>0 Q
 . S ^TIU(8925.1,"ACL",TIUCLASS,X,+TIUDA)=""
 . S ^TIU(8925.1,"ACL",38,X,+TIUDA)=""
 . D SACLKWIC(X,TIUCLASS,+TIUDA)
 . ; Now build x-ref for document classes
 . S TIUCLASS=+$$DOCCLASS^TIULC1(+TIUDA)
 . I TIUCLASS'>0 Q
 . S ^TIU(8925.1,"ACL",TIUCLASS,X,+TIUDA)=""
 . D SACLKWIC(X,TIUCLASS,+TIUDA)
 Q
SACLKWIC(X,TIUCLASS,TIUDA) ; Set logic for KWIC analog
 N TIUI,TIUJ,TIUC S TIUI=1
 F TIUJ=1:1:$L(X)+1 D
 . S TIUC=$E(X,TIUJ)
 . I "(,.?! '-/&:;)"[TIUC S TIUC=$E($E(X,TIUI,TIUJ-1),1,30),TIUI=TIUJ+1
 . I  I $L(TIUC)>2,(^DD("KWIC")'[TIUC),(TIUC'=X) S (^TIU(8925.1,"ACL",TIUCLASS,TIUC_"  <"_X_">",TIUDA),^TIU(8925.1,"ACL",38,TIUC_"  <"_X_">",TIUDA))=""
 Q
KACL(X,FLD) ; KILL Logic for ACL cross-reference
 N TIUCLASS,TIUTTL,TIUDA
 I FLD=10.01 D
 . ; First remove x-ref for Clinical Documents & Immediate descendents
 . S TIUCLASS=+$$CLINDOC^TIULC1(+X)
 . S TIUTTL=$P($G(^TIU(8925.1,+X,0)),U)
 . Q:TIUTTL']""
 . Q:X=TIUTTL
 . K ^TIU(8925.1,"ACL",TIUCLASS,TIUTTL,+X)
 . K ^TIU(8925.1,"ACL",38,TIUTTL,+X)
 . D KACLKWIC(TIUTTL,TIUCLASS,+X)
 . ; Now remove x-ref for document classes
 . S TIUCLASS=+$$DOCCLASS^TIULC1(+X)
 . K ^TIU(8925.1,"ACL",TIUCLASS,TIUTTL,+X)
 . D KACLKWIC(TIUTTL,TIUCLASS,+X)
 I $S(FLD=.02:1,FLD=.03:1,1:0) D  Q
 . N TIUDA
 . Q:X']""
 . S TIUDA=$S(+$G(DA(1)):+$G(DA(1)),1:+$G(DA))
 . I $P($G(^TIU(8925.1,+TIUDA,0)),U,4)'="DOC" Q
 . S TIUSTTS=$P($G(^TIU(8925.1,+TIUDA,0)),U,7)
 . ; Include only TEST or ACTIVE titles
 . I $S(TIUSTTS=10:0,TIUSTTS=11:0,1:1) Q
 . S TIUTTL=$P($G(^TIU(8925.1,+TIUDA,0)),U)
 . Q:TIUTTL']""
 . S TIUTTL=X_"  <"_TIUTTL_">"
 . ; First build x-ref for Clinical Documents & Immediate descendents
 . S TIUCLASS=+$$CLINDOC^TIULC1(+TIUDA)
 . I TIUCLASS'>0 Q
 . K ^TIU(8925.1,"ACL",TIUCLASS,TIUTTL,+TIUDA)
 . K ^TIU(8925.1,"ACL",38,TIUTTL,+TIUDA)
 . ; Now build x-ref for document classes
 . S TIUCLASS=+$$DOCCLASS^TIULC1(+TIUDA)
 . I TIUCLASS'>0 Q
 . K ^TIU(8925.1,"ACL",TIUCLASS,TIUTTL,+TIUDA)
 I FLD=.07 D
 . N TIUDA
 . S TIUDA=$S(+$G(DA(1)):+$G(DA(1)),1:+$G(DA))
 . ; First remove x-ref for Clinical Documents & Immediate descendents
 . S TIUCLASS=+$$CLINDOC^TIULC1(+TIUDA)
 . S TIUTTL=$P($G(^TIU(8925.1,+TIUDA,0)),U)
 . Q:TIUTTL']""
 . K ^TIU(8925.1,"ACL",TIUCLASS,TIUTTL,+TIUDA)
 . K ^TIU(8925.1,"ACL",38,TIUTTL,+TIUDA)
 . D KACLKWIC(TIUTTL,TIUCLASS,+TIUDA)
 . ; Now remove x-ref for document classes
 . S TIUCLASS=+$$DOCCLASS^TIULC1(+TIUDA)
 . K ^TIU(8925.1,"ACL",TIUCLASS,TIUTTL,+TIUDA)
 . D KACLKWIC(TIUTTL,TIUCLASS,+TIUDA)
 I FLD=.01 D
 . N TIUDA
 . S TIUDA=$S(+$G(DA(1)):+$G(DA(1)),1:+$G(DA))
 . ; First remove x-ref for Clinical Documents & Immediate descendents
 . S TIUCLASS=+$$CLINDOC^TIULC1(+TIUDA)
 . K ^TIU(8925.1,"ACL",TIUCLASS,X,+TIUDA)
 . K ^TIU(8925.1,"ACL",38,X,+TIUDA)
 . D KACLKWIC(X,TIUCLASS,+TIUDA)
 . ; Now remove x-ref for document classes
 . S TIUCLASS=+$$DOCCLASS^TIULC1(+TIUDA)
 . K ^TIU(8925.1,"ACL",TIUCLASS,X,+TIUDA)
 . D KACLKWIC(X,TIUCLASS,+TIUDA)
 Q
KACLKWIC(X,TIUCLASS,TIUDA) ; KILL Logic for KWIC analog
 N TIUI,TIUJ,TIUC S TIUI=1
 F TIUJ=1:1:$L(X)+1 D
 . S TIUC=$E(X,TIUJ)
 . I "(,.?! '-/&:;)"[TIUC S TIUC=$E($E(X,TIUI,TIUJ-1),1,30),TIUI=TIUJ+1
 . I  I $L(TIUC)>2 K ^TIU(8925.1,"ACL",TIUCLASS,TIUC_"  <"_X_">",TIUDA),^TIU(8925.1,"ACL",38,TIUC_"  <"_X_">",TIUDA)
 Q