Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: TIURM

TIURM.m

Go to the documentation of this file.
  1. TIURM ; SLC/JER - MIS Document Review ;9/24/03
  1. ;;1.0;TEXT INTEGRATION UTILITIES;**74,79,58,100,113,216,224,286**;Jun 20, 1997;Build 10
  1. ;;Per VA Directive 6402, this routine should not be modified
  1. ;12/7/00 split TIURM into TIURM & TIURM1
  1. MAKELIST(TIUCLASS) ; Get Search Criteria
  1. N DIRUT,DTOUT,DUOUT,TIUI,STATUS,TIUTYP,TIUSTAT,TIUEDFLT,TIUDCL
  1. N TIUDPRMT,STATWORD,STATIFN,NOWFLAG,TIUK
  1. K DIROUT
  1. D INITRR^TIULRR(0)
  1. DIVISION ; Select Division(s)
  1. D SELDIV^TIULA
  1. I SELDIV'>0 S VALMQUIT=1 Q
  1. I $D(TIUDI) D
  1. . S TIUK=0 F S TIUK=$O(TIUDI(TIUK)) Q:'TIUK D
  1. . . S TIUDI("ENTRIES")=$G(TIUDI("ENTRIES"))_TIUK_";"
  1. E S TIUDI("ENTRIES")="ALL DIVISIONS"
  1. STATUS S STATUS=$S($D(TIUQUIK):$$SELSTAT^TIULA(.TIUSTAT,"F","UNSIGNED,UNCOSIGNED"),1:$$SELSTAT^TIULA(.TIUSTAT,"A",$$DFLTSTAT(DUZ)))
  1. ;VMP/ELR changed status ck from <0 TO <1 to account for entering an * p224
  1. I +STATUS<1 S VALMQUIT=1 Q
  1. S TIUI=0
  1. F S TIUI=$O(TIUSTAT(TIUI)) Q:'TIUI D
  1. . S STATIFN=$O(^TIU(8925.6,"B",$$UPPER^TIULS($P(TIUSTAT(TIUI),U,3)),0))
  1. . Q:'STATIFN
  1. . S STATUS("IFNS")=$G(STATUS("IFNS"))_STATIFN_";"
  1. S TIUI=1,STATWORD=$$UPPER^TIULS($P(TIUSTAT(1),U,3))
  1. I +$G(TIUSTAT(4))'>0 F S TIUI=$O(TIUSTAT(TIUI)) Q:+TIUI'>0 D
  1. . S STATWORD=STATWORD_$S(TIUI=+TIUSTAT(1):" & ",1:", ")_$$UPPER^TIULS($P(TIUSTAT(TIUI),U,3))
  1. I +$G(TIUSTAT(4))>0 S STATWORD=$S($P(TIUSTAT(4),U,4)="ALL":"ALL",1:STATWORD_", OTHER")
  1. S STATUS("WORDS")=STATWORD
  1. DOCTYPE ; Select Document Type(s)
  1. N TIUDCL
  1. ; -- Ask user for docmt types and set ^TMP("TIUTYP",$J):
  1. D SELTYP^TIULA(TIUCLASS,.TIUTYP,"A","LAST","DOC",0,.TIUDCL)
  1. I +$G(DIROUT) S VALMQUIT=1 Q
  1. I +$G(@TIUTYP)'>0,'$D(TIUQUIK) K @TIUTYP G STATUS
  1. D CHECKADD
  1. ERLY S TIUEDFLT=$S(TIUCLASS=3:"T-2",TIUCLASS=244:"T-30",1:"T-7")
  1. S TIUDPRMT="Entry"
  1. S TIUEDT=$S($D(TIUQUIK):1,1:$$EDATE^TIULA(TIUDPRMT,"",TIUEDFLT))
  1. I +$G(DIROUT) S VALMQUIT=1 Q
  1. I TIUEDT'>0 K @TIUTYP G DOCTYPE
  1. LATE S TIULDT=$S($D(TIUQUIK):9999999,1:$$LDATE^TIULA(TIUDPRMT))
  1. I +$G(DIROUT) S VALMQUIT=1 Q
  1. I TIULDT'>0 G ERLY
  1. I TIUEDT>TIULDT D SWAP(.TIUEDT,.TIULDT)
  1. I $L(TIULDT,".")=1 D EXPRANGE(.TIUEDT,.TIULDT) ; P74. Add late date time whether or not late date is same as early date.
  1. ; -- Reset late date to NOW on rebuild:
  1. ; TIU*1.0*286 djh
  1. S NOWFLAG=$$FMDIFF^XLFDT($$NOW^XLFDT,TIULDT,2)<60
  1. I '$G(TIURBLD) W !,"Searching for the documents."
  1. D BUILD(TIUCLASS,.STATUS,TIUEDT,TIULDT,NOWFLAG,.TIUDI)
  1. ; -- If attaching ID note & changed view,
  1. ; update video for line to be attached: --
  1. I $G(TIUGLINK) D RESTOREG^TIULM(.TIUGLINK)
  1. K TIUDI,SELDIV
  1. Q
  1. CHECKADD ; Checks whether Addendum is included in the list of types
  1. N TIUI,HIT,NUMTYPS
  1. S (TIUI,HIT)=0
  1. F S TIUI=$O(^TMP("TIUTYP",$J,TIUI)) Q:+TIUI'>0!+HIT I $$UP^XLFSTR(^TMP("TIUTYP",$J,TIUI))["ADDENDUM" S HIT=1
  1. S NUMTYPS=^TMP("TIUTYP",$J)
  1. 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
  1. Q
  1. SWAP(TIUX,TIUY) ; Swap any two variables
  1. N TIUTMP S TIUTMP=TIUX,TIUX=TIUY,TIUY=TIUTMP
  1. Q
  1. 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.
  1. I $P(TIUY,U)=DT S TIUY=$$NOW^XLFDT I 1
  1. E S TIUY=$P(TIUY,U)_"."_235959 ;P74 Add seconds
  1. Q
  1. BUILD(TIUCLASS,STATUS,EARLY,LATE,NOWFLAG,TIUDI) ; Build List
  1. N TIUPREF
  1. S TIUPREF=$$PERSPRF^TIULE(DUZ)
  1. K ^TMP("TIUR",$J),^TMP("TIURIDX",$J),^TMP("TIUI",$J)
  1. ; If user entered NOW at first build, update NOW for rebuild;
  1. ; Save data in ^TMP("TIURIDX",$J,0) for rebuild:
  1. I $G(TIURBLD),$G(NOWFLAG) S LATE=$$NOW^XLFDT
  1. S ^TMP("TIURIDX",$J,0)=+EARLY_U_+LATE_U_$G(STATUS("IFNS"))_U_NOWFLAG
  1. S ^TMP("TIUR",$J,"RTN")="TIURM"
  1. I '$D(TIUPRM0)!'$D(TIUPRM0) D SETPARM^TIULE
  1. S EARLY=+$G(EARLY,0),LATE=+$G(LATE,3333333)
  1. D GATHER^TIURM1(TIUPREF,TIUCLASS,STATUS("IFNS"),EARLY,LATE,.TIUDI)
  1. D PUTLIST^TIURM1(TIUPREF,TIUCLASS,.STATUS,.TIUDI)
  1. K ^TMP("TIUI",$J)
  1. Q
  1. CLEAN ; Clean up your mess!
  1. K ^TMP("TIUR",$J),^TMP("TIURIDX",$J) D CLEAN^VALM10,KILLRR^TIULRR
  1. K VALMY
  1. K ^TMP("TIUTYP",$J)
  1. Q
  1. URGENCY(TIUDA) ; What is the urgency of the current document
  1. N TIUY,TIUD0,TIUDSTAT,TIUDURG
  1. S TIUD0=$G(^TIU(8925,+TIUDA,0)),TIUDSTAT=$P(TIUD0,U,5)
  1. S TIUDURG=$P(TIUD0,U,9)
  1. S TIUY=$S(TIUDSTAT<7:$S(TIUDURG="P":1,1:2),1:3)
  1. Q TIUY
  1. DFLTSTAT(USER) ; Set default STATUS for current user
  1. N TIUMIS,TIUMD,TIUY,TIUDPRM D DOCPRM^TIULC1(244,.TIUDPRM)
  1. S TIUMIS=$$ISA^USRLM(DUZ,"MEDICAL INFORMATION SECTION")
  1. I +TIUMIS,+$P($G(TIUDPRM(0)),U,3) S TIUY="UNVERIFIED" G DFLTX
  1. I $$ISA^USRLM(DUZ,"PROVIDER") S TIUY="COMPLETED" G DFLTX
  1. S TIUY="COMPLETED"
  1. DFLTX Q TIUY
  1. ;
  1. RBLD ; Rebuild list after actions 11/30/00
  1. N TIUEXP,TIUR0,TIURIDX0,TIUEDT,TIULDT
  1. N TIURBLD,TIUI,TIUCLASS,TIUDI,TIUSCRN
  1. S TIURBLD=1
  1. D FIXLSTNW^TIULM ;restore video for elements added to end of list
  1. I +$O(^TMP("TIUR",$J,"EXPAND",0)) D
  1. . M TIUEXP=^TMP("TIUR",$J,"EXPAND")
  1. S TIUR0=^TMP("TIUR",$J,0),TIURIDX0=^TMP("TIURIDX",$J,0)
  1. S TIUCLASS=^TMP("TIUR",$J,"CLASS")
  1. S STATUS("WORDS")=$P(TIUR0,U,2)
  1. S STATUS("IFNS")=$P(TIURIDX0,U,3)
  1. S TIUEDT=$P(TIURIDX0,U),TIULDT=$P(TIURIDX0,U,2),NOWFLAG=+$P(TIURIDX0,U,4)
  1. M TIUDI=^TMP("TIUR",$J,"DIV")
  1. ;VMP/ELR ADDED THE FOLLOWING LINE IN PATCH 224
  1. S TIUSCRN="ALL"
  1. D BUILD(TIUCLASS,.STATUS,TIUEDT,TIULDT,NOWFLAG,.TIUDI)
  1. ; Reexpand previously expanded items:
  1. D RELOAD^TIUROR1(.TIUEXP)
  1. D BREATHE^TIUROR1(1)
  1. Q