source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUR3.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 5.6 KB
Line 
1TIUR3 ; SLC/JER - Integrated Document Review ;11/01/03 [1/12/05 11:42am]
2 ;;1.0;TEXT INTEGRATION UTILITIES;**157**;Jun 20, 1997
3 ;This routine was made from a copy of TIUR and modified to be used
4 ; for option TIU REVIEW UNSIGNED ADDSIG
5MAKELIST(TIUCLASS,TIUCHVW) ; Get Search Criteria
6 N DIRUT,DTOUT,DUOUT,TIUI,SCREEN,STATUS,TIUTYP,TIUSTAT,TIUEDFLT,TIUDCL
7 N TIUDPRMT,TIUPICT,TIUOUT,STATWORD,STATIFN,NOWFLAG
8 K DIROUT
9 D INITRR^TIULRR(0)
10 ; TIURPN used in Order Entry 2.5, OR OE/RR MENU CLIN:
11 I +$G(ORVP),(+$G(TIUCHVW)'>0) D EN^TIURPN(TIUCLASS,+ORVP) Q
12STATUS S STATUS=$$STAT
13 I +STATUS<0 S VALMQUIT=1 Q
14 S TIUI=0
15 F S TIUI=$O(TIUSTAT(TIUI)) Q:'TIUI!(+$G(TIUOUT)) D
16 . I $P($G(TIUSTAT(TIUI)),U,3)="" S TIUOUT=1 Q
17 . S STATIFN=$O(^TIU(8925.6,"B",$$UPPER^TIULS($P(TIUSTAT(TIUI),U,3)),0))
18 . Q:'STATIFN
19 . S STATUS("IFNS")=$G(STATUS("IFNS"))_STATIFN_";"
20 I +$G(TIUOUT) S VALMQUIT=1 Q
21 S TIUI=1,STATWORD=$$UPPER^TIULS($P(TIUSTAT(1),U,3))
22 I +$G(TIUSTAT(4))'>0 F S TIUI=$O(TIUSTAT(TIUI)) Q:+TIUI'>0 D
23 . S STATWORD=STATWORD_$S(TIUI=+TIUSTAT(1):" & ",1:", ")_$$UPPER^TIULS($P(TIUSTAT(TIUI),U,3))
24 I +$G(TIUSTAT(4))>0 S STATWORD=$S($P(TIUSTAT(4),U,4)="ALL":"ALL",1:STATWORD_", OTHER")
25 S STATUS("WORDS")=STATWORD
26DOCTYPE ; Select Document Type(s)
27 N TIUDCL K TIUPICT
28 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)
29 ; SELTYP sets array ^TMP("TIUTYP",$J);
30 ; SELTYP used to set data into TIUTYP array
31 ; Now TIUTYP just ="^TMP("TIUTYP",$J)"
32 I $S($D(TIUQUIK):1,($D(ORVP)&'+$G(TIUCHVW)):1,1:0) D SELTYP^TIULA(TIUCLASS,.TIUTYP,"F","ALL","DOC",0)
33 I +$G(DIROUT) S VALMQUIT=1 Q
34 I +$G(@TIUTYP)'>0,'$D(TIUQUIK) G STATUS
35SCREEN ;
36 N TIUNAME
37 S TIUNAME=$$GET1^DIQ(200,+DUZ,.01)
38 I $D(TIUQUIK) D I 1 ; all my unsigned TIUQUIK=1
39 . I $G(TIUQUIK)=3 S SCREEN(1)="ALL^ANY" Q
40 . S SCREEN(1)="AAU^"_DUZ_U_TIUNAME
41 . S:$G(TIUQUIK)=1 SCREEN(2)="ASUP^"_DUZ
42 . S SCREEN="ALL"
43 E D SELCAT^TIULA1(.SCREEN,"A","AUTHOR")
44 I +$G(DIROUT) S VALMQUIT=1 Q
45 I $D(SCREEN)'>9 K @TIUTYP G DOCTYPE
46 I $D(@TIUTYP)'>9 W !,$C(7),"You must select one or more TITLES..." G SCREEN
47 D CHECKADD
48ERLY S TIUEDFLT=$S(TIUCLASS=3:"T-2",TIUCLASS=244:"T-30",1:"T-7")
49 S TIUDPRMT=$S(TIUCLASS=244:"Discharge",1:"Reference")
50 S TIUEDT=1
51 I +$G(DIROUT) S VALMQUIT=1 Q
52 I TIUEDT'>0 G SCREEN
53 S TIULDT=$S($D(TIUQUIK):9999999,$D(ORVP)&(+$G(TIUCHVW)'>0):+$$NOW^XLFDT,1:$P($$LDATE^TIULA(TIUDPRMT),U))
54 I +$G(DIROUT) S VALMQUIT=1 Q
55 I TIULDT'>0 G ERLY
56 I TIUEDT>TIULDT D SWAP(.TIUEDT,.TIULDT)
57 I $L(TIULDT,".")=1 D EXPRANGE(.TIUEDT,.TIULDT)
58 ; -- Reset late date to NOW on rebuild:
59 S NOWFLAG=$S(TIULDT-$$NOW^XLFDT<.0001:1,1:0)
60 I '$G(TIURBLD) W !,"Searching for the documents."
61 D BUILD(TIUCLASS,.STATUS,.SCREEN,TIUEDT,TIULDT,NOWFLAG) ;11/30/00 removed param TIUTYP since BUILD uses global now.
62 ; -- If attaching ID note & changed view,
63 ; update video for line to be attached: --
64 I $G(TIUGLINK) D RESTOREG^TIULM(.TIUGLINK)
65 ;K @TIUTYP ;11/30/00 keep ^TMP("TIUTYP",$J) for rebuild
66 Q
67STAT() ; Determine status
68 N TIUY
69 I +$G(TIUQUIK) D G STATX
70 . S TIUY=$$SELSTAT^TIULA(.TIUSTAT,"F",$S(TIUQUIK=1:"UNSIGNED,UNCOSIGNED",TIUQUIK>1:"UNDICTATED,UNTRANSCRIBED"))
71 I $D(ORVP),'+$G(TIUCHVW) D G STATX
72 . S TIUY=$$SELSTAT^TIULA(.TIUSTAT,"F","COMPLETED")
73 S TIUY=$$SELSTAT^TIULA(.TIUSTAT,"A",$$DFLTSTAT^TIURM(DUZ))
74STATX Q TIUY
75CHECKADD ; Checks whether Addendum is included in the list of types
76 N TIUI,HIT,NUMTYPS
77 S (TIUI,HIT)=0
78 F S TIUI=$O(^TMP("TIUTYP",$J,TIUI)) Q:+TIUI'>0!+HIT I $$UP^XLFSTR(^TMP("TIUTYP",$J,TIUI))["ADDENDUM" S HIT=1
79 S NUMTYPS=^TMP("TIUTYP",$J)
80 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
81 Q
82 ;
83SWAP(TIUX,TIUY) ; Swap variables
84 N TIUTMP S TIUTMP=TIUX,TIUX=TIUY,TIUY=TIUTMP
85 Q
86EXPRANGE(TIUX,TIUY) ; Expand late date to include time
87 ;P74 If user entered date/time = T, then numerical date time is FIRST ^ PIECE ONLY of TIUX & TIUY.
88 I $P(TIUY,U)=DT S TIUY=$$NOW^XLFDT I 1
89 E S TIUY=$P(TIUY,U)_"."_235959 ;P74 Add seconds
90 Q
91BUILD(TIUCLASS,STATUS,SCREEN,EARLY,LATE,NOWFLAG) ; Build List.
92 ;11/30/00 - removed param TYPES. 12/3 added param TIUCLASS
93 ; BUILD (GATHER) uses docmt type info from ^TMP("TIUTYP",$J)
94 N TIUDT,TIUI,TIUK
95 N TIUT,TIUTP,XREF,TIUS,TIUPREF
96 S TIUPREF=$$PERSPRF^TIULE(DUZ),(TIUK,VALMCNT)=0
97 K ^TMP("TIUR",$J),^TMP("TIURIDX",$J),^TMP("TIUI",$J)
98 ; If user entered NOW at first build, update NOW for rebuild;
99 ; Save data in ^TMP("TIURIDX",$J,0) for rebuild:
100 I $G(TIURBLD),$G(NOWFLAG) S LATE=$$NOW^XLFDT
101 S ^TMP("TIURIDX",$J,0)=+EARLY_U_+LATE_U_$G(STATUS("IFNS"))_U_NOWFLAG
102 S ^TMP("TIUR",$J,"RTN")="TIUR3"
103 I '$D(TIUPRM0) D SETPARM^TIULE
104 S EARLY=9999999-+$G(EARLY),LATE=9999999-$S(+$G(LATE):+$G(LATE),1:3333333)
105 D GATHER^TIUR4(TIUCLASS,TIUPREF)
106 D PUTLIST^TIUR2(TIUPREF,TIUCLASS,.STATUS,.SCREEN)
107 K ^TMP("TIUI",$J)
108 Q
109 ;
110CLEAN ; Clean up your mess!
111 K ^TMP("TIUR",$J),^TMP("TIURIDX",$J) D CLEAN^VALM10,KILLRR^TIULRR
112 K VALMY
113 K ^TMP("TIUTYP",$J)
114 Q
115 ;
116RBLD ; Rebuild list after actions 11/30/00
117 N TIUEXP,TIUR0,TIURIDX0,TIUSCRN,TMP,TIUEDT,TIULDT,TIUSTAT
118 N TIURBLD,TIUI,TIUCLASS,NOWFLAG
119 S TIURBLD=1
120 D FIXLSTNW^TIULM ;restore video for elements added to end of list
121 I +$O(^TMP("TIUR",$J,"EXPAND",0)) D
122 . M TIUEXP=^TMP("TIUR",$J,"EXPAND")
123 S TIUR0=^TMP("TIUR",$J,0),TIURIDX0=^TMP("TIURIDX",$J,0)
124 S TIUSCRN="ALL",TIUCLASS=^TMP("TIUR",$J,"CLASS")
125 S STATUS("WORDS")=$P(TIUR0,U,2)
126 S STATUS("IFNS")=$P(TIURIDX0,U,3)
127 S TIUEDT=$P(TIURIDX0,U),TIULDT=$P(TIURIDX0,U,2),NOWFLAG=+$P(TIURIDX0,U,4)
128 K VALMHDR
129 D BUILD(TIUCLASS,.STATUS,.TIUSCRN,TIUEDT,TIULDT,NOWFLAG)
130 ; Reexpand previously expanded items:
131 D RELOAD^TIUROR1(.TIUEXP)
132 D BREATHE^TIUROR1(1)
133 Q
Note: See TracBrowser for help on using the repository browser.