source: WorldVistAEHR/trunk/r/PATIENT_DATA_EXCHANGE-VAQ/VAQREQ07.m@ 1800

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

initial load of WorldVistAEHR

File size: 3.7 KB
Line 
1VAQREQ07 ;ALB/JFP - PDX, CREATE NOTIFY LIST, REQUEST SCREEN;01MAR93
2 ;;1.5;PATIENT DATA EXCHANGE;;NOV 17, 1993
3EP ; -- Main entry point for the list processor
4 ; - Called from VAQREQ02
5 ;
6REQ ; -- Request users for notify list
7 K ^TMP("VAQNOTI",$J)
8 N POP,NOTIDA,NOTIUSER,DIRUT,DTOUT,DUOUT,D,J,L,N,X,Y
9 ;
10 F J=1:1 D ASKNOTI I $D(DIRUT) D DBLCHK Q:$D(DIRUT)!(POP)
11 ; -- Cleanup and quit
12 K POP,NOTIDA,NOTIUSER,DIRUT,DTOUT,DUOUT,D,J,L,N,X,Y
13 K MAILDA,MAILNM
14 QUIT
15 ;
16DBLCHK ; -- Double check for exit
17 Q:$D(DUOUT)
18 S (VAQNOTI,POP)="0"
19 I $D(^TMP("VAQNOTI",$J)) D DBL1
20 QUIT
21 ;
22DBL1 ;
23 W !!
24 S DIR(0)="Y",DIR("B")="NO",DIR("A")="Include Data with Notification(s):"
25 D ^DIR K DIR
26 I Y=1 S VAQNOTI="1"
27 W !!
28 S DIR(0)="Y",DIR("B")="YES",DIR("A")="Exit Notify:"
29 D ^DIR K DIR
30 I Y=1 S POP=1
31 QUIT
32 ;
33ASKNOTI ; -- Call to Dir to request notify list
34 D:$D(^TMP("VAQNOTI",$J)) LISTD
35 S POP=0
36 S DIR("A")="User to notify: "
37 S DIR(0)="FAO^1:30"
38 S DIR("?")="^D HLP1^VAQREQ07"
39 S DIR("??")="^D HLP2^VAQREQ07"
40 W ! D ^DIR K DIR Q:$D(DIRUT)
41 S X=Y
42 I X="*L" D LISTD Q:POP
43 I $E(X,1,1)="-" D DELNOTI Q:POP
44 I $E(X,1,2)'="G." D NOTI Q:POP
45 I $E(X,1,2)="G." D GNOTI Q:POP
46 QUIT
47 ;
48NOTI ; -- Dic lookup to verify user in file 200 (new person)
49 S DIC="^VA(200,",DIC(0)="EMQZ"
50 D ^DIC K DIC I $D(DTOUT)!$D(DUOUT)!(Y<0) S POP=1 QUIT
51 S NOTIDA=$P(Y,U,1),NOTIUSER=$P(Y,U,2),^TMP("VAQNOTI",$J,NOTIUSER)=NOTIDA
52 QUIT
53 ;
54GNOTI ; -- Dic lookup to verify mail group name in file XMB(3.8
55 S X=$P(X,".",2) ; -- strip off G.
56 S DIC="^XMB(3.8,"
57 S DIC(0)="EMQZ"
58 D ^DIC K DIC I $D(DTOUT)!$D(DUOUT)!(Y<0) S POP=1 QUIT
59 S MAILDA=$P(Y,U,1)
60 S MAILNM=$P(Y,U,2)
61 D G1
62 QUIT
63 ;
64G1 S NOTIDA=""
65 N XMDUZ,XMCHAN,X,Y
66 S XMDUZ=$G(DUZ),XMCHAN=1
67 S X="G."_MAILNM
68 D WHO^XMA21 ; -- Mailman call to determine whos in group, sets XMY(
69 F S NOTIDA=$O(XMY(NOTIDA)) Q:'NOTIDA D SETG
70 QUIT
71 ;
72SETG ; --
73 Q:NOTIDA'?1N.N
74 S NOTIUSER=$P($G(^VA(200,NOTIDA,0)),U,1)
75 S ^TMP("VAQNOTI",$J,NOTIUSER)=NOTIDA
76 QUIT
77 ;
78DELNOTI ; -- Deletes person from notify list
79 S POP=1,X=$E(X,2,99)
80 I X="" W " ...No Entries Selected" QUIT
81 S X=$$PARTIC^VAQUTL94("^TMP(""VAQNOTI"","_$J_")",X)
82 I X=-1 W " ... Not Selected" QUIT
83 I '$D(^TMP("VAQNOTI",$J,X)) W " ... ",X," Not Selected" QUIT
84 K ^TMP("VAQNOTI",$J,X) W " ... ",X," Deleted"
85 QUIT
86 ;
87HLP1 ; -- Display options for user to notify prompt
88 W !!!,"Options for User to notify prompt:",!
89 W !,"User to notify: users name ; select user (new person)"
90 W !,"User to notify: G.mail group ; select mail group"
91 W !,"User to notify: -users name ; de-selects a user"
92 W !,"User to notify: *L ; list selected users"
93 W !,"User to notify: ^ ; terminates option"
94 W !,"User to notify: return ; done with option"
95 W !,"User to notify: ? ; list of input options"
96 W !,"User to notify: ?? ; displays choices"
97 QUIT
98 ;
99HLP2 ; -- Display new person file or mail group file
100 W !!,"(1) - New Person",!,"(2) - Mail Group",!
101 R "Select Display Option: ",X:DTIME Q:X=""
102 I X="^" QUIT
103 I X=1 D H1 QUIT
104 I X=2 D H2 QUIT
105 W " ...invalid entry"
106 K X
107 QUIT
108 ;
109H1 ; -- Displays new person file
110 S DIC="^VA(200,",DIC(0)="C",D="B"
111 D DQ^DICQ
112 K DIC,D
113 QUIT
114 ;
115H2 ; -- Display mail groups
116 S DIC="^XMB(3.8,"
117 S DIC(0)="CM"
118 S D="B",DZ="??"
119 D DQ^DICQ
120 K DIC,D,DZ
121 QUIT
122 ;
123LISTD ; -- Displays a list of names selected
124 S POP=1
125 I '$D(^TMP("VAQNOTI",$J)) W " ...No User(s) Selected" QUIT
126 W !!,"-------------------------------- User Selected --------------------------------"
127 S N="" F L=0:1 S N=$O(^TMP("VAQNOTI",$J,N)) Q:N="" W:'(L#8) ! W ?L#8*30 W N
128 W !,"--------------------------------------------------------------------------------"
129 W ! QUIT
130 ;
131END ; -- End of code
132 QUIT
Note: See TracBrowser for help on using the repository browser.