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
Q
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
Q
;
SWAP(TIUX,TIUY) ; Swap variables
N TIUTMP S TIUTMP=TIUX,TIUX=TIUY,TIUY=TIUTMP
Q
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
Q
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)
Q
;
CLEAN ; Clean up your mess!
K ^TMP("TIUR",$J),^TMP("TIURIDX",$J) D CLEAN^VALM10,KILLRR^TIULRR
K VALMY
K ^TMP("TIUTYP",$J)
Q
;
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)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIUR3 5852 printed Nov 22, 2024@17:54:51 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
