- TIURM ; SLC/JER - MIS Document Review ;9/24/03
- ;;1.0;TEXT INTEGRATION UTILITIES;**74,79,58,100,113,216,224,286**;Jun 20, 1997;Build 10
- ;;Per VA Directive 6402, this routine should not be modified
- ;12/7/00 split TIURM into TIURM & TIURM1
- MAKELIST(TIUCLASS) ; Get Search Criteria
- N DIRUT,DTOUT,DUOUT,TIUI,STATUS,TIUTYP,TIUSTAT,TIUEDFLT,TIUDCL
- N TIUDPRMT,STATWORD,STATIFN,NOWFLAG,TIUK
- K DIROUT
- D INITRR^TIULRR(0)
- DIVISION ; Select Division(s)
- D SELDIV^TIULA
- I SELDIV'>0 S VALMQUIT=1 Q
- I $D(TIUDI) D
- . S TIUK=0 F S TIUK=$O(TIUDI(TIUK)) Q:'TIUK D
- . . S TIUDI("ENTRIES")=$G(TIUDI("ENTRIES"))_TIUK_";"
- E S TIUDI("ENTRIES")="ALL DIVISIONS"
- STATUS S STATUS=$S($D(TIUQUIK):$$SELSTAT^TIULA(.TIUSTAT,"F","UNSIGNED,UNCOSIGNED"),1:$$SELSTAT^TIULA(.TIUSTAT,"A",$$DFLTSTAT(DUZ)))
- ;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 D
- . S STATIFN=$O(^TIU(8925.6,"B",$$UPPER^TIULS($P(TIUSTAT(TIUI),U,3)),0))
- . Q:'STATIFN
- . S STATUS("IFNS")=$G(STATUS("IFNS"))_STATIFN_";"
- 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)
- N TIUDCL
- ; -- Ask user for docmt types and set ^TMP("TIUTYP",$J):
- D SELTYP^TIULA(TIUCLASS,.TIUTYP,"A","LAST","DOC",0,.TIUDCL)
- I +$G(DIROUT) S VALMQUIT=1 Q
- I +$G(@TIUTYP)'>0,'$D(TIUQUIK) K @TIUTYP G STATUS
- D CHECKADD
- ERLY S TIUEDFLT=$S(TIUCLASS=3:"T-2",TIUCLASS=244:"T-30",1:"T-7")
- S TIUDPRMT="Entry"
- S TIUEDT=$S($D(TIUQUIK):1,1:$$EDATE^TIULA(TIUDPRMT,"",TIUEDFLT))
- I +$G(DIROUT) S VALMQUIT=1 Q
- I TIUEDT'>0 K @TIUTYP G DOCTYPE
- LATE S TIULDT=$S($D(TIUQUIK):9999999,1:$$LDATE^TIULA(TIUDPRMT))
- 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) ; P74. Add late date time whether or not late date is same as early date.
- ; -- 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,TIUEDT,TIULDT,NOWFLAG,.TIUDI)
- ; -- If attaching ID note & changed view,
- ; update video for line to be attached: --
- I $G(TIUGLINK) D RESTOREG^TIULM(.TIUGLINK)
- K TIUDI,SELDIV
- Q
- 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 any two 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,EARLY,LATE,NOWFLAG,TIUDI) ; Build List
- N TIUPREF
- S TIUPREF=$$PERSPRF^TIULE(DUZ)
- 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")="TIURM"
- I '$D(TIUPRM0)!'$D(TIUPRM0) D SETPARM^TIULE
- S EARLY=+$G(EARLY,0),LATE=+$G(LATE,3333333)
- D GATHER^TIURM1(TIUPREF,TIUCLASS,STATUS("IFNS"),EARLY,LATE,.TIUDI)
- D PUTLIST^TIURM1(TIUPREF,TIUCLASS,.STATUS,.TIUDI)
- 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
- URGENCY(TIUDA) ; What is the urgency of the current document
- N TIUY,TIUD0,TIUDSTAT,TIUDURG
- S TIUD0=$G(^TIU(8925,+TIUDA,0)),TIUDSTAT=$P(TIUD0,U,5)
- S TIUDURG=$P(TIUD0,U,9)
- S TIUY=$S(TIUDSTAT<7:$S(TIUDURG="P":1,1:2),1:3)
- Q TIUY
- DFLTSTAT(USER) ; Set default STATUS for current user
- N TIUMIS,TIUMD,TIUY,TIUDPRM D DOCPRM^TIULC1(244,.TIUDPRM)
- S TIUMIS=$$ISA^USRLM(DUZ,"MEDICAL INFORMATION SECTION")
- I +TIUMIS,+$P($G(TIUDPRM(0)),U,3) S TIUY="UNVERIFIED" G DFLTX
- I $$ISA^USRLM(DUZ,"PROVIDER") S TIUY="COMPLETED" G DFLTX
- S TIUY="COMPLETED"
- DFLTX Q TIUY
- ;
- RBLD ; Rebuild list after actions 11/30/00
- N TIUEXP,TIUR0,TIURIDX0,TIUEDT,TIULDT
- N TIURBLD,TIUI,TIUCLASS,TIUDI,TIUSCRN
- 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 TIUCLASS=^TMP("TIUR",$J,"CLASS")
- 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)
- M TIUDI=^TMP("TIUR",$J,"DIV")
- ;VMP/ELR ADDED THE FOLLOWING LINE IN PATCH 224
- S TIUSCRN="ALL"
- D BUILD(TIUCLASS,.STATUS,TIUEDT,TIULDT,NOWFLAG,.TIUDI)
- ; Reexpand previously expanded items:
- D RELOAD^TIUROR1(.TIUEXP)
- D BREATHE^TIUROR1(1)
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HTIURM 5454 printed Jan 18, 2025@03:46:31 Page 2
- 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
- +2 ;;Per VA Directive 6402, this routine should not be modified
- +3 ;12/7/00 split TIURM into TIURM & TIURM1
- MAKELIST(TIUCLASS) ; Get Search Criteria
- +1 NEW DIRUT,DTOUT,DUOUT,TIUI,STATUS,TIUTYP,TIUSTAT,TIUEDFLT,TIUDCL
- +2 NEW TIUDPRMT,STATWORD,STATIFN,NOWFLAG,TIUK
- +3 KILL DIROUT
- +4 DO INITRR^TIULRR(0)
- DIVISION ; Select Division(s)
- +1 DO SELDIV^TIULA
- +2 IF SELDIV'>0
- SET VALMQUIT=1
- QUIT
- +3 IF $DATA(TIUDI)
- Begin DoDot:1
- +4 SET TIUK=0
- FOR
- SET TIUK=$ORDER(TIUDI(TIUK))
- if 'TIUK
- QUIT
- Begin DoDot:2
- +5 SET TIUDI("ENTRIES")=$GET(TIUDI("ENTRIES"))_TIUK_";"
- End DoDot:2
- End DoDot:1
- +6 IF '$TEST
- SET TIUDI("ENTRIES")="ALL DIVISIONS"
- STATUS SET STATUS=$SELECT($DATA(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
- +2 IF +STATUS<1
- SET VALMQUIT=1
- QUIT
- +3 SET TIUI=0
- +4 FOR
- SET TIUI=$ORDER(TIUSTAT(TIUI))
- if 'TIUI
- QUIT
- Begin DoDot:1
- +5 SET STATIFN=$ORDER(^TIU(8925.6,"B",$$UPPER^TIULS($PIECE(TIUSTAT(TIUI),U,3)),0))
- +6 if 'STATIFN
- QUIT
- +7 SET STATUS("IFNS")=$GET(STATUS("IFNS"))_STATIFN_";"
- End DoDot:1
- +8 SET TIUI=1
- SET STATWORD=$$UPPER^TIULS($PIECE(TIUSTAT(1),U,3))
- +9 IF +$GET(TIUSTAT(4))'>0
- FOR
- SET TIUI=$ORDER(TIUSTAT(TIUI))
- if +TIUI'>0
- QUIT
- Begin DoDot:1
- +10 SET STATWORD=STATWORD_$SELECT(TIUI=+TIUSTAT(1):" & ",1:", ")_$$UPPER^TIULS($PIECE(TIUSTAT(TIUI),U,3))
- End DoDot:1
- +11 IF +$GET(TIUSTAT(4))>0
- SET STATWORD=$SELECT($PIECE(TIUSTAT(4),U,4)="ALL":"ALL",1:STATWORD_", OTHER")
- +12 SET STATUS("WORDS")=STATWORD
- DOCTYPE ; Select Document Type(s)
- +1 NEW TIUDCL
- +2 ; -- Ask user for docmt types and set ^TMP("TIUTYP",$J):
- +3 DO SELTYP^TIULA(TIUCLASS,.TIUTYP,"A","LAST","DOC",0,.TIUDCL)
- +4 IF +$GET(DIROUT)
- SET VALMQUIT=1
- QUIT
- +5 IF +$GET(@TIUTYP)'>0
- IF '$DATA(TIUQUIK)
- KILL @TIUTYP
- GOTO STATUS
- +6 DO CHECKADD
- ERLY SET TIUEDFLT=$SELECT(TIUCLASS=3:"T-2",TIUCLASS=244:"T-30",1:"T-7")
- +1 SET TIUDPRMT="Entry"
- +2 SET TIUEDT=$SELECT($DATA(TIUQUIK):1,1:$$EDATE^TIULA(TIUDPRMT,"",TIUEDFLT))
- +3 IF +$GET(DIROUT)
- SET VALMQUIT=1
- QUIT
- +4 IF TIUEDT'>0
- KILL @TIUTYP
- GOTO DOCTYPE
- LATE SET TIULDT=$SELECT($DATA(TIUQUIK):9999999,1:$$LDATE^TIULA(TIUDPRMT))
- +1 IF +$GET(DIROUT)
- SET VALMQUIT=1
- QUIT
- +2 IF TIULDT'>0
- GOTO ERLY
- +3 IF TIUEDT>TIULDT
- DO SWAP(.TIUEDT,.TIULDT)
- +4 ; P74. Add late date time whether or not late date is same as early date.
- IF $LENGTH(TIULDT,".")=1
- DO EXPRANGE(.TIUEDT,.TIULDT)
- +5 ; -- Reset late date to NOW on rebuild:
- +6 ; TIU*1.0*286 djh
- +7 SET NOWFLAG=$$FMDIFF^XLFDT($$NOW^XLFDT,TIULDT,2)<60
- +8 IF '$GET(TIURBLD)
- WRITE !,"Searching for the documents."
- +9 DO BUILD(TIUCLASS,.STATUS,TIUEDT,TIULDT,NOWFLAG,.TIUDI)
- +10 ; -- If attaching ID note & changed view,
- +11 ; update video for line to be attached: --
- +12 IF $GET(TIUGLINK)
- DO RESTOREG^TIULM(.TIUGLINK)
- +13 KILL TIUDI,SELDIV
- +14 QUIT
- 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
- SWAP(TIUX,TIUY) ; Swap any two 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,EARLY,LATE,NOWFLAG,TIUDI) ; Build List
- +1 NEW TIUPREF
- +2 SET TIUPREF=$$PERSPRF^TIULE(DUZ)
- +3 KILL ^TMP("TIUR",$JOB),^TMP("TIURIDX",$JOB),^TMP("TIUI",$JOB)
- +4 ; If user entered NOW at first build, update NOW for rebuild;
- +5 ; Save data in ^TMP("TIURIDX",$J,0) for rebuild:
- +6 IF $GET(TIURBLD)
- IF $GET(NOWFLAG)
- SET LATE=$$NOW^XLFDT
- +7 SET ^TMP("TIURIDX",$JOB,0)=+EARLY_U_+LATE_U_$GET(STATUS("IFNS"))_U_NOWFLAG
- +8 SET ^TMP("TIUR",$JOB,"RTN")="TIURM"
- +9 IF '$DATA(TIUPRM0)!'$DATA(TIUPRM0)
- DO SETPARM^TIULE
- +10 SET EARLY=+$GET(EARLY,0)
- SET LATE=+$GET(LATE,3333333)
- +11 DO GATHER^TIURM1(TIUPREF,TIUCLASS,STATUS("IFNS"),EARLY,LATE,.TIUDI)
- +12 DO PUTLIST^TIURM1(TIUPREF,TIUCLASS,.STATUS,.TIUDI)
- +13 KILL ^TMP("TIUI",$JOB)
- +14 QUIT
- 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
- URGENCY(TIUDA) ; What is the urgency of the current document
- +1 NEW TIUY,TIUD0,TIUDSTAT,TIUDURG
- +2 SET TIUD0=$GET(^TIU(8925,+TIUDA,0))
- SET TIUDSTAT=$PIECE(TIUD0,U,5)
- +3 SET TIUDURG=$PIECE(TIUD0,U,9)
- +4 SET TIUY=$SELECT(TIUDSTAT<7:$SELECT(TIUDURG="P":1,1:2),1:3)
- +5 QUIT TIUY
- DFLTSTAT(USER) ; Set default STATUS for current user
- +1 NEW TIUMIS,TIUMD,TIUY,TIUDPRM
- DO DOCPRM^TIULC1(244,.TIUDPRM)
- +2 SET TIUMIS=$$ISA^USRLM(DUZ,"MEDICAL INFORMATION SECTION")
- +3 IF +TIUMIS
- IF +$PIECE($GET(TIUDPRM(0)),U,3)
- SET TIUY="UNVERIFIED"
- GOTO DFLTX
- +4 IF $$ISA^USRLM(DUZ,"PROVIDER")
- SET TIUY="COMPLETED"
- GOTO DFLTX
- +5 SET TIUY="COMPLETED"
- DFLTX QUIT TIUY
- +1 ;
- RBLD ; Rebuild list after actions 11/30/00
- +1 NEW TIUEXP,TIUR0,TIURIDX0,TIUEDT,TIULDT
- +2 NEW TIURBLD,TIUI,TIUCLASS,TIUDI,TIUSCRN
- +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 TIUCLASS=^TMP("TIUR",$JOB,"CLASS")
- +9 SET STATUS("WORDS")=$PIECE(TIUR0,U,2)
- +10 SET STATUS("IFNS")=$PIECE(TIURIDX0,U,3)
- +11 SET TIUEDT=$PIECE(TIURIDX0,U)
- SET TIULDT=$PIECE(TIURIDX0,U,2)
- SET NOWFLAG=+$PIECE(TIURIDX0,U,4)
- +12 MERGE TIUDI=^TMP("TIUR",$JOB,"DIV")
- +13 ;VMP/ELR ADDED THE FOLLOWING LINE IN PATCH 224
- +14 SET TIUSCRN="ALL"
- +15 DO BUILD(TIUCLASS,.STATUS,TIUEDT,TIULDT,NOWFLAG,.TIUDI)
- +16 ; Reexpand previously expanded items:
- +17 DO RELOAD^TIUROR1(.TIUEXP)
- +18 DO BREATHE^TIUROR1(1)
- +19 QUIT