source: FOIAVistA/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUGR1.m@ 772

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

initial load of FOIAVistA 6/30/08 version

File size: 3.8 KB
Line 
1TIUGR1 ; SLC/MAM - More ID Note Review Screen Actions ;4/12/01
2 ;;1.0;TEXT INTEGRATION UTILITIES;**100**;Jun 20, 1997
3 ;
4IDNOTEB(TIUDA) ; Browse Screen Action IN Interdisciplinary Note
5 ; Requires TIUDA
6 ; If editing this module, please keep TIUGR consistent with it.
7 N TITLE,PREFIX,TITLEDA,CANADD,CANATT,ADDED,TIUQUIT,TIUIDDAD
8 ;TIUCHNG is newed in TIURA2; Don't new it here
9 S VALMBCK="R"
10 ; -- If note is addendum, can't attach; say so & quit: --
11 I +^TIU(8925,TIUDA,0)=81 D G IDNOTEBX
12 . D CANT^TIUGR("A") S TIUCHNG("REFRESH")=1
13 ; -- If note is already an entry of an ID note, unlink it: --
14 S TIUIDDAD=$$HASIDDAD^TIUGBR(TIUDA)
15 I TIUIDDAD D G IDNOTEBX
16 . D UNLKKID(TIUDA,TIUIDDAD)
17 . I $G(TIUQUIT) S TIUCHNG("REFRESH")=1 Q
18 . S TIUCHNG("RBLD")=1
19 . K VALMHDR ; TIUDA is no longer an ID entry so update header
20 ; -- If user can add an entry to the note, do it & quit: --
21 S CANADD=$$CANDO^TIULP(TIUDA,"ATTACH ID ENTRY")
22 I CANADD D ADDDAD^TIUGEDIT(TIUDA,.ADDED) D G IDNOTEBX
23 . I 'ADDED S TIUCHNG("REFRESH")=1 Q
24 . S TIUCHNG("RBLD")=1 K VALMHDR
25 ; -- If user can't add entry to note, & attaching note to
26 ; an existing note is not permitted, say can't add & quit: --
27 ; -- Note itself has entries: --
28 I 'CANADD,$$HASIDKID^TIUGBR(TIUDA) D G IDNOTEBX
29 . W !!,$P(CANADD,U,2) D PAUSE^TIUGR
30 . S TIUCHNG("REFRESH")=1
31 ; -- Note is a possible parent: --
32 S TITLEDA=+^TIU(8925,TIUDA,0)
33 I 'CANADD,$$POSSPRNT^TIULP(TITLEDA) D G IDNOTEBX
34 . W !!,$P(CANADD,U,2) D PAUSE^TIUGR
35 . S TIUCHNG("REFRESH")=1
36 ; -- See if user can attach note to an existing note: --
37 S CANATT=$$CANDO^TIULP(TIUDA,"ATTACH TO ID NOTE")
38 ; -- If user can attach, tell user not to use Browse:
39 I CANATT W !!,"To attach this note to an ID parent, please exit Browse and try again ",!,"from a Review Screen showing a list of notes.",! H 5 S TIUCHNG("REFRESH")=1 G IDNOTEBX
40 ; -- If user can't attach, say can't attach: --
41 I 'CANATT W !!,$P(CANATT,U,2) D PAUSE^TIUGR S TIUCHNG("REFRESH")=1
42IDNOTEBX ;
43 ; -- Rebuild browse screen for updated record: --
44 ; (Review screen is updated from BROWSE^TIURA2)
45 S TIUGDATA=$$IDDATA^TIURECL1(TIUDA) ;may have changed
46 D BLDTMP^TIUBR(TIUDA)
47 Q
48 ;
49UNLKKID(KIDDA,TIUIDDAD,DETACHED) ; Unlink ID entry
50 ; Check if user can unlink, and if so, unlink it.
51 N CANUNLK,UNLINK,MSG,DADDA,TIUQUIT
52 S DETACHED=0
53 W !!,"This note is attached to an interdisciplinary note."
54 ; -- Same users can unlink as can link: --
55 S CANUNLK=$$CANDO^TIULP(KIDDA,"ATTACH TO ID NOTE")
56 I CANUNLK S CANUNLK=$$CANDO^TIULP(TIUIDDAD,"ATTACH ID ENTRY")
57 I 'CANUNLK D G UNLKKIDX
58 . ;S MSG=$P(CANUNLK,U,2),MSG=$P(MSG,"You may not ATTACH this",2)
59 . ;S MSG=$P(MSG,"to an ID note."),MSG=" You may not DETACH this"_MSG
60 . W !,"You may not detach this note from its interdisciplinary note."
61 . I $$READ^TIUU("EA","Press RETURN to continue...")
62 . S TIUQUIT=1
63 S UNLINK=$$READ^TIUU("Y","Do you want to detach it","NO")
64 I 'UNLINK W !!,"Entry not detached." H 1 S TIUQUIT=1 G UNLKKIDX
65 S DADDA=$P($G(^TMP("TIUR",$J,"IDDATA",KIDDA)),U,3)
66 D UNLINK(KIDDA)
67 I DADDA D UPIDDATA^TIURL1(KIDDA),UPIDDATA^TIURL1(DADDA)
68 W !!,"Entry detached." H 1
69 ;S VALMSG="** Entry detached **" ;4/9/01
70 S TIUCHNG("RBLD")=1,DETACHED=1 ;4/9/01
71UNLKKIDX ;
72 ;I $G(TIUQUIT) S VALMSG="** Entry not detached **",TIUCHNG("REFRESH")=1 Q ;4/9/01
73 I $G(TIUQUIT) S TIUCHNG("REFRESH")=1 Q ;4/9/01
74 Q
75 ;
76UNLINK(DA) ; Unlink DA from DADDA
77 N DIE,DR,IDDAD
78 S IDDAD=+$G(^TIU(8925,DA,21))
79 S DIE=8925,DR="2101////@"
80 D ^DIE
81 D AUDLINK(DA,"d",IDDAD)
82 D IDDEL^TIUALRT1(DA)
83 Q
84AUDLINK(TIUDA,ACTION,IDPARENT) ; Audit Attach/Detach Events
85 N DIC,DIE,DA,DR,X,Y,TIUD0,TIUD21,DLAYGO
86 Q:$G(ACTION)']""!(+$G(IDPARENT)'>0)
87 S TIUD0=$G(^TIU(8925,TIUDA,0))
88 S X=""""_"`"_TIUDA_"""",(DIC,DLAYGO)=8925.5,DIC(0)="FLX" D ^DIC Q:+Y'>0
89 S DA=+Y,DIE=DIC
90 S DR="3.01////"_ACTION_";3.02////"_$$NOW^XLFDT
91 S DR=DR_";3.03////"_DUZ_";3.04////"_$P(TIUD0,U,5)
92 S DR=DR_";3.05////"_IDPARENT
93 D ^DIE
94 Q
Note: See TracBrowser for help on using the repository browser.