- 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
- 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