source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIURPTTL.m@ 1763

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

initial load of WorldVistAEHR

File size: 4.4 KB
Line 
1TIURPTTL ; SLC/JER - Review Documents by PATIENT & TITLE ;2/26/01
2 ;;1.0;TEXT INTEGRATION UTILITIES;**100**;Jun 20, 1997
3 ; 12/5/00 split rtn w GATHER, PUTLIST, ADDELMNT to new rtn TIURPTT1
4 ;
5MAKELIST(TIUCLASS) ; Get Search Criteria
6 N DFN,TIUI,SCREEN,STATUS,TIUTYP,TIUSTAT,TIUEDFLT,TIUDCL,TIUQUIT
7 N STATWORD,STATIFN,NOWFLAG
8STATUS S STATUS=$$SELSTAT^TIULA(.TIUSTAT,"F","ALL")
9 I +STATUS<0 S VALMQUIT=1 Q
10 S TIUI=0
11 F S TIUI=$O(TIUSTAT(TIUI)) Q:'TIUI D
12 . S STATIFN=$O(^TIU(8925.6,"B",$$UPPER^TIULS($P(TIUSTAT(TIUI),U,3)),0))
13 . Q:'STATIFN
14 . S STATUS("IFNS")=$G(STATUS("IFNS"))_STATIFN_";"
15 S TIUI=1,STATWORD=$$UPPER^TIULS($P(TIUSTAT(1),U,3))
16 I +$G(TIUSTAT(4))'>0 F S TIUI=$O(TIUSTAT(TIUI)) Q:+TIUI'>0 D
17 . S STATWORD=STATWORD_$S(TIUI=+TIUSTAT(1):" & ",1:", ")_$$UPPER^TIULS($P(TIUSTAT(TIUI),U,3))
18 I +$G(TIUSTAT(4))>0 S STATWORD=$S($P(TIUSTAT(4),U,4)="ALL":"ALL",1:STATWORD_", OTHER")
19 S STATUS("WORDS")=STATWORD
20PATIENT ; Select Patient
21 S DFN=$S(+$G(ORVP):+$G(ORVP),1:+$$PATIENT^TIULA)
22 I +DFN'>0 S VALMQUIT=1 Q
23DOCTYPE ; Select Document Type(s)
24 N TIUDCL
25 D TITLPICK^TIULA3(.TIUTYP,TIUCLASS)
26 I +$D(TIUQUIT) S VALMQUIT=1 Q
27 I +$G(TIUTYP)'>0,'$D(TIUQUIK) G STATUS
28SCREEN ;
29 N TIUNAME
30 S TIUNAME=$P($G(^VA(200,+DUZ,0)),U)
31 S SCREEN=1,SCREEN(1)="APT^"_DFN
32 D CHECKADD(.TIUTYP)
33ERLY S TIUEDFLT=$S(TIUCLASS=3:"T-2",TIUCLASS=244:"T-30",1:"T-7")
34 S TIUEDT=$S($D(TIUQUIK):1,1:$P($$EDATE^TIULA("Reference","",TIUEDFLT),U))
35 I +$G(DIROUT) S VALMQUIT=1 Q
36 I TIUEDT'>0 G SCREEN
37 S TIULDT=$S($D(TIUQUIK):9999999,1:$P($$LDATE^TIULA("Reference"),U))
38 I +$G(DIROUT) S VALMQUIT=1 Q
39 I TIULDT'>0 G ERLY
40 I TIUEDT>TIULDT D SWAP^TIUR(.TIUEDT,.TIULDT)
41 I $L(TIULDT,".")=1 D EXPRANGE^TIUR(.TIUEDT,.TIULDT)
42 ; -- Reset late date to NOW on rebuild:
43 S NOWFLAG=$S(TIULDT-$$NOW^XLFDT<.0001:1,1:0)
44 I '$G(TIURBLD) W !,"Searching for the documents."
45 D BUILD(TIUCLASS,.STATUS,.TIUTYP,.SCREEN,TIUEDT,TIULDT,NOWFLAG)
46 ; -- If changed view while attaching ID note, update video for note: --
47 I $G(TIUGLINK) D RESTOREG^TIULM(.TIUGLINK)
48 Q
49CHECKADD(TYPES) ; Checks whether Addendum is included in the list of types
50 N TIUI,HIT S (TIUI,HIT)=0
51 F S TIUI=$O(TYPES(TIUI)) Q:+TIUI'>0!+HIT I $$UP^XLFSTR(TYPES(TIUI))["ADDENDUM" S HIT=1
52 I +HIT'>0 S TYPES(TYPES+1)=+TYPES(TYPES)+1_U_"81^Addendum^NOT PICKED",TYPES=TYPES+1
53 Q
54BUILD(TIUCLASS,STATUS,TYPES,SCREEN,EARLY,LATE,NOWFLAG) ; Build List
55 N TIUCNT,TIUDT,TIUI,TIUJ,TIUK,TIUQ,TIUIFN,TIUREC
56 N XREF,TIUS,TIUPREF
57 S TIUPREF=$$PERSPRF^TIULE(DUZ),(TIUK,VALMCNT)=0
58 K ^TMP("TIUR",$J),^TMP("TIURIDX",$J),^TMP("TIUI",$J),^TMP("TIUTYP",$J)
59 ; If user entered NOW at first build, update NOW for rebuild;
60 ; Save data in ^TMP("TIURIDX",$J,0) for rebuild:
61 I $G(TIURBLD),$G(NOWFLAG) S LATE=$$NOW^XLFDT
62 S ^TMP("TIURIDX",$J,0)=+EARLY_U_+LATE_U_$G(STATUS("IFNS"))_U_NOWFLAG
63 ; Save docmt types in ^TMP("TIUTYP",$J) for rebuild:
64 M ^TMP("TIUTYP",$J)=TYPES
65 S ^TMP("TIUR",$J,"RTN")="TIURPTTL"
66 I '$D(TIUPRM0)!'$D(TIUPRM0) D SETPARM^TIULE
67 S EARLY=9999999-+$G(EARLY),LATE=9999999-$S(+$G(LATE):+$G(LATE),1:3333333)
68 F S TIUK=$O(SCREEN(TIUK)) Q:TIUK'>0 D
69 . S XREF=$P(SCREEN(TIUK),U)
70 . I XREF'="ASUB" D
71 . . S TIUI=$S(XREF'="APRB":$P(SCREEN(TIUK),U,2),1:$$UPPER^TIULS($P(SCREEN(TIUK),U,3)))
72 . . D GATHER^TIURPTT1(TIUI,TIUPREF,TIUCLASS,STATUS("IFNS"),EARLY,LATE,XREF)
73 . I XREF="ASUB" D
74 . . S TIUI=$O(^TIU(8925,XREF,$P(SCREEN(TIUK),U,2)),-1)
75 . . F S TIUI=$O(^TIU(8925,XREF,TIUI)) Q:TIUI=""!(TIUI'[$P(SCREEN(TIUK),U,2)) D GATHER^TIURPTT1(TIUI,TIUPREF,TIUCLASS,STATUS("IFNS"),EARLY,LATE,XREF)
76 D PUTLIST^TIURPTT1(TIUPREF,TIUCLASS,.STATUS,.SCREEN)
77 Q
78CLEAN ; Clean up your mess!
79 K ^TMP("TIUR",$J),^TMP("TIURIDX",$J) D CLEAN^VALM10
80 K VALMY,^TMP("TIUTYP",$J)
81 Q
82 ;
83RBLD ; Rebuild list after actions 11/30/00
84 N TIUEXP,TIUR0,TIURIDX0,TIUSCRN,TMP,TIUEDT,TIULDT,TIUSTAT
85 N TIURBLD,TIUI,TIUCLASS,TIUTYP,NOWFLAG
86 S TIURBLD=1
87 D FIXLSTNW^TIULM ;restore video for elements added to end of list
88 I +$O(^TMP("TIUR",$J,"EXPAND",0)) D
89 . M TIUEXP=^TMP("TIUR",$J,"EXPAND")
90 M TIUTYP=^TMP("TIUTYP",$J)
91 S TIUR0=^TMP("TIUR",$J,0),TIURIDX0=^TMP("TIURIDX",$J,0)
92 S TIUSCRN=$P(TIUR0,U,3,99),TIUCLASS=^TMP("TIUR",$J,"CLASS")
93 S TIUI=1
94 F S TMP=$P(TIUSCRN,";",TIUI) Q:TMP="" D
95 . S TIUSCRN(TIUI)=TMP,TIUI=TIUI+1
96 S TIUSCRN=$L(TIUSCRN,";")
97 S STATUS("WORDS")=$P(TIUR0,U,2)
98 S STATUS("IFNS")=$P(TIURIDX0,U,3)
99 S TIUEDT=$P(TIURIDX0,U),TIULDT=$P(TIURIDX0,U,2),NOWFLAG=+$P(TIURIDX0,U,4)
100 D BUILD(TIUCLASS,.STATUS,.TIUTYP,.TIUSCRN,TIUEDT,TIULDT,NOWFLAG)
101 ; Reexpand previously expanded items:
102 D RELOAD^TIUROR1(.TIUEXP)
103 D BREATHE^TIUROR1(1)
104 Q
Note: See TracBrowser for help on using the repository browser.