TIURENDX ; slc/mli - reindex TIU x-refs ;9/21/98@11:59:22
;;1.0;TEXT INTEGRATION UTILITIES;**26**;Jun 20, 1997
;
; This routine will re-index the set logic only of the ACLPT, ACLAU,
; ACLEC, and ACLSB cross-references on file 8925 (TIU DOCUMENT).
; This will fix a problem with discharge summaries showing in TIU,
; but not in CPRS.
;
EN ; -- allow process to be queued
S ZTDESC="Re-index TIU x-refs",ZTIO="",ZTRTN="DQ^TIURENDX"
D ^%ZTLOAD
K ZTDESC,ZTIO,ZTRTN,ZTSK
Q
;
DQ ; -- dequeue process
N TIUDA,TIUX,X
; Initialize ^XTMP("TIURENDX")
K ^XTMP("TIURENDX")
S ^XTMP("TIURENDX",0)=$$FMADD^XLFDT(DT,90)_U_DT
S ^XTMP("TIURENDX","T0")=$$NOW^XLFDT
S (^XTMP("TIURENDX","COUNT"),^("ACLPT"),^("ACLSB"),^("ACLAU"),^("ACLEC"))=0
; first, remove the ACL* x-refs, which may be corrupted
K ^TIU(8925,"ACLAU"),^TIU(8925,"ACLEC")
K ^TIU(8925,"ACLSB"),^TIU(8925,"ACLPT")
; next, rebuild 'em
S TIUDA=0
F S TIUDA=$O(^TIU(8925,TIUDA)) Q:'TIUDA D
. N TIUSTAT,DA,TIUD0
. S TIUD0=$G(^TIU(8925,TIUDA,0))
. S TIUX=$P(TIUD0,U)
. I TIUX']"" Q
. I +$$ISCOMP(TIUD0) Q ; Don't process components
. S TIUSTAT=+$P($G(^TIU(8925,TIUDA,0)),U,5) Q:TIUSTAT'>0
. S DA=TIUDA
. ; Include UNSIGNED documents in the ACLAU x-ref
. I TIUSTAT=5 D SACLAU^TIUDD0(.01,TIUX),SACLAU1^TIUDD0(.01,TIUX) S ^XTMP("TIURENDX","ACLAU")=^XTMP("TIURENDX","ACLAU")+1,^XTMP("TIURENDX","COUNT")=^XTMP("TIURENDX","COUNT")+1
. ; Include UNCOSIGNED documents in the ACLEC & ACLPT x-refs
. I TIUSTAT=6 D SACLEC^TIUDD0(.01,TIUX),SACLPT^TIUDD0(.01,TIUX) S ^XTMP("TIURENDX","ACLEC")=^XTMP("TIURENDX","ACLEC")+1,^XTMP("TIURENDX","ACLPT")=^XTMP("TIURENDX","ACLPT")+1,^XTMP("TIURENDX","COUNT")=^XTMP("TIURENDX","COUNT")+1
. ; Include ALL COMPLETED documents in the ACLPT & ACLSB x-refs
. I TIUSTAT>6 D SACLPT^TIUDD0(.01,TIUX),SACLSB^TIUDD0(.01,TIUX) S ^XTMP("TIURENDX","ACLPT")=^XTMP("TIURENDX","ACLPT")+1,^XTMP("TIURENDX","ACLSB")=^XTMP("TIURENDX","ACLSB")+1,^XTMP("TIURENDX","COUNT")=^XTMP("TIURENDX","COUNT")+1
. S ^XTMP("TIURENDX",+$P(TIUD0,U,5))=+$G(^XTMP("TIURENDX",+$P(TIUD0,U,5)))+1
S ^XTMP("TIURENDX","T1")=$$NOW^XLFDT
D BULLETIN
Q
ISCOMP(TIUD0) ; Is this record a component?
Q $S($P($G(^TIU(8925.1,+TIUD0,0)),U,4)="CO":1,1:0)
BULLETIN ; Send Bulletins on completion
N TIUCNT,TIUBDT,TIUDIFF,TIUETM,TIUEDT,TIURPS,TIURAU,TIUREC,TIURPT
N TIURSB,XMY,XMB,XMDUZ
S TIUCNT=+$G(^XTMP("TIURENDX","COUNT"))
S TIUBDT=$$DATE^TIULS(+^XTMP("TIURENDX","T0"),"MM/DD/YY HR:MIN")
S TIUEDT=$$DATE^TIULS(+^XTMP("TIURENDX","T1"),"MM/DD/YY HR:MIN")
S TIURAU=^XTMP("TIURENDX","ACLAU")
S TIUREC=^XTMP("TIURENDX","ACLEC")
S TIURPT=^XTMP("TIURENDX","ACLPT")
S TIURSB=^XTMP("TIURENDX","ACLSB")
S TIUDIFF=$$FMDIFF^XLFDT(+^XTMP("TIURENDX","T1"),+^XTMP("TIURENDX","T0"),2)
S TIUETM=$$FMDIFF^XLFDT(+^XTMP("TIURENDX","T1"),+^XTMP("TIURENDX","T0"),3)
S TIURPS=$J(TIUCNT/TIUDIFF,5,2)
S XMY(+$G(DUZ))=""
S XMB="TIU RE-INDEX DOCUMENT FILE"
S XMDUZ="TIU RE-INDEX DOCUMENT FILE"
S XMB(1)=TIUBDT,XMB(2)=TIUEDT,XMB(3)=TIURPT,XMB(4)=TIURSB
S XMB(5)=TIURAU,XMB(6)=TIUREC,XMB(7)=TIUCNT,XMB(8)=TIUETM
S XMB(9)=TIURPS
D ^XMB,KILL^XM
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIURENDX 3160 printed Dec 13, 2024@02:45:17 Page 2
TIURENDX ; slc/mli - reindex TIU x-refs ;9/21/98@11:59:22
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**26**;Jun 20, 1997
+2 ;
+3 ; This routine will re-index the set logic only of the ACLPT, ACLAU,
+4 ; ACLEC, and ACLSB cross-references on file 8925 (TIU DOCUMENT).
+5 ; This will fix a problem with discharge summaries showing in TIU,
+6 ; but not in CPRS.
+7 ;
EN ; -- allow process to be queued
+1 SET ZTDESC="Re-index TIU x-refs"
SET ZTIO=""
SET ZTRTN="DQ^TIURENDX"
+2 DO ^%ZTLOAD
+3 KILL ZTDESC,ZTIO,ZTRTN,ZTSK
+4 QUIT
+5 ;
DQ ; -- dequeue process
+1 NEW TIUDA,TIUX,X
+2 ; Initialize ^XTMP("TIURENDX")
+3 KILL ^XTMP("TIURENDX")
+4 SET ^XTMP("TIURENDX",0)=$$FMADD^XLFDT(DT,90)_U_DT
+5 SET ^XTMP("TIURENDX","T0")=$$NOW^XLFDT
+6 SET (^XTMP("TIURENDX","COUNT"),^("ACLPT"),^("ACLSB"),^("ACLAU"),^("ACLEC"))=0
+7 ; first, remove the ACL* x-refs, which may be corrupted
+8 KILL ^TIU(8925,"ACLAU"),^TIU(8925,"ACLEC")
+9 KILL ^TIU(8925,"ACLSB"),^TIU(8925,"ACLPT")
+10 ; next, rebuild 'em
+11 SET TIUDA=0
+12 FOR
SET TIUDA=$ORDER(^TIU(8925,TIUDA))
if 'TIUDA
QUIT
Begin DoDot:1
+13 NEW TIUSTAT,DA,TIUD0
+14 SET TIUD0=$GET(^TIU(8925,TIUDA,0))
+15 SET TIUX=$PIECE(TIUD0,U)
+16 IF TIUX']""
QUIT
+17 ; Don't process components
IF +$$ISCOMP(TIUD0)
QUIT
+18 SET TIUSTAT=+$PIECE($GET(^TIU(8925,TIUDA,0)),U,5)
if TIUSTAT'>0
QUIT
+19 SET DA=TIUDA
+20 ; Include UNSIGNED documents in the ACLAU x-ref
+21 IF TIUSTAT=5
DO SACLAU^TIUDD0(.01,TIUX)
DO SACLAU1^TIUDD0(.01,TIUX)
SET ^XTMP("TIURENDX","ACLAU")=^XTMP("TIURENDX","ACLAU")+1
SET ^XTMP("TIURENDX","COUNT")=^XTMP("TIURENDX","COUNT")+1
+22 ; Include UNCOSIGNED documents in the ACLEC & ACLPT x-refs
+23 IF TIUSTAT=6
DO SACLEC^TIUDD0(.01,TIUX)
DO SACLPT^TIUDD0(.01,TIUX)
SET ^XTMP("TIURENDX","ACLEC")=^XTMP("TIURENDX","ACLEC")+1
SET ^XTMP("TIURENDX","ACLPT")=^XTMP("TIURENDX","ACLPT")+1
SET ^XTMP("TIURENDX","COUNT")=^XTMP("TIURENDX","COUNT")+1
+24 ; Include ALL COMPLETED documents in the ACLPT & ACLSB x-refs
+25 IF TIUSTAT>6
DO SACLPT^TIUDD0(.01,TIUX)
DO SACLSB^TIUDD0(.01,TIUX)
SET ^XTMP("TIURENDX","ACLPT")=^XTMP("TIURENDX","ACLPT")+1
SET ^XTMP("TIURENDX","ACLSB")=^XTMP("TIURENDX","ACLSB")+1
SET ^XTMP("TIURENDX","COUNT")=^XTMP("TIURENDX","COUNT")+1
+26 SET ^XTMP("TIURENDX",+$PIECE(TIUD0,U,5))=+$GET(^XTMP("TIURENDX",+$PIECE(TIUD0,U,5)))+1
End DoDot:1
+27 SET ^XTMP("TIURENDX","T1")=$$NOW^XLFDT
+28 DO BULLETIN
+29 QUIT
ISCOMP(TIUD0) ; Is this record a component?
+1 QUIT $SELECT($PIECE($GET(^TIU(8925.1,+TIUD0,0)),U,4)="CO":1,1:0)
BULLETIN ; Send Bulletins on completion
+1 NEW TIUCNT,TIUBDT,TIUDIFF,TIUETM,TIUEDT,TIURPS,TIURAU,TIUREC,TIURPT
+2 NEW TIURSB,XMY,XMB,XMDUZ
+3 SET TIUCNT=+$GET(^XTMP("TIURENDX","COUNT"))
+4 SET TIUBDT=$$DATE^TIULS(+^XTMP("TIURENDX","T0"),"MM/DD/YY HR:MIN")
+5 SET TIUEDT=$$DATE^TIULS(+^XTMP("TIURENDX","T1"),"MM/DD/YY HR:MIN")
+6 SET TIURAU=^XTMP("TIURENDX","ACLAU")
+7 SET TIUREC=^XTMP("TIURENDX","ACLEC")
+8 SET TIURPT=^XTMP("TIURENDX","ACLPT")
+9 SET TIURSB=^XTMP("TIURENDX","ACLSB")
+10 SET TIUDIFF=$$FMDIFF^XLFDT(+^XTMP("TIURENDX","T1"),+^XTMP("TIURENDX","T0"),2)
+11 SET TIUETM=$$FMDIFF^XLFDT(+^XTMP("TIURENDX","T1"),+^XTMP("TIURENDX","T0"),3)
+12 SET TIURPS=$JUSTIFY(TIUCNT/TIUDIFF,5,2)
+13 SET XMY(+$GET(DUZ))=""
+14 SET XMB="TIU RE-INDEX DOCUMENT FILE"
+15 SET XMDUZ="TIU RE-INDEX DOCUMENT FILE"
+16 SET XMB(1)=TIUBDT
SET XMB(2)=TIUEDT
SET XMB(3)=TIURPT
SET XMB(4)=TIURSB
+17 SET XMB(5)=TIURAU
SET XMB(6)=TIUREC
SET XMB(7)=TIUCNT
SET XMB(8)=TIUETM
+18 SET XMB(9)=TIURPS
+19 DO ^XMB
DO KILL^XM
+20 QUIT
