source: WorldVistAEHR/trunk/r/MAILMAN-XM/XMJMP.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: 8.4 KB
Line 
1XMJMP ;ISC-SF/GMB-Print,Backup messages ;12/04/2002 10:53
2 ;;8.0;MailMan;**9**;Jun 28, 2002
3 ; PRINT Replaces ENTPRT^XMA0,^XMA02,ENTPRT^XMAP,QE2^XMA5
4 ; BACKUP Replaces E^XMA1,ENT8^XMAH,ENTR^XMAP,ENTBCK^XMAP
5 ; (ISC-WASH/CAP/THM)
6PRINT(XMDUZ,XMK,XMZ,XMPRTHDR,XMBROWSE) ; Print
7 ; XMPRTHDR 1=Print header
8 ; 0=don't (headerless print)
9 ; XMRECIPS 0=Don't print recipients
10 ; 1=Print summary recipients
11 ; 2=Print detail recipients
12 ; XMBROWSE 0=Print normally
13 ; 1=Direct the print to the VA FileMan Browser
14 N XMWHICH,XMRESPS,XMABORT,XMRECIPS,XMSAVE,ZTSK
15 S XMABORT=0
16 I $G(XMBROWSE) S XMRECIPS=0
17 E D QRECIP(.XMRECIPS,.XMABORT) Q:XMABORT
18 S XMRESPS=$$RESP^XMXUTIL2(XMZ)
19 I XMRESPS D Q:XMABORT
20 . S XMWHICH="0-"_XMRESPS
21 . D WHICH(XMZ,XMRESPS,$$EZBLD^DIALOG(34500),.XMWHICH,.XMABORT) ; Print
22 . ; If responses includes from x through the end, then set it so that
23 . ; if the user queues for later printing, any new add'l responses
24 . ; will be printed, too.
25 . I XMWHICH["-",$P(XMWHICH,"-",$L(XMWHICH,"-"))=XMRESPS S XMWHICH=$P(XMWHICH,"-",1,$L(XMWHICH,"-")-1)_"-"
26 E S XMWHICH="0-"
27 S:$G(XMPRTHDR)="" XMPRTHDR=1 ; default is to print with headers
28 F I="DUZ","XMDUZ","XMV(","XMK","XMZ","XMWHICH","XMRECIPS","XMPRTHDR" S XMSAVE(I)=""
29 I $D(XMSECURE) F I="XMPAKMAN","XMSECURE","XMSECURE(" S XMSAVE(I)=""
30 I $G(XMBROWSE) N IOP,DDBDMSG S IOP="BROWSER",DDBDMSG=$$EZBLD^DIALOG(34537,XMZ)_" "_$$ZSUBJ^XMXUTIL2(XMZ) ; (Instead of "VA FileMan Browser")
31 D EN^XUTMDEVQ("PRTMSGX^XMJMP",$$EZBLD^DIALOG(34501),.XMSAVE,,1) ; MailMan: Print
32 I $D(ZTSK) W !,$$EZBLD^DIALOG(34501.1,ZTSK) ; Request queued. Task number: |1|
33 Q
34PRTMSG(XMDUZ,XMK,XMZ,XMWHICH,XMRECIPS,XMPRTHDR) ;
35PRTMSGX ;
36PRINTMSG ;
37 N XMKN,XMRESPS,XMZREC,XMPTR
38 S XMZREC=$G(^XMB(3.9,XMZ,0)) Q:XMZREC=""
39 D BSKT^XMJMP1(XMDUZ,XMZ,.XMK,.XMKN)
40 D RESPONSE(XMDUZ,XMZ,.XMRESPS,.XMPTR)
41 W:$E($G(IOST),1,2)="C-" @IOF
42 D:XMPRTHDR IDHDR(XMDUZ)
43 D PRINTIT^XMJMP1(XMDUZ,XMK,XMKN,XMZ,XMZREC,XMRESPS,XMPTR,XMWHICH,XMRECIPS,0,XMPRTHDR)
44 I $D(ZTQUEUED) S ZTREQ="@" D ^%ZISC ; This close device is needed to preserve the temp global used by p-message.
45 Q
46IDHDR(XMDUZ) ; Header: "MailMan msg for..."
47 N XMREC,XMPARM
48 S XMREC=$G(^VA(200,XMDUZ,0))
49 W $C(13),$$EZBLD^DIALOG(34502,XMV("NAME")) ; MailMan message for
50 I $P(XMREC,U,9)'="",$D(^DIC(3.1,+$P(XMREC,U,9),0)) W " ",$P(^(0),U,1) ; VA TITLE
51 S XMPARM(1)=^XMB("NETNAME"),XMPARM(2)=$$MMDT^XMXUTIL1($$NOW^XLFDT)
52 W !,$$EZBLD^DIALOG(34503,.XMPARM),! ; Printed at site date
53 Q
54QRECIP(XMRECIPS,XMABORT) ;
55 N DIR,DIRUT,Y,XMSUMRY
56 S DIR(0)="Y"
57 S DIR("A")=$$EZBLD^DIALOG(34504) ; Print recipient list
58 S DIR("B")=$$EZBLD^DIALOG(39053) ; No
59 D BLD^DIALOG(34505,"","","DIR(""?"")")
60 D ^DIR I $D(DIRUT) S XMABORT=1 Q
61 I Y=0 S XMRECIPS=0 Q
62 S XMSUMRY=$$EZBLD^DIALOG(34507)
63 S DIR(0)="SM^"_$$EZBLD^DIALOG(34506)_";"_XMSUMRY
64 S DIR("A")=$$EZBLD^DIALOG(34508) ; Print Detail or Summary recipient chain
65 S DIR("B")=$P(XMSUMRY,":",2,99) ; Summary
66 D ^DIR I $D(DIRUT) S XMABORT=1 Q
67 S XMRECIPS=$S(Y=$P(XMSUMRY,":",1):1,1:2)
68 Q
69DISPMSG(XMDUZ,XMK,XMKN,XMZ,XMSECBAD,XMNOBACK) ; Display message
70 N XMRESPS,XMRESP,XMPTR,XMZREC,XMBACKUP
71 S XMZREC=^XMB(3.9,XMZ,0)
72 S XMPAKMAN=$$PAKMAN^XMXSEC1(XMZ,XMZREC)
73 D RESPONSE(XMDUZ,XMZ,.XMRESPS,.XMPTR,.XMRESP)
74 I XMRESP'="",XMRESPS S XMRESP=XMRESP+1 I XMRESP>XMRESPS,'$G(XMNOBACK) S XMBACKUP=1
75 I XMDUZ=.5,XMK>999 S XMRESP=XMRESPS+1 K:$D(XMBACKUP) XMBACKUP
76 E I $D(^XMB(3.9,XMZ,"K")),'$D(XMSECURE),'$$KEYOK^XMJMCODE(XMZ,$P(XMZREC,U,10)) S XMSECBAD=1 Q
77 W @IOF
78 D PRINTIT^XMJMP1(XMDUZ,XMK,XMKN,XMZ,XMZREC,XMRESPS,XMPTR,+XMRESP_"-",0,1,1)
79 I $G(XMBACKUP) W !!,$$EZBLD^DIALOG(34509) ; You are at the end of this message. Enter 'B' to Backup and review it.
80 Q
81RESPONSE(XMDUZ,XMZ,XMRESPS,XMPTR,XMRESP) ;
82 ; XMRESP="" if the user hasn't read the message at all
83 ; 0 if the user has read the original message only
84 ; n if the user has read thru response n
85 S XMRESPS=+$P($G(^XMB(3.9,XMZ,3,0)),U,4)
86 ;S XMPTR=+$O(^XMB(3.9,XMZ,1,"C",$S(XMDUZ=.6:DUZ,1:XMDUZ),0))
87 S XMPTR=+$O(^XMB(3.9,XMZ,1,"C",XMDUZ,0))
88 S XMRESP=$P($G(^XMB(3.9,XMZ,1,XMPTR,0)),U,2)
89 Q
90CHKRESP(XMDUZ,XMZO,XMRESPSO,XMRESP) ;
91 N XMRESPS
92 S XMRESPS=+$P($G(^XMB(3.9,XMZO,3,0)),U,4)
93 Q:XMRESPS=+XMRESP ; No new responses
94 I XMRESPSO>XMRESP D Q:XMRESPSO=XMRESPS
95 . I XMRESPSO-1>XMRESP D
96 . . ; >> You haven't read responses |1|-|2|. You may backup to see them. <<
97 . . N XMPARM
98 . . S XMPARM(1)=XMRESP+1,XMPARM(2)=XMRESPSO
99 . . W !,$$EZBLD^DIALOG(34510,.XMPARM)
100 . E W !,$$EZBLD^DIALOG(34511,XMRESP+1) ; >> You haven't read response |1|. You may backup to see it. <<
101 . S XMRESP=XMRESPSO
102 N XMZ
103 F S XMRESP=$O(^XMB(3.9,XMZO,3,XMRESP)) Q:'XMRESP S XMZ=$P($G(^(XMRESP,0)),U,1) I XMZ,$P($G(^XMB(3.9,XMZ,0)),U,2)'=XMDUZ Q
104 Q:'XMRESP
105 W !,$$EZBLD^DIALOG(34512,XMRESP) ; >> Response |1| has arrived - you may backup to see it. <<
106 Q
107BACKUP(XMDUZ,XMK,XMKN,XMZ) ; Backup
108 N XMWHICH,XMRESPS,XMABORT,XMZREC,XMPTR
109 S XMZREC=^XMB(3.9,XMZ,0)
110 I $D(^XMB(3.9,XMZ,"K")),'$D(XMSECURE) Q:'$$KEYOK^XMJMCODE(XMZ,$P(XMZREC,U,10))
111 S XMABORT=0
112 D RESPONSE(XMDUZ,XMZ,.XMRESPS,.XMPTR,.XMWHICH)
113 I XMRESPS D HOWMUCH^XMJMP1(XMZ,XMRESPS,.XMWHICH,.XMABORT) Q:XMABORT
114 W @IOF
115 D PRINTIT^XMJMP1(XMDUZ,XMK,XMKN,XMZ,XMZREC,XMRESPS,XMPTR,XMWHICH,0,1,1)
116 Q
117WHICH(XMZ,XMRESPS,XMVERB,XMWHICH,XMABORT) ;
118 N DIR,DIRUT,Y,XMTEXT
119 ; There is 1 response. / There are X responses. Response 0 is the original message. (?? shows index)
120 D BLD^DIALOG($S(XMRESPS=1:34514,1:34515),XMRESPS,"","XMTEXT")
121 M DIR("A")=XMTEXT
122 S DIR("A")=$$EZBLD^DIALOG(34516,XMVERB) ; Select the responses to |1|:
123 S:$D(XMWHICH) DIR("B")=XMWHICH
124 S DIR("PRE")="I X?.E1N1""-"" S X=X_XMRESPS W XMRESPS"
125 S DIR(0)="LACO^0:"_XMRESPS
126 S DIR("??")="^D HELPRESP^XMJMP1(XMZ,XMRESPS)"
127 D ^DIR I $D(DTOUT)!$D(DUOUT) S XMABORT=1 Q
128 S:X'="" XMWHICH=$E(Y,1,$L(Y)-1)
129 Q
130PONE(XMDUZ,XMK,XMZ,XMPRTHDR,XMABORT) ;
131PONEX ; Print one message. Check it to see if
132 ; the user is allowed to see it. (confidential, scrambled)
133 ; If not, print an error message.
134 N XMZREC
135 I $G(XMK)="" S XMK=$$BSKT^XMXUTIL2(XMDUZ,XMZ)
136 I '$D(^XMB(3.9,XMZ,0)),XMK D ZAPIT^XMJBM(XMDUZ,XMK,XMZ) S XMABORT=1 Q
137 S XMZREC=^XMB(3.9,XMZ,0)
138 I XMDUZ'=DUZ,'$$SURRACC^XMXSEC(XMDUZ,"",XMZ,XMZREC) D Q ; "access"
139 . D SHOW^XMJERR
140 . S XMABORT=1
141 N XMSECURE,XMPAKMAN ; Important 'new' - part of scramble and packman handling
142 S XMPAKMAN=$$PAKMAN^XMXSEC1(XMZ,XMZREC)
143 I $D(^XMB(3.9,XMZ,"K")),'$$KEYOK^XMJMCODE(XMZ,$P(XMZREC,U,10)) S XMABORT=1 Q
144 N XMRECIPS,XMRESPS,XMWHICH
145 D QRECIP(.XMRECIPS,.XMABORT) Q:XMABORT
146 D RESPONSE(XMDUZ,XMZ,.XMRESPS,"",.XMWHICH)
147 I XMRESPS D Q:XMABORT
148 . N XMRESP
149 . S XMRESP=XMWHICH
150 . I $D(^XMB(3.7,XMDUZ,"N0",XMK,XMZ)),XMRESP S:XMRESP'=XMRESPS XMRESP=XMRESP+1
151 . E S XMRESP=0
152 . I XMRESP=XMRESPS S XMWHICH=XMRESP
153 . E S XMWHICH=XMRESP_"-"_XMRESPS
154 . D WHICH(XMZ,XMRESPS,$$EZBLD^DIALOG(34500),.XMWHICH,.XMABORT) ; Print
155 E S XMWHICH=0
156 F I="DUZ","XMDUZ","XMV(","XMK","XMZ","XMWHICH","XMRECIPS","XMPRTHDR" S XMSAVE(I)=""
157 I $D(XMSECURE) F I="XMPAKMAN","XMSECURE","XMSECURE(" S XMSAVE(I)=""
158 D EN^XUTMDEVQ("PRTMSGX^XMJMP",$$EZBLD^DIALOG(34501),.XMSAVE) ; MailMan: Print
159 I $G(POP) S XMABORT=1
160 Q
161 ;PLIST(XMDUZ,XMZLIST,XMRECIPS,XMPRTHDR,XMMSG)
162PLISTX ;
163 ; Print a list of messages.
164 ; Check each message as we come to it to see if
165 ; the user is allowed to see it. (confidential, scrambled)
166 ; If not, print an error message.
167 N I,J,XMK,XMKN,XMZ,XMFIRST,XMCNT,XMABORT
168 S XMFIRST=1,(XMCNT,XMABORT,I)=0
169 F S I=$O(XMZLIST(I)) Q:'I D Q:XMABORT
170 . F J=1:1:$L(XMZLIST(I),",") D Q:XMABORT
171 . . S XMZ=$P(XMZLIST(I),",",J)
172 . . Q:'$D(^XMB(3.9,XMZ,0))
173 . . D BSKT^XMJMP1(XMDUZ,XMZ,.XMK,.XMKN)
174 . . D PRTMULT(XMDUZ,XMK,XMKN,XMZ,XMRECIPS,XMPRTHDR,.XMFIRST,.XMCNT,.XMABORT)
175 Q:$D(ZTQUEUED)
176 S XMMSG=$$EZBLD^DIALOG($S(XMCNT=1:34318.1,1:34318),XMCNT)
177 Q
178PRTMULT(XMDUZ,XMK,XMKN,XMZ,XMRECIPS,XMPRTHDR,XMFIRST,XMCNT,XMABORT) ; Multiple message print
179 N XMNOGO,XMZREC,XMRESPS,XMRESP,XMPTR,XMSECURE,XMPAKMAN
180 I $D(ZTQUEUED) S ZTREQ="@"
181 S XMNOGO=0
182 S XMZREC=$G(^XMB(3.9,XMZ,0))
183 I XMZREC="" D ZAPIT^XMXMSGS2(XMDUZ,XMK,XMZ) Q
184 S XMPAKMAN=$$PAKMAN^XMXSEC1(XMZ,XMZREC)
185 D CHECK^XMJMP2(XMDUZ,XMZ,XMZREC,.XMNOGO) Q:XMNOGO&'$D(ZTQUEUED)
186 I $E(IOST,1,2)="C-"!'XMFIRST W @IOF
187 S XMFIRST=0
188 D:XMPRTHDR IDHDR(XMDUZ)
189 I XMNOGO D NOGOMSG^XMJMP2(XMDUZ,XMZ,XMZREC,.XMNOGO) Q
190 D RESPONSE(XMDUZ,XMZ,.XMRESPS,.XMPTR,.XMRESP)
191 I $D(^XMB(3.7,XMDUZ,"N0",XMK,XMZ)),XMRESP S:XMRESP'=XMRESPS XMRESP=XMRESP+1
192 E S XMRESP=0
193 D PRINTIT^XMJMP1(XMDUZ,XMK,XMKN,XMZ,XMZREC,XMRESPS,XMPTR,XMRESP_"-",XMRECIPS,0,XMPRTHDR,1,.XMABORT)
194 S XMCNT=XMCNT+1
195 ;Q:XMABORT
196 ;I $E(IOST,1,2)="C-" D PAGE^XMXUTIL(.XMABORT)
197 Q
Note: See TracBrowser for help on using the repository browser.