source: WorldVistAEHR/trunk/r/MAILMAN-XM/XMJMQ.m@ 1361

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

initial load of WorldVistAEHR
File size: 7.4 KB
RevLine 
[613]1XMJMQ ;ISC-SF/GMB-Q,QD,QN Query recipients ;12/04/2002 11:21
2 ;;8.0;MailMan;**10**;Jun 28, 2002
3 ; Replaces ^XMA5,^XMA5A (ISC-WASH/THM/CAP)
4Q(XMDUZ,XMK,XMKN,XMZ) ; Query
5 N XMRESPM,XMABORT
6 D QINIT^XMJMQ1(XMDUZ,XMK,XMKN,XMZ,.XMRESPM,.XMABORT)
7 D SUMMARY^XMJMQ1(XMZ,0,"","","",.XMABORT)
8 Q
9QD(XMDUZ,XMK,XMKN,XMZ) ; Query Detail
10 N XMRESPM,XMABORT
11 D QINIT^XMJMQ1(XMDUZ,XMK,XMKN,XMZ,.XMRESPM,.XMABORT)
12 D DETAIL(XMZ,0,"","","",.XMABORT)
13 Q
14QN(XMDUZ,XMK,XMKN,XMZ) ; Query Network
15 N XMRESPM,XMABORT
16 D QINIT^XMJMQ1(XMDUZ,XMK,XMKN,XMZ,.XMRESPM,.XMABORT)
17 D NETWORK^XMJMQ1(XMZ,.XMABORT) Q:XMABORT
18 D DETAIL(XMZ,0,"","","",.XMABORT)
19 Q
20QX(XMDUZ,XMK,XMKN,XMZ,XMWHAT) ; Query Special
21 ; XMWHAT = "QC" - show local users who are current
22 ; "QNC" - show local users who are not current
23 ; "QT" - show local users who have terminated
24 N XMRESPM,XMABORT,XMTO,XMIEN,XMTYPE,XMRESPS,XMCNT,XMTOTAL,XMPHDR
25 D QINIT^XMJMQ1(XMDUZ,XMK,XMKN,XMZ,.XMRESPM,.XMABORT)
26 I $Y+3>IOSL D PAGE(.XMABORT) Q:XMABORT
27 S XMRESPS=+$P($G(^XMB(3.9,XMZ,3,0)),U,4)
28 W !
29 S (XMPHDR,XMCNT,XMTOTAL,XMTO)=0
30 F S XMTO=$O(^XMB(3.9,XMZ,1,"C",XMTO)) Q:+XMTO'=XMTO D Q:XMABORT
31 . S XMTOTAL=XMTOTAL+1
32 . S XMIEN=$O(^XMB(3.9,XMZ,1,"C",XMTO,""))
33 . I XMWHAT="QC",$P(^XMB(3.9,XMZ,1,XMIEN,0),U,2)'=XMRESPS Q ; not current
34 . I XMWHAT="QNC",$P(^XMB(3.9,XMZ,1,XMIEN,0),U,2)=XMRESPS Q ; current
35 . I XMWHAT="QT",'$G(^XMB(3.9,XMZ,1,XMIEN,"D")) Q ; not terminated
36 . S XMCNT=XMCNT+1
37 . D WNAME(XMZ,$$NAME^XMXUTIL(XMTO),XMIEN,XMRESPM,.XMTYPE,.XMABORT)
38 Q:XMABORT
39 I $Y+3+(XMCNT>0)>IOSL D PAGE(.XMABORT) Q:XMABORT
40 N XMTEXT,XMPARM
41 I XMCNT W !
42 S XMPARM(1)=XMCNT,XMPARM(2)=XMTOTAL
43 D BLD^DIALOG($S(XMWHAT="QC":37431.9,XMWHAT="QNC":37432.9,1:37433.9),.XMPARM,"","XMTEXT","F")
44 D MSG^DIALOG("WM","",IOM,"","XMTEXT")
45 ; Local recipients who are (not) current: |1| of |2|
46 ; Local recipients who have terminated: |1| of |2|
47 Q
48QNAME(XMDUZ,XMK,XMKN,XMZ) ; Query someone's name
49 N XMRESPM,XMABORT,DIR,Y,DIRUT,XMNAME
50 F D Q:$D(DIRUT)
51 . S DIR(0)="FO^1:30^K:"", ""[$E(X) X"
52 . S DIR("A")=$$EZBLD^DIALOG(34555) ; Enter the person's name or partial name
53 . D BLD^DIALOG(34556,"","","DIR(""?"")")
54 . ;Name must be from 1 to 30 characters,
55 . ;and must not contain ^, or begin with comma or space.
56 . D ^DIR Q:$D(DIRUT)
57 . S XMNAME=Y
58 . D QINIT^XMJMQ1(XMDUZ,XMK,XMKN,XMZ,.XMRESPM,.XMABORT)
59 . D SEARCH^XMJMQ1(XMZ,XMNAME,XMRESPM)
60 Q
61QNAMEX(XMDUZ,XMK,XMKN,XMZ,XMNAME) ; Query someone's name (name is supplied)
62 N XMRESPM,XMABORT
63 I ($L(XMNAME)<1)!($L(XMNAME)>30)!(XMNAME[U)!(", "[$E(XMNAME,1)) D Q
64 . N XMTEXT
65 . W $C(7)
66 . D BLD^DIALOG(34556,"","","XMTEXT","F")
67 . D MSG^DIALOG("WH","","","","XMTEXT")
68 . ;Name must be from 1 to 30 characters,
69 . ;and must not contain ^, or begin with comma or space.
70 D QINIT^XMJMQ1(XMDUZ,XMK,XMKN,XMZ,.XMRESPM,.XMABORT)
71 D SEARCH^XMJMQ1(XMZ,XMNAME,XMRESPM)
72 Q
73DETAIL(XMZ,XMPHDR,XMSUBJ,XMZSTR,XMPAGE,XMABORT) ;
74 ; XMRESPM Last part msg: of Number of responses in msg
75 N XMTO,XMRESPM,XMNAME,XMIEN,XMTYPE
76 I $Y+3>IOSL D PAGE(.XMABORT) Q:XMABORT
77 W !
78 S XMRESPM=+$P($G(^XMB(3.9,XMZ,3,0)),U,4)
79 S XMRESPM=$$EZBLD^DIALOG($S(XMRESPM=1:34557.1,1:34557),XMRESPM) ; XMRESPM_ response / responses
80 S XMTO="*" ; Show broadcast first.
81 F S XMTO=$O(^XMB(3.9,XMZ,1,"C",XMTO)) Q:$E(XMTO,1,1)'="*" D Q:XMABORT
82 . S XMIEN=$O(^XMB(3.9,XMZ,1,"C",XMTO,""))
83 . S XMNAME=$P(^XMB(3.9,XMZ,1,XMIEN,0),U,1)
84 . D WNAME(XMZ,XMNAME,XMIEN,XMRESPM,.XMTYPE,.XMABORT)
85 Q:XMABORT
86 S XMTO=""
87 F S XMTO=$O(^XMB(3.9,XMZ,1,"C",XMTO)) Q:XMTO="" D Q:XMABORT
88 . S XMIEN=$O(^XMB(3.9,XMZ,1,"C",XMTO,""))
89 . I XMTO=+XMTO D
90 . . S XMNAME=$$NAME^XMXUTIL(XMTO)
91 . E D Q:$E(XMTO,1,1)="*"
92 . . I $L(XMTO)>29 S XMNAME=$P(^XMB(3.9,XMZ,1,XMIEN,0),U,1) Q
93 . . S XMNAME=XMTO
94 . D WNAME(XMZ,XMNAME,XMIEN,XMRESPM,.XMTYPE,.XMABORT)
95 Q
96WNAME(XMZ,XMNAME,XMIEN,XMRESPM,XMTYPE,XMABORT) ;
97 N XMREC
98 S XMREC=^XMB(3.9,XMZ,1,XMIEN,0)
99 I $Y+3>IOSL D PAGE(.XMABORT) Q:XMABORT
100 W !
101 I $D(^XMB(3.9,XMZ,1,XMIEN,"T")) D ; CC: Info: Thru:
102 . S XMTYPE=$P(^XMB(3.9,XMZ,1,XMIEN,"T"),U,1)
103 . Q:XMTYPE=""
104 . S:'$D(XMTYPE(XMTYPE)) XMTYPE(XMTYPE)=$$EXTERNAL^DILFD(3.91,6.5,"",XMTYPE)
105 . W XMTYPE(XMTYPE),": "
106 W XMNAME
107 W:$X<18 ?18
108 I +$P(XMREC,U,1)=$P(XMREC,U,1) D Q ; local user
109 . I $P(XMREC,U,3)="" D
110 . . W $$EZBLD^DIALOG(34574) ; " Not read."
111 . E D Q:XMABORT
112 . . D W3(34575,$$MMDT^XMXUTIL1($P(XMREC,U,3)),.XMABORT) Q:XMABORT ; Last read:
113 . . I $P(XMREC,U,2) D Q:XMABORT
114 . . . N XMPARM
115 . . . S XMPARM(1)=$P(XMREC,U,2),XMPARM(2)=XMRESPM
116 . . . D W3(34576,.XMPARM,.XMABORT) ; (x of y responses)
117 . . I $P(XMREC,U,10)'="" D W3(34577,$$MMDT^XMXUTIL1($P(XMREC,U,10)),.XMABORT) Q:XMABORT ; [First read: x]
118 . . I $D(^XMB(3.9,XMZ,1,XMIEN,"C")) D W3(34578,$$MMDT^XMXUTIL1(^("C")),.XMABORT) Q:XMABORT ; Copied:
119 . . I $D(^XMB(3.9,XMZ,1,XMIEN,"S")) D W3(34580,^("S"),.XMABORT) Q:XMABORT ; Surrogate:
120 . . I $D(^XMB(3.9,XMZ,1,XMIEN,"D")),^("D") D W3(34581,$$MMDT^XMXUTIL1(^("D")),.XMABORT) Q:XMABORT ; Terminated:
121 . I $D(^XMB(3.9,XMZ,1,XMIEN,"F")) D FWD(XMZ,XMIEN,.XMABORT) Q:XMABORT
122 I $E(XMNAME,1,2)="F.",$P(XMREC,U,12)'=""!$P(XMREC,U,11) D Q
123 . I $P(XMREC,U,5)'="" D W3(34582,$$MMDT^XMXUTIL1($P(XMREC,U,5)),.XMABORT) Q:XMABORT ; Sent to fax:
124 . I $P(XMREC,U,6)'="" D W3(34583,$P(XMREC,U,6),.XMABORT) Q:XMABORT ; Status:
125 . I $P(XMREC,U,12)'="" D W3(34584,$P(XMREC,U,12),.XMABORT) Q:XMABORT ; Fax ID:
126 . I $D(^XMB(3.9,XMZ,1,XMIEN,"F")) D FWD(XMZ,XMIEN,.XMABORT) Q:XMABORT
127 I XMNAME["@" D Q
128 . I $P(XMREC,U,5)'="" D W3(34585,$$MMDT^XMXUTIL1($P(XMREC,U,5)),.XMABORT) Q:XMABORT ; Sent:
129 . I $P(XMREC,U,8)'="" D W3($S($P(XMREC,U,8)=1:34586,1:34587),$P(XMREC,U,8),.XMABORT) Q:XMABORT ; Time: x seconds
130 . I $P(XMREC,U,7)'="",$D(^DIC(4.2,$P(XMREC,U,7),0)) D W3(34588,$P(^(0),U),.XMABORT) Q:XMABORT ; Path:
131 . I $P(XMREC,U,4)'="" D W3(34590,$P(XMREC,U,4),.XMABORT) Q:XMABORT ; Message ID:
132 . I $P(XMREC,U,6)'="" D W3(34583,$P(XMREC,U,6),.XMABORT) Q:XMABORT ; Status:
133 . I $D(^XMB(3.9,XMZ,1,XMIEN,"F")) D FWD(XMZ,XMIEN,.XMABORT) Q:XMABORT
134 I $E(XMNAME,1,3)="* (" D Q ; Broadcast
135 . I $D(^XMB(3.9,XMZ,1,XMIEN,"F")) D FWD(XMZ,XMIEN,.XMABORT)
136 I ".D.H.S."[("."_$E(XMNAME,1,2)) D Q
137 . I $P(XMREC,U,3)'="" D W3(34591,$$MMDT^XMXUTIL1($P(XMREC,U,3)),.XMABORT) Q:XMABORT ; Date:
138 . I $P(XMREC,U,6)'="" D W3(34583,$P(XMREC,U,6),.XMABORT) Q:XMABORT ; Status:
139 . I $D(^XMB(3.9,XMZ,1,XMIEN,"F")) D FWD(XMZ,XMIEN,.XMABORT) Q:XMABORT
140 Q
141FWD(XMZ,XMIEN,XMABORT) ;
142 N XMFWDREC,XMFWDBY,XMFWDTYP
143 S XMFWDREC=^XMB(3.9,XMZ,1,XMIEN,"F")
144 S XMFWDBY=$P(XMFWDREC,U)
145 I $E(XMFWDBY,1)=" " D W3(34592,XMFWDBY,.XMABORT) Q ; Forwarded on:
146 I $E(XMFWDBY,1)?1N!($E(XMFWDBY,1)=".") D W3(34593,$$NAME^XMXUTIL(+XMFWDBY)_" "_$P(XMFWDBY," ",2,99),.XMABORT) Q ; Forwarded by:
147 S XMFWDTYP=$P(XMFWDREC,U,3)
148 D W3($S(XMFWDTYP="A":34593.1,XMFWDTYP="F":34593.2,1:34593),XMFWDBY,.XMABORT) ; Auto-Forwarded / Filter-Forwarded / Forwarded by:
149 Q:$P(XMFWDREC,U,4)=""
150 N XMPARM
151 S XMPARM(1)=$$NAME^XMXUTIL($P(XMFWDREC,U,2))
152 S XMPARM(2)=$P(XMFWDREC,U,4)
153 S XMFWDTYP=$P(XMFWDREC,U,5)
154 ; Filter-Forwarded / Forwarded to |1| by: |2|
155 D W3($S(XMFWDTYP="F":34594.1,1:34594),.XMPARM,.XMABORT)
156 Q
157W3(XMPIECE,XMPARM,XMABORT) ;
158 S XMPIECE=$$EZBLD^DIALOG(XMPIECE,.XMPARM)
159 I 1+$L(XMPIECE)+$X>IOM D Q:XMABORT
160 . I $Y+3+($L(XMPIECE)-1\60)>IOSL D PAGE(.XMABORT) Q:XMABORT
161 . W !,?18
162 . Q:$L(XMPIECE)<61
163 . F D Q:$L(XMPIECE)<61
164 . . W " ",$E(XMPIECE,1,60),!,?18
165 . . S XMPIECE=$E(XMPIECE,61,999)
166 W " ",XMPIECE
167 Q
168 ;PAGE(XMPHDR,XMSUBJ,XMZSTR,XMPAGE,XMABORT);
169PAGE(XMABORT) ;
170 I $E($G(IOST),1,2)="C-" D PAGE^XMXUTIL(.XMABORT) Q:XMABORT
171 W @IOF
172 Q:'XMPHDR
173 D PAGE2HDR^XMJMP1(XMSUBJ,XMZSTR,.XMPAGE)
174 Q
Note: See TracBrowser for help on using the repository browser.