XMJMP1 ;ISC-SF/GMB-Print,Backup (cont.) ;12/04/2002 10:57
;;8.0;MailMan;**9**;Jun 28, 2002
BSKT(XMDUZ,XMZ,XMK,XMKN) ;
I +$G(XMK),$D(^XMB(3.7,"M",XMZ,XMDUZ,XMK)) S XMKN=$$BSKTNAME^XMXUTIL(XMDUZ,XMK) Q
N XMKSTR
S XMKSTR=$$BSKT^XMXUTIL2(XMDUZ,XMZ,1)
S XMK=$P(XMKSTR,U,1),XMKN=$S(XMK:$P(XMKSTR,U,2),1:$$EZBLD^DIALOG(34014)) ; * N/A *
Q
HOWMUCH(XMZ,XMRESPS,XMWHICH,XMABORT) ;
N DIR,DIRUT,Y,XMRESP,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
I XMWHICH<XMRESPS,XMWHICH'="" D ; (On broadcasts with responses, XMWHICH will usually be null.)
. S DIR("A")=$$EZBLD^DIALOG(34518) ; Backup to:
. S DIR("B")=+$O(^XMB(3.9,XMZ,3,XMWHICH)) ; (XMWHICH+1)
E D
. S DIR("A")=$$EZBLD^DIALOG(34519) ; Backup to: Original message
. S DIR("B")=0
S DIR(0)="NA^-"_XMRESPS_":"_XMRESPS
D BLD^DIALOG(34520,"","","DIR(""?"")")
;If you select 0, you will Backup to the original message.
;If you select one of the responses, you will Backup to it.
S DIR("??")="^D HELPRESP^XMJMP1(XMZ,XMRESPS)"
D ^DIR I $D(DIRUT) S XMABORT=1 Q
S XMRESP=$S(Y<0:XMRESPS+Y+1,1:Y)
S XMWHICH=$S(XMRESP=XMRESPS:XMRESP,1:XMRESP_"-"_XMRESPS)
Q
HELPRESP(XMZ,XMRESPS) ;
N XMRESP,XMLEN,XMABORT
S XMABORT=0
W @IOF,$$EZBLD^DIALOG($S(XMRESPS=1:34530,1:34531),XMRESPS)
;There is 1 response / There are _XMRESPS_ responses. Response 0 is the original message.
S XMRESP=$S(XMV("ORDER")=1:0,1:XMRESPS+1)
W ! D HRHDR(XMRESPS,XMRESP,.XMLEN)
D:XMV("ORDER")=1 HRLINE(XMZ,0)
F S XMRESP=$O(^XMB(3.9,XMZ,3,XMRESP),XMV("ORDER")) Q:XMRESP'>0 D Q:XMABORT
. I $Y+3>IOSL D PAGE^XMXUTIL(.XMABORT) Q:XMABORT D
. . W @IOF D HRHDR(XMRESPS,XMRESP,.XMLEN)
. D HRLINE($P(^XMB(3.9,XMZ,3,XMRESP,0),U),XMRESP)
Q:XMABORT
Q:XMV("ORDER")=1
I $Y+3>IOSL D PAGE^XMXUTIL(.XMABORT) Q:XMABORT D
. W @IOF D HRHDR(XMRESPS,XMRESP,.XMLEN)
D HRLINE(XMZ,0)
Q
HRHDR(XMRESPS,XMRESP,XMLEN) ;
S XMLEN("RESP")=$S(XMV("ORDER")=1:$L($$MIN^XLFMTH(XMRESPS,XMRESP+IOSL)),1:$L(XMRESP))
S XMLEN("DATE")=$L($$MMDT^XMXUTIL1(DT))
S XMLEN("LINE")=5
S XMLEN("FROM")=79-XMLEN("RESP")-XMLEN("DATE")-XMLEN("LINE")-3
W $$LJ^XLFSTR($$EZBLD^DIALOG(34532),XMLEN("RESP")+XMLEN("DATE")+3,"."),$$LJ^XLFSTR($$EZBLD^DIALOG(34006),XMLEN("FROM"),"."),$$EZBLD^DIALOG(34003.1) ; "Response"/"From"/"Lines"
Q
HRLINE(XMZ,XMRESP) ;
N XMZREC
S XMZREC=$G(^XMB(3.9,XMZ,0))
W !,$J(XMRESP,XMLEN("RESP")),") ",$$DATE^XMXUTIL2(XMZREC,0)," ",$$MELD^XMXUTIL1($$NAME^XMXUTIL($P(XMZREC,U,2),1),+$P($G(^XMB(3.9,XMZ,2,0)),U,4),XMLEN("FROM")+XMLEN("LINE"))
Q
RESPHDR(XMZ,XMRESP) ;
N XMZREC
S XMZREC=$G(^XMB(3.9,XMZ,0))
D WL(XMRESP_") "_$$NAME^XMXUTIL($P(XMZREC,U,2),1))
D:$P(XMZREC,U,4)'="" W(" ",$$EZBLD^DIALOG(34533,$$NAME^XMXUTIL($P(XMZREC,U,4),1))) ; (Sender: x)
D W(" ",$$DATE($P(XMZREC,U,3)))
D W(" ",$$LINES(XMZ))
Q
DATE(XMDT) ;
Q:XMDT'=+XMDT XMDT
Q $$MMDT^XMXUTIL1(XMDT)
LINES(XMZ) ;
N XMLINES
S XMLINES=+$P($G(^XMB(3.9,XMZ,2,0)),U,4)
Q $$EZBLD^DIALOG($S(XMLINES=1:34534.1,1:34534),XMLINES) ; line/lines
PRINTIT(XMDUZ,XMK,XMKN,XMZ,XMZREC,XMRESPS,XMPTR,XMWHICH,XMRECIPS,XMDISP,XMPRTHDR,XMMULT,XMABORT) ;
N XMSUBJ,XMPAGE,XMZSTR,I,XMRESP,XMRANGE,XMREMMSG
S:'$D(XMABORT) XMABORT=0
S XMSUBJ=$P(XMZREC,U,1) S:XMSUBJ["~U~" XMSUBJ=$$DECODEUP^XMXUTIL1(XMSUBJ)
S XMSUBJ=$$EZBLD^DIALOG(34536,XMSUBJ),XMZSTR=$$EZBLD^DIALOG(34537,XMZ) ; Subj: x / [#x]
S XMREMMSG=($P(XMZREC,U,2)["@")
S XMPAGE=1
D:XMPRTHDR HEADER(XMDUZ,XMK,XMKN,XMZ,XMRESPS,XMZREC,XMSUBJ,XMZSTR)
I XMWHICH>XMRESPS D:$D(^XMB(3.7,XMDUZ,"N0",XMK,XMZ)) NONEW^XMXUTIL(XMDUZ,XMK,XMZ,1) Q
F I=1:1:$L(XMWHICH,",") D Q:XMABORT
. S XMRANGE=$P(XMWHICH,",",I)
. S:$E(XMRANGE,$L(XMRANGE))="-" XMRANGE=XMRANGE_XMRESPS
. F XMRESP=$P(XMRANGE,"-",1):1:$S(XMRANGE["-":$P(XMRANGE,"-",2),1:XMRANGE) D Q:XMABORT
. . I XMRESP>0 D RESPONSE(XMZ,.XMRESP,XMSUBJ,XMZSTR,XMDISP,XMPRTHDR,XMREMMSG,.XMPAGE,.XMABORT) Q
. . D BODY(XMZ,XMSUBJ,XMZSTR,XMDISP,XMPRTHDR,.XMPAGE,.XMABORT)
D:XMPTR LASTACC(XMDUZ,XMK,XMZ,XMZREC,XMSUBJ,XMPTR,XMRESP,+$G(XMMULT))
Q:XMABORT
D:XMRECIPS PRECIPS(XMDUZ,XMK,XMZ,XMRECIPS,XMSUBJ,XMZSTR,XMPRTHDR,.XMPAGE,.XMABORT)
I XMK,$D(^XMB(3.7,XMDUZ,"N0",XMK,XMZ)),+XMRESP=+$P($G(^XMB(3.9,XMZ,3,0)),U,4) D NONEW^XMXUTIL(XMDUZ,XMK,XMZ,1)
Q
LASTACC(XMDUZ,XMK,XMZ,XMZREC,XMSUBJ,XMPTR,XMRESP,XMMULT) ; Note first, last accesses, number of responses read
N XMIM,XMIU,XMINSTR,XMCONFRM
S XMIM("SUBJ")=$P(XMSUBJ," ",2,99)
S XMIM("FROM")=$P(XMZREC,U,2)
S XMINSTR("FLAGS")=$S("^Y^y^"[(U_$P(XMZREC,U,5)_U):"R",1:"")
S XMIU("IEN")=XMPTR
S XMIU("RESP")=XMRESP
D LASTACC^XMXUTIL(XMDUZ,XMK,XMZ,XMRESP,.XMIM,.XMINSTR,.XMIU,.XMCONFRM)
Q:'XMCONFRM!$D(ZTQUEUED)
U IO(0)
D:XMMULT NOGOID^XMJMP2(XMZ,XMZREC)
W !,$$EZBLD^DIALOG(34540) ; >> Confirmation message sent to sender. <<
U IO
Q
PRECIPS(XMDUZ,XMK,XMZ,XMRECIPS,XMSUBJ,XMZSTR,XMPRTHDR,XMPAGE,XMABORT) ; Print recipients (replaces QE2^XMA5)
D INFO^XMJMQ1(XMDUZ,XMK,XMZ,XMPRTHDR,XMSUBJ,XMZSTR,.XMPAGE,.XMABORT) Q:XMABORT
D LATER^XMJMQ1(XMDUZ,XMZ,XMPRTHDR,XMSUBJ,XMZSTR,.XMPAGE,.XMABORT) Q:XMABORT
I XMRECIPS=1 D
. D SUMMARY^XMJMQ1(XMZ,XMPRTHDR,XMSUBJ,XMZSTR,.XMPAGE,.XMABORT)
E D DETAIL^XMJMQ(XMZ,XMPRTHDR,XMSUBJ,XMZSTR,.XMPAGE,.XMABORT)
Q
D PAGE1HDR(XMDUZ,XMK,XMKN,XMZ,XMRESPS,XMZREC,XMSUBJ,XMZSTR)
D W(" ",$$EZBLD^DIALOG(34541)) ; Page 1
I XMK,$D(^XMB(3.7,XMDUZ,"N0",XMK,XMZ)) D W(" ",$$EZBLD^DIALOG($S($D(^XMB(3.7,XMDUZ,"N",XMK,XMZ)):34543,1:34544))) ; Priority! / *New*
D LINE
Q
LINE ;
W !,"-------------------------------------------------------------------------------"
Q
PAGE1HDR(XMDUZ,XMK,XMKN,XMZ,XMRESPS,XMZREC,XMSUBJ,XMZSTR) ;
W XMSUBJ
D W(" ",XMZSTR)
D W(" ",$$DATE($P(XMZREC,U,3)))
D W(" ",$$LINES(XMZ))
;D:$O(^XMB(3.9,XMZ,2005,0)) W(" ",$$EZBLD^DIALOG(34573)) ; Attachment(s).
D WL($$EZBLD^DIALOG(34538,$$NAME^XMXUTIL($P(XMZREC,U,2),1))) ; From:
D:$P(XMZREC,U,4)'="" W(" ",$$EZBLD^DIALOG(34533,$$NAME^XMXUTIL($P(XMZREC,U,4),1))) ; (Sender: x)
I XMRESPS>0 D
. N XMPTR,XMRESP,XMPARM
. ;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)
. S XMPARM(1)=XMRESP,XMPARM(2)=XMRESPS
. D W(" ",$$EZBLD^DIALOG($S(XMRESPS=1:34545,1:34546),.XMPARM)) ; XMRESP_ of _XMRESPS_ response(s) read.
D W(" ",$$EZBLD^DIALOG(34539,XMKN)) ; In '_XMKN_' basket.
I $O(^XMB(3.73,"AC",XMZ,XMDUZ,0)) D W(" ",$$EZBLD^DIALOG(34595.1)) ; Message will be NEW Later.
I XMK D
. N XMVAPOR
. S XMVAPOR=$P($G(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)),U,5)
. I XMVAPOR D W(" ",$$EZBLD^DIALOG(34572,$$FMTE^XLFDT(XMVAPOR))) ; Automatic Deletion Date:
Q
WL(XMSTRING) ;
I $L(XMSTRING)'<IOM,IOM>1 F D Q:$L(XMSTRING)<IOM
. W !,$E(XMSTRING,1,IOM-1)
. S XMSTRING=$E(XMSTRING,IOM,999)
W !,XMSTRING
Q
W(XMSPACE,XMSTRING) ;
I $X+$L(XMSPACE)+$L(XMSTRING)>IOM D WL(XMSTRING) Q
W XMSPACE,XMSTRING
Q
BODY(XMZ,XMSUBJ,XMZSTR,XMDISP,XMPRTHDR,XMPAGE,XMABORT) ;
N XMTEXT,I,J
S I=.999999
F S I=$O(^XMB(3.9,XMZ,2,I)) Q:I'>0 D Q:XMABORT
. S XMTEXT=^XMB(3.9,XMZ,2,I,0)
. I $D(XMSECURE),'$G(XMPAKMAN) S XMTEXT=$$DECSTR^XMJMCODE(XMTEXT) ; PackMan messages are never scrambled, just "secured".
. I $E(XMTEXT,1)="$",$F("$TXT$END",$E(XMTEXT,1,4))#4=1 S XMTEXT=$P(XMTEXT,U) ; hide code for secured packman msg.
. I XMTEXT["|TAB|" F S J=$F(XMTEXT,"|TAB|")-6 Q:J<0 S XMTEXT=$E(XMTEXT,1,J)_$E(" ",1,9-(J-(J\9*9)))_$E(XMTEXT,J+6,999)
. ; A site was sending a print to a device whose IOM was 0.
. ; In such a case, we should ignore IOM.
. F D Q:$L(XMTEXT)<IOM!XMABORT!(IOM<2) S XMTEXT=$E(XMTEXT,IOM,999)
. . I $Y+3+($E($G(IOST),1,2)="C-")>IOSL D Q:XMABORT
. . . D PAGE(XMZ,XMSUBJ,XMZSTR,XMDISP,XMPRTHDR,.XMPAGE,.XMABORT)
. . E W !
. . W $S(IOM>1:$E(XMTEXT,1,IOM-1),1:XMTEXT)
Q
PAGE(XMZ,XMSUBJ,XMZSTR,XMDISP,XMPRTHDR,XMPAGE,XMABORT) ;
I $E($G(IOST),1,2)="C-",XMDISP W ! D PAGE^XMXUTIL(.XMABORT) Q:XMABORT
W @IOF
D:XMPRTHDR PAGE2HDR(XMSUBJ,XMZSTR,.XMPAGE)
Q
PAGE2HDR(XMSUBJ,XMZSTR,XMPAGE) ;
S XMPAGE=XMPAGE+1
W XMSUBJ
D W(" ",XMZSTR)
D W(" ",$$EZBLD^DIALOG(34542,XMPAGE)) ; Page x
D LINE
W !
Q
RESPONSE(XMZ,XMRESP,XMSUBJ,XMZSTR,XMDISP,XMPRTHDR,XMREMMSG,XMPAGE,XMABORT) ;
N XMZR,XMRSUBJ,XMREMREP
S XMZR=+$P($G(^XMB(3.9,XMZ,3,XMRESP,0)),U)
;I '$D(^XMB(3.9,XMZR,0)) D Q
;. ;N DA,DIK
;. ;S DA(1)=XMZ,DA=XMRESP
;. ;S DIK="^XMB(3.9,XMZ,3,"
;. ;D ^DIK
S XMRSUBJ=$P($G(^XMB(3.9,XMZR,0)),U)
S XMREMREP=$S(XMRSUBJ?1"R"1.N:0,XMRSUBJ="":0,1:1) ; Reply is to or from a remote site
I $Y+(XMREMMSG!XMREMREP)+7+($E($G(IOST),1,2)="C-")>IOSL D Q:XMABORT
. D PAGE(XMZR,XMSUBJ,XMZSTR,XMDISP,XMPRTHDR,.XMPAGE,.XMABORT)
. S:XMABORT XMRESP=XMRESP-1
E W !
D RESPHDR(XMZR,XMRESP)
I XMREMREP D
. W !," ",$$EZBLD^DIALOG(34536,$S(XMRSUBJ["~U~":$$DECODEUP^XMXUTIL1(XMRSUBJ),1:XMRSUBJ)) ; Subj:
E I XMREMMSG D
. W !," ",$$EZBLD^DIALOG(34535) ; <Local Reply>
W !
D BODY(XMZR,XMSUBJ,XMZSTR,XMDISP,XMPRTHDR,.XMPAGE,.XMABORT)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMJMP1 9194 printed Nov 22, 2024@17:22:18 Page 2
XMJMP1 ;ISC-SF/GMB-Print,Backup (cont.) ;12/04/2002 10:57
+1 ;;8.0;MailMan;**9**;Jun 28, 2002
BSKT(XMDUZ,XMZ,XMK,XMKN) ;
+1 IF +$GET(XMK)
IF $DATA(^XMB(3.7,"M",XMZ,XMDUZ,XMK))
SET XMKN=$$BSKTNAME^XMXUTIL(XMDUZ,XMK)
QUIT
+2 NEW XMKSTR
+3 SET XMKSTR=$$BSKT^XMXUTIL2(XMDUZ,XMZ,1)
+4 ; * N/A *
SET XMK=$PIECE(XMKSTR,U,1)
SET XMKN=$SELECT(XMK:$PIECE(XMKSTR,U,2),1:$$EZBLD^DIALOG(34014))
+5 QUIT
HOWMUCH(XMZ,XMRESPS,XMWHICH,XMABORT) ;
+1 NEW DIR,DIRUT,Y,XMRESP,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 ; (On broadcasts with responses, XMWHICH will usually be null.)
IF XMWHICH<XMRESPS
IF XMWHICH'=""
Begin DoDot:1
+6 ; Backup to:
SET DIR("A")=$$EZBLD^DIALOG(34518)
+7 ; (XMWHICH+1)
SET DIR("B")=+$ORDER(^XMB(3.9,XMZ,3,XMWHICH))
End DoDot:1
+8 IF '$TEST
Begin DoDot:1
+9 ; Backup to: Original message
SET DIR("A")=$$EZBLD^DIALOG(34519)
+10 SET DIR("B")=0
End DoDot:1
+11 SET DIR(0)="NA^-"_XMRESPS_":"_XMRESPS
+12 DO BLD^DIALOG(34520,"","","DIR(""?"")")
+13 ;If you select 0, you will Backup to the original message.
+14 ;If you select one of the responses, you will Backup to it.
+15 SET DIR("??")="^D HELPRESP^XMJMP1(XMZ,XMRESPS)"
+16 DO ^DIR
IF $DATA(DIRUT)
SET XMABORT=1
QUIT
+17 SET XMRESP=$SELECT(Y<0:XMRESPS+Y+1,1:Y)
+18 SET XMWHICH=$SELECT(XMRESP=XMRESPS:XMRESP,1:XMRESP_"-"_XMRESPS)
+19 QUIT
HELPRESP(XMZ,XMRESPS) ;
+1 NEW XMRESP,XMLEN,XMABORT
+2 SET XMABORT=0
+3 WRITE @IOF,$$EZBLD^DIALOG($SELECT(XMRESPS=1:34530,1:34531),XMRESPS)
+4 ;There is 1 response / There are _XMRESPS_ responses. Response 0 is the original message.
+5 SET XMRESP=$SELECT(XMV("ORDER")=1:0,1:XMRESPS+1)
+6 WRITE !
DO HRHDR(XMRESPS,XMRESP,.XMLEN)
+7 if XMV("ORDER")=1
DO HRLINE(XMZ,0)
+8 FOR
SET XMRESP=$ORDER(^XMB(3.9,XMZ,3,XMRESP),XMV("ORDER"))
if XMRESP'>0
QUIT
Begin DoDot:1
+9 IF $Y+3>IOSL
DO PAGE^XMXUTIL(.XMABORT)
if XMABORT
QUIT
Begin DoDot:2
+10 WRITE @IOF
DO HRHDR(XMRESPS,XMRESP,.XMLEN)
End DoDot:2
+11 DO HRLINE($PIECE(^XMB(3.9,XMZ,3,XMRESP,0),U),XMRESP)
End DoDot:1
if XMABORT
QUIT
+12 if XMABORT
QUIT
+13 if XMV("ORDER")=1
QUIT
+14 IF $Y+3>IOSL
DO PAGE^XMXUTIL(.XMABORT)
if XMABORT
QUIT
Begin DoDot:1
+15 WRITE @IOF
DO HRHDR(XMRESPS,XMRESP,.XMLEN)
End DoDot:1
+16 DO HRLINE(XMZ,0)
+17 QUIT
HRHDR(XMRESPS,XMRESP,XMLEN) ;
+1 SET XMLEN("RESP")=$SELECT(XMV("ORDER")=1:$LENGTH($$MIN^XLFMTH(XMRESPS,XMRESP+IOSL)),1:$LENGTH(XMRESP))
+2 SET XMLEN("DATE")=$LENGTH($$MMDT^XMXUTIL1(DT))
+3 SET XMLEN("LINE")=5
+4 SET XMLEN("FROM")=79-XMLEN("RESP")-XMLEN("DATE")-XMLEN("LINE")-3
+5 ; "Response"/"From"/"Lines"
WRITE $$LJ^XLFSTR($$EZBLD^DIALOG(34532),XMLEN("RESP")+XMLEN("DATE")+3,"."),$$LJ^XLFSTR($$EZBLD^DIALOG(34006),XMLEN("FROM"),"."),$$EZBLD^DIALOG(34003.1)
+6 QUIT
HRLINE(XMZ,XMRESP) ;
+1 NEW XMZREC
+2 SET XMZREC=$GET(^XMB(3.9,XMZ,0))
+3 WRITE !,$JUSTIFY(XMRESP,XMLEN("RESP")),") ",$$DATE^XMXUTIL2(XMZREC,0)," ",$$MELD^XMXUTIL1($$NAME^XMXUTIL($PIECE(XMZREC,U,2),1),+$PIECE($GET(^XMB(3.9,XMZ,2,0)),U,4),XMLEN("FROM")+XMLEN("LINE"))
+4 QUIT
RESPHDR(XMZ,XMRESP) ;
+1 NEW XMZREC
+2 SET XMZREC=$GET(^XMB(3.9,XMZ,0))
+3 DO WL(XMRESP_") "_$$NAME^XMXUTIL($PIECE(XMZREC,U,2),1))
+4 ; (Sender: x)
if $PIECE(XMZREC,U,4)'=""
DO W(" ",$$EZBLD^DIALOG(34533,$$NAME^XMXUTIL($PIECE(XMZREC,U,4),1)))
+5 DO W(" ",$$DATE($PIECE(XMZREC,U,3)))
+6 DO W(" ",$$LINES(XMZ))
+7 QUIT
DATE(XMDT) ;
+1 if XMDT'=+XMDT
QUIT XMDT
+2 QUIT $$MMDT^XMXUTIL1(XMDT)
LINES(XMZ) ;
+1 NEW XMLINES
+2 SET XMLINES=+$PIECE($GET(^XMB(3.9,XMZ,2,0)),U,4)
+3 ; line/lines
QUIT $$EZBLD^DIALOG($SELECT(XMLINES=1:34534.1,1:34534),XMLINES)
PRINTIT(XMDUZ,XMK,XMKN,XMZ,XMZREC,XMRESPS,XMPTR,XMWHICH,XMRECIPS,XMDISP,XMPRTHDR,XMMULT,XMABORT) ;
+1 NEW XMSUBJ,XMPAGE,XMZSTR,I,XMRESP,XMRANGE,XMREMMSG
+2 if '$DATA(XMABORT)
SET XMABORT=0
+3 SET XMSUBJ=$PIECE(XMZREC,U,1)
if XMSUBJ["~U~"
SET XMSUBJ=$$DECODEUP^XMXUTIL1(XMSUBJ)
+4 ; Subj: x / [#x]
SET XMSUBJ=$$EZBLD^DIALOG(34536,XMSUBJ)
SET XMZSTR=$$EZBLD^DIALOG(34537,XMZ)
+5 SET XMREMMSG=($PIECE(XMZREC,U,2)["@")
+6 SET XMPAGE=1
+7 if XMPRTHDR
DO HEADER(XMDUZ,XMK,XMKN,XMZ,XMRESPS,XMZREC,XMSUBJ,XMZSTR)
+8 IF XMWHICH>XMRESPS
if $DATA(^XMB(3.7,XMDUZ,"N0",XMK,XMZ))
DO NONEW^XMXUTIL(XMDUZ,XMK,XMZ,1)
QUIT
+9 FOR I=1:1:$LENGTH(XMWHICH,",")
Begin DoDot:1
+10 SET XMRANGE=$PIECE(XMWHICH,",",I)
+11 if $EXTRACT(XMRANGE,$LENGTH(XMRANGE))="-"
SET XMRANGE=XMRANGE_XMRESPS
+12 FOR XMRESP=$PIECE(XMRANGE,"-",1):1:$SELECT(XMRANGE["-":$PIECE(XMRANGE,"-",2),1:XMRANGE)
Begin DoDot:2
+13 IF XMRESP>0
DO RESPONSE(XMZ,.XMRESP,XMSUBJ,XMZSTR,XMDISP,XMPRTHDR,XMREMMSG,.XMPAGE,.XMABORT)
QUIT
+14 DO BODY(XMZ,XMSUBJ,XMZSTR,XMDISP,XMPRTHDR,.XMPAGE,.XMABORT)
End DoDot:2
if XMABORT
QUIT
End DoDot:1
if XMABORT
QUIT
+15 if XMPTR
DO LASTACC(XMDUZ,XMK,XMZ,XMZREC,XMSUBJ,XMPTR,XMRESP,+$GET(XMMULT))
+16 if XMABORT
QUIT
+17 if XMRECIPS
DO PRECIPS(XMDUZ,XMK,XMZ,XMRECIPS,XMSUBJ,XMZSTR,XMPRTHDR,.XMPAGE,.XMABORT)
+18 IF XMK
IF $DATA(^XMB(3.7,XMDUZ,"N0",XMK,XMZ))
IF +XMRESP=+$PIECE($GET(^XMB(3.9,XMZ,3,0)),U,4)
DO NONEW^XMXUTIL(XMDUZ,XMK,XMZ,1)
+19 QUIT
LASTACC(XMDUZ,XMK,XMZ,XMZREC,XMSUBJ,XMPTR,XMRESP,XMMULT) ; Note first, last accesses, number of responses read
+1 NEW XMIM,XMIU,XMINSTR,XMCONFRM
+2 SET XMIM("SUBJ")=$PIECE(XMSUBJ," ",2,99)
+3 SET XMIM("FROM")=$PIECE(XMZREC,U,2)
+4 SET XMINSTR("FLAGS")=$SELECT("^Y^y^"[(U_$PIECE(XMZREC,U,5)_U):"R",1:"")
+5 SET XMIU("IEN")=XMPTR
+6 SET XMIU("RESP")=XMRESP
+7 DO LASTACC^XMXUTIL(XMDUZ,XMK,XMZ,XMRESP,.XMIM,.XMINSTR,.XMIU,.XMCONFRM)
+8 if 'XMCONFRM!$DATA(ZTQUEUED)
QUIT
+9 USE IO(0)
+10 if XMMULT
DO NOGOID^XMJMP2(XMZ,XMZREC)
+11 ; >> Confirmation message sent to sender. <<
WRITE !,$$EZBLD^DIALOG(34540)
+12 USE IO
+13 QUIT
PRECIPS(XMDUZ,XMK,XMZ,XMRECIPS,XMSUBJ,XMZSTR,XMPRTHDR,XMPAGE,XMABORT) ; Print recipients (replaces QE2^XMA5)
+1 DO INFO^XMJMQ1(XMDUZ,XMK,XMZ,XMPRTHDR,XMSUBJ,XMZSTR,.XMPAGE,.XMABORT)
if XMABORT
QUIT
+2 DO LATER^XMJMQ1(XMDUZ,XMZ,XMPRTHDR,XMSUBJ,XMZSTR,.XMPAGE,.XMABORT)
if XMABORT
QUIT
+3 IF XMRECIPS=1
Begin DoDot:1
+4 DO SUMMARY^XMJMQ1(XMZ,XMPRTHDR,XMSUBJ,XMZSTR,.XMPAGE,.XMABORT)
End DoDot:1
+5 IF '$TEST
DO DETAIL^XMJMQ(XMZ,XMPRTHDR,XMSUBJ,XMZSTR,.XMPAGE,.XMABORT)
+6 QUIT
+1 DO PAGE1HDR(XMDUZ,XMK,XMKN,XMZ,XMRESPS,XMZREC,XMSUBJ,XMZSTR)
+2 ; Page 1
DO W(" ",$$EZBLD^DIALOG(34541))
+3 ; Priority! / *New*
IF XMK
IF $DATA(^XMB(3.7,XMDUZ,"N0",XMK,XMZ))
DO W(" ",$$EZBLD^DIALOG($SELECT($DATA(^XMB(3.7,XMDUZ,"N",XMK,XMZ)):34543,1:34544)))
+4 DO LINE
+5 QUIT
LINE ;
+1 WRITE !,"-------------------------------------------------------------------------------"
+2 QUIT
PAGE1HDR(XMDUZ,XMK,XMKN,XMZ,XMRESPS,XMZREC,XMSUBJ,XMZSTR) ;
+1 WRITE XMSUBJ
+2 DO W(" ",XMZSTR)
+3 DO W(" ",$$DATE($PIECE(XMZREC,U,3)))
+4 DO W(" ",$$LINES(XMZ))
+5 ;D:$O(^XMB(3.9,XMZ,2005,0)) W(" ",$$EZBLD^DIALOG(34573)) ; Attachment(s).
+6 ; From:
DO WL($$EZBLD^DIALOG(34538,$$NAME^XMXUTIL($PIECE(XMZREC,U,2),1)))
+7 ; (Sender: x)
if $PIECE(XMZREC,U,4)'=""
DO W(" ",$$EZBLD^DIALOG(34533,$$NAME^XMXUTIL($PIECE(XMZREC,U,4),1)))
+8 IF XMRESPS>0
Begin DoDot:1
+9 NEW XMPTR,XMRESP,XMPARM
+10 ;S XMPTR=+$O(^XMB(3.9,XMZ,1,"C",$S(XMDUZ=.6:DUZ,1:XMDUZ),0))
+11 SET XMPTR=+$ORDER(^XMB(3.9,XMZ,1,"C",XMDUZ,0))
+12 SET XMRESP=+$PIECE($GET(^XMB(3.9,XMZ,1,XMPTR,0)),U,2)
+13 SET XMPARM(1)=XMRESP
SET XMPARM(2)=XMRESPS
+14 ; XMRESP_ of _XMRESPS_ response(s) read.
DO W(" ",$$EZBLD^DIALOG($SELECT(XMRESPS=1:34545,1:34546),.XMPARM))
End DoDot:1
+15 ; In '_XMKN_' basket.
DO W(" ",$$EZBLD^DIALOG(34539,XMKN))
+16 ; Message will be NEW Later.
IF $ORDER(^XMB(3.73,"AC",XMZ,XMDUZ,0))
DO W(" ",$$EZBLD^DIALOG(34595.1))
+17 IF XMK
Begin DoDot:1
+18 NEW XMVAPOR
+19 SET XMVAPOR=$PIECE($GET(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)),U,5)
+20 ; Automatic Deletion Date:
IF XMVAPOR
DO W(" ",$$EZBLD^DIALOG(34572,$$FMTE^XLFDT(XMVAPOR)))
End DoDot:1
+21 QUIT
WL(XMSTRING) ;
+1 IF $LENGTH(XMSTRING)'<IOM
IF IOM>1
FOR
Begin DoDot:1
+2 WRITE !,$EXTRACT(XMSTRING,1,IOM-1)
+3 SET XMSTRING=$EXTRACT(XMSTRING,IOM,999)
End DoDot:1
if $LENGTH(XMSTRING)<IOM
QUIT
+4 WRITE !,XMSTRING
+5 QUIT
W(XMSPACE,XMSTRING) ;
+1 IF $X+$LENGTH(XMSPACE)+$LENGTH(XMSTRING)>IOM
DO WL(XMSTRING)
QUIT
+2 WRITE XMSPACE,XMSTRING
+3 QUIT
BODY(XMZ,XMSUBJ,XMZSTR,XMDISP,XMPRTHDR,XMPAGE,XMABORT) ;
+1 NEW XMTEXT,I,J
+2 SET I=.999999
+3 FOR
SET I=$ORDER(^XMB(3.9,XMZ,2,I))
if I'>0
QUIT
Begin DoDot:1
+4 SET XMTEXT=^XMB(3.9,XMZ,2,I,0)
+5 ; PackMan messages are never scrambled, just "secured".
IF $DATA(XMSECURE)
IF '$GET(XMPAKMAN)
SET XMTEXT=$$DECSTR^XMJMCODE(XMTEXT)
+6 ; hide code for secured packman msg.
IF $EXTRACT(XMTEXT,1)="$"
IF $FIND("$TXT$END",$EXTRACT(XMTEXT,1,4))#4=1
SET XMTEXT=$PIECE(XMTEXT,U)
+7 IF XMTEXT["|TAB|"
FOR
SET J=$FIND(XMTEXT,"|TAB|")-6
if J<0
QUIT
SET XMTEXT=$EXTRACT(XMTEXT,1,J)_$EXTRACT(" ",1,9-(J-(J\9*9)))_$EXTRACT(XMTEXT,J+6,999)
+8 ; A site was sending a print to a device whose IOM was 0.
+9 ; In such a case, we should ignore IOM.
+10 FOR
Begin DoDot:2
+11 IF $Y+3+($EXTRACT($GET(IOST),1,2)="C-")>IOSL
Begin DoDot:3
+12 DO PAGE(XMZ,XMSUBJ,XMZSTR,XMDISP,XMPRTHDR,.XMPAGE,.XMABORT)
End DoDot:3
if XMABORT
QUIT
+13 IF '$TEST
WRITE !
+14 WRITE $SELECT(IOM>1:$EXTRACT(XMTEXT,1,IOM-1),1:XMTEXT)
End DoDot:2
if $LENGTH(XMTEXT)<IOM!XMABORT!(IOM<2)
QUIT
SET XMTEXT=$EXTRACT(XMTEXT,IOM,999)
End DoDot:1
if XMABORT
QUIT
+15 QUIT
PAGE(XMZ,XMSUBJ,XMZSTR,XMDISP,XMPRTHDR,XMPAGE,XMABORT) ;
+1 IF $EXTRACT($GET(IOST),1,2)="C-"
IF XMDISP
WRITE !
DO PAGE^XMXUTIL(.XMABORT)
if XMABORT
QUIT
+2 WRITE @IOF
+3 if XMPRTHDR
DO PAGE2HDR(XMSUBJ,XMZSTR,.XMPAGE)
+4 QUIT
PAGE2HDR(XMSUBJ,XMZSTR,XMPAGE) ;
+1 SET XMPAGE=XMPAGE+1
+2 WRITE XMSUBJ
+3 DO W(" ",XMZSTR)
+4 ; Page x
DO W(" ",$$EZBLD^DIALOG(34542,XMPAGE))
+5 DO LINE
+6 WRITE !
+7 QUIT
RESPONSE(XMZ,XMRESP,XMSUBJ,XMZSTR,XMDISP,XMPRTHDR,XMREMMSG,XMPAGE,XMABORT) ;
+1 NEW XMZR,XMRSUBJ,XMREMREP
+2 SET XMZR=+$PIECE($GET(^XMB(3.9,XMZ,3,XMRESP,0)),U)
+3 ;I '$D(^XMB(3.9,XMZR,0)) D Q
+4 ;. ;N DA,DIK
+5 ;. ;S DA(1)=XMZ,DA=XMRESP
+6 ;. ;S DIK="^XMB(3.9,XMZ,3,"
+7 ;. ;D ^DIK
+8 SET XMRSUBJ=$PIECE($GET(^XMB(3.9,XMZR,0)),U)
+9 ; Reply is to or from a remote site
SET XMREMREP=$SELECT(XMRSUBJ?1"R"1.N:0,XMRSUBJ="":0,1:1)
+10 IF $Y+(XMREMMSG!XMREMREP)+7+($EXTRACT($GET(IOST),1,2)="C-")>IOSL
Begin DoDot:1
+11 DO PAGE(XMZR,XMSUBJ,XMZSTR,XMDISP,XMPRTHDR,.XMPAGE,.XMABORT)
+12 if XMABORT
SET XMRESP=XMRESP-1
End DoDot:1
if XMABORT
QUIT
+13 IF '$TEST
WRITE !
+14 DO RESPHDR(XMZR,XMRESP)
+15 IF XMREMREP
Begin DoDot:1
+16 ; Subj:
WRITE !," ",$$EZBLD^DIALOG(34536,$SELECT(XMRSUBJ["~U~":$$DECODEUP^XMXUTIL1(XMRSUBJ),1:XMRSUBJ))
End DoDot:1
+17 IF '$TEST
IF XMREMMSG
Begin DoDot:1
+18 ; <Local Reply>
WRITE !," ",$$EZBLD^DIALOG(34535)
End DoDot:1
+19 WRITE !
+20 DO BODY(XMZR,XMSUBJ,XMZSTR,XMDISP,XMPRTHDR,.XMPAGE,.XMABORT)
+21 QUIT
