68 lines
3.0 KiB
Mathematica
68 lines
3.0 KiB
Mathematica
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
|