- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUR.m
r613 r623 1 TIUR ; SLC/JER - Integrated Document Review ;11/01/03 2 ;;1.0;TEXT INTEGRATION UTILITIES;**74,79,58,100,113,112,207,224**;Jun 20, 1997;Build 7 3 ; 11/30/00 Moved PUTLIST & ADDELMNT to TIUR1 4 MAKELIST(TIUCLASS,TIUCHVW) ; Get Search Criteria 5 N DIRUT,DTOUT,DUOUT,TIUI,SCREEN,STATUS,TIUTYP,TIUSTAT,TIUEDFLT,TIUDCL 6 N TIUDPRMT,TIUPICT,TIUOUT,STATWORD,STATIFN,NOWFLAG,TIUSC207,TIU1DOC 7 K DIROUT 8 D INITRR^TIULRR(0) 9 ; TIURPN used in Order Entry 2.5, OR OE/RR MENU CLIN: 10 I +$G(ORVP),(+$G(TIUCHVW)'>0) D EN^TIURPN(TIUCLASS,+ORVP) Q 11 STATUS S STATUS=$$STAT 12 ;VMP/ELR changed status ck from <0 TO <1 to account for entering an * p224 13 I +STATUS<1 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 26 DOCTYPE ; Select Document Type(s) 27 ; TIU207-If only 1 docytyp and have been to screen prompt then go back another level to avoid loop with next prompt. 28 I $G(TIUSC207)=1,$G(TIU1DOC)=1 D G STATUS 29 .S (TIUSC207,TIU1DOC)=0 30 S (TIUSC207,TIU1DOC)=0 31 N TIUDCL K TIUPICT 32 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) 33 S TIU1DOC=+$P($G(^TIU(8925.1,+TIUCLASS,10,0)),U,3) 34 ; SELTYP sets array ^TMP("TIUTYP",$J); 35 ; SELTYP used to set data into TIUTYP array 36 ; Now TIUTYP just ="^TMP("TIUTYP",$J)" 37 I $S($D(TIUQUIK):1,($D(ORVP)&'+$G(TIUCHVW)):1,1:0) D SELTYP^TIULA(TIUCLASS,.TIUTYP,"F","ALL","DOC",0) 38 I +$G(DIROUT) S VALMQUIT=1 Q 39 I +$G(@TIUTYP)'>0,'$D(TIUQUIK) G STATUS 40 SCREEN ; 41 S TIUSC207=1 42 N TIUNAME,TIUOVER 43 S TIUNAME=$P($G(^VA(200,+DUZ,0)),U) 44 I $D(TIUQUIK) D I 1 ; all my unsigned TIUQUIK=1 45 . I $G(TIUQUIK)=3 S SCREEN(1)="ALL^ANY" Q 46 . S SCREEN(1)="AAU^"_DUZ_U_TIUNAME 47 . S:$G(TIUQUIK)=1 SCREEN(2)="ASUP^"_DUZ 48 . S SCREEN="ALL" 49 E I $D(ORVP),'+$G(TIUCHVW) S SCREEN(1)="APT^"_+ORVP_U_$P($G(^DPT(+ORVP,0)),U) I 1 50 S TIUOVER="" 51 E D SELCAT^TIULA1(.SCREEN,"A","AUTHOR",.TIUOVER) 52 I +$G(DIROUT) S VALMQUIT=1 Q 53 I $D(SCREEN)'>9 K @TIUTYP G DOCTYPE 54 I $D(@TIUTYP)'>9 W !,$C(7),"You must select one or more TITLES..." G SCREEN 55 I $G(SCREEN(1))="ALL^ANY",+$G(ORVP) S SCREEN(1)="APT^"_+$G(ORVP)_U_$P($G(^DPT(+$G(ORVP),0)),U) 56 D CHECKADD 57 ERLY S TIUEDFLT=$S(TIUCLASS=3:"T-2",TIUCLASS=244:"T-30",1:"T-7") 58 S TIUDPRMT=$S(TIUCLASS=244:"Discharge",1:"Reference") 59 S TIUEDT=$S($D(TIUQUIK):1,$D(ORVP)&(+$G(TIUCHVW)'>0):$$FMADD^XLFDT(DT,$S($D(^DPT(+$G(ORVP),.1))'>0:-180,1:-30)),1:$P($$EDATE^TIULA(TIUDPRMT,"",TIUEDFLT),U)) 60 I +$G(DIROUT) S VALMQUIT=1 Q 61 I TIUEDT'>0 G SCREEN 62 S TIULDT=$S($D(TIUQUIK):9999999,$D(ORVP)&(+$G(TIUCHVW)'>0):+$$NOW^XLFDT,1:$P($$LDATE^TIULA(TIUDPRMT),U)) 63 I +$G(DIROUT) S VALMQUIT=1 Q 64 I TIULDT'>0 G ERLY 65 I TIUEDT>TIULDT D SWAP(.TIUEDT,.TIULDT) 66 I $L(TIULDT,".")=1 D EXPRANGE(.TIUEDT,.TIULDT) 67 ; -- Reset late date to NOW on rebuild: 68 S NOWFLAG=$S(TIULDT-$$NOW^XLFDT<.0001:1,1:0) 69 I '$G(TIURBLD) W !,"Searching for the documents." 70 D BUILD(TIUCLASS,.STATUS,.SCREEN,TIUEDT,TIULDT,NOWFLAG) ;11/30/00 removed param TIUTYP since BUILD uses global now. 71 ; -- If attaching ID note & changed view, 72 ; update video for line to be attached: -- 73 I $G(TIUGLINK) D RESTOREG^TIULM(.TIUGLINK) 74 ;K @TIUTYP ;11/30/00 keep ^TMP("TIUTYP",$J) for rebuild 75 Q 76 STAT() ; Determine status 77 N TIUY 78 I +$G(TIUQUIK) D G STATX 79 . S TIUY=$$SELSTAT^TIULA(.TIUSTAT,"F",$S(TIUQUIK=1:"UNSIGNED,UNCOSIGNED",TIUQUIK>1:"UNDICTATED,UNTRANSCRIBED")) 80 I $D(ORVP),'+$G(TIUCHVW) D G STATX 81 . S TIUY=$$SELSTAT^TIULA(.TIUSTAT,"F","COMPLETED") 82 S TIUY=$$SELSTAT^TIULA(.TIUSTAT,"A",$$DFLTSTAT^TIURM(DUZ)) 83 STATX Q TIUY 84 CHECKADD ; Checks whether Addendum is included in the list of types 85 N TIUI,HIT,NUMTYPS 86 S (TIUI,HIT)=0 87 F S TIUI=$O(^TMP("TIUTYP",$J,TIUI)) Q:+TIUI'>0!+HIT I $$UP^XLFSTR(^TMP("TIUTYP",$J,TIUI))["ADDENDUM" S HIT=1 88 S NUMTYPS=^TMP("TIUTYP",$J) 89 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 90 Q 91 ; 92 SWAP(TIUX,TIUY) ; Swap variables 93 N TIUTMP S TIUTMP=TIUX,TIUX=TIUY,TIUY=TIUTMP 94 Q 95 EXPRANGE(TIUX,TIUY) ; Expand late date to include time 96 ;P74 If user entered date/time = T, then numerical date time is FIRST ^ PIECE ONLY of TIUX & TIUY. 97 I $P(TIUY,U)=DT S TIUY=$$NOW^XLFDT I 1 98 E S TIUY=$P(TIUY,U)_"."_235959 ;P74 Add seconds 99 Q 100 BUILD(TIUCLASS,STATUS,SCREEN,EARLY,LATE,NOWFLAG) ; Build List. 101 ;11/30/00 - removed param TYPES. 12/3 added param TIUCLASS 102 ; BUILD (GATHER) uses docmt type info from ^TMP("TIUTYP",$J) 103 N TIUDT,TIUI,TIUK 104 N TIUT,TIUTP,XREF,TIUS,TIUPREF 105 S TIUPREF=$$PERSPRF^TIULE(DUZ),(TIUK,VALMCNT)=0 106 K ^TMP("TIUR",$J),^TMP("TIURIDX",$J),^TMP("TIUI",$J) 107 ; If user entered NOW at first build, update NOW for rebuild; 108 ; Save data in ^TMP("TIURIDX",$J,0) for rebuild: 109 I $G(TIURBLD),$G(NOWFLAG) S LATE=$$NOW^XLFDT 110 S ^TMP("TIURIDX",$J,0)=+EARLY_U_+LATE_U_$G(STATUS("IFNS"))_U_NOWFLAG 111 S ^TMP("TIUR",$J,"RTN")="TIUR" 112 S ^TMP("TIUR",$J,"TITLE OVERRIDE")=$G(TIUOVER) 113 I '$D(TIUPRM0) D SETPARM^TIULE 114 S EARLY=9999999-+$G(EARLY),LATE=9999999-$S(+$G(LATE):+$G(LATE),1:3333333) 115 F S TIUK=$O(SCREEN(TIUK)) Q:TIUK'>0 D 116 . I $G(SCREEN)'="ALL" S SCREEN=$G(TIUK) 117 . S XREF=$P(SCREEN(TIUK),U) 118 . I XREF'="ASUB" D 119 . . S TIUI=$S(XREF'="APRB":$P(SCREEN(TIUK),U,2),1:$$UPPER^TIULS($P(SCREEN(TIUK),U,3))) 120 . . D GATHER^TIUR1(TIUI,TIUPREF,TIUCLASS,STATUS("IFNS"),EARLY,LATE,XREF,SCREEN) 121 . I XREF="ASUB" D 122 . . S TIUI=$O(^TIU(8925,XREF,$P(SCREEN(TIUK),U,2)),-1) 123 . . F S TIUI=$O(^TIU(8925,XREF,TIUI)) Q:TIUI=""!(TIUI'[$P(SCREEN(TIUK),U,2)) D GATHER^TIUR1(TIUI,TIUPREF,TIUCLASS,STATUS("IFNS"),EARLY,LATE,XREF,SCREEN) 124 D PUTLIST^TIUR2(TIUPREF,TIUCLASS,.STATUS,.SCREEN) 125 K ^TMP("TIUI",$J) 126 Q 127 ; 128 CLEAN ; Clean up your mess! 129 K ^TMP("TIUR",$J),^TMP("TIURIDX",$J) D CLEAN^VALM10,KILLRR^TIULRR 130 K VALMY 131 K ^TMP("TIUTYP",$J) 132 Q 133 ; 134 RBLD ; Rebuild list after actions 11/30/00 135 N TIUEXP,TIUR0,TIURIDX0,TIUSCRN,TMP,TIUEDT,TIULDT,TIUSTAT 136 N TIURBLD,TIUI,TIUCLASS,NOWFLAG 137 S TIURBLD=1 138 D FIXLSTNW^TIULM ;restore video for elements added to end of list 139 I +$O(^TMP("TIUR",$J,"EXPAND",0)) D 140 . M TIUEXP=^TMP("TIUR",$J,"EXPAND") 141 S TIUR0=^TMP("TIUR",$J,0),TIURIDX0=^TMP("TIURIDX",$J,0) 142 S TIUSCRN=$P(TIUR0,U,3,99),TIUCLASS=^TMP("TIUR",$J,"CLASS") 143 S TIUI=1 144 F S TMP=$P(TIUSCRN,";",TIUI) Q:TMP="" D 145 . S TIUSCRN(TIUI)=TMP,TIUI=TIUI+1 146 S TIUSCRN=$L(TIUSCRN,";") 147 S STATUS("WORDS")=$P(TIUR0,U,2) 148 S STATUS("IFNS")=$P(TIURIDX0,U,3) 149 S TIUEDT=$P(TIURIDX0,U),TIULDT=$P(TIURIDX0,U,2),NOWFLAG=+$P(TIURIDX0,U,4) 150 ;VMP/ELR ADDED THE FOLLOWING LINE IN PATCH 224 151 S TIUSCRN="ALL" 152 D BUILD(TIUCLASS,.STATUS,.TIUSCRN,TIUEDT,TIULDT,NOWFLAG) 153 ; Reexpand previously expanded items: 154 D RELOAD^TIUROR1(.TIUEXP) 155 D BREATHE^TIUROR1(1) 156 Q 1 TIUR ; SLC/JER - Integrated Document Review ;11/01/03 2 ;;1.0;TEXT INTEGRATION UTILITIES;**74,79,58,100,113,112,207**;Jun 20, 1997 3 ; 11/30/00 Moved PUTLIST & ADDELMNT to TIUR1 4 MAKELIST(TIUCLASS,TIUCHVW) ; Get Search Criteria 5 N DIRUT,DTOUT,DUOUT,TIUI,SCREEN,STATUS,TIUTYP,TIUSTAT,TIUEDFLT,TIUDCL 6 N TIUDPRMT,TIUPICT,TIUOUT,STATWORD,STATIFN,NOWFLAG,TIUSC207,TIU1DOC 7 K DIROUT 8 D INITRR^TIULRR(0) 9 ; TIURPN used in Order Entry 2.5, OR OE/RR MENU CLIN: 10 I +$G(ORVP),(+$G(TIUCHVW)'>0) D EN^TIURPN(TIUCLASS,+ORVP) Q 11 STATUS S STATUS=$$STAT 12 I +STATUS<0 S VALMQUIT=1 Q 13 S TIUI=0 14 F S TIUI=$O(TIUSTAT(TIUI)) Q:'TIUI!(+$G(TIUOUT)) D 15 . I $P($G(TIUSTAT(TIUI)),U,3)="" S TIUOUT=1 Q 16 . S STATIFN=$O(^TIU(8925.6,"B",$$UPPER^TIULS($P(TIUSTAT(TIUI),U,3)),0)) 17 . Q:'STATIFN 18 . S STATUS("IFNS")=$G(STATUS("IFNS"))_STATIFN_";" 19 I +$G(TIUOUT) S VALMQUIT=1 Q 20 S TIUI=1,STATWORD=$$UPPER^TIULS($P(TIUSTAT(1),U,3)) 21 I +$G(TIUSTAT(4))'>0 F S TIUI=$O(TIUSTAT(TIUI)) Q:+TIUI'>0 D 22 . S STATWORD=STATWORD_$S(TIUI=+TIUSTAT(1):" & ",1:", ")_$$UPPER^TIULS($P(TIUSTAT(TIUI),U,3)) 23 I +$G(TIUSTAT(4))>0 S STATWORD=$S($P(TIUSTAT(4),U,4)="ALL":"ALL",1:STATWORD_", OTHER") 24 S STATUS("WORDS")=STATWORD 25 DOCTYPE ; Select Document Type(s) 26 ; TIU207-If only 1 docytyp and have been to screen prompt then go back another level to avoid loop with next prompt. 27 I $G(TIUSC207)=1,$G(TIU1DOC)=1 D G STATUS 28 .S (TIUSC207,TIU1DOC)=0 29 S (TIUSC207,TIU1DOC)=0 30 N TIUDCL K TIUPICT 31 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) 32 S TIU1DOC=+$P($G(^TIU(8925.1,+TIUCLASS,10,0)),U,3) 33 ; SELTYP sets array ^TMP("TIUTYP",$J); 34 ; SELTYP used to set data into TIUTYP array 35 ; Now TIUTYP just ="^TMP("TIUTYP",$J)" 36 I $S($D(TIUQUIK):1,($D(ORVP)&'+$G(TIUCHVW)):1,1:0) D SELTYP^TIULA(TIUCLASS,.TIUTYP,"F","ALL","DOC",0) 37 I +$G(DIROUT) S VALMQUIT=1 Q 38 I +$G(@TIUTYP)'>0,'$D(TIUQUIK) G STATUS 39 SCREEN ; 40 S TIUSC207=1 41 N TIUNAME,TIUOVER 42 S TIUNAME=$P($G(^VA(200,+DUZ,0)),U) 43 I $D(TIUQUIK) D I 1 ; all my unsigned TIUQUIK=1 44 . I $G(TIUQUIK)=3 S SCREEN(1)="ALL^ANY" Q 45 . S SCREEN(1)="AAU^"_DUZ_U_TIUNAME 46 . S:$G(TIUQUIK)=1 SCREEN(2)="ASUP^"_DUZ 47 . S SCREEN="ALL" 48 E I $D(ORVP),'+$G(TIUCHVW) S SCREEN(1)="APT^"_+ORVP_U_$P($G(^DPT(+ORVP,0)),U) I 1 49 S TIUOVER="" 50 E D SELCAT^TIULA1(.SCREEN,"A","AUTHOR",.TIUOVER) 51 I +$G(DIROUT) S VALMQUIT=1 Q 52 I $D(SCREEN)'>9 K @TIUTYP G DOCTYPE 53 I $D(@TIUTYP)'>9 W !,$C(7),"You must select one or more TITLES..." G SCREEN 54 I $G(SCREEN(1))="ALL^ANY",+$G(ORVP) S SCREEN(1)="APT^"_+$G(ORVP)_U_$P($G(^DPT(+$G(ORVP),0)),U) 55 D CHECKADD 56 ERLY S TIUEDFLT=$S(TIUCLASS=3:"T-2",TIUCLASS=244:"T-30",1:"T-7") 57 S TIUDPRMT=$S(TIUCLASS=244:"Discharge",1:"Reference") 58 S TIUEDT=$S($D(TIUQUIK):1,$D(ORVP)&(+$G(TIUCHVW)'>0):$$FMADD^XLFDT(DT,$S($D(^DPT(+$G(ORVP),.1))'>0:-180,1:-30)),1:$P($$EDATE^TIULA(TIUDPRMT,"",TIUEDFLT),U)) 59 I +$G(DIROUT) S VALMQUIT=1 Q 60 I TIUEDT'>0 G SCREEN 61 S TIULDT=$S($D(TIUQUIK):9999999,$D(ORVP)&(+$G(TIUCHVW)'>0):+$$NOW^XLFDT,1:$P($$LDATE^TIULA(TIUDPRMT),U)) 62 I +$G(DIROUT) S VALMQUIT=1 Q 63 I TIULDT'>0 G ERLY 64 I TIUEDT>TIULDT D SWAP(.TIUEDT,.TIULDT) 65 I $L(TIULDT,".")=1 D EXPRANGE(.TIUEDT,.TIULDT) 66 ; -- Reset late date to NOW on rebuild: 67 S NOWFLAG=$S(TIULDT-$$NOW^XLFDT<.0001:1,1:0) 68 I '$G(TIURBLD) W !,"Searching for the documents." 69 D BUILD(TIUCLASS,.STATUS,.SCREEN,TIUEDT,TIULDT,NOWFLAG) ;11/30/00 removed param TIUTYP since BUILD uses global now. 70 ; -- If attaching ID note & changed view, 71 ; update video for line to be attached: -- 72 I $G(TIUGLINK) D RESTOREG^TIULM(.TIUGLINK) 73 ;K @TIUTYP ;11/30/00 keep ^TMP("TIUTYP",$J) for rebuild 74 Q 75 STAT() ; Determine status 76 N TIUY 77 I +$G(TIUQUIK) D G STATX 78 . S TIUY=$$SELSTAT^TIULA(.TIUSTAT,"F",$S(TIUQUIK=1:"UNSIGNED,UNCOSIGNED",TIUQUIK>1:"UNDICTATED,UNTRANSCRIBED")) 79 I $D(ORVP),'+$G(TIUCHVW) D G STATX 80 . S TIUY=$$SELSTAT^TIULA(.TIUSTAT,"F","COMPLETED") 81 S TIUY=$$SELSTAT^TIULA(.TIUSTAT,"A",$$DFLTSTAT^TIURM(DUZ)) 82 STATX Q TIUY 83 CHECKADD ; Checks whether Addendum is included in the list of types 84 N TIUI,HIT,NUMTYPS 85 S (TIUI,HIT)=0 86 F S TIUI=$O(^TMP("TIUTYP",$J,TIUI)) Q:+TIUI'>0!+HIT I $$UP^XLFSTR(^TMP("TIUTYP",$J,TIUI))["ADDENDUM" S HIT=1 87 S NUMTYPS=^TMP("TIUTYP",$J) 88 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 89 Q 90 ; 91 SWAP(TIUX,TIUY) ; Swap variables 92 N TIUTMP S TIUTMP=TIUX,TIUX=TIUY,TIUY=TIUTMP 93 Q 94 EXPRANGE(TIUX,TIUY) ; Expand late date to include time 95 ;P74 If user entered date/time = T, then numerical date time is FIRST ^ PIECE ONLY of TIUX & TIUY. 96 I $P(TIUY,U)=DT S TIUY=$$NOW^XLFDT I 1 97 E S TIUY=$P(TIUY,U)_"."_235959 ;P74 Add seconds 98 Q 99 BUILD(TIUCLASS,STATUS,SCREEN,EARLY,LATE,NOWFLAG) ; Build List. 100 ;11/30/00 - removed param TYPES. 12/3 added param TIUCLASS 101 ; BUILD (GATHER) uses docmt type info from ^TMP("TIUTYP",$J) 102 N TIUDT,TIUI,TIUK 103 N TIUT,TIUTP,XREF,TIUS,TIUPREF 104 S TIUPREF=$$PERSPRF^TIULE(DUZ),(TIUK,VALMCNT)=0 105 K ^TMP("TIUR",$J),^TMP("TIURIDX",$J),^TMP("TIUI",$J) 106 ; If user entered NOW at first build, update NOW for rebuild; 107 ; Save data in ^TMP("TIURIDX",$J,0) for rebuild: 108 I $G(TIURBLD),$G(NOWFLAG) S LATE=$$NOW^XLFDT 109 S ^TMP("TIURIDX",$J,0)=+EARLY_U_+LATE_U_$G(STATUS("IFNS"))_U_NOWFLAG 110 S ^TMP("TIUR",$J,"RTN")="TIUR" 111 S ^TMP("TIUR",$J,"TITLE OVERRIDE")=$G(TIUOVER) 112 I '$D(TIUPRM0) D SETPARM^TIULE 113 S EARLY=9999999-+$G(EARLY),LATE=9999999-$S(+$G(LATE):+$G(LATE),1:3333333) 114 F S TIUK=$O(SCREEN(TIUK)) Q:TIUK'>0 D 115 . I $G(SCREEN)'="ALL" S SCREEN=$G(TIUK) 116 . S XREF=$P(SCREEN(TIUK),U) 117 . I XREF'="ASUB" D 118 . . S TIUI=$S(XREF'="APRB":$P(SCREEN(TIUK),U,2),1:$$UPPER^TIULS($P(SCREEN(TIUK),U,3))) 119 . . D GATHER^TIUR1(TIUI,TIUPREF,TIUCLASS,STATUS("IFNS"),EARLY,LATE,XREF,SCREEN) 120 . I XREF="ASUB" D 121 . . S TIUI=$O(^TIU(8925,XREF,$P(SCREEN(TIUK),U,2)),-1) 122 . . F S TIUI=$O(^TIU(8925,XREF,TIUI)) Q:TIUI=""!(TIUI'[$P(SCREEN(TIUK),U,2)) D GATHER^TIUR1(TIUI,TIUPREF,TIUCLASS,STATUS("IFNS"),EARLY,LATE,XREF,SCREEN) 123 D PUTLIST^TIUR2(TIUPREF,TIUCLASS,.STATUS,.SCREEN) 124 K ^TMP("TIUI",$J) 125 Q 126 ; 127 CLEAN ; Clean up your mess! 128 K ^TMP("TIUR",$J),^TMP("TIURIDX",$J) D CLEAN^VALM10,KILLRR^TIULRR 129 K VALMY 130 K ^TMP("TIUTYP",$J) 131 Q 132 ; 133 RBLD ; Rebuild list after actions 11/30/00 134 N TIUEXP,TIUR0,TIURIDX0,TIUSCRN,TMP,TIUEDT,TIULDT,TIUSTAT 135 N TIURBLD,TIUI,TIUCLASS,NOWFLAG 136 S TIURBLD=1 137 D FIXLSTNW^TIULM ;restore video for elements added to end of list 138 I +$O(^TMP("TIUR",$J,"EXPAND",0)) D 139 . M TIUEXP=^TMP("TIUR",$J,"EXPAND") 140 S TIUR0=^TMP("TIUR",$J,0),TIURIDX0=^TMP("TIURIDX",$J,0) 141 S TIUSCRN=$P(TIUR0,U,3,99),TIUCLASS=^TMP("TIUR",$J,"CLASS") 142 S TIUI=1 143 F S TMP=$P(TIUSCRN,";",TIUI) Q:TMP="" D 144 . S TIUSCRN(TIUI)=TMP,TIUI=TIUI+1 145 S TIUSCRN=$L(TIUSCRN,";") 146 S STATUS("WORDS")=$P(TIUR0,U,2) 147 S STATUS("IFNS")=$P(TIURIDX0,U,3) 148 S TIUEDT=$P(TIURIDX0,U),TIULDT=$P(TIURIDX0,U,2),NOWFLAG=+$P(TIURIDX0,U,4) 149 D BUILD(TIUCLASS,.STATUS,.TIUSCRN,TIUEDT,TIULDT,NOWFLAG) 150 ; Reexpand previously expanded items: 151 D RELOAD^TIUROR1(.TIUEXP) 152 D BREATHE^TIUROR1(1) 153 Q
Note:
See TracChangeset
for help on using the changeset viewer.
