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