198 lines
8.4 KiB
Mathematica
198 lines
8.4 KiB
Mathematica
XMJMP ;ISC-SF/GMB-Print,Backup messages ;12/04/2002 10:53
|
|
;;8.0;MailMan;**9**;Jun 28, 2002
|
|
; PRINT Replaces ENTPRT^XMA0,^XMA02,ENTPRT^XMAP,QE2^XMA5
|
|
; BACKUP Replaces E^XMA1,ENT8^XMAH,ENTR^XMAP,ENTBCK^XMAP
|
|
; (ISC-WASH/CAP/THM)
|
|
PRINT(XMDUZ,XMK,XMZ,XMPRTHDR,XMBROWSE) ; Print
|
|
; XMPRTHDR 1=Print header
|
|
; 0=don't (headerless print)
|
|
; XMRECIPS 0=Don't print recipients
|
|
; 1=Print summary recipients
|
|
; 2=Print detail recipients
|
|
; XMBROWSE 0=Print normally
|
|
; 1=Direct the print to the VA FileMan Browser
|
|
N XMWHICH,XMRESPS,XMABORT,XMRECIPS,XMSAVE,ZTSK
|
|
S XMABORT=0
|
|
I $G(XMBROWSE) S XMRECIPS=0
|
|
E D QRECIP(.XMRECIPS,.XMABORT) Q:XMABORT
|
|
S XMRESPS=$$RESP^XMXUTIL2(XMZ)
|
|
I XMRESPS D Q:XMABORT
|
|
. S XMWHICH="0-"_XMRESPS
|
|
. D WHICH(XMZ,XMRESPS,$$EZBLD^DIALOG(34500),.XMWHICH,.XMABORT) ; Print
|
|
. ; If responses includes from x through the end, then set it so that
|
|
. ; if the user queues for later printing, any new add'l responses
|
|
. ; will be printed, too.
|
|
. I XMWHICH["-",$P(XMWHICH,"-",$L(XMWHICH,"-"))=XMRESPS S XMWHICH=$P(XMWHICH,"-",1,$L(XMWHICH,"-")-1)_"-"
|
|
E S XMWHICH="0-"
|
|
S:$G(XMPRTHDR)="" XMPRTHDR=1 ; default is to print with headers
|
|
F I="DUZ","XMDUZ","XMV(","XMK","XMZ","XMWHICH","XMRECIPS","XMPRTHDR" S XMSAVE(I)=""
|
|
I $D(XMSECURE) F I="XMPAKMAN","XMSECURE","XMSECURE(" S XMSAVE(I)=""
|
|
I $G(XMBROWSE) N IOP,DDBDMSG S IOP="BROWSER",DDBDMSG=$$EZBLD^DIALOG(34537,XMZ)_" "_$$ZSUBJ^XMXUTIL2(XMZ) ; (Instead of "VA FileMan Browser")
|
|
D EN^XUTMDEVQ("PRTMSGX^XMJMP",$$EZBLD^DIALOG(34501),.XMSAVE,,1) ; MailMan: Print
|
|
I $D(ZTSK) W !,$$EZBLD^DIALOG(34501.1,ZTSK) ; Request queued. Task number: |1|
|
|
Q
|
|
PRTMSG(XMDUZ,XMK,XMZ,XMWHICH,XMRECIPS,XMPRTHDR) ;
|
|
PRTMSGX ;
|
|
PRINTMSG ;
|
|
N XMKN,XMRESPS,XMZREC,XMPTR
|
|
S XMZREC=$G(^XMB(3.9,XMZ,0)) Q:XMZREC=""
|
|
D BSKT^XMJMP1(XMDUZ,XMZ,.XMK,.XMKN)
|
|
D RESPONSE(XMDUZ,XMZ,.XMRESPS,.XMPTR)
|
|
W:$E($G(IOST),1,2)="C-" @IOF
|
|
D:XMPRTHDR IDHDR(XMDUZ)
|
|
D PRINTIT^XMJMP1(XMDUZ,XMK,XMKN,XMZ,XMZREC,XMRESPS,XMPTR,XMWHICH,XMRECIPS,0,XMPRTHDR)
|
|
I $D(ZTQUEUED) S ZTREQ="@" D ^%ZISC ; This close device is needed to preserve the temp global used by p-message.
|
|
Q
|
|
IDHDR(XMDUZ) ; Header: "MailMan msg for..."
|
|
N XMREC,XMPARM
|
|
S XMREC=$G(^VA(200,XMDUZ,0))
|
|
W $C(13),$$EZBLD^DIALOG(34502,XMV("NAME")) ; MailMan message for
|
|
I $P(XMREC,U,9)'="",$D(^DIC(3.1,+$P(XMREC,U,9),0)) W " ",$P(^(0),U,1) ; VA TITLE
|
|
S XMPARM(1)=^XMB("NETNAME"),XMPARM(2)=$$MMDT^XMXUTIL1($$NOW^XLFDT)
|
|
W !,$$EZBLD^DIALOG(34503,.XMPARM),! ; Printed at site date
|
|
Q
|
|
QRECIP(XMRECIPS,XMABORT) ;
|
|
N DIR,DIRUT,Y,XMSUMRY
|
|
S DIR(0)="Y"
|
|
S DIR("A")=$$EZBLD^DIALOG(34504) ; Print recipient list
|
|
S DIR("B")=$$EZBLD^DIALOG(39053) ; No
|
|
D BLD^DIALOG(34505,"","","DIR(""?"")")
|
|
D ^DIR I $D(DIRUT) S XMABORT=1 Q
|
|
I Y=0 S XMRECIPS=0 Q
|
|
S XMSUMRY=$$EZBLD^DIALOG(34507)
|
|
S DIR(0)="SM^"_$$EZBLD^DIALOG(34506)_";"_XMSUMRY
|
|
S DIR("A")=$$EZBLD^DIALOG(34508) ; Print Detail or Summary recipient chain
|
|
S DIR("B")=$P(XMSUMRY,":",2,99) ; Summary
|
|
D ^DIR I $D(DIRUT) S XMABORT=1 Q
|
|
S XMRECIPS=$S(Y=$P(XMSUMRY,":",1):1,1:2)
|
|
Q
|
|
DISPMSG(XMDUZ,XMK,XMKN,XMZ,XMSECBAD,XMNOBACK) ; Display message
|
|
N XMRESPS,XMRESP,XMPTR,XMZREC,XMBACKUP
|
|
S XMZREC=^XMB(3.9,XMZ,0)
|
|
S XMPAKMAN=$$PAKMAN^XMXSEC1(XMZ,XMZREC)
|
|
D RESPONSE(XMDUZ,XMZ,.XMRESPS,.XMPTR,.XMRESP)
|
|
I XMRESP'="",XMRESPS S XMRESP=XMRESP+1 I XMRESP>XMRESPS,'$G(XMNOBACK) S XMBACKUP=1
|
|
I XMDUZ=.5,XMK>999 S XMRESP=XMRESPS+1 K:$D(XMBACKUP) XMBACKUP
|
|
E I $D(^XMB(3.9,XMZ,"K")),'$D(XMSECURE),'$$KEYOK^XMJMCODE(XMZ,$P(XMZREC,U,10)) S XMSECBAD=1 Q
|
|
W @IOF
|
|
D PRINTIT^XMJMP1(XMDUZ,XMK,XMKN,XMZ,XMZREC,XMRESPS,XMPTR,+XMRESP_"-",0,1,1)
|
|
I $G(XMBACKUP) W !!,$$EZBLD^DIALOG(34509) ; You are at the end of this message. Enter 'B' to Backup and review it.
|
|
Q
|
|
RESPONSE(XMDUZ,XMZ,XMRESPS,XMPTR,XMRESP) ;
|
|
; XMRESP="" if the user hasn't read the message at all
|
|
; 0 if the user has read the original message only
|
|
; n if the user has read thru response n
|
|
S XMRESPS=+$P($G(^XMB(3.9,XMZ,3,0)),U,4)
|
|
;S XMPTR=+$O(^XMB(3.9,XMZ,1,"C",$S(XMDUZ=.6:DUZ,1:XMDUZ),0))
|
|
S XMPTR=+$O(^XMB(3.9,XMZ,1,"C",XMDUZ,0))
|
|
S XMRESP=$P($G(^XMB(3.9,XMZ,1,XMPTR,0)),U,2)
|
|
Q
|
|
CHKRESP(XMDUZ,XMZO,XMRESPSO,XMRESP) ;
|
|
N XMRESPS
|
|
S XMRESPS=+$P($G(^XMB(3.9,XMZO,3,0)),U,4)
|
|
Q:XMRESPS=+XMRESP ; No new responses
|
|
I XMRESPSO>XMRESP D Q:XMRESPSO=XMRESPS
|
|
. I XMRESPSO-1>XMRESP D
|
|
. . ; >> You haven't read responses |1|-|2|. You may backup to see them. <<
|
|
. . N XMPARM
|
|
. . S XMPARM(1)=XMRESP+1,XMPARM(2)=XMRESPSO
|
|
. . W !,$$EZBLD^DIALOG(34510,.XMPARM)
|
|
. E W !,$$EZBLD^DIALOG(34511,XMRESP+1) ; >> You haven't read response |1|. You may backup to see it. <<
|
|
. S XMRESP=XMRESPSO
|
|
N XMZ
|
|
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
|
|
Q:'XMRESP
|
|
W !,$$EZBLD^DIALOG(34512,XMRESP) ; >> Response |1| has arrived - you may backup to see it. <<
|
|
Q
|
|
BACKUP(XMDUZ,XMK,XMKN,XMZ) ; Backup
|
|
N XMWHICH,XMRESPS,XMABORT,XMZREC,XMPTR
|
|
S XMZREC=^XMB(3.9,XMZ,0)
|
|
I $D(^XMB(3.9,XMZ,"K")),'$D(XMSECURE) Q:'$$KEYOK^XMJMCODE(XMZ,$P(XMZREC,U,10))
|
|
S XMABORT=0
|
|
D RESPONSE(XMDUZ,XMZ,.XMRESPS,.XMPTR,.XMWHICH)
|
|
I XMRESPS D HOWMUCH^XMJMP1(XMZ,XMRESPS,.XMWHICH,.XMABORT) Q:XMABORT
|
|
W @IOF
|
|
D PRINTIT^XMJMP1(XMDUZ,XMK,XMKN,XMZ,XMZREC,XMRESPS,XMPTR,XMWHICH,0,1,1)
|
|
Q
|
|
WHICH(XMZ,XMRESPS,XMVERB,XMWHICH,XMABORT) ;
|
|
N DIR,DIRUT,Y,XMTEXT
|
|
; There is 1 response. / There are X responses. Response 0 is the original message. (?? shows index)
|
|
D BLD^DIALOG($S(XMRESPS=1:34514,1:34515),XMRESPS,"","XMTEXT")
|
|
M DIR("A")=XMTEXT
|
|
S DIR("A")=$$EZBLD^DIALOG(34516,XMVERB) ; Select the responses to |1|:
|
|
S:$D(XMWHICH) DIR("B")=XMWHICH
|
|
S DIR("PRE")="I X?.E1N1""-"" S X=X_XMRESPS W XMRESPS"
|
|
S DIR(0)="LACO^0:"_XMRESPS
|
|
S DIR("??")="^D HELPRESP^XMJMP1(XMZ,XMRESPS)"
|
|
D ^DIR I $D(DTOUT)!$D(DUOUT) S XMABORT=1 Q
|
|
S:X'="" XMWHICH=$E(Y,1,$L(Y)-1)
|
|
Q
|
|
PONE(XMDUZ,XMK,XMZ,XMPRTHDR,XMABORT) ;
|
|
PONEX ; Print one message. Check it to see if
|
|
; the user is allowed to see it. (confidential, scrambled)
|
|
; If not, print an error message.
|
|
N XMZREC
|
|
I $G(XMK)="" S XMK=$$BSKT^XMXUTIL2(XMDUZ,XMZ)
|
|
I '$D(^XMB(3.9,XMZ,0)),XMK D ZAPIT^XMJBM(XMDUZ,XMK,XMZ) S XMABORT=1 Q
|
|
S XMZREC=^XMB(3.9,XMZ,0)
|
|
I XMDUZ'=DUZ,'$$SURRACC^XMXSEC(XMDUZ,"",XMZ,XMZREC) D Q ; "access"
|
|
. D SHOW^XMJERR
|
|
. S XMABORT=1
|
|
N XMSECURE,XMPAKMAN ; Important 'new' - part of scramble and packman handling
|
|
S XMPAKMAN=$$PAKMAN^XMXSEC1(XMZ,XMZREC)
|
|
I $D(^XMB(3.9,XMZ,"K")),'$$KEYOK^XMJMCODE(XMZ,$P(XMZREC,U,10)) S XMABORT=1 Q
|
|
N XMRECIPS,XMRESPS,XMWHICH
|
|
D QRECIP(.XMRECIPS,.XMABORT) Q:XMABORT
|
|
D RESPONSE(XMDUZ,XMZ,.XMRESPS,"",.XMWHICH)
|
|
I XMRESPS D Q:XMABORT
|
|
. N XMRESP
|
|
. S XMRESP=XMWHICH
|
|
. I $D(^XMB(3.7,XMDUZ,"N0",XMK,XMZ)),XMRESP S:XMRESP'=XMRESPS XMRESP=XMRESP+1
|
|
. E S XMRESP=0
|
|
. I XMRESP=XMRESPS S XMWHICH=XMRESP
|
|
. E S XMWHICH=XMRESP_"-"_XMRESPS
|
|
. D WHICH(XMZ,XMRESPS,$$EZBLD^DIALOG(34500),.XMWHICH,.XMABORT) ; Print
|
|
E S XMWHICH=0
|
|
F I="DUZ","XMDUZ","XMV(","XMK","XMZ","XMWHICH","XMRECIPS","XMPRTHDR" S XMSAVE(I)=""
|
|
I $D(XMSECURE) F I="XMPAKMAN","XMSECURE","XMSECURE(" S XMSAVE(I)=""
|
|
D EN^XUTMDEVQ("PRTMSGX^XMJMP",$$EZBLD^DIALOG(34501),.XMSAVE) ; MailMan: Print
|
|
I $G(POP) S XMABORT=1
|
|
Q
|
|
;PLIST(XMDUZ,XMZLIST,XMRECIPS,XMPRTHDR,XMMSG)
|
|
PLISTX ;
|
|
; Print a list of messages.
|
|
; Check each message as we come to it to see if
|
|
; the user is allowed to see it. (confidential, scrambled)
|
|
; If not, print an error message.
|
|
N I,J,XMK,XMKN,XMZ,XMFIRST,XMCNT,XMABORT
|
|
S XMFIRST=1,(XMCNT,XMABORT,I)=0
|
|
F S I=$O(XMZLIST(I)) Q:'I D Q:XMABORT
|
|
. F J=1:1:$L(XMZLIST(I),",") D Q:XMABORT
|
|
. . S XMZ=$P(XMZLIST(I),",",J)
|
|
. . Q:'$D(^XMB(3.9,XMZ,0))
|
|
. . D BSKT^XMJMP1(XMDUZ,XMZ,.XMK,.XMKN)
|
|
. . D PRTMULT(XMDUZ,XMK,XMKN,XMZ,XMRECIPS,XMPRTHDR,.XMFIRST,.XMCNT,.XMABORT)
|
|
Q:$D(ZTQUEUED)
|
|
S XMMSG=$$EZBLD^DIALOG($S(XMCNT=1:34318.1,1:34318),XMCNT)
|
|
Q
|
|
PRTMULT(XMDUZ,XMK,XMKN,XMZ,XMRECIPS,XMPRTHDR,XMFIRST,XMCNT,XMABORT) ; Multiple message print
|
|
N XMNOGO,XMZREC,XMRESPS,XMRESP,XMPTR,XMSECURE,XMPAKMAN
|
|
I $D(ZTQUEUED) S ZTREQ="@"
|
|
S XMNOGO=0
|
|
S XMZREC=$G(^XMB(3.9,XMZ,0))
|
|
I XMZREC="" D ZAPIT^XMXMSGS2(XMDUZ,XMK,XMZ) Q
|
|
S XMPAKMAN=$$PAKMAN^XMXSEC1(XMZ,XMZREC)
|
|
D CHECK^XMJMP2(XMDUZ,XMZ,XMZREC,.XMNOGO) Q:XMNOGO&'$D(ZTQUEUED)
|
|
I $E(IOST,1,2)="C-"!'XMFIRST W @IOF
|
|
S XMFIRST=0
|
|
D:XMPRTHDR IDHDR(XMDUZ)
|
|
I XMNOGO D NOGOMSG^XMJMP2(XMDUZ,XMZ,XMZREC,.XMNOGO) Q
|
|
D RESPONSE(XMDUZ,XMZ,.XMRESPS,.XMPTR,.XMRESP)
|
|
I $D(^XMB(3.7,XMDUZ,"N0",XMK,XMZ)),XMRESP S:XMRESP'=XMRESPS XMRESP=XMRESP+1
|
|
E S XMRESP=0
|
|
D PRINTIT^XMJMP1(XMDUZ,XMK,XMKN,XMZ,XMZREC,XMRESPS,XMPTR,XMRESP_"-",XMRECIPS,0,XMPRTHDR,1,.XMABORT)
|
|
S XMCNT=XMCNT+1
|
|
;Q:XMABORT
|
|
;I $E(IOST,1,2)="C-" D PAGE^XMXUTIL(.XMABORT)
|
|
Q
|