TIURENDX.m

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