TIURA2 ; SLC/JER - More review screen actions ;26-Mar-2014 17:13;DU
;;1.0;TEXT INTEGRATION UTILITIES;**88,58,100,123,1002,112,1009,182,1010,269,1013**;Jun 20, 1997;Build 33
; 6/20/00: Moved DISPLAY, BROWSE, & BROWS1 from TIURA to TIURA2
;IHS/ITSC/LJF 7/30/2003 bypass rebuild if called by BTIURPT
;IHS/OIT/LJF 03/17/2005 PATCH #1002 - added PEP to BROWS1 subroutine
;to be called by PCC Audit function
DISPLAY ; Detailed Display
N TIUDA,TIUD,TIUDATA,TIUI,Y,DIROUT,TIUQUIT,RSTRCTD
I '$D(VALMY) D EN^VALM2(XQORNOD(0))
S TIUI=0
F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:$D(TIUQUIT)
. N TIUVIEW
. S TIUDATA=$G(^TMP("TIURIDX",$J,TIUI))
. D CLEAR^VALM1
. W !!,"Reviewing #",+TIUDATA
. S TIUDA=+$P(TIUDATA,U,2)
. S TIUVIEW=$$CANDO^TIULP(TIUDA,"VIEW")
. I +TIUVIEW'>0 D Q
. . W !!,$C(7),$P(TIUVIEW,U,2),!
. . I $$READ^TIUU("EA","RETURN to continue...") ; pause
. . D RESTORE^VALM10(+TIUI)
. S RSTRCTD=$$DOCRES^TIULRR(TIUDA)
. I RSTRCTD D Q
. . W !!,$C(7),"Ok, no harm done...",!
. . I $$READ^TIUU("EA","RETURN to continue...") ; pause
. . D RESTORE^VALM10(+TIUI)
. D EN^TIUAUDIT
. I +$G(TIUQUIT) D FIXLSTNW^TIULM Q
. I TIUI'=$P($G(TIUGLINK),U,2) D RESTORE^VALM10(+TIUI) ; See rtn TIURL
K VALMY S VALMBCK="R"
Q
BROWSE(TIULTMP) ; Browse selected documents
; TIULTMP is list template name
N TIUDA,DFN,TIU,TIUCHNG,TIUDATA,TIUI,Y,DIROUT,TIUQUIT
N TIUGDATA
I '$D(VALMY) D EN^VALM2(XQORNOD(0))
S TIUI=0
F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:$D(TIUQUIT)
. N TIUVIEW,TIUGACT,RSTRCTD
. S TIUDATA=$G(^TMP("TIURIDX",$J,TIUI))
. S TIUDA=+$P(TIUDATA,U,2)
. S TIUGDATA=$G(^TMP("TIUR",$J,"IDDATA",TIUDA)) ; ID note/entry
. D CLEAR^VALM1
. W !!,"Reviewing Item #",TIUI
. S RSTRCTD=$$DOCRES^TIULRR(TIUDA)
. I RSTRCTD D Q
. . W !!,$C(7),"Ok, no harm done...",!
. . I $$READ^TIUU("EA","RETURN to continue...") ; pause
. D BROWS1(TIULTMP,TIUDA,TIUGDATA)
; -- Update or Rebuild list: --
I $G(TIUCHNG("DELETE"))!$G(TIUCHNG("ADDM")) S TIUCHNG("RBLD")=1
S TIUCHNG("UPDATE")=1 ; default
;D UPRBLD^TIURL(.TIUCHNG,.VALMY) K VALMY ;IHS/ITSC/LJF 7/20/2003
K VALMY
S VALMBCK="R"
Q
GETSORT(PRMSORT,EXPSORT) ; Get order for ID entries
Q $S($G(EXPSORT)'="":EXPSORT,1:PRMSORT)
;
BROWS1(TIULTMP,TIUDA,TIUGDATA) ; PEP Browse single document IHS/OIT/LJF 3/17/2005
; Calls EN^VALM
N %DT,C,D0,DIQ2,FINISH,TIU,TIUVIEW
I '$D(TIUGDATA) S TIUGDATA=$$IDDATA^TIURECL1(TIUDA)
I TIULTMP="TIU COMPLETE NOTES",$P(TIUGDATA,U,2) W !!,"You are completing the PARENT ENTRY of this interdisciplinary note."
I '$P(TIUGDATA,U,2) D Q:+TIUVIEW'>0 ;TIU*1*123
. S TIUVIEW=$$CANDO^TIULP(TIUDA,"VIEW")
. I +TIUVIEW'>0 D
. . W !!,$C(7),$P(TIUVIEW,U,2),!
. . I $$READ^TIUU("EA","RETURN to continue...") ; pause
I '$D(TIUPRM0)!'$D(TIUPRM1) D SETPARM^TIULE
D EN^VALM(TIULTMP)
K ^TMP("TIUVIEW",$J)
Q
;
EXPAND ; Expand/Collapse ID notes, Addenda in lists
N TIUDNM,TIULNM,TIUSTAT
D:'$D(VALMY) EN^VALM2(XQORNOD(0))
I $D(VALMY) D EC^TIURECL(.VALMY)
W !,"Refreshing the list."
K VALMY
S VALMCNT=+$G(@VALMAR@(0))
S VALMBCK="R"
Q
;
PRNTSCRN(VALMY) ; Evaluate whether a record may be printed
N TIUI S TIUI=""
F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:$D(DIROUT)
. N TIUPMTHD,TIUDTYP,TIUPFHDR,TIUPFNBR,TIUPGRP,TIUPRINT,TIUFLAG,RSTRCTD,TIUTYP
. S RSTRCTD=0,TIUDATA=$G(^TMP("TIURIDX",$J,TIUI))
. ; *269 vmp/djh - Check if file exists
. S TIUDA=+$P(TIUDATA,U,2),TIUTYP=+$G(^TIU(8925,TIUDA,0))
. Q:TIUTYP'>0
. ; Evaluate whether user can print record
. S TIUPRINT=$$CANDO^TIULP(TIUDA,"PRINT RECORD")
. I +TIUPRINT'>0 D Q
. . W !!,"Item #",TIUI,": ",!,$P(TIUPRINT,U,2),!
. . K VALMY(TIUI)
. . I $$READ^TIUU("EA","RETURN to continue...")
. ;-- Add Check for restricted record when available --
. S DFN=+$P(^TIU(8925,TIUDA,0),U,2)
. S RSTRCTD=$$PTRES^TIULRR(DFN)
. I +RSTRCTD D Q
. . W !!,"Item #",TIUI," Removed from print list.",!
. . K VALMY(TIUI)
. . I $$READ^TIUU("EA","Press RETURN to continue...")
. I +$G(TIUPFLG) S TIUFLAG=+$$CHARTONE^TIURA1(TIUDA)
Q
DICTATED ; Mark Document(s) "dictated"
N TIUCHNG,TIUI,TIUY,Y,DIROUT
I '$D(VALMY) D EN^VALM2(XQORNOD(0))
S TIUI=0
F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:$D(DIROUT)
. N TIU,DFN,TIUDA,TIUDATA,RSTRCTD
. S TIUDATA=$G(^TMP("TIURIDX",$J,TIUI))
. S TIUDA=+$P(TIUDATA,U,2) S RSTRCTD=$$DOCRES^TIULRR(TIUDA)
. I RSTRCTD D Q
. . W !!,$C(7),"Ok, no harm done...",!
. . I $$READ^TIUU("EA","RETURN to continue...") ; pause
. D EN^VALM("TIU DOCUMENT DICTATED")
; -- Update or Rebuild list: --
S TIUCHNG("UPDATE")=1
D UPRBLD^TIURL(.TIUCHNG,.VALMY) K VALMY
S VALMBCK="R"
Q
DICTATE1(TIUDA) ; Single record sign on chart
N DICMSG D FULL^VALM1
D DICT(TIUDA,.DICMSG)
W !!,$G(DICMSG(1)),!,$G(DICMSG(2)),! H $S($D(DICMSG(0)):+DICMSG(0),1:3)
Q
DICT(DA,MSG) ; Mark signed on chart. Edit on-chart signatures.
N AUTHOR,DIE,DR,Y,TIUSTAT,EXPCSNR,ATTNDNG,TIUDA,TIUPRMT,TIU0,TIU12,TIU13
S TIU0=$G(^TIU(8925,+DA,0)),TIU12=$G(^(12)),TIU13=$G(^(13))
S TIUSTAT=$P(TIU0,U,5)
S TIUPRMT=$S(TIUSTAT>1:"Edit Dictation Data? ",1:"Has this document been dictated? ")
W ! S MSG=$$READ^TIUU("YAO",TIUPRMT,"NO") W !
I 'MSG S TIUCHNG=0 G DICTX
S TIUCHNG=1
S AUTHOR=$$PERSNAME^TIULC1(+$P(TIU12,U,2))
S EXPCSNR=$$PERSNAME^TIULC1(+$P(TIU12,U,8))
S:+$P(TIU12,U,9) ATTNDNG=$$PERSNAME^TIULC1(+$P(TIU12,U,9))
S DR="1202//^S X=AUTHOR;1307//^S X=$S(+$P(TIU13,U,7)'>0:""NOW"",1:$$DATE^TIULS(+$P(TIU13,U,7),""MM/DD/CCYY@HR:MIN:SEC""))"
I $D(ATTNDNG) S DR=DR_";1209//^S X=ATTNDNG"
E I $D(EXPCSNR) S DR=DR_";1208//^S X=EXPCSNR"
S DR=DR_";1204////^S X=$$WHOSIGNS^TIULC1(DA);1208////^S X=$$WHOCOSIG^TIULC1(DA)"
S DIE=8925 D ^DIE
S TIU0=$G(^TIU(8925,+DA,0)),TIU12=$G(^(12)),TIU13=$G(^(13))
;Toggle status between undictated and untranscribed, depending on Dict Date
S DR=".05///^S X=$S(+$P(TIU13,U,7):""UNTRANSCRIBED"",1:""UNDICTATED"")",DIE=8925 D ^DIE
D UPDTIRT^TIUDIRT(.TIU,+DA)
DICTX S MSG(1)=" Dictation data "_$S(TIUCHNG:"",1:"NOT ")_"changed."
Q
TIURA2 ; SLC/JER - More review screen actions ;26-Mar-2014 17:13;DU
+1 ;;1.0;TEXT INTEGRATION UTILITIES;**88,58,100,123,1002,112,1009,182,1010,269,1013**;Jun 20, 1997;Build 33
+2 ; 6/20/00: Moved DISPLAY, BROWSE, & BROWS1 from TIURA to TIURA2
+3 ;IHS/ITSC/LJF 7/30/2003 bypass rebuild if called by BTIURPT
+4 ;IHS/OIT/LJF 03/17/2005 PATCH #1002 - added PEP to BROWS1 subroutine
+5 ;to be called by PCC Audit function
DISPLAY ; Detailed Display
+1 NEW TIUDA,TIUD,TIUDATA,TIUI,Y,DIROUT,TIUQUIT,RSTRCTD
+2 IF '$DATA(VALMY)
DO EN^VALM2(XQORNOD(0))
+3 SET TIUI=0
+4 FOR
SET TIUI=$ORDER(VALMY(TIUI))
IF +TIUI'>0
QUIT
Begin DoDot:1
+5 NEW TIUVIEW
+6 SET TIUDATA=$GET(^TMP("TIURIDX",$JOB,TIUI))
+7 DO CLEAR^VALM1
+8 WRITE !!,"Reviewing #",+TIUDATA
+9 SET TIUDA=+$PIECE(TIUDATA,U,2)
+10 SET TIUVIEW=$$CANDO^TIULP(TIUDA,"VIEW")
+11 IF +TIUVIEW'>0
Begin DoDot:2
+12 WRITE !!,$CHAR(7),$PIECE(TIUVIEW,U,2),!
+13 ; pause
IF $$READ^TIUU("EA","RETURN to continue...")
+14 DO RESTORE^VALM10(+TIUI)
End DoDot:2
QUIT
+15 SET RSTRCTD=$$DOCRES^TIULRR(TIUDA)
+16 IF RSTRCTD
Begin DoDot:2
+17 WRITE !!,$CHAR(7),"Ok, no harm done...",!
+18 ; pause
IF $$READ^TIUU("EA","RETURN to continue...")
+19 DO RESTORE^VALM10(+TIUI)
End DoDot:2
QUIT
+20 DO EN^TIUAUDIT
+21 IF +$GET(TIUQUIT)
DO FIXLSTNW^TIULM
QUIT
+22 ; See rtn TIURL
IF TIUI'=$PIECE($GET(TIUGLINK),U,2)
DO RESTORE^VALM10(+TIUI)
End DoDot:1
IF $DATA(TIUQUIT)
QUIT
+23 KILL VALMY
SET VALMBCK="R"
+24 QUIT
BROWSE(TIULTMP) ; Browse selected documents
+1 ; TIULTMP is list template name
+2 NEW TIUDA,DFN,TIU,TIUCHNG,TIUDATA,TIUI,Y,DIROUT,TIUQUIT
+3 NEW TIUGDATA
+4 IF '$DATA(VALMY)
DO EN^VALM2(XQORNOD(0))
+5 SET TIUI=0
+6 FOR
SET TIUI=$ORDER(VALMY(TIUI))
IF +TIUI'>0
QUIT
Begin DoDot:1
+7 NEW TIUVIEW,TIUGACT,RSTRCTD
+8 SET TIUDATA=$GET(^TMP("TIURIDX",$JOB,TIUI))
+9 SET TIUDA=+$PIECE(TIUDATA,U,2)
+10 ; ID note/entry
SET TIUGDATA=$GET(^TMP("TIUR",$JOB,"IDDATA",TIUDA))
+11 DO CLEAR^VALM1
+12 WRITE !!,"Reviewing Item #",TIUI
+13 SET RSTRCTD=$$DOCRES^TIULRR(TIUDA)
+14 IF RSTRCTD
Begin DoDot:2
+15 WRITE !!,$CHAR(7),"Ok, no harm done...",!
+16 ; pause
IF $$READ^TIUU("EA","RETURN to continue...")
End DoDot:2
QUIT
+17 DO BROWS1(TIULTMP,TIUDA,TIUGDATA)
End DoDot:1
IF $DATA(TIUQUIT)
QUIT
+18 ; -- Update or Rebuild list: --
+19 IF $GET(TIUCHNG("DELETE"))!$GET(TIUCHNG("ADDM"))
SET TIUCHNG("RBLD")=1
+20 ; default
SET TIUCHNG("UPDATE")=1
+21 ;D UPRBLD^TIURL(.TIUCHNG,.VALMY) K VALMY ;IHS/ITSC/LJF 7/20/2003
+22 KILL VALMY
+23 SET VALMBCK="R"
+24 QUIT
GETSORT(PRMSORT,EXPSORT) ; Get order for ID entries
+1 QUIT $SELECT($GET(EXPSORT)'="":EXPSORT,1:PRMSORT)
+2 ;
BROWS1(TIULTMP,TIUDA,TIUGDATA) ; PEP Browse single document IHS/OIT/LJF 3/17/2005
+1 ; Calls EN^VALM
+2 NEW %DT,C,D0,DIQ2,FINISH,TIU,TIUVIEW
+3 IF '$DATA(TIUGDATA)
SET TIUGDATA=$$IDDATA^TIURECL1(TIUDA)
+4 IF TIULTMP="TIU COMPLETE NOTES"
IF $PIECE(TIUGDATA,U,2)
WRITE !!,"You are completing the PARENT ENTRY of this interdisciplinary note."
+5 ;TIU*1*123
IF '$PIECE(TIUGDATA,U,2)
Begin DoDot:1
+6 SET TIUVIEW=$$CANDO^TIULP(TIUDA,"VIEW")
+7 IF +TIUVIEW'>0
Begin DoDot:2
+8 WRITE !!,$CHAR(7),$PIECE(TIUVIEW,U,2),!
+9 ; pause
IF $$READ^TIUU("EA","RETURN to continue...")
End DoDot:2
End DoDot:1
IF +TIUVIEW'>0
QUIT
+10 IF '$DATA(TIUPRM0)!'$DATA(TIUPRM1)
DO SETPARM^TIULE
+11 DO EN^VALM(TIULTMP)
+12 KILL ^TMP("TIUVIEW",$JOB)
+13 QUIT
+14 ;
EXPAND ; Expand/Collapse ID notes, Addenda in lists
+1 NEW TIUDNM,TIULNM,TIUSTAT
+2 IF '$DATA(VALMY)
DO EN^VALM2(XQORNOD(0))
+3 IF $DATA(VALMY)
DO EC^TIURECL(.VALMY)
+4 WRITE !,"Refreshing the list."
+5 KILL VALMY
+6 SET VALMCNT=+$GET(@VALMAR@(0))
+7 SET VALMBCK="R"
+8 QUIT
+9 ;
PRNTSCRN(VALMY) ; Evaluate whether a record may be printed
+1 NEW TIUI
SET TIUI=""
+2 FOR
SET TIUI=$ORDER(VALMY(TIUI))
IF +TIUI'>0
QUIT
Begin DoDot:1
+3 NEW TIUPMTHD,TIUDTYP,TIUPFHDR,TIUPFNBR,TIUPGRP,TIUPRINT,TIUFLAG,RSTRCTD,TIUTYP
+4 SET RSTRCTD=0
SET TIUDATA=$GET(^TMP("TIURIDX",$JOB,TIUI))
+5 ; *269 vmp/djh - Check if file exists
+6 SET TIUDA=+$PIECE(TIUDATA,U,2)
SET TIUTYP=+$GET(^TIU(8925,TIUDA,0))
+7 IF TIUTYP'>0
QUIT
+8 ; Evaluate whether user can print record
+9 SET TIUPRINT=$$CANDO^TIULP(TIUDA,"PRINT RECORD")
+10 IF +TIUPRINT'>0
Begin DoDot:2
+11 WRITE !!,"Item #",TIUI,": ",!,$PIECE(TIUPRINT,U,2),!
+12 KILL VALMY(TIUI)
+13 IF $$READ^TIUU("EA","RETURN to continue...")
End DoDot:2
QUIT
+14 ;-- Add Check for restricted record when available --
+15 SET DFN=+$PIECE(^TIU(8925,TIUDA,0),U,2)
+16 SET RSTRCTD=$$PTRES^TIULRR(DFN)
+17 IF +RSTRCTD
Begin DoDot:2
+18 WRITE !!,"Item #",TIUI," Removed from print list.",!
+19 KILL VALMY(TIUI)
+20 IF $$READ^TIUU("EA","Press RETURN to continue...")
End DoDot:2
QUIT
+21 IF +$GET(TIUPFLG)
SET TIUFLAG=+$$CHARTONE^TIURA1(TIUDA)
End DoDot:1
IF $DATA(DIROUT)
QUIT
+22 QUIT
DICTATED ; Mark Document(s) "dictated"
+1 NEW TIUCHNG,TIUI,TIUY,Y,DIROUT
+2 IF '$DATA(VALMY)
DO EN^VALM2(XQORNOD(0))
+3 SET TIUI=0
+4 FOR
SET TIUI=$ORDER(VALMY(TIUI))
IF +TIUI'>0
QUIT
Begin DoDot:1
+5 NEW TIU,DFN,TIUDA,TIUDATA,RSTRCTD
+6 SET TIUDATA=$GET(^TMP("TIURIDX",$JOB,TIUI))
+7 SET TIUDA=+$PIECE(TIUDATA,U,2)
SET RSTRCTD=$$DOCRES^TIULRR(TIUDA)
+8 IF RSTRCTD
Begin DoDot:2
+9 WRITE !!,$CHAR(7),"Ok, no harm done...",!
+10 ; pause
IF $$READ^TIUU("EA","RETURN to continue...")
End DoDot:2
QUIT
+11 DO EN^VALM("TIU DOCUMENT DICTATED")
End DoDot:1
IF $DATA(DIROUT)
QUIT
+12 ; -- Update or Rebuild list: --
+13 SET TIUCHNG("UPDATE")=1
+14 DO UPRBLD^TIURL(.TIUCHNG,.VALMY)
KILL VALMY
+15 SET VALMBCK="R"
+16 QUIT
DICTATE1(TIUDA) ; Single record sign on chart
+1 NEW DICMSG
DO FULL^VALM1
+2 DO DICT(TIUDA,.DICMSG)
+3 WRITE !!,$GET(DICMSG(1)),!,$GET(DICMSG(2)),!
HANG $SELECT($DATA(DICMSG(0)):+DICMSG(0),1:3)
+4 QUIT
DICT(DA,MSG) ; Mark signed on chart. Edit on-chart signatures.
+1 NEW AUTHOR,DIE,DR,Y,TIUSTAT,EXPCSNR,ATTNDNG,TIUDA,TIUPRMT,TIU0,TIU12,TIU13
+2 SET TIU0=$GET(^TIU(8925,+DA,0))
SET TIU12=$GET(^(12))
SET TIU13=$GET(^(13))
+3 SET TIUSTAT=$PIECE(TIU0,U,5)
+4 SET TIUPRMT=$SELECT(TIUSTAT>1:"Edit Dictation Data? ",1:"Has this document been dictated? ")
+5 WRITE !
SET MSG=$$READ^TIUU("YAO",TIUPRMT,"NO")
WRITE !
+6 IF 'MSG
SET TIUCHNG=0
GOTO DICTX
+7 SET TIUCHNG=1
+8 SET AUTHOR=$$PERSNAME^TIULC1(+$PIECE(TIU12,U,2))
+9 SET EXPCSNR=$$PERSNAME^TIULC1(+$PIECE(TIU12,U,8))
+10 IF +$PIECE(TIU12,U,9)
SET ATTNDNG=$$PERSNAME^TIULC1(+$PIECE(TIU12,U,9))
+11 SET DR="1202//^S X=AUTHOR;1307//^S X=$S(+$P(TIU13,U,7)'>0:""NOW"",1:$$DATE^TIULS(+$P(TIU13,U,7),""MM/DD/CCYY@HR:MIN:SEC""))"
+12 IF $DATA(ATTNDNG)
SET DR=DR_";1209//^S X=ATTNDNG"
+13 IF '$TEST
IF $DATA(EXPCSNR)
SET DR=DR_";1208//^S X=EXPCSNR"
+14 SET DR=DR_";1204////^S X=$$WHOSIGNS^TIULC1(DA);1208////^S X=$$WHOCOSIG^TIULC1(DA)"
+15 SET DIE=8925
DO ^DIE
+16 SET TIU0=$GET(^TIU(8925,+DA,0))
SET TIU12=$GET(^(12))
SET TIU13=$GET(^(13))
+17 ;Toggle status between undictated and untranscribed, depending on Dict Date
+18 SET DR=".05///^S X=$S(+$P(TIU13,U,7):""UNTRANSCRIBED"",1:""UNDICTATED"")"
SET DIE=8925
DO ^DIE
+19 DO UPDTIRT^TIUDIRT(.TIU,+DA)
DICTX SET MSG(1)=" Dictation data "_$SELECT(TIUCHNG:"",1:"NOT ")_"changed."
+1 QUIT
