source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIURA2.m@ 1150

Last change on this file since 1150 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 5.5 KB
RevLine 
[613]1TIURA2 ; SLC/JER - More review screen actions ;4/29/04
2 ;;1.0;TEXT INTEGRATION UTILITIES;**88,58,100,123,112,182**;Jun 20, 1997
3 ; 6/20/00: Moved DISPLAY, BROWSE, & BROWS1 from TIURA to TIURA2
4DISPLAY ; Detailed Display
5 N TIUDA,TIUD,TIUDATA,TIUI,Y,DIROUT,TIUQUIT,RSTRCTD
6 I '$D(VALMY) D EN^VALM2(XQORNOD(0))
7 S TIUI=0
8 F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:$D(TIUQUIT)
9 . N TIUVIEW
10 . S TIUDATA=$G(^TMP("TIURIDX",$J,TIUI))
11 . D CLEAR^VALM1
12 . W !!,"Reviewing #",+TIUDATA
13 . S TIUDA=+$P(TIUDATA,U,2)
14 . S TIUVIEW=$$CANDO^TIULP(TIUDA,"VIEW")
15 . I +TIUVIEW'>0 D Q
16 . . W !!,$C(7),$P(TIUVIEW,U,2),!
17 . . I $$READ^TIUU("EA","RETURN to continue...") ; pause
18 . . D RESTORE^VALM10(+TIUI)
19 . S RSTRCTD=$$DOCRES^TIULRR(TIUDA)
20 . I RSTRCTD D Q
21 . . W !!,$C(7),"Ok, no harm done...",!
22 . . I $$READ^TIUU("EA","RETURN to continue...") ; pause
23 . . D RESTORE^VALM10(+TIUI)
24 . D EN^TIUAUDIT
25 . I +$G(TIUQUIT) D FIXLSTNW^TIULM Q
26 . I TIUI'=$P($G(TIUGLINK),U,2) D RESTORE^VALM10(+TIUI) ; See rtn TIURL
27 K VALMY S VALMBCK="R"
28 Q
29BROWSE(TIULTMP) ; Browse selected documents
30 ; TIULTMP is list template name
31 N TIUDA,DFN,TIU,TIUCHNG,TIUDATA,TIUI,Y,DIROUT,TIUQUIT
32 N TIUGDATA
33 I '$D(VALMY) D EN^VALM2(XQORNOD(0))
34 S TIUI=0
35 F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:$D(TIUQUIT)
36 . N TIUVIEW,TIUGACT,RSTRCTD
37 . S TIUDATA=$G(^TMP("TIURIDX",$J,TIUI))
38 . S TIUDA=+$P(TIUDATA,U,2)
39 . S TIUGDATA=$G(^TMP("TIUR",$J,"IDDATA",TIUDA)) ; ID note/entry
40 . D CLEAR^VALM1
41 . W !!,"Reviewing Item #",TIUI
42 . S RSTRCTD=$$DOCRES^TIULRR(TIUDA)
43 . I RSTRCTD D Q
44 . . W !!,$C(7),"Ok, no harm done...",!
45 . . I $$READ^TIUU("EA","RETURN to continue...") ; pause
46 . D BROWS1(TIULTMP,TIUDA,TIUGDATA)
47 ; -- Update or Rebuild list: --
48 I $G(TIUCHNG("DELETE"))!$G(TIUCHNG("ADDM")) S TIUCHNG("RBLD")=1
49 S TIUCHNG("UPDATE")=1 ; default
50 D UPRBLD^TIURL(.TIUCHNG,.VALMY) K VALMY
51 S VALMBCK="R"
52 Q
53GETSORT(PRMSORT,EXPSORT) ; Get order for ID entries
54 Q $S($G(EXPSORT)'="":EXPSORT,1:PRMSORT)
55 ;
56BROWS1(TIULTMP,TIUDA,TIUGDATA) ; Browse single document
57 ; Calls EN^VALM
58 N %DT,C,D0,DIQ2,FINISH,TIU,TIUVIEW
59 I '$D(TIUGDATA) S TIUGDATA=$$IDDATA^TIURECL1(TIUDA)
60 I TIULTMP="TIU COMPLETE NOTES",$P(TIUGDATA,U,2) W !!,"You are completing the PARENT ENTRY of this interdisciplinary note."
61 I '$P(TIUGDATA,U,2) D Q:+TIUVIEW'>0 ;TIU*1*123
62 . S TIUVIEW=$$CANDO^TIULP(TIUDA,"VIEW")
63 . I +TIUVIEW'>0 D
64 . . W !!,$C(7),$P(TIUVIEW,U,2),!
65 . . I $$READ^TIUU("EA","RETURN to continue...") ; pause
66 I '$D(TIUPRM0)!'$D(TIUPRM1) D SETPARM^TIULE
67 D EN^VALM(TIULTMP)
68 K ^TMP("TIUVIEW",$J)
69 Q
70 ;
71EXPAND ; Expand/Collapse ID notes, Addenda in lists
72 N TIUDNM,TIULNM,TIUSTAT
73 D:'$D(VALMY) EN^VALM2(XQORNOD(0))
74 I $D(VALMY) D EC^TIURECL(.VALMY)
75 W !,"Refreshing the list."
76 K VALMY
77 S VALMCNT=+$G(@VALMAR@(0))
78 S VALMBCK="R"
79 Q
80 ;
81PRNTSCRN(VALMY) ; Evaluate whether a record may be printed
82 N TIUI S TIUI=""
83 F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:$D(DIROUT)
84 . N TIUPMTHD,TIUDTYP,TIUPFHDR,TIUPFNBR,TIUPGRP,TIUPRINT,TIUFLAG,RSTRCTD,TIUTYP
85 . S RSTRCTD=0,TIUDATA=$G(^TMP("TIURIDX",$J,TIUI))
86 . S TIUDA=+$P(TIUDATA,U,2),TIUTYP=$P(^TIU(8925,TIUDA,0),U)
87 . ; Evaluate whether user can print record
88 . S TIUPRINT=$$CANDO^TIULP(TIUDA,"PRINT RECORD")
89 . I +TIUPRINT'>0 D Q
90 . . W !!,"Item #",TIUI,": ",!,$P(TIUPRINT,U,2),!
91 . . K VALMY(TIUI)
92 . . I $$READ^TIUU("EA","RETURN to continue...")
93 . ;-- Add Check for restricted record when available --
94 . S DFN=+$P(^TIU(8925,TIUDA,0),U,2)
95 . S RSTRCTD=$$PTRES^TIULRR(DFN)
96 . I +RSTRCTD D Q
97 . . W !!,"Item #",TIUI," Removed from print list.",!
98 . . K VALMY(TIUI)
99 . . I $$READ^TIUU("EA","Press RETURN to continue...")
100 . I +$G(TIUPFLG) S TIUFLAG=+$$CHARTONE^TIURA1(TIUDA)
101 Q
102DICTATED ; Mark Document(s) "dictated"
103 N TIUCHNG,TIUI,TIUY,Y,DIROUT
104 I '$D(VALMY) D EN^VALM2(XQORNOD(0))
105 S TIUI=0
106 F S TIUI=$O(VALMY(TIUI)) Q:+TIUI'>0 D Q:$D(DIROUT)
107 . N TIU,DFN,TIUDA,TIUDATA,RSTRCTD
108 . S TIUDATA=$G(^TMP("TIURIDX",$J,TIUI))
109 . S TIUDA=+$P(TIUDATA,U,2) S RSTRCTD=$$DOCRES^TIULRR(TIUDA)
110 . I RSTRCTD D Q
111 . . W !!,$C(7),"Ok, no harm done...",!
112 . . I $$READ^TIUU("EA","RETURN to continue...") ; pause
113 . D EN^VALM("TIU DOCUMENT DICTATED")
114 ; -- Update or Rebuild list: --
115 S TIUCHNG("UPDATE")=1
116 D UPRBLD^TIURL(.TIUCHNG,.VALMY) K VALMY
117 S VALMBCK="R"
118 Q
119DICTATE1(TIUDA) ; Single record sign on chart
120 N DICMSG D FULL^VALM1
121 D DICT(TIUDA,.DICMSG)
122 W !!,$G(DICMSG(1)),!,$G(DICMSG(2)),! H $S($D(DICMSG(0)):+DICMSG(0),1:3)
123 Q
124DICT(DA,MSG) ; Mark signed on chart. Edit on-chart signatures.
125 N AUTHOR,DIE,DR,Y,TIUSTAT,EXPCSNR,ATTNDNG,TIUDA,TIUPRMT,TIU0,TIU12,TIU13
126 S TIU0=$G(^TIU(8925,+DA,0)),TIU12=$G(^(12)),TIU13=$G(^(13))
127 S TIUSTAT=$P(TIU0,U,5)
128 S TIUPRMT=$S(TIUSTAT>1:"Edit Dictation Data? ",1:"Has this document been dictated? ")
129 W ! S MSG=$$READ^TIUU("YAO",TIUPRMT,"NO") W !
130 I 'MSG S TIUCHNG=0 G DICTX
131 S TIUCHNG=1
132 S AUTHOR=$$PERSNAME^TIULC1(+$P(TIU12,U,2))
133 S EXPCSNR=$$PERSNAME^TIULC1(+$P(TIU12,U,8))
134 S:+$P(TIU12,U,9) ATTNDNG=$$PERSNAME^TIULC1(+$P(TIU12,U,9))
135 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""))"
136 I $D(ATTNDNG) S DR=DR_";1209//^S X=ATTNDNG"
137 E I $D(EXPCSNR) S DR=DR_";1208//^S X=EXPCSNR"
138 S DR=DR_";1204////^S X=$$WHOSIGNS^TIULC1(DA);1208////^S X=$$WHOCOSIG^TIULC1(DA)"
139 S DIE=8925 D ^DIE
140 S TIU0=$G(^TIU(8925,+DA,0)),TIU12=$G(^(12)),TIU13=$G(^(13))
141 ;Toggle status between undictated and untranscribed, depending on Dict Date
142 S DR=".05///^S X=$S(+$P(TIU13,U,7):""UNTRANSCRIBED"",1:""UNDICTATED"")",DIE=8925 D ^DIE
143 D UPDTIRT^TIUDIRT(.TIU,+DA)
144DICTX S MSG(1)=" Dictation data "_$S(TIUCHNG:"",1:"NOT ")_"changed."
145 Q
Note: See TracBrowser for help on using the repository browser.