- TIUR ; SLC/JER - Integrated Document Review ;11/01/03
- ;;1.0;TEXT INTEGRATION UTILITIES;**74,79,58,100,113,112,207,224,272,282,286**;Jun 20, 1997;Build 10
- ;;Per VA Directive 6402, this routine should not be modified
- ; 11/30/00 Moved PUTLIST & ADDELMNT to TIUR1
- MAKELIST(TIUCLASS,TIUCHVW) ; Get Search Criteria
- N DIRUT,DTOUT,DUOUT,TIUI,SCREEN,STATUS,TIUTYP,TIUSTAT,TIUEDFLT,TIUDCL
- N TIUDPRMT,TIUPICT,TIUOUT,STATWORD,STATIFN,NOWFLAG,TIUSC207,TIU1DOC
- 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 ;
- ; Kill status to clear out the variable when "^" is used to backup
- K STATUS S STATUS=$$STAT
- ;VMP/ELR changed status ck from <0 TO <1 to account for entering an * p224
- I +STATUS<1 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)
- ; TIU207-If only 1 docytyp and have been to screen prompt then go back another level to avoid loop with next prompt.
- I $G(TIUSC207)=1,$G(TIU1DOC)=1 D G STATUS
- .S (TIUSC207,TIU1DOC)=0
- S (TIUSC207,TIU1DOC)=0
- 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)
- S TIU1DOC=+$P($G(^TIU(8925.1,+TIUCLASS,10,0)),U,3)
- ; 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 ;
- S TIUSC207=1
- N TIUNAME,TIUOVER
- S TIUNAME=$P($G(^VA(200,+DUZ,0)),U)
- 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 I $D(ORVP),'+$G(TIUCHVW) S SCREEN(1)="APT^"_+ORVP_U_$P($G(^DPT(+ORVP,0)),U) I 1
- S TIUOVER=""
- E D SELCAT^TIULA1(.SCREEN,"A","AUTHOR",.TIUOVER)
- 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
- I $G(SCREEN(1))="ALL^ANY",+$G(ORVP) S SCREEN(1)="APT^"_+$G(ORVP)_U_$P($G(^DPT(+$G(ORVP),0)),U)
- 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=$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))
- 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:
- ; TIU*1.0*286 djh
- S NOWFLAG=$$FMDIFF^XLFDT($$NOW^XLFDT,TIULDT,2)<60
- 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")="TIUR"
- S ^TMP("TIUR",$J,"TITLE OVERRIDE")=$G(TIUOVER)
- I '$D(TIUPRM0) D SETPARM^TIULE
- S EARLY=9999999-+$G(EARLY),LATE=9999999-$S(+$G(LATE):+$G(LATE),1:3333333)
- F S TIUK=$O(SCREEN(TIUK)) Q:TIUK'>0 D
- . I $G(SCREEN)'="ALL" S SCREEN=$G(TIUK)
- . S XREF=$P(SCREEN(TIUK),U)
- . I XREF'="ASUB" D
- . . S TIUI=$S(XREF'="APRB":$P(SCREEN(TIUK),U,2),1:$$UPPER^TIULS($P(SCREEN(TIUK),U,3)))
- . . D GATHER^TIUR1(TIUI,TIUPREF,TIUCLASS,STATUS("IFNS"),EARLY,LATE,XREF,SCREEN)
- . ;*282 - Search by multiple terms
- . I XREF="ASUB" D
- . . N TIUSUBJ
- . . S TIUSUBJ=$S($P(SCREEN(TIUK),U,2)[" ":$P($P(SCREEN(TIUK),U,2)," "),1:$P(SCREEN(TIUK),U,2))
- . . S TIUI=$O(^TIU(8925,XREF,TIUSUBJ),-1)
- . . F S TIUI=$O(^TIU(8925,XREF,TIUI)) Q:TIUI=""!(TIUI'[TIUSUBJ) D GATHER^TIUR1(TIUI,TIUPREF,TIUCLASS,STATUS("IFNS"),EARLY,LATE,XREF,SCREEN)
- . . I $P(SCREEN(TIUK),U,2)[" " D
- . . . N TIUIEN,TIUX,TIUY
- . . . S TIUX=0 F S TIUX=$O(^TMP("TIUI",$J,TIUX)) Q:TIUX="" D
- . . . . S TIUY=0 F S TIUY=$O(^TMP("TIUI",$J,TIUX,TIUY)) Q:TIUY="" D
- . . . . . S TIUIEN=0 F S TIUIEN=$O(^TMP("TIUI",$J,TIUX,TIUY,TIUIEN)) Q:TIUIEN="" I $$UP^XLFSTR(^TIU(8925,TIUIEN,17))'[($P(SCREEN(TIUK),U,2)) K ^TMP("TIUI",$J,TIUX,TIUY,TIUIEN)
- 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=$P(TIUR0,U,3,99),TIUCLASS=^TMP("TIUR",$J,"CLASS")
- S TIUI=1
- F S TMP=$P(TIUSCRN,";",TIUI) Q:TMP="" D
- . S TIUSCRN(TIUI)=TMP,TIUI=TIUI+1
- S TIUSCRN=$L(TIUSCRN,";")
- 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)
- ;VMP/ELR ADDED THE FOLLOWING LINE IN PATCH 224
- S TIUSCRN="ALL"
- 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[HTIUR 7966 printed Jan 18, 2025@03:46:02 Page 2
- TIUR ; SLC/JER - Integrated Document Review ;11/01/03
- +1 ;;1.0;TEXT INTEGRATION UTILITIES;**74,79,58,100,113,112,207,224,272,282,286**;Jun 20, 1997;Build 10
- +2 ;;Per VA Directive 6402, this routine should not be modified
- +3 ; 11/30/00 Moved PUTLIST & ADDELMNT to TIUR1
- 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,TIUSC207,TIU1DOC
- +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 ;
- +1 ; Kill status to clear out the variable when "^" is used to backup
- +2 KILL STATUS
- SET STATUS=$$STAT
- +3 ;VMP/ELR changed status ck from <0 TO <1 to account for entering an * p224
- +4 IF +STATUS<1
- SET VALMQUIT=1
- QUIT
- +5 SET TIUI=0
- +6 FOR
- SET TIUI=$ORDER(TIUSTAT(TIUI))
- if 'TIUI!(+$GET(TIUOUT))
- QUIT
- Begin DoDot:1
- +7 IF $PIECE($GET(TIUSTAT(TIUI)),U,3)=""
- SET TIUOUT=1
- QUIT
- +8 SET STATIFN=$ORDER(^TIU(8925.6,"B",$$UPPER^TIULS($PIECE(TIUSTAT(TIUI),U,3)),0))
- +9 if 'STATIFN
- QUIT
- +10 SET STATUS("IFNS")=$GET(STATUS("IFNS"))_STATIFN_";"
- End DoDot:1
- +11 IF +$GET(TIUOUT)
- SET VALMQUIT=1
- QUIT
- +12 SET TIUI=1
- SET STATWORD=$$UPPER^TIULS($PIECE(TIUSTAT(1),U,3))
- +13 IF +$GET(TIUSTAT(4))'>0
- FOR
- SET TIUI=$ORDER(TIUSTAT(TIUI))
- if +TIUI'>0
- QUIT
- Begin DoDot:1
- +14 SET STATWORD=STATWORD_$SELECT(TIUI=+TIUSTAT(1):" & ",1:", ")_$$UPPER^TIULS($PIECE(TIUSTAT(TIUI),U,3))
- End DoDot:1
- +15 IF +$GET(TIUSTAT(4))>0
- SET STATWORD=$SELECT($PIECE(TIUSTAT(4),U,4)="ALL":"ALL",1:STATWORD_", OTHER")
- +16 SET STATUS("WORDS")=STATWORD
- DOCTYPE ; Select Document Type(s)
- +1 ; TIU207-If only 1 docytyp and have been to screen prompt then go back another level to avoid loop with next prompt.
- +2 IF $GET(TIUSC207)=1
- IF $GET(TIU1DOC)=1
- Begin DoDot:1
- +3 SET (TIUSC207,TIU1DOC)=0
- End DoDot:1
- GOTO STATUS
- +4 SET (TIUSC207,TIU1DOC)=0
- +5 NEW TIUDCL
- KILL TIUPICT
- +6 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)
- +7 SET TIU1DOC=+$PIECE($GET(^TIU(8925.1,+TIUCLASS,10,0)),U,3)
- +8 ; SELTYP sets array ^TMP("TIUTYP",$J);
- +9 ; SELTYP used to set data into TIUTYP array
- +10 ; Now TIUTYP just ="^TMP("TIUTYP",$J)"
- +11 IF $SELECT($DATA(TIUQUIK):1,($DATA(ORVP)&'+$GET(TIUCHVW)):1,1:0)
- DO SELTYP^TIULA(TIUCLASS,.TIUTYP,"F","ALL","DOC",0)
- +12 IF +$GET(DIROUT)
- SET VALMQUIT=1
- QUIT
- +13 IF +$GET(@TIUTYP)'>0
- IF '$DATA(TIUQUIK)
- GOTO STATUS
- SCREEN ;
- +1 SET TIUSC207=1
- +2 NEW TIUNAME,TIUOVER
- +3 SET TIUNAME=$PIECE($GET(^VA(200,+DUZ,0)),U)
- +4 ; all my unsigned TIUQUIK=1
- IF $DATA(TIUQUIK)
- Begin DoDot:1
- +5 IF $GET(TIUQUIK)=3
- SET SCREEN(1)="ALL^ANY"
- QUIT
- +6 SET SCREEN(1)="AAU^"_DUZ_U_TIUNAME
- +7 if $GET(TIUQUIK)=1
- SET SCREEN(2)="ASUP^"_DUZ
- +8 SET SCREEN="ALL"
- End DoDot:1
- IF 1
- +9 IF '$TEST
- IF $DATA(ORVP)
- IF '+$GET(TIUCHVW)
- SET SCREEN(1)="APT^"_+ORVP_U_$PIECE($GET(^DPT(+ORVP,0)),U)
- IF 1
- +10 SET TIUOVER=""
- +11 IF '$TEST
- DO SELCAT^TIULA1(.SCREEN,"A","AUTHOR",.TIUOVER)
- +12 IF +$GET(DIROUT)
- SET VALMQUIT=1
- QUIT
- +13 IF $DATA(SCREEN)'>9
- KILL @TIUTYP
- GOTO DOCTYPE
- +14 IF $DATA(@TIUTYP)'>9
- WRITE !,$CHAR(7),"You must select one or more TITLES..."
- GOTO SCREEN
- +15 IF $GET(SCREEN(1))="ALL^ANY"
- IF +$GET(ORVP)
- SET SCREEN(1)="APT^"_+$GET(ORVP)_U_$PIECE($GET(^DPT(+$GET(ORVP),0)),U)
- +16 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=$SELECT($DATA(TIUQUIK):1,$DATA(ORVP)&(+$GET(TIUCHVW)'>0):$$FMADD^XLFDT(DT,$SELECT($DATA(^DPT(+$GET(ORVP),.1))'>0:-180,1:-30)),1:$PIECE($$EDATE^TIULA(TIUDPRMT,"",TIUEDFLT),U))
- +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 ; TIU*1.0*286 djh
- +12 SET NOWFLAG=$$FMDIFF^XLFDT($$NOW^XLFDT,TIULDT,2)<60
- +13 IF '$GET(TIURBLD)
- WRITE !,"Searching for the documents."
- +14 ;11/30/00 removed param TIUTYP since BUILD uses global now.
- DO BUILD(TIUCLASS,.STATUS,.SCREEN,TIUEDT,TIULDT,NOWFLAG)
- +15 ; -- If attaching ID note & changed view,
- +16 ; update video for line to be attached: --
- +17 IF $GET(TIUGLINK)
- DO RESTOREG^TIULM(.TIUGLINK)
- +18 ;K @TIUTYP ;11/30/00 keep ^TMP("TIUTYP",$J) for rebuild
- +19 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")="TIUR"
- +12 SET ^TMP("TIUR",$JOB,"TITLE OVERRIDE")=$GET(TIUOVER)
- +13 IF '$DATA(TIUPRM0)
- DO SETPARM^TIULE
- +14 SET EARLY=9999999-+$GET(EARLY)
- SET LATE=9999999-$SELECT(+$GET(LATE):+$GET(LATE),1:3333333)
- +15 FOR
- SET TIUK=$ORDER(SCREEN(TIUK))
- if TIUK'>0
- QUIT
- Begin DoDot:1
- +16 IF $GET(SCREEN)'="ALL"
- SET SCREEN=$GET(TIUK)
- +17 SET XREF=$PIECE(SCREEN(TIUK),U)
- +18 IF XREF'="ASUB"
- Begin DoDot:2
- +19 SET TIUI=$SELECT(XREF'="APRB":$PIECE(SCREEN(TIUK),U,2),1:$$UPPER^TIULS($PIECE(SCREEN(TIUK),U,3)))
- +20 DO GATHER^TIUR1(TIUI,TIUPREF,TIUCLASS,STATUS("IFNS"),EARLY,LATE,XREF,SCREEN)
- End DoDot:2
- +21 ;*282 - Search by multiple terms
- +22 IF XREF="ASUB"
- Begin DoDot:2
- +23 NEW TIUSUBJ
- +24 SET TIUSUBJ=$SELECT($PIECE(SCREEN(TIUK),U,2)[" ":$PIECE($PIECE(SCREEN(TIUK),U,2)," "),1:$PIECE(SCREEN(TIUK),U,2))
- +25 SET TIUI=$ORDER(^TIU(8925,XREF,TIUSUBJ),-1)
- +26 FOR
- SET TIUI=$ORDER(^TIU(8925,XREF,TIUI))
- if TIUI=""!(TIUI'[TIUSUBJ)
- QUIT
- DO GATHER^TIUR1(TIUI,TIUPREF,TIUCLASS,STATUS("IFNS"),EARLY,LATE,XREF,SCREEN)
- +27 IF $PIECE(SCREEN(TIUK),U,2)[" "
- Begin DoDot:3
- +28 NEW TIUIEN,TIUX,TIUY
- +29 SET TIUX=0
- FOR
- SET TIUX=$ORDER(^TMP("TIUI",$JOB,TIUX))
- if TIUX=""
- QUIT
- Begin DoDot:4
- +30 SET TIUY=0
- FOR
- SET TIUY=$ORDER(^TMP("TIUI",$JOB,TIUX,TIUY))
- if TIUY=""
- QUIT
- Begin DoDot:5
- +31 SET TIUIEN=0
- FOR
- SET TIUIEN=$ORDER(^TMP("TIUI",$JOB,TIUX,TIUY,TIUIEN))
- if TIUIEN=""
- QUIT
- IF $$UP^XLFSTR(^TIU(8925,TIUIEN,17))'[($PIECE(SCREEN(TIUK),U,2))
- KILL ^TMP("TIUI",$JOB,TIUX,TIUY,TIUIEN)
- End DoDot:5
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +32 DO PUTLIST^TIUR2(TIUPREF,TIUCLASS,.STATUS,.SCREEN)
- +33 KILL ^TMP("TIUI",$JOB)
- +34 QUIT
- +35 ;
- 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=$PIECE(TIUR0,U,3,99)
- SET TIUCLASS=^TMP("TIUR",$JOB,"CLASS")
- +9 SET TIUI=1
- +10 FOR
- SET TMP=$PIECE(TIUSCRN,";",TIUI)
- if TMP=""
- QUIT
- Begin DoDot:1
- +11 SET TIUSCRN(TIUI)=TMP
- SET TIUI=TIUI+1
- End DoDot:1
- +12 SET TIUSCRN=$LENGTH(TIUSCRN,";")
- +13 SET STATUS("WORDS")=$PIECE(TIUR0,U,2)
- +14 SET STATUS("IFNS")=$PIECE(TIURIDX0,U,3)
- +15 SET TIUEDT=$PIECE(TIURIDX0,U)
- SET TIULDT=$PIECE(TIURIDX0,U,2)
- SET NOWFLAG=+$PIECE(TIURIDX0,U,4)
- +16 ;VMP/ELR ADDED THE FOLLOWING LINE IN PATCH 224
- +17 SET TIUSCRN="ALL"
- +18 DO BUILD(TIUCLASS,.STATUS,.TIUSCRN,TIUEDT,TIULDT,NOWFLAG)
- +19 ; Reexpand previously expanded items:
- +20 DO RELOAD^TIUROR1(.TIUEXP)
- +21 DO BREATHE^TIUROR1(1)
- +22 QUIT