source: WorldVistAEHR/trunk/r/TEXT_INTEGRATION_UTILITIES-GMRP-TIU/TIUGR2.m@ 931

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

initial load of WorldVistAEHR
File size: 3.0 KB
Line 
1TIUGR2 ; SLC/MAM - ID Note Review Screen Actions ;2/28/01
2 ;;1.0;TEXT INTEGRATION UTILITIES;**100**;Jun 20, 1997
3 ;
4LKDAD(KIDDATA) ; Select DAD ID note to attach KID to, and attach it.
5 ; Called by PICK^TIULM when user selects line at action prompt
6 ;when TIUGLINK exists. Needs $0(VALMY(0)).
7 ; KIDDATA = TIUGLINK = DA^lineno^titlename for entry being attached,
8 ; where lineno = 0 if not in current screen
9 N LINENO,CANLINK2,DADDATA,DADDA,DADTL,CONTINUE,LINKED
10 N TIUI,PDOCTYP,TIUCHNG
11 S LINKED=0
12 S LINENO=+$O(VALMY(0))
13 S DADDATA=$G(^TMP("TIURIDX",$J,LINENO))
14 S DADDA=+$P(DADDATA,U,2)
15 I '$D(^TIU(8925,+DADDA,0)) G LKDADX
16 ; -- Set can't attach msg:
17 I +^TIU(8925,+DADDA,0)=81 S CANLINK2="0^You cannot attach ID entries to addenda."
18 S PDOCTYP=$P(^TIU(8925,+DADDA,0),U,4)
19 I (PDOCTYP=27)!(PDOCTYP=25)!(PDOCTYP=31)!(PDOCTYP=30) S CANLINK2="0^You cannot attach ID entries to CWAD notes."
20 I $P(^TIU(8925,+DADDA,14),U,5) S CANLINK2="0^You cannot attach ID entries to consult results."
21 I '$D(CANLINK2) S CANLINK2=$$CANDO^TIULP(DADDA,"ATTACH ID ENTRY")
22 I CANLINK2 D
23 . Q:($P(^TIU(8925,DADDA,0),U,2)=$P(^TIU(8925,+KIDDATA,0),U,2))
24 . S $P(CANLINK2,U,2)="You cannot attach these notes; they do not have the same patient."
25 . S $P(CANLINK2,U)=0
26 ; -- Tell user they can't attach, and quit:
27 I 'CANLINK2 D G LKDADX
28 . W !!," ",$P(CANLINK2,U,2),!
29 . W "Please reselect the child and choose a different parent."
30 . I $$READ^TIUU("EA","Press RETURN to continue...")
31 ; -- Attach:
32 S DADTL=$P($$DOCTYPE^TIULF(DADDA),U,2)
33 W !!," Attaching ",$P(KIDDATA,U,3)," to ",!,DADTL,"."
34 S CONTINUE=$$READ^TIUU("Y"," Are you sure","YES")
35 I 'CONTINUE!$D(DUOUT)!$D(DTOUT)!$D(DIROUT) G LKDADX
36 S LINKED=1
37 D LINK(+TIUGLINK,DADDA)
38 I $L(DADTL)>26 S DADTL=$E(DADTL,1,26)
39LKDADX ; Exit
40 ; -- Restore video for KID line if kid is in current screen:
41 I $P(KIDDATA,U,2) D RESTORE^VALM10($P(KIDDATA,U,2))
42 ; -- Set msgbar, UPRBLD parameter:
43 I 'LINKED S VALMSG="** Note not attached **",TIUCHNG("REFRESH")=1
44 I LINKED S VALMSG="** Note attached to "_DADTL_" **",TIUCHNG("RBLD")=1
45 D UPRBLD^TIURL(.TIUCHNG,.VALMY) ;don't K VALMY - done in PICK^TIULM
46 S VALMBCK="R" K TIUGLINK
47 Q
48 ;
49LINKMSG(TIUGLINK) ; Returns VALMSG displayed after LKKID.
50 ;Used in ENTRY ACTION of protocol TIU ACTION MENU OE/RR.
51 ; Can't just set VALMSG in LKKID because it gets overwritten by ENTRY
52 ;ACTION if user selects item number as independent List Manager action.
53 N KIDTL
54 S KIDTL=$P(TIUGLINK,U,3)
55 I $L(KIDTL)>33 S KIDTL=$E(KIDTL,1,33)
56 Q "** Attaching "_KIDTL_" **"
57 ;
58LINK(DA,DADDA) ; Link DA to parent ID note DADDA
59 N DIE,DR
60 S DIE=8925,DR="2101////"_DADDA
61 D ^DIE
62 D AUDLINK^TIUGR1(DA,"a",DADDA)
63 D SENDID^TIUALRT1(DA)
64 Q
65 ;
66LINKQUIT ; Quit without linking
67 ; Action QUIT Review Screen if started linking and didn't succeed
68 ; Called by TIU ACTION QUIT from Review Screen if $G(TIUGLINK).
69 ; Unscreens review actions
70 N TIUI
71 S TIUI=0
72 F TIUI=+$O(VALMY(TIUI)) Q:'TIUI D RESTORE^VALM10(TIUI)
73 I $P($G(TIUGLINK),U,2) D RESTORE^VALM10(+$P(TIUGLINK,U,2))
74 S VALMSG="** Note not attached **"
75 K VALMY,TIUGLINK
76 S VALMBCK="R"
77 Q
78 ;
Note: See TracBrowser for help on using the repository browser.