Routine: TIUR3

TIUR3 ; SLC/JER - Integrated Document Review ;11/01/03 [1/12/05 11:42am]

 ;;1.0;TEXT INTEGRATION UTILITIES;**157**;Jun 20, 1997

 ;This routine was made from a copy of TIUR and modified to be used

 ; for option TIU REVIEW UNSIGNED ADDSIG

MAKELIST(TIUCLASS,TIUCHVW) ; Get Search Criteria

 N DIRUT,DTOUT,DUOUT,TIUI,SCREEN,STATUS,TIUTYP,TIUSTAT,TIUEDFLT,TIUDCL

 N TIUDPRMT,TIUPICT,TIUOUT,STATWORD,STATIFN,NOWFLAG

 K DIROUT

 D INITRR^TIULRR(0)

 ;  TIURPN used in Order Entry 2.5, OR OE/RR MENU CLIN:

 I +$G(ORVP),(+$G(TIUCHVW)'>0) D EN^TIURPN(TIUCLASS,+ORVP) Q

STATUS S STATUS=$$STAT

 I +STATUS<0 S VALMQUIT=1 Q

 S TIUI=0

 F  S TIUI=$O(TIUSTAT(TIUI)) Q:'TIUI!(+$G(TIUOUT))  D

 . I $P($G(TIUSTAT(TIUI)),U,3)="" S TIUOUT=1 Q

 . S STATIFN=$O(^TIU(8925.6,"B",$$UPPER^TIULS($P(TIUSTAT(TIUI),U,3)),0))

 . Q:'STATIFN

 . S STATUS("IFNS")=$G(STATUS("IFNS"))_STATIFN_";"

 I +$G(TIUOUT) S VALMQUIT=1 Q

 S TIUI=1,STATWORD=$$UPPER^TIULS($P(TIUSTAT(1),U,3))

 I +$G(TIUSTAT(4))'>0 F  S TIUI=$O(TIUSTAT(TIUI)) Q:+TIUI'>0  D

 . S STATWORD=STATWORD_$S(TIUI=+TIUSTAT(1):" & ",1:", ")_$$UPPER^TIULS($P(TIUSTAT(TIUI),U,3))

 I +$G(TIUSTAT(4))>0 S STATWORD=$S($P(TIUSTAT(4),U,4)="ALL":"ALL",1:STATWORD_", OTHER")

 S STATUS("WORDS")=STATWORD

DOCTYPE ; Select Document Type(s)

 N TIUDCL K TIUPICT

 I $S(('$D(TIUQUIK)&'$D(ORVP)):1,($D(ORVP)&+$G(TIUCHVW)):1,1:0) D SELTYP^TIULA(TIUCLASS,.TIUTYP,"A","LAST","DOC",0,.TIUDCL,.TIUPICT)

 ; SELTYP sets array ^TMP("TIUTYP",$J);

 ; SELTYP used to set data into TIUTYP array

 ; Now TIUTYP just ="^TMP("TIUTYP",$J)"

 I $S($D(TIUQUIK):1,($D(ORVP)&'+$G(TIUCHVW)):1,1:0) D SELTYP^TIULA(TIUCLASS,.TIUTYP,"F","ALL","DOC",0)

 I +$G(DIROUT) S VALMQUIT=1 Q

 I +$G(@TIUTYP)'>0,'$D(TIUQUIK) G STATUS

SCREEN ;

 N TIUNAME

 S TIUNAME=$$GET1^DIQ(200,+DUZ,.01)

 I $D(TIUQUIK) D  I 1 ; all my unsigned TIUQUIK=1

 . I $G(TIUQUIK)=3 S SCREEN(1)="ALL^ANY" Q

 . S SCREEN(1)="AAU^"_DUZ_U_TIUNAME

 . S:$G(TIUQUIK)=1 SCREEN(2)="ASUP^"_DUZ

 . S SCREEN="ALL"

 E  D SELCAT^TIULA1(.SCREEN,"A","AUTHOR")

 I +$G(DIROUT) S VALMQUIT=1 Q

 I $D(SCREEN)'>9 K @TIUTYP G DOCTYPE

 I $D(@TIUTYP)'>9 W !,$C(7),"You must select one or more TITLES..." G SCREEN

 D CHECKADD

ERLY S TIUEDFLT=$S(TIUCLASS=3:"T-2",TIUCLASS=244:"T-30",1:"T-7")

 S TIUDPRMT=$S(TIUCLASS=244:"Discharge",1:"Reference")

 S TIUEDT=1

 I +$G(DIROUT) S VALMQUIT=1 Q

 I TIUEDT'>0 G SCREEN

 S TIULDT=$S($D(TIUQUIK):9999999,$D(ORVP)&(+$G(TIUCHVW)'>0):+$$NOW^XLFDT,1:$P($$LDATE^TIULA(TIUDPRMT),U))

 I +$G(DIROUT) S VALMQUIT=1 Q

 I TIULDT'>0 G ERLY

 I TIUEDT>TIULDT D SWAP(.TIUEDT,.TIULDT)

 I $L(TIULDT,".")=1 D EXPRANGE(.TIUEDT,.TIULDT)

 ; -- Reset late date to NOW on rebuild:

 S NOWFLAG=$S(TIULDT-$$NOW^XLFDT<.0001:1,1:0)

 I '$G(TIURBLD) W !,"Searching for the documents."

 D BUILD(TIUCLASS,.STATUS,.SCREEN,TIUEDT,TIULDT,NOWFLAG) ;11/30/00 removed param TIUTYP since BUILD uses global now.

 ; -- If attaching ID note & changed view,

 ;    update video for line to be attached: --

 I $G(TIUGLINK) D RESTOREG^TIULM(.TIUGLINK)

 ;K @TIUTYP ;11/30/00 keep ^TMP("TIUTYP",$J) for rebuild

STAT() ; Determine status

 N TIUY

 I +$G(TIUQUIK) D  G STATX

 . S TIUY=$$SELSTAT^TIULA(.TIUSTAT,"F",$S(TIUQUIK=1:"UNSIGNED,UNCOSIGNED",TIUQUIK>1:"UNDICTATED,UNTRANSCRIBED"))

 I $D(ORVP),'+$G(TIUCHVW) D  G STATX

 . S TIUY=$$SELSTAT^TIULA(.TIUSTAT,"F","COMPLETED")

 S TIUY=$$SELSTAT^TIULA(.TIUSTAT,"A",$$DFLTSTAT^TIURM(DUZ))

STATX Q TIUY

CHECKADD ; Checks whether Addendum is included in the list of types

 N TIUI,HIT,NUMTYPS

 S (TIUI,HIT)=0

 F  S TIUI=$O(^TMP("TIUTYP",$J,TIUI)) Q:+TIUI'>0!+HIT  I $$UP^XLFSTR(^TMP("TIUTYP",$J,TIUI))["ADDENDUM" S HIT=1

 S NUMTYPS=^TMP("TIUTYP",$J)

 I +HIT'>0 S ^TMP("TIUTYP",$J,NUMTYPS+1)=+^TMP("TIUTYP",$J,NUMTYPS)+1_U_"81^Addendum^NOT PICKED",^TMP("TIUTYP",$J)=^TMP("TIUTYP",$J)+1

SWAP(TIUX,TIUY) ; Swap variables

 N TIUTMP S TIUTMP=TIUX,TIUX=TIUY,TIUY=TIUTMP

EXPRANGE(TIUX,TIUY) ; Expand late date to include time

 ;P74 If user entered date/time = T, then numerical date time is FIRST ^ PIECE ONLY of TIUX & TIUY.

 I $P(TIUY,U)=DT S TIUY=$$NOW^XLFDT I 1

 E  S TIUY=$P(TIUY,U)_"."_235959 ;P74 Add seconds

BUILD(TIUCLASS,STATUS,SCREEN,EARLY,LATE,NOWFLAG) ; Build List.

 ;11/30/00 - removed param TYPES. 12/3 added param TIUCLASS

 ; BUILD (GATHER) uses docmt type info from ^TMP("TIUTYP",$J)

 N TIUDT,TIUI,TIUK

 N TIUT,TIUTP,XREF,TIUS,TIUPREF

 S TIUPREF=$$PERSPRF^TIULE(DUZ),(TIUK,VALMCNT)=0

 K ^TMP("TIUR",$J),^TMP("TIURIDX",$J),^TMP("TIUI",$J)

 ; If user entered NOW at first build, update NOW for rebuild;

 ; Save data in ^TMP("TIURIDX",$J,0) for rebuild:

 I $G(TIURBLD),$G(NOWFLAG) S LATE=$$NOW^XLFDT

 S ^TMP("TIURIDX",$J,0)=+EARLY_U_+LATE_U_$G(STATUS("IFNS"))_U_NOWFLAG

 S ^TMP("TIUR",$J,"RTN")="TIUR3"

 I '$D(TIUPRM0) D SETPARM^TIULE

 S EARLY=9999999-+$G(EARLY),LATE=9999999-$S(+$G(LATE):+$G(LATE),1:3333333)

 D GATHER^TIUR4(TIUCLASS,TIUPREF)

 D PUTLIST^TIUR2(TIUPREF,TIUCLASS,.STATUS,.SCREEN)

 K ^TMP("TIUI",$J)

CLEAN ; Clean up your mess!

 K ^TMP("TIUR",$J),^TMP("TIURIDX",$J) D CLEAN^VALM10,KILLRR^TIULRR

 K VALMY

 K ^TMP("TIUTYP",$J)

RBLD ; Rebuild list after actions 11/30/00

 N TIUEXP,TIUR0,TIURIDX0,TIUSCRN,TMP,TIUEDT,TIULDT,TIUSTAT

 N TIURBLD,TIUI,TIUCLASS,NOWFLAG

 S TIURBLD=1

 D FIXLSTNW^TIULM ;restore video for elements added to end of list

 I +$O(^TMP("TIUR",$J,"EXPAND",0)) D

 . M TIUEXP=^TMP("TIUR",$J,"EXPAND")

 S TIUR0=^TMP("TIUR",$J,0),TIURIDX0=^TMP("TIURIDX",$J,0)

 S TIUSCRN="ALL",TIUCLASS=^TMP("TIUR",$J,"CLASS")

 S STATUS("WORDS")=$P(TIUR0,U,2)

 S STATUS("IFNS")=$P(TIURIDX0,U,3)

 S TIUEDT=$P(TIURIDX0,U),TIULDT=$P(TIURIDX0,U,2),NOWFLAG=+$P(TIURIDX0,U,4)

 K VALMHDR

 D BUILD(TIUCLASS,.STATUS,.TIUSCRN,TIUEDT,TIULDT,NOWFLAG)

 ; Reexpand previously expanded items:

 D RELOAD^TIUROR1(.TIUEXP)

 D BREATHE^TIUROR1(1)

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUR3   5852     printed  Mar 13, 2025@21:49:50                                                                                                                                                                                                       Page 2

TIUR3     ; SLC/JER - Integrated Document Review ;11/01/03 [1/12/05 11:42am]

 +1       ;;1.0;TEXT INTEGRATION UTILITIES;**157**;Jun 20, 1997

 +2       ;This routine was made from a copy of TIUR and modified to be used

 +3       ; for option TIU REVIEW UNSIGNED ADDSIG

MAKELIST(TIUCLASS,TIUCHVW) ; Get Search Criteria

 +1        NEW DIRUT,DTOUT,DUOUT,TIUI,SCREEN,STATUS,TIUTYP,TIUSTAT,TIUEDFLT,TIUDCL

 +2        NEW TIUDPRMT,TIUPICT,TIUOUT,STATWORD,STATIFN,NOWFLAG

 +3        KILL DIROUT

 +4        DO INITRR^TIULRR(0)

 +5       ;  TIURPN used in Order Entry 2.5, OR OE/RR MENU CLIN:

 +6        IF +$GET(ORVP)

               IF (+$GET(TIUCHVW)'>0)

                   DO EN^TIURPN(TIUCLASS,+ORVP)

                   QUIT

STATUS     SET STATUS=$$STAT

 +1        IF +STATUS<0

               SET VALMQUIT=1

               QUIT

 +2        SET TIUI=0

 +3        FOR

               SET TIUI=$ORDER(TIUSTAT(TIUI))

               if 'TIUI!(+$GET(TIUOUT))

                   QUIT

               Begin DoDot:1

 +4                IF $PIECE($GET(TIUSTAT(TIUI)),U,3)=""

                       SET TIUOUT=1

                       QUIT

 +5                SET STATIFN=$ORDER(^TIU(8925.6,"B",$$UPPER^TIULS($PIECE(TIUSTAT(TIUI),U,3)),0))

 +6                if 'STATIFN

                       QUIT

 +7                SET STATUS("IFNS")=$GET(STATUS("IFNS"))_STATIFN_";"

               End DoDot:1

 +8        IF +$GET(TIUOUT)

               SET VALMQUIT=1

               QUIT

 +9        SET TIUI=1

           SET STATWORD=$$UPPER^TIULS($PIECE(TIUSTAT(1),U,3))

 +10       IF +$GET(TIUSTAT(4))'>0

FOR

                   SET TIUI=$ORDER(TIUSTAT(TIUI))

                   if +TIUI'>0

                       QUIT

                   Begin DoDot:1

 +11                   SET STATWORD=STATWORD_$SELECT(TIUI=+TIUSTAT(1):" & ",1:", ")_$$UPPER^TIULS($PIECE(TIUSTAT(TIUI),U,3))

                   End DoDot:1

 +12       IF +$GET(TIUSTAT(4))>0

               SET STATWORD=$SELECT($PIECE(TIUSTAT(4),U,4)="ALL":"ALL",1:STATWORD_", OTHER")

 +13       SET STATUS("WORDS")=STATWORD

DOCTYPE   ; Select Document Type(s)

 +1        NEW TIUDCL

           KILL TIUPICT

 +2        IF $SELECT(('$DATA(TIUQUIK)&'$DATA(ORVP)):1,($DATA(ORVP)&+$GET(TIUCHVW)):1,1:0)

               DO SELTYP^TIULA(TIUCLASS,.TIUTYP,"A","LAST","DOC",0,.TIUDCL,.TIUPICT)

 +3       ; SELTYP sets array ^TMP("TIUTYP",$J);

 +4       ; SELTYP used to set data into TIUTYP array

 +5       ; Now TIUTYP just ="^TMP("TIUTYP",$J)"

 +6        IF $SELECT($DATA(TIUQUIK):1,($DATA(ORVP)&'+$GET(TIUCHVW)):1,1:0)

               DO SELTYP^TIULA(TIUCLASS,.TIUTYP,"F","ALL","DOC",0)

 +7        IF +$GET(DIROUT)

               SET VALMQUIT=1

               QUIT

 +8        IF +$GET(@TIUTYP)'>0

               IF '$DATA(TIUQUIK)

                   GOTO STATUS

SCREEN    ;

 +1        NEW TIUNAME

 +2        SET TIUNAME=$$GET1^DIQ(200,+DUZ,.01)

 +3       ; all my unsigned TIUQUIK=1

           IF $DATA(TIUQUIK)

               Begin DoDot:1

 +4                IF $GET(TIUQUIK)=3

                       SET SCREEN(1)="ALL^ANY"

                       QUIT

 +5                SET SCREEN(1)="AAU^"_DUZ_U_TIUNAME

 +6                if $GET(TIUQUIK)=1

                       SET SCREEN(2)="ASUP^"_DUZ

 +7                SET SCREEN="ALL"

               End DoDot:1

               IF 1

 +8       IF '$TEST

               DO SELCAT^TIULA1(.SCREEN,"A","AUTHOR")

 +9        IF +$GET(DIROUT)

               SET VALMQUIT=1

               QUIT

 +10       IF $DATA(SCREEN)'>9

               KILL @TIUTYP

               GOTO DOCTYPE

 +11       IF $DATA(@TIUTYP)'>9

               WRITE !,$CHAR(7),"You must select one or more TITLES..."

               GOTO SCREEN

 +12       DO CHECKADD

ERLY       SET TIUEDFLT=$SELECT(TIUCLASS=3:"T-2",TIUCLASS=244:"T-30",1:"T-7")

 +1        SET TIUDPRMT=$SELECT(TIUCLASS=244:"Discharge",1:"Reference")

 +2        SET TIUEDT=1

 +3        IF +$GET(DIROUT)

               SET VALMQUIT=1

               QUIT

 +4        IF TIUEDT'>0

               GOTO SCREEN

 +5        SET TIULDT=$SELECT($DATA(TIUQUIK):9999999,$DATA(ORVP)&(+$GET(TIUCHVW)'>0):+$$NOW^XLFDT,1:$PIECE($$LDATE^TIULA(TIUDPRMT),U))

 +6        IF +$GET(DIROUT)

               SET VALMQUIT=1

               QUIT

 +7        IF TIULDT'>0

               GOTO ERLY

 +8        IF TIUEDT>TIULDT

               DO SWAP(.TIUEDT,.TIULDT)

 +9        IF $LENGTH(TIULDT,".")=1

               DO EXPRANGE(.TIUEDT,.TIULDT)

 +10      ; -- Reset late date to NOW on rebuild:

 +11       SET NOWFLAG=$SELECT(TIULDT-$$NOW^XLFDT<.0001:1,1:0)

 +12       IF '$GET(TIURBLD)

               WRITE !,"Searching for the documents."

 +13      ;11/30/00 removed param TIUTYP since BUILD uses global now.

           DO BUILD(TIUCLASS,.STATUS,.SCREEN,TIUEDT,TIULDT,NOWFLAG)

 +14      ; -- If attaching ID note & changed view,

 +15      ;    update video for line to be attached: --

 +16       IF $GET(TIUGLINK)

               DO RESTOREG^TIULM(.TIUGLINK)

 +17      ;K @TIUTYP ;11/30/00 keep ^TMP("TIUTYP",$J) for rebuild

 +18       QUIT

STAT()    ; Determine status

 +1        NEW TIUY

 +2        IF +$GET(TIUQUIK)

               Begin DoDot:1

 +3                SET TIUY=$$SELSTAT^TIULA(.TIUSTAT,"F",$SELECT(TIUQUIK=1:"UNSIGNED,UNCOSIGNED",TIUQUIK>1:"UNDICTATED,UNTRANSCRIBED"))

               End DoDot:1

               GOTO STATX

 +4        IF $DATA(ORVP)

               IF '+$GET(TIUCHVW)

                   Begin DoDot:1

 +5                    SET TIUY=$$SELSTAT^TIULA(.TIUSTAT,"F","COMPLETED")

                   End DoDot:1

                   GOTO STATX

 +6        SET TIUY=$$SELSTAT^TIULA(.TIUSTAT,"A",$$DFLTSTAT^TIURM(DUZ))

STATX      QUIT TIUY

CHECKADD  ; Checks whether Addendum is included in the list of types

 +1        NEW TIUI,HIT,NUMTYPS

 +2        SET (TIUI,HIT)=0

 +3        FOR

               SET TIUI=$ORDER(^TMP("TIUTYP",$JOB,TIUI))

               if +TIUI'>0!+HIT

                   QUIT

               IF $$UP^XLFSTR(^TMP("TIUTYP",$JOB,TIUI))["ADDENDUM"

                   SET HIT=1

 +4        SET NUMTYPS=^TMP("TIUTYP",$JOB)

 +5        IF +HIT'>0

               SET ^TMP("TIUTYP",$JOB,NUMTYPS+1)=+^TMP("TIUTYP",$JOB,NUMTYPS)+1_U_"81^Addendum^NOT PICKED"

               SET ^TMP("TIUTYP",$JOB)=^TMP("TIUTYP",$JOB)+1

 +6        QUIT

 +7       ;

SWAP(TIUX,TIUY) ; Swap variables

 +1        NEW TIUTMP

           SET TIUTMP=TIUX

           SET TIUX=TIUY

           SET TIUY=TIUTMP

 +2        QUIT

EXPRANGE(TIUX,TIUY) ; Expand late date to include time

 +1       ;P74 If user entered date/time = T, then numerical date time is FIRST ^ PIECE ONLY of TIUX & TIUY.

 +2        IF $PIECE(TIUY,U)=DT

               SET TIUY=$$NOW^XLFDT

               IF 1

 +3       ;P74 Add seconds

          IF '$TEST

               SET TIUY=$PIECE(TIUY,U)_"."_235959

 +4        QUIT

BUILD(TIUCLASS,STATUS,SCREEN,EARLY,LATE,NOWFLAG) ; Build List.

 +1       ;11/30/00 - removed param TYPES. 12/3 added param TIUCLASS

 +2       ; BUILD (GATHER) uses docmt type info from ^TMP("TIUTYP",$J)

 +3        NEW TIUDT,TIUI,TIUK

 +4        NEW TIUT,TIUTP,XREF,TIUS,TIUPREF

 +5        SET TIUPREF=$$PERSPRF^TIULE(DUZ)

           SET (TIUK,VALMCNT)=0

 +6        KILL ^TMP("TIUR",$JOB),^TMP("TIURIDX",$JOB),^TMP("TIUI",$JOB)

 +7       ; If user entered NOW at first build, update NOW for rebuild;

 +8       ; Save data in ^TMP("TIURIDX",$J,0) for rebuild:

 +9        IF $GET(TIURBLD)

               IF $GET(NOWFLAG)

                   SET LATE=$$NOW^XLFDT

 +10       SET ^TMP("TIURIDX",$JOB,0)=+EARLY_U_+LATE_U_$GET(STATUS("IFNS"))_U_NOWFLAG

 +11       SET ^TMP("TIUR",$JOB,"RTN")="TIUR3"

 +12       IF '$DATA(TIUPRM0)

               DO SETPARM^TIULE

 +13       SET EARLY=9999999-+$GET(EARLY)

           SET LATE=9999999-$SELECT(+$GET(LATE):+$GET(LATE),1:3333333)

 +14       DO GATHER^TIUR4(TIUCLASS,TIUPREF)

 +15       DO PUTLIST^TIUR2(TIUPREF,TIUCLASS,.STATUS,.SCREEN)

 +16       KILL ^TMP("TIUI",$JOB)

 +17       QUIT

 +18      ;

CLEAN     ; Clean up your mess!

 +1        KILL ^TMP("TIUR",$JOB),^TMP("TIURIDX",$JOB)

           DO CLEAN^VALM10

           DO KILLRR^TIULRR

 +2        KILL VALMY

 +3        KILL ^TMP("TIUTYP",$JOB)

 +4        QUIT

 +5       ;

RBLD      ; Rebuild list after actions 11/30/00

 +1        NEW TIUEXP,TIUR0,TIURIDX0,TIUSCRN,TMP,TIUEDT,TIULDT,TIUSTAT

 +2        NEW TIURBLD,TIUI,TIUCLASS,NOWFLAG

 +3        SET TIURBLD=1

 +4       ;restore video for elements added to end of list

           DO FIXLSTNW^TIULM

 +5        IF +$ORDER(^TMP("TIUR",$JOB,"EXPAND",0))

               Begin DoDot:1

 +6                MERGE TIUEXP=^TMP("TIUR",$JOB,"EXPAND")

               End DoDot:1

 +7        SET TIUR0=^TMP("TIUR",$JOB,0)

           SET TIURIDX0=^TMP("TIURIDX",$JOB,0)

 +8        SET TIUSCRN="ALL"

           SET TIUCLASS=^TMP("TIUR",$JOB,"CLASS")

 +9        SET STATUS("WORDS")=$PIECE(TIUR0,U,2)

 +10       SET STATUS("IFNS")=$PIECE(TIURIDX0,U,3)

 +11       SET TIUEDT=$PIECE(TIURIDX0,U)

           SET TIULDT=$PIECE(TIURIDX0,U,2)

           SET NOWFLAG=+$PIECE(TIURIDX0,U,4)

 +12       KILL VALMHDR

 +13       DO BUILD(TIUCLASS,.STATUS,.TIUSCRN,TIUEDT,TIULDT,NOWFLAG)

 +14      ; Reexpand previously expanded items:

 +15       DO RELOAD^TIUROR1(.TIUEXP)

 +16       DO BREATHE^TIUROR1(1)

 +17       QUIT

TIUR3.m