source: WorldVistAEHR/trunk/r/CONSULT_REQUEST_TRACKING-GMRC-GMRS-GMRT/GMRCACMT.m@ 724

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

initial load of WorldVistAEHR

File size: 5.4 KB
Line 
1GMRCACMT ;SLC/DLT,DCM,MA,JFR - Comment Action and alerting ;8/19/03 07:27
2 ;;3.0;CONSULT/REQUEST TRACKING;**4,14,18,20,22,29,35,47,55**;DEC 27, 1997;Build 4
3 ; This routine invokes IA #10060
4 ;
5COMMENT(GMRCO) ;Add a comment without changing the status
6 K GMRCQIT,GMRCQUT N GMRCA
7 I $D(IOTM),$D(IOBM),$D(IOSTBM) D FULL^VALM1
8 S GMRCNOW=$$NOW^XLFDT,GMRCAD=GMRCNOW
9 S GMRCOM=1,GMRCA=20,GMRCPROV=$P(^GMR(123,GMRCO,0),"^",14) D AUDIT^GMRCP
10 ; GMRCOM=1 defined the variable and tells AUDIT^GMRCP that the
11 ; word-processing logic should be executed. If an actual comment is
12 ; added, $P(GMRCOM,"^",2)=1 (send alert), if not GMRCOM=1 and no '^'
13 ; exists (do not send alert)
14 I $G(GMRCERR)=1 S GMRCMSG=GMRCERMS D EXAC^GMRCADC(GMRCMSG),END Q
15 ;continue if no lock problems occurred
16 I $P(GMRCOM,"^",2) D
17 . I $P($G(^GMR(123,GMRCO,12)),U,5)="F" D
18 .. W !!,"The ordering provider for this inter-facility consult will"
19 .. W " automatically be ",!,"notified.",!
20 . D PROCALRT("",1,20,GMRCO)
21 . ;update LAST ACTION field even though no status change
22 . N GMRCDR,GMRCSTS
23 . S GMRCSTS="",GMRCDR="9////20"
24 . D STATUS^GMRCP
25 D END
26 Q
27 ;
28PROCALRT(GMRCORTX,GMRCDELR,ACTION,GMRCO) ;Process alert for comments
29 ;If GMRCDELR=1, the ordering provider can be deleted from the list.
30 N GMRCADUZ,GMRCANS,NOTIF,GMRCQIT,GMRCTM
31 ;S GMRCANS=$$READ("Y","Do You Wish To Send An Alert With This Comment","N","Enter Y to continue with recipient prompts. Otherwise, enter N.",1)
32 ;I (GMRCANS[U)!(GMRCANS=0) D END Q
33 ;
34 D WHOTO
35 ;I $G(GMRCQIT) D END Q ;User "^" at requesting provider.
36 ;
37 N GMRCALT
38 S NOTIF=$S(ACTION=20:63,ACTION=8:63,1:23)
39 ;
40 D SENDMSG(NOTIF,+GMRCO,$G(GMRCTM))
41 Q
42 ;
43SENDMSG(NOTIF,GMRCO,GMRCATM) ;Send the alert
44 N GMRCDFN
45 I '$D(GMRCADUZ) S GMRCADUZ=""
46 W !,"Processing Alerts..."
47 S GMRCDFN=$P($G(^GMR(123,+GMRCO,0)),"^",2)
48 I '$L(GMRCORTX) D
49 . N TXT
50 . S TXT="Comment Added to "
51 . I $P($G(^GMR(123,GMRCO,12)),U,5)'="P" S GMRCORTX=TXT_"consult " Q
52 . S GMRCORTX=TXT_"remote consult "
53 S GMRCORTX=GMRCORTX_$$ORTX^GMRCAU(+GMRCO)
54 D MSG^GMRCP(GMRCDFN,GMRCORTX,+GMRCO,NOTIF,.GMRCADUZ,$G(GMRCATM))
55 Q
56 ;
57END ;kill off variables and exit
58 K GMRC,GMRCA,GMRCMSG,GMRCOM,GMRCO,GMRCORTX,GMRCERR,GMRCERMS,GMRCQUT,GMRCUT
59 I $D(DTOUT)!$D(DIROUT) S GMRCQIT=""
60 K DTOUT,DIROUT,DUOUT,DIRUT
61 S:$D(^TMP("GMRC",$J,"CURRENT","MENU")) XQORM("HIJACK")=^("MENU")
62 Q
63 ;
64WHOTO ;Get the users who should receive an alert
65 ;Asks about requesting provider first, then prompts for additional users
66 ;Returns GMRCADUZ array of users to send an alert to and GMRCQIT if "^"
67 N GMRCRP,GMRCANS,GMRCUPD
68 S GMRCRP=+$P($G(^GMR(123,+GMRCO,0)),U,14) ;requesting provider entry
69 S GMRCUPD=$$VALID^GMRCAU($P(^GMR(123,+GMRCO,0),U,5),GMRCO,DUZ)
70 I GMRCRP=DUZ D ;alert team if ord. prov. takes the action
71 . S GMRCTM=1
72 . W !,"Service update users will be notified.",!
73 I +GMRCUPD>1,GMRCRP'=DUZ D ; alert ord. prov if update users takes action
74 . S GMRCADUZ(GMRCRP)=""
75 . W !,"Requesting provider will be notified.",!
76 I '$G(GMRCTM),+GMRCUPD<2 D ;alert both if not ord. prov or update user
77 . S GMRCTM=1,GMRCADUZ(GMRCRP)=""
78 . W !,"Requesting provider and service update users will be notified.",!
79 ;
80 ;
81ANDTO ;Ask for additional recipients
82 D NAMELIST("Additional alert recipients: ",.GMRCADUZ,GMRCDELR)
83 Q
84 ;
85NAMELIST(GMRCP,GMRCOLD,GMRCDELR) ;manage the list of recipients
86 ;
87 ; GMRCP - Prompt
88 ; GMRCOLD - Original list with ordering provider.
89 ; GMRCDELR - 1 means the original list may have names deleted
90 ; Returns final list in GMRCOLD array
91 ;
92 N GMRCNEW,GMRCNT,GMRCDUZ,GMRCUSER,GMRCQ,GMRCADD,DIC,X,Y
93 ;
94 M GMRCNEW=GMRCOLD
95 I GMRCDELR=1 K GMRCOLD S GMRCOLD="" ;Remove mandatory users from GMRCOLD
96 S GMRCNT=0 F D Q:(GMRCUSER[U)
97 .S GMRCUSER=$$READ("FAO;3;46",$S(GMRCNT:"And ",1:"")_GMRCP,"","^D NAMEHELP^GMRCACMT")
98 .S:'$L(GMRCUSER) GMRCUSER=U Q:(GMRCUSER[U)
99 .I ($E(GMRCUSER,1)="-") S GMRCADD=0,GMRCUSER=$E(GMRCUSER,2,$L(GMRCUSER))
100 .E S GMRCADD=1
101 .;
102 .S X=GMRCUSER,DIC=200,DIC(0)="EMQ" D ^DIC
103 .;
104 .I (Y>0) D I 1
105 ..;W $E($P(Y,U,2),$L(GMRCUSER)+1,$L($P(Y,U,2)))
106 ..;
107 ..I GMRCADD D
108 ...I $D(GMRCNEW(+Y)) W " already in the list." Q
109 ...S GMRCNEW(+Y)="" W " added to the list." S GMRCNT=GMRCNT+1
110 ..;
111 ..I 'GMRCADD D
112 ...I $D(GMRCOLD(+Y)) W " can't delete this name from the list." Q
113 ...I '$D(GMRCNEW(+Y)) W " not currently in the list." Q
114 ...K GMRCNEW(+Y) S GMRCNT=GMRCNT-1 W " deleted from the list."
115 .;
116 .E I $L(GMRCUSER) W " Name not found."
117 ;
118 M GMRCOLD=GMRCNEW
119 Q
120 ;
121READ(GMRC0,GMRCA,GMRCB,GMRCH,GMRCL) ;read logic
122 ;
123 ; GMRC0 -> DIR(0) --- Type of read
124 ; GMRCA -> DIR("A") - Prompt
125 ; GMRCB -> DIR("B") - Default Answer
126 ; GMRCH -> DIR("?") - Help text or ^Execute code
127 ; GMRCL -> Number of blank lines to put before Prompt
128 ;
129 ; Returns "^" or answer
130 ;
131 N GMRCLINE,DIR,DTOUT,DUOUT,DIRUT,DIROUT
132 Q:'$L($G(GMRC0)) U
133 S DIR(0)=GMRC0
134 S:$L($G(GMRCA)) DIR("A")=GMRCA
135 S:$L($G(GMRCB)) DIR("B")=GMRCB
136 S:$L($G(GMRCH)) DIR("?")=GMRCH
137 F GMRCLINE=1:1:($G(GMRCL)-1) W !
138 D ^DIR
139 I $D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT) Q U
140 Q Y
141 ;
142 ;
143NAMEHELP ;Help for the recipient list logic
144 N GMRCDUZ
145 W !,"Enter the name of the user to send the alert to,"
146 W !," or put a '-' in front of a name to delete from the list."
147 W !
148 W !," Example:"
149 W !," SMITH,FRED -> to add Fred to the list."
150 W !," -SMITH,FRED -> to delete Fred from the list."
151 W !,"Already selected: "
152 W !
153 S GMRCDUZ=0 F S GMRCDUZ=$O(GMRCNEW(GMRCDUZ)) Q:'GMRCDUZ D
154 .W !,?5,$P(^VA(200,GMRCDUZ,0),U,1)
155 .W:$D(GMRCOLD(GMRCDUZ)) " <mandatory>"
156 W !
157 Q
158 ;
Note: See TracBrowser for help on using the repository browser.