source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUGR.m@ 1578

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

initial load of WorldVistAEHR
File size: 5.1 KB
RevLine 
[613]1TIUGR ; SLC/MAM - ID Note Review Screen Actions ; IDNOTE; 4/12/01
2 ;;1.0;TEXT INTEGRATION UTILITIES;**100**;Jun 20, 1997
3 ;
4IDNOTE ; Review Screen Action IN Interdisciplinary Note
5 ;If editing this module, please keep TIUGR1 consistent with it.
6 ; -- Sets TIUGLINK if user starts attaching
7 ; the note to an existing note: --
8 ; TIUGLINK = IFN of ID entry^Lineno^Title.
9 ; (If ID entry is chosen via browse instead of review, Lineno=0)
10 N LINENO,NTDATA,NTDA,ADDED,TIUQUIT,TITLE,TITLEDA
11 N CANATT,CANADD,PDOCTYP,TIUCHNG,LNO
12 N TIUDAARY,DETACHED,TIUACT,TIULST,TIUIDDAD
13 ; -- If user has already selected note to attach, but not note
14 ; to attach it to, write msg and quit: --
15 ;I $G(TIUGLINK) D ATTCHMSG(TIUGLINK) S TIUQUIT=1 G IDNOTEX
16 ; -- If user has already selected note to attach, but not note
17 ; to attach it to, and reselects IN, quit attach action: --
18 I $G(TIUGLINK) D LINKQUIT^TIUGR2 S TIUQUIT=1 G IDNOTEX
19 ; -- Select note to act on, if not already selected: --
20 I '$D(VALMY) D I $G(TIUQUIT) G IDNOTEX
21 . I $P($G(XQORNOD(0)),U,4)'["=" D
22 . . W !!," To ADD a new entry to an interdisciplinary note, please select the",!,"interdisciplinary note."
23 . . W !," To ATTACH an existing stand-alone note to an interdisciplinary note,",!,"please select the note you want to attach."
24 . D EN^VALM2(XQORNOD(0),"S") S LINENO=+$O(VALMY(0))
25 . I 'LINENO S TIUQUIT=1 Q
26 . ; -- Reverse video selected note: --
27 . D RESTORE^VALM10(LINENO),CNTRL^VALM10(LINENO,6,VALM("RM"),IORVON,IORVOFF),WRITE^VALM10(LINENO)
28 ; -- In case note was already selected: --
29 S LINENO=+$O(VALMY(0))
30 ; -- Set notedata NTDATA = lineno^IFN^? --
31 S NTDATA=$G(^TMP("TIURIDX",$J,LINENO))
32 S NTDA=+$P(NTDATA,U,2)
33 I '$D(^TIU(8925,+NTDA,0)) S TIUCHNG("REFRESH")=1,TIUQUIT=1 G IDNOTEX
34 S TITLE=$$DOCTYPE^TIULF(NTDA)
35 I $O(VALMY(LINENO)) D
36 . W !!,"Notes must be selected one at a time for interdisciplinary"
37 . W !,"note actions. Acting on your FIRST selection,"
38 . W !?3,$P(TITLE,U,2) H 5
39 . S LNO=LINENO F S LNO=$O(VALMY(LNO)) Q:'LNO D
40 . . D RESTORE^VALM10(LNO)
41 . . D WRITE^VALM10(LNO)
42 . . K VALMY(LNO)
43 ; -- If note is addendum, CWAD, or consult result,
44 ; user can't detach/attach it or add new entry to it.
45 ; Say so & quit: --
46 I +^TIU(8925,+NTDA,0)=81 D CANT("A") S TIUCHNG("REFRESH")=1 G IDNOTEX
47 S PDOCTYP=$P(^TIU(8925,+NTDA,0),U,4)
48 I (PDOCTYP=27)!(PDOCTYP=25)!(PDOCTYP=31)!(PDOCTYP=30) D G IDNOTEX
49 . D CANT("CWAD") S TIUCHNG("REFRESH")=1
50 I $P($G(^TIU(8925,+NTDA,14)),U,5) D G IDNOTEX
51 . D CANT("CR") S TIUCHNG("REFRESH")=1
52 ; -- If note is already an entry of an ID note, unlink it: --
53 S TIUIDDAD=$$HASIDDAD^TIUGBR(NTDA)
54 I TIUIDDAD D G IDNOTEX
55 . S TIUACT="DETACHED",TIUDAARY(LINENO)=NTDA
56 . D UNLKKID^TIUGR1(NTDA,TIUIDDAD,.DETACHED)
57 . I '$G(DETACHED) S TIUCHNG("REFRESH")=1,TIULST="" Q
58 . S TIUCHNG("RBLD")=1,TIULST=LINENO
59 ; -- If user can add an entry to the note, do it & quit: --
60 S CANADD=$$CANDO^TIULP(NTDA,"ATTACH ID ENTRY")
61 I CANADD D G IDNOTEX
62 . D ADDDAD^TIUGEDIT(NTDA,.ADDED)
63 . I 'ADDED S TIUCHNG("REFRESH")=1 Q
64 . S TIUCHNG("RBLD")=1
65 ; -- If user can't add entry to note, & attaching note to
66 ; an existing note is not permitted, say can't add & quit: --
67 ; -- Note itself has entries: --
68 I 'CANADD,$$HASIDKID^TIUGBR(NTDA) D G IDNOTEX
69 . W !!,$P(CANADD,U,2) D PAUSE S TIUCHNG("REFRESH")=1
70 ; -- Note is a possible parent: --
71 S TITLEDA=+^TIU(8925,NTDA,0)
72 I 'CANADD,$$POSSPRNT^TIULP(TITLEDA) D G IDNOTEX
73 . W !!,$P(CANADD,U,2) D PAUSE S TIUCHNG("REFRESH")=1
74 ; -- See if user can attach note to an existing note: --
75 S CANATT=$$CANDO^TIULP(NTDA,"ATTACH TO ID NOTE")
76 ; -- If user can attach note, set TIUGLINK,
77 ; write "Attaching...", and quit: --
78 I CANATT D G IDNOTEX
79 . S TIUGLINK=NTDA_U_LINENO_U_$P(TITLE,U,2)
80 . D ATTCHMSG(TIUGLINK) ; User is mid-attach, don't set TIUCHNG
81 ; -- If user can't attach, say can't attach, and quit
82 I 'CANATT D
83 . W !!,$P(CANATT,U,2) D PAUSE
84 . S TIUCHNG("REFRESH")=1
85IDNOTEX ; Restore video for selected line and refresh/update/rebuild list:
86 I $G(TIUCHNG("REFRESH"))!$G(TIUCHNG("UPDATE"))!$G(TIUCHNG("RBLD")) D
87 . S VALMY(LINENO)=""
88 . D UPRBLD^TIURL(.TIUCHNG,.VALMY)
89 S VALMBCK="R" K VALMY
90 I $G(TIUACT)="DETACHED" D VMSG^TIURS1(TIULST,.TIUDAARY,"DETACHED")
91 Q
92 ;
93PAUSE ;Wait til user hits return
94 I $$READ^TIUU("EA","Press RETURN to continue...")
95 Q
96 ;
97CANT(TYPE) ; Tell user they can't act on addendum, CWAD, or
98 ;Consult result
99 I TYPE="A" D
100 . W !!," An addendum is linked to its parent when it is first made and"
101 . W !,"cannot be attached or detached like an interdisciplinary note."
102 . W !,"To add an addendum to a note, use action 'Make Addendum.'"
103 I TYPE="CWAD" D
104 . W !!," CWAD notes cannot be used as interdisciplinary notes."
105 I TYPE="CR" D
106 . W !!," Consult results cannot be used as interdisciplinary notes."
107 D PAUSE
108 Q
109 ;
110ATTCHMSG(KIDDATA) ; Offer instructions when user has selected
111 ;the note to attach but not the note to attach it to.
112 W !!," Attaching ",$P(KIDDATA,U,3),"."
113 W !," Please select the note you want to attach it to."
114 W !," Or, reselect action IN if you no longer wish to attach the note."
115 I $$READ^TIUU("EA","Press RETURN when you have finished reading this message...")
116 Q
117 ;
Note: See TracBrowser for help on using the repository browser.