XMJMOI ;ISC-SF/GMB-Options at Ignore prompt ;03/20/2003 09:28
;;8.0;MailMan;**15**;Jun 28, 2002
; Replaces ^XMA1,^XMA10 (ISC-WASH/CAP/THM)
READMSG(XMNEWS,XMDUZ,XMK,XMKN,XMZ,XMABORT) ;
N XMFINISH,XMFROM,XMINSTR,XMRESTR,XMIEN,XMSUBJ,XMSETPRI,XMRESPSO,XMRESP,XMORIGN8,XMDIR,XMY,XMOPT,XMOX
D INIT^XMJMOI1(XMDUZ,XMZ,.XMSUBJ,.XMFROM,.XMORIGN8,.XMINSTR,.XMRESTR,.XMIEN,.XMRESPSO,.XMRESP)
S (XMFINISH,XMABORT)=0
F D Q:XMFINISH!XMABORT
. N XMNAME,XMEDITOK
. D CHKBSKT(XMDUZ,XMZ,.XMK,.XMKN)
. D READSET^XMJMOI1(XMDUZ,XMK,XMKN,XMZ,XMFROM,XMORIGN8,.XMINSTR,XMIEN,.XMDIR,.XMOPT,.XMOX)
. I XMIEN,'$D(XMOPT("B","?")) D CHKRESP^XMJMP(XMDUZ,XMZ,XMRESPSO,XMRESP)
. D XMDIR^XMJDIR(.XMDIR,.XMOPT,.XMOX,.XMY,.XMABORT)
. S XMEDITOK='$D(XMOPT("E","?")) ; Used in 'forward'
. K XMDIR,XMOPT,XMOX
. Q:XMABORT
. D CHKBSKT(XMDUZ,XMZ,.XMK,.XMKN)
. D @XMY
D:XMINSTR("FLAGS")["P" PRIORITY^XMJMOI1
I XMINSTR("FLAGS")["N" D Q
. I XMNEWS D Q
. . I $D(^XTMP("XM","MAKENEW",XMDUZ,XMZ)),$D(^XMB(3.7,XMDUZ,"N0",XMK,XMZ)) D NONEW^XMXUTIL(XMDUZ,XMK,XMZ,1)
. D MAKENEW^XMXUTIL(XMDUZ,XMK,XMZ,1)
;I 'XMABORT,$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)
I 'XMABORT,$D(^XMB(3.7,XMDUZ,"N0",XMK,XMZ)) D NONEW^XMXUTIL(XMDUZ,XMK,XMZ,1)
I XMABORT,XMNEWS,'$D(^XMB(3.7,XMDUZ,"N0",XMK,XMZ)) S ^XTMP("XM","MAKENEW",XMDUZ,XMZ)=""
Q
CHKBSKT(XMDUZ,XMZ,XMK,XMKN) ; Is the message still where we think it is?
I XMK,'$D(^XMB(3.7,"M",XMZ,XMDUZ,XMK)) D RESETXMK^XMJMOI1(XMDUZ,XMZ,.XMK,.XMKN) Q
I 'XMK,$D(^XMB(3.7,"M",XMZ,XMDUZ)) D RESETXMK^XMJMOI1(XMDUZ,XMZ,.XMK,.XMKN)
Q
A ; Answer to sender only
I '$$GOTNS^XMVVITA(XMDUZ) D Q:'$$GOTNS^XMVVITA(XMDUZ)
. W !!,$$EZBLD^DIALOG(37401.1) ; You must have a Network Signature to Answer a message.
. D CRE8NS^XMVVITA
D ANSWER^XMJMA(XMDUZ,XMZ,XMSUBJ,XMFROM)
D IMBACK^XMJMOI1(34070) ; Finished with 'Answer' command.
Q
AA ; Access Attachments
N XMAPBLOB
I $G(IOT)="IMPC" D BLOB^XMAPBLOB Q
D NODISP^XMAPBLOB
Q
B ; Backup
D BACKUP^XMJMP(XMDUZ,XMK,XMKN,XMZ)
S XMRESP=$P($G(^XMB(3.9,XMZ,1,XMIEN,0)),U,2)
Q
BR ; Print to the Browser
D PRINT(1,1)
Q
C ; Copy
D COPY^XMJMC(XMDUZ,XMK,XMZ,XMFROM)
D IMBACK^XMJMOI1(34071) ; Finished with 'Copy' command.
Q
D ; Delete
D DEL^XMXMSGS2(XMDUZ,XMK,XMZ)
W !,$$EZBLD^DIALOG(34302.2) ; Message deleted.
S XMFINISH=1
Q:XMINSTR("FLAGS")'["N"
S XMINSTR("FLAGS")=$TR(XMINSTR("FLAGS"),"N")
K:XMNEWS ^XTMP("XM","MAKENEW",XMDUZ,XMZ)
Q
E ; Edit
D EDIT^XMJMOIE(XMDUZ,XMK,XMZ,.XMSUBJ,.XMINSTR,.XMRESTR)
Q
F ; Forward
N XMABORT
D GETRESTR^XMJMOI1(XMDUZ,XMZ,"",.XMINSTR,.XMRESTR)
S XMABORT=0
D INIT^XMXADDR
D TOWHOM^XMJMT(XMDUZ,$$EZBLD^DIALOG(34111),.XMINSTR,.XMRESTR,.XMABORT) ; Find out to whom to forward
I 'XMABORT D
. I XMEDITOK,'$D(XMINSTR("VAPOR")),$$BCAST^XMJMSO D I XMABORT W !,$$EZBLD^DIALOG(34309.4) Q ; Message not forwarded.
. . I '$$QVAPOR^XMJMSO S:$D(DTOUT)!$D(DUOUT) XMABORT=1 Q
. . D V^XMJMOIE I $D(DTOUT)!$D(DUOUT) S XMABORT=1
. D FWD^XMKP(XMDUZ,XMZ,.XMINSTR)
. W !,$$EZBLD^DIALOG(34309.2) ; Message forwarded.
D CLEANUP^XMXADDR
Q
H ; Headerless Print
D PRINT(0)
Q
HG ; Help:Group Information
D HELP^XMHIG
Q
HU ; Help:User Information
D HELP^XMHIU
Q
I ; Ignore
S XMFINISH=1
Q
IN ; Information Only toggle
I $G(XMINSTR("FLAGS"))["I" D
. S XMINSTR("FLAGS")=$TR(XMINSTR("FLAGS"),"I")
. S $P(^XMB(3.9,XMZ,0),U,12)=""
. W !,$$EZBLD^DIALOG(37409.9) ; Message is no longer 'Information only'.
E D
. S XMINSTR("FLAGS")=$G(XMINSTR("FLAGS"))_"I"
. S $P(^XMB(3.9,XMZ,0),U,12)="y"
. W !,$$EZBLD^DIALOG(37408.9) ; Message is now 'Information only'. No one may reply.
Q
K ; Toggle Priority of future replies
I $G(XMINSTR("FLAGS"))["K" D
. S XMINSTR("FLAGS")=$TR(XMINSTR("FLAGS"),"K")
. S $P(^XMB(3.9,XMZ,1,XMIEN,0),U,9)=1
. W !,$$EZBLD^DIALOG(37412.9) ; Responses will not be delivered as Priority Mail.
E D
. S XMINSTR("FLAGS")=$G(XMINSTR("FLAGS"))_"K"
. S $P(^XMB(3.9,XMZ,1,XMIEN,0),U,9)=""
. W !,$$EZBLD^DIALOG(37411.9) ; Responses will be delivered as Priority Mail.
S XMSETPRI=1
Q
L ; Later
D LATER^XMJMD(XMDUZ,XMZ)
Q
N ; Toggle New
I XMINSTR("FLAGS")["N" D
. S XMINSTR("FLAGS")=$TR(XMINSTR("FLAGS"),"N")
. K:XMNEWS ^XTMP("XM","MAKENEW",XMDUZ,XMZ)
. W !,$$EZBLD^DIALOG(37415.9) ; Message will NOT be new next time.
E D
. S XMINSTR("FLAGS")=XMINSTR("FLAGS")_"N"
. S:XMNEWS ^XTMP("XM","MAKENEW",XMDUZ,XMZ)=""
. W !,$$EZBLD^DIALOG(37414.9) ; Message will be new next time.
. I XMK>.5!XMNEWS Q
. D SAVEMSG(XMDUZ,.XMK,.XMKN,XMZ,XMSUBJ,XMFROM,$G(XMINSTR("RCPT BSKT")))
Q
P ; Print
D PRINT(1)
Q
PRINT(XMPRTHDR,XMBROWSE) ;
N XMABORT
S XMABORT=0
I '$G(XMBROWSE),XMINSTR("TYPE")["K"!(XMINSTR("TYPE")["X") D Q:XMABORT
. N DIR,XMMSG,XMPARM
. S XMMSG=$$EZBLD^DIALOG($S(XMINSTR("TYPE")["K":34076,1:34077)) ; KIDS build / PackMan message
. D BLD^DIALOG(34078,XMMSG,"","DIR(""A"")") ; Print just the descriptive text of this _XMMSG
. ;This is a _XMMSG_.
. ;Answer YES to print just the descriptive text.
. ;Answer NO to print the whole thing (x lines) and/or any responses.
. S XMPARM(1)=XMMSG,XMPARM(2)=$$LINE^XMXUTIL2(XMZ)
. D BLD^DIALOG(34079,.XMPARM,"","DIR(""?"")") ; Print just the descriptive text of this _XMMSG
. S DIR(0)="Y",DIR("B")=$$EZBLD^DIALOG(39054) ; Yes
. D ^DIR I $D(DIRUT) S XMABORT=1 Q
. Q:'Y
. N A,DIE,DIF,X,XCF,XCN,XMR
. S XMR=^XMB(3.9,XMZ,0)
. D XT^XMP2
. S XMABORT=1
D PRINT^XMJMP(XMDUZ,XMK,XMZ,XMPRTHDR,.XMBROWSE)
S XMRESP=$P($G(^XMB(3.9,XMZ,1,XMIEN,0)),U,2)
Q
Q ; Query
D Q^XMJMQ(XMDUZ,XMK,XMKN,XMZ)
Q
QC ; Query Current
D QX^XMJMQ(XMDUZ,XMK,XMKN,XMZ,"QC")
Q
QD ; Query Detailed
I $D(XMNAME) D QNAMEX^XMJMQ(XMDUZ,XMK,XMKN,XMZ,XMNAME) Q
D QD^XMJMQ(XMDUZ,XMK,XMKN,XMZ)
Q
QN ; Query Network
D QN^XMJMQ(XMDUZ,XMK,XMKN,XMZ)
Q
QNC ; Query Not Current
D QX^XMJMQ(XMDUZ,XMK,XMKN,XMZ,"QNC")
Q
QT ; Query Terminated
D QX^XMJMQ(XMDUZ,XMK,XMKN,XMZ,"QT")
Q
RI ; Reply, Include previous response(s)
R ; Reply
N XMINCL
S XMINCL=(XMY="RI")
I $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)
D REPLY^XMJMR(XMDUZ,.XMK,.XMKN,XMZ,XMSUBJ,XMFROM,.XMINSTR,XMIEN,XMRESPSO,XMINCL,.XMRESP)
Q
S ; Save (replaces S^XMA1B)
N XMKTO,XMDIC
I XMK,XMK'=.5 S XMDIC("B")="@" ; no default basket
E D
. N XMKTO
. S XMKTO=0
. D CHEKBSKT^XMTDL2(XMDUZ,.XMKTO,XMSUBJ,XMFROM,$G(XMINSTR("RCPT BSKT")))
. S XMDIC("B")=$P(^XMB(3.7,XMDUZ,2,XMKTO,0),U)
D SELBSKT^XMJBU(XMDUZ,$$EZBLD^DIALOG(34325.1),"L",.XMDIC,.XMKTO) Q:XMKTO=U ; Save message into basket:
D CHKBSKT(XMDUZ,XMZ,.XMK,.XMKN)
I XMKTO=XMK D
. W !,$$EZBLD^DIALOG(34326.1) ; That's the same basket the message is already in.
E D
. I $D(^XMB(3.7,XMDUZ,"N0",XMK,XMZ)) D NONEW^XMXUTIL(XMDUZ,XMK,XMZ,1)
. D MOVEIT^XMXMSGS2(XMDUZ,XMK,XMZ,XMKTO)
. W !,$$EZBLD^DIALOG(34324.2) ; Message saved.
. S XMK=XMKTO
S XMFINISH=1
Q
T ; Terminate (replaces T^XMA1)
D TERM^XMXMSGS2(XMDUZ,XMK,XMZ)
W !,$$EZBLD^DIALOG($S(XMK<1:34331.1,1:34331)) ; You won't see future replies. (In WASTE basket)
S XMFINISH=1
S:XMINSTR("FLAGS")["P" XMINSTR("FLAGS")=$TR(XMINSTR("FLAGS"),"P")
Q:XMINSTR("FLAGS")'["N"
S XMINSTR("FLAGS")=$TR(XMINSTR("FLAGS"),"N")
K:XMNEWS ^XTMP("XM","MAKENEW",XMDUZ,XMZ)
Q
V ; Set Vaporize date for msg in basket (replaces DATE^XMA11A)
N DIE,DA,DR
L +^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0):1
S DIE="^XMB(3.7,"_XMDUZ_",2,"_XMK_",1,"
S DA(2)=XMDUZ,DA(1)=XMK,DA=XMZ
S DR=5
D ^DIE
L -^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)
Q
W ; Write a new msg
N XMSECURE,XMPAKMAN,XMSECBAD ; Needed! (In case Write from KIDS msg.)
D SEND^XMJMS
D IMBACK^XMJMOI1(34072) ; Finished with 'Write' command.
Q
X ; Xtract PackMan msg
I XMDUZ=.5,XMK>999 G XP
N X,DIC,C,I,ER,J,K,T,X2,XCF,XCM,XCN,XMLOC,XMN,XMP0,XMR,XMS
S X=XMZ,DIC(0)="N"
D MM^XMP
Q
XP ; Xmit Priority Toggle (for remote transmit queues only)
N XMTPRI,XMABORT
S XMABORT=0
D ASKPRI^XMJMORX(.XMTPRI,.XMABORT) Q:XMABORT
D XP^XMXMSGS1(XMDUZ,XMK,XMZ,XMTPRI)
Q
SAVEMSG(XMDUZ,XMK,XMKN,XMZ,XMSUBJ,XMFROM,XMZBSKT) ;
; The message is currently in the waste basket or no basket.
; Save it to an appropriate (not waste) basket.
N XMKTO
S XMKTO=0
D CHEKBSKT^XMTDL2(XMDUZ,.XMKTO,XMSUBJ,XMFROM,$G(XMINSTR("RCPT BSKT")))
S:XMKTO=.5 XMKTO=1
S XMKN=$P(^XMB(3.7,XMDUZ,2,XMKTO,0),U,1)
I 'XMK D
. D PUTMSG^XMXMSGS2(XMDUZ,XMKTO,XMKN,XMZ)
E D
. ; Message is in waste basket
. D COPYIT^XMXMSGS2(XMDUZ,.5,XMZ,XMKTO)
. D ZAPIT^XMXMSGS2(XMDUZ,.5,XMZ)
S XMK=XMKTO
W !,$$EZBLD^DIALOG(34325.9,XMKN) ; Message saved to _XMKN_ basket.
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMJMOI 8742 printed Apr 09, 2024@21:15:05 Page 2
XMJMOI ;ISC-SF/GMB-Options at Ignore prompt ;03/20/2003 09:28
+1 ;;8.0;MailMan;**15**;Jun 28, 2002
+2 ; Replaces ^XMA1,^XMA10 (ISC-WASH/CAP/THM)
READMSG(XMNEWS,XMDUZ,XMK,XMKN,XMZ,XMABORT) ;
+1 NEW XMFINISH,XMFROM,XMINSTR,XMRESTR,XMIEN,XMSUBJ,XMSETPRI,XMRESPSO,XMRESP,XMORIGN8,XMDIR,XMY,XMOPT,XMOX
+2 DO INIT^XMJMOI1(XMDUZ,XMZ,.XMSUBJ,.XMFROM,.XMORIGN8,.XMINSTR,.XMRESTR,.XMIEN,.XMRESPSO,.XMRESP)
+3 SET (XMFINISH,XMABORT)=0
+4 FOR
Begin DoDot:1
+5 NEW XMNAME,XMEDITOK
+6 DO CHKBSKT(XMDUZ,XMZ,.XMK,.XMKN)
+7 DO READSET^XMJMOI1(XMDUZ,XMK,XMKN,XMZ,XMFROM,XMORIGN8,.XMINSTR,XMIEN,.XMDIR,.XMOPT,.XMOX)
+8 IF XMIEN
IF '$DATA(XMOPT("B","?"))
DO CHKRESP^XMJMP(XMDUZ,XMZ,XMRESPSO,XMRESP)
+9 DO XMDIR^XMJDIR(.XMDIR,.XMOPT,.XMOX,.XMY,.XMABORT)
+10 ; Used in 'forward'
SET XMEDITOK='$DATA(XMOPT("E","?"))
+11 KILL XMDIR,XMOPT,XMOX
+12 if XMABORT
QUIT
+13 DO CHKBSKT(XMDUZ,XMZ,.XMK,.XMKN)
+14 DO @XMY
End DoDot:1
if XMFINISH!XMABORT
QUIT
+15 if XMINSTR("FLAGS")["P"
DO PRIORITY^XMJMOI1
+16 IF XMINSTR("FLAGS")["N"
Begin DoDot:1
+17 IF XMNEWS
Begin DoDot:2
+18 IF $DATA(^XTMP("XM","MAKENEW",XMDUZ,XMZ))
IF $DATA(^XMB(3.7,XMDUZ,"N0",XMK,XMZ))
DO NONEW^XMXUTIL(XMDUZ,XMK,XMZ,1)
End DoDot:2
QUIT
+19 DO MAKENEW^XMXUTIL(XMDUZ,XMK,XMZ,1)
End DoDot:1
QUIT
+20 ;I 'XMABORT,$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)
+21 IF 'XMABORT
IF $DATA(^XMB(3.7,XMDUZ,"N0",XMK,XMZ))
DO NONEW^XMXUTIL(XMDUZ,XMK,XMZ,1)
+22 IF XMABORT
IF XMNEWS
IF '$DATA(^XMB(3.7,XMDUZ,"N0",XMK,XMZ))
SET ^XTMP("XM","MAKENEW",XMDUZ,XMZ)=""
+23 QUIT
CHKBSKT(XMDUZ,XMZ,XMK,XMKN) ; Is the message still where we think it is?
+1 IF XMK
IF '$DATA(^XMB(3.7,"M",XMZ,XMDUZ,XMK))
DO RESETXMK^XMJMOI1(XMDUZ,XMZ,.XMK,.XMKN)
QUIT
+2 IF 'XMK
IF $DATA(^XMB(3.7,"M",XMZ,XMDUZ))
DO RESETXMK^XMJMOI1(XMDUZ,XMZ,.XMK,.XMKN)
+3 QUIT
A ; Answer to sender only
+1 IF '$$GOTNS^XMVVITA(XMDUZ)
Begin DoDot:1
+2 ; You must have a Network Signature to Answer a message.
WRITE !!,$$EZBLD^DIALOG(37401.1)
+3 DO CRE8NS^XMVVITA
End DoDot:1
if '$$GOTNS^XMVVITA(XMDUZ)
QUIT
+4 DO ANSWER^XMJMA(XMDUZ,XMZ,XMSUBJ,XMFROM)
+5 ; Finished with 'Answer' command.
DO IMBACK^XMJMOI1(34070)
+6 QUIT
AA ; Access Attachments
+1 NEW XMAPBLOB
+2 IF $GET(IOT)="IMPC"
DO BLOB^XMAPBLOB
QUIT
+3 DO NODISP^XMAPBLOB
+4 QUIT
B ; Backup
+1 DO BACKUP^XMJMP(XMDUZ,XMK,XMKN,XMZ)
+2 SET XMRESP=$PIECE($GET(^XMB(3.9,XMZ,1,XMIEN,0)),U,2)
+3 QUIT
BR ; Print to the Browser
+1 DO PRINT(1,1)
+2 QUIT
C ; Copy
+1 DO COPY^XMJMC(XMDUZ,XMK,XMZ,XMFROM)
+2 ; Finished with 'Copy' command.
DO IMBACK^XMJMOI1(34071)
+3 QUIT
D ; Delete
+1 DO DEL^XMXMSGS2(XMDUZ,XMK,XMZ)
+2 ; Message deleted.
WRITE !,$$EZBLD^DIALOG(34302.2)
+3 SET XMFINISH=1
+4 if XMINSTR("FLAGS")'["N"
QUIT
+5 SET XMINSTR("FLAGS")=$TRANSLATE(XMINSTR("FLAGS"),"N")
+6 if XMNEWS
KILL ^XTMP("XM","MAKENEW",XMDUZ,XMZ)
+7 QUIT
E ; Edit
+1 DO EDIT^XMJMOIE(XMDUZ,XMK,XMZ,.XMSUBJ,.XMINSTR,.XMRESTR)
+2 QUIT
F ; Forward
+1 NEW XMABORT
+2 DO GETRESTR^XMJMOI1(XMDUZ,XMZ,"",.XMINSTR,.XMRESTR)
+3 SET XMABORT=0
+4 DO INIT^XMXADDR
+5 ; Find out to whom to forward
DO TOWHOM^XMJMT(XMDUZ,$$EZBLD^DIALOG(34111),.XMINSTR,.XMRESTR,.XMABORT)
+6 IF 'XMABORT
Begin DoDot:1
+7 ; Message not forwarded.
IF XMEDITOK
IF '$DATA(XMINSTR("VAPOR"))
IF $$BCAST^XMJMSO
Begin DoDot:2
+8 IF '$$QVAPOR^XMJMSO
if $DATA(DTOUT)!$DATA(DUOUT)
SET XMABORT=1
QUIT
+9 DO V^XMJMOIE
IF $DATA(DTOUT)!$DATA(DUOUT)
SET XMABORT=1
End DoDot:2
IF XMABORT
WRITE !,$$EZBLD^DIALOG(34309.4)
QUIT
+10 DO FWD^XMKP(XMDUZ,XMZ,.XMINSTR)
+11 ; Message forwarded.
WRITE !,$$EZBLD^DIALOG(34309.2)
End DoDot:1
+12 DO CLEANUP^XMXADDR
+13 QUIT
H ; Headerless Print
+1 DO PRINT(0)
+2 QUIT
HG ; Help:Group Information
+1 DO HELP^XMHIG
+2 QUIT
HU ; Help:User Information
+1 DO HELP^XMHIU
+2 QUIT
I ; Ignore
+1 SET XMFINISH=1
+2 QUIT
IN ; Information Only toggle
+1 IF $GET(XMINSTR("FLAGS"))["I"
Begin DoDot:1
+2 SET XMINSTR("FLAGS")=$TRANSLATE(XMINSTR("FLAGS"),"I")
+3 SET $PIECE(^XMB(3.9,XMZ,0),U,12)=""
+4 ; Message is no longer 'Information only'.
WRITE !,$$EZBLD^DIALOG(37409.9)
End DoDot:1
+5 IF '$TEST
Begin DoDot:1
+6 SET XMINSTR("FLAGS")=$GET(XMINSTR("FLAGS"))_"I"
+7 SET $PIECE(^XMB(3.9,XMZ,0),U,12)="y"
+8 ; Message is now 'Information only'. No one may reply.
WRITE !,$$EZBLD^DIALOG(37408.9)
End DoDot:1
+9 QUIT
K ; Toggle Priority of future replies
+1 IF $GET(XMINSTR("FLAGS"))["K"
Begin DoDot:1
+2 SET XMINSTR("FLAGS")=$TRANSLATE(XMINSTR("FLAGS"),"K")
+3 SET $PIECE(^XMB(3.9,XMZ,1,XMIEN,0),U,9)=1
+4 ; Responses will not be delivered as Priority Mail.
WRITE !,$$EZBLD^DIALOG(37412.9)
End DoDot:1
+5 IF '$TEST
Begin DoDot:1
+6 SET XMINSTR("FLAGS")=$GET(XMINSTR("FLAGS"))_"K"
+7 SET $PIECE(^XMB(3.9,XMZ,1,XMIEN,0),U,9)=""
+8 ; Responses will be delivered as Priority Mail.
WRITE !,$$EZBLD^DIALOG(37411.9)
End DoDot:1
+9 SET XMSETPRI=1
+10 QUIT
L ; Later
+1 DO LATER^XMJMD(XMDUZ,XMZ)
+2 QUIT
N ; Toggle New
+1 IF XMINSTR("FLAGS")["N"
Begin DoDot:1
+2 SET XMINSTR("FLAGS")=$TRANSLATE(XMINSTR("FLAGS"),"N")
+3 if XMNEWS
KILL ^XTMP("XM","MAKENEW",XMDUZ,XMZ)
+4 ; Message will NOT be new next time.
WRITE !,$$EZBLD^DIALOG(37415.9)
End DoDot:1
+5 IF '$TEST
Begin DoDot:1
+6 SET XMINSTR("FLAGS")=XMINSTR("FLAGS")_"N"
+7 if XMNEWS
SET ^XTMP("XM","MAKENEW",XMDUZ,XMZ)=""
+8 ; Message will be new next time.
WRITE !,$$EZBLD^DIALOG(37414.9)
+9 IF XMK>.5!XMNEWS
QUIT
+10 DO SAVEMSG(XMDUZ,.XMK,.XMKN,XMZ,XMSUBJ,XMFROM,$GET(XMINSTR("RCPT BSKT")))
End DoDot:1
+11 QUIT
P ; Print
+1 DO PRINT(1)
+2 QUIT
PRINT(XMPRTHDR,XMBROWSE) ;
+1 NEW XMABORT
+2 SET XMABORT=0
+3 IF '$GET(XMBROWSE)
IF XMINSTR("TYPE")["K"!(XMINSTR("TYPE")["X")
Begin DoDot:1
+4 NEW DIR,XMMSG,XMPARM
+5 ; KIDS build / PackMan message
SET XMMSG=$$EZBLD^DIALOG($SELECT(XMINSTR("TYPE")["K":34076,1:34077))
+6 ; Print just the descriptive text of this _XMMSG
DO BLD^DIALOG(34078,XMMSG,"","DIR(""A"")")
+7 ;This is a _XMMSG_.
+8 ;Answer YES to print just the descriptive text.
+9 ;Answer NO to print the whole thing (x lines) and/or any responses.
+10 SET XMPARM(1)=XMMSG
SET XMPARM(2)=$$LINE^XMXUTIL2(XMZ)
+11 ; Print just the descriptive text of this _XMMSG
DO BLD^DIALOG(34079,.XMPARM,"","DIR(""?"")")
+12 ; Yes
SET DIR(0)="Y"
SET DIR("B")=$$EZBLD^DIALOG(39054)
+13 DO ^DIR
IF $DATA(DIRUT)
SET XMABORT=1
QUIT
+14 if 'Y
QUIT
+15 NEW A,DIE,DIF,X,XCF,XCN,XMR
+16 SET XMR=^XMB(3.9,XMZ,0)
+17 DO XT^XMP2
+18 SET XMABORT=1
End DoDot:1
if XMABORT
QUIT
+19 DO PRINT^XMJMP(XMDUZ,XMK,XMZ,XMPRTHDR,.XMBROWSE)
+20 SET XMRESP=$PIECE($GET(^XMB(3.9,XMZ,1,XMIEN,0)),U,2)
+21 QUIT
Q ; Query
+1 DO Q^XMJMQ(XMDUZ,XMK,XMKN,XMZ)
+2 QUIT
QC ; Query Current
+1 DO QX^XMJMQ(XMDUZ,XMK,XMKN,XMZ,"QC")
+2 QUIT
QD ; Query Detailed
+1 IF $DATA(XMNAME)
DO QNAMEX^XMJMQ(XMDUZ,XMK,XMKN,XMZ,XMNAME)
QUIT
+2 DO QD^XMJMQ(XMDUZ,XMK,XMKN,XMZ)
+3 QUIT
QN ; Query Network
+1 DO QN^XMJMQ(XMDUZ,XMK,XMKN,XMZ)
+2 QUIT
QNC ; Query Not Current
+1 DO QX^XMJMQ(XMDUZ,XMK,XMKN,XMZ,"QNC")
+2 QUIT
QT ; Query Terminated
+1 DO QX^XMJMQ(XMDUZ,XMK,XMKN,XMZ,"QT")
+2 QUIT
RI ; Reply, Include previous response(s)
R ; Reply
+1 NEW XMINCL
+2 SET XMINCL=(XMY="RI")
+3 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)
+4 DO REPLY^XMJMR(XMDUZ,.XMK,.XMKN,XMZ,XMSUBJ,XMFROM,.XMINSTR,XMIEN,XMRESPSO,XMINCL,.XMRESP)
+5 QUIT
S ; Save (replaces S^XMA1B)
+1 NEW XMKTO,XMDIC
+2 ; no default basket
IF XMK
IF XMK'=.5
SET XMDIC("B")="@"
+3 IF '$TEST
Begin DoDot:1
+4 NEW XMKTO
+5 SET XMKTO=0
+6 DO CHEKBSKT^XMTDL2(XMDUZ,.XMKTO,XMSUBJ,XMFROM,$GET(XMINSTR("RCPT BSKT")))
+7 SET XMDIC("B")=$PIECE(^XMB(3.7,XMDUZ,2,XMKTO,0),U)
End DoDot:1
+8 ; Save message into basket:
DO SELBSKT^XMJBU(XMDUZ,$$EZBLD^DIALOG(34325.1),"L",.XMDIC,.XMKTO)
if XMKTO=U
QUIT
+9 DO CHKBSKT(XMDUZ,XMZ,.XMK,.XMKN)
+10 IF XMKTO=XMK
Begin DoDot:1
+11 ; That's the same basket the message is already in.
WRITE !,$$EZBLD^DIALOG(34326.1)
End DoDot:1
+12 IF '$TEST
Begin DoDot:1
+13 IF $DATA(^XMB(3.7,XMDUZ,"N0",XMK,XMZ))
DO NONEW^XMXUTIL(XMDUZ,XMK,XMZ,1)
+14 DO MOVEIT^XMXMSGS2(XMDUZ,XMK,XMZ,XMKTO)
+15 ; Message saved.
WRITE !,$$EZBLD^DIALOG(34324.2)
+16 SET XMK=XMKTO
End DoDot:1
+17 SET XMFINISH=1
+18 QUIT
T ; Terminate (replaces T^XMA1)
+1 DO TERM^XMXMSGS2(XMDUZ,XMK,XMZ)
+2 ; You won't see future replies. (In WASTE basket)
WRITE !,$$EZBLD^DIALOG($SELECT(XMK<1:34331.1,1:34331))
+3 SET XMFINISH=1
+4 if XMINSTR("FLAGS")["P"
SET XMINSTR("FLAGS")=$TRANSLATE(XMINSTR("FLAGS"),"P")
+5 if XMINSTR("FLAGS")'["N"
QUIT
+6 SET XMINSTR("FLAGS")=$TRANSLATE(XMINSTR("FLAGS"),"N")
+7 if XMNEWS
KILL ^XTMP("XM","MAKENEW",XMDUZ,XMZ)
+8 QUIT
V ; Set Vaporize date for msg in basket (replaces DATE^XMA11A)
+1 NEW DIE,DA,DR
+2 LOCK +^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0):1
+3 SET DIE="^XMB(3.7,"_XMDUZ_",2,"_XMK_",1,"
+4 SET DA(2)=XMDUZ
SET DA(1)=XMK
SET DA=XMZ
+5 SET DR=5
+6 DO ^DIE
+7 LOCK -^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)
+8 QUIT
W ; Write a new msg
+1 ; Needed! (In case Write from KIDS msg.)
NEW XMSECURE,XMPAKMAN,XMSECBAD
+2 DO SEND^XMJMS
+3 ; Finished with 'Write' command.
DO IMBACK^XMJMOI1(34072)
+4 QUIT
X ; Xtract PackMan msg
+1 IF XMDUZ=.5
IF XMK>999
GOTO XP
+2 NEW X,DIC,C,I,ER,J,K,T,X2,XCF,XCM,XCN,XMLOC,XMN,XMP0,XMR,XMS
+3 SET X=XMZ
SET DIC(0)="N"
+4 DO MM^XMP
+5 QUIT
XP ; Xmit Priority Toggle (for remote transmit queues only)
+1 NEW XMTPRI,XMABORT
+2 SET XMABORT=0
+3 DO ASKPRI^XMJMORX(.XMTPRI,.XMABORT)
if XMABORT
QUIT
+4 DO XP^XMXMSGS1(XMDUZ,XMK,XMZ,XMTPRI)
+5 QUIT
SAVEMSG(XMDUZ,XMK,XMKN,XMZ,XMSUBJ,XMFROM,XMZBSKT) ;
+1 ; The message is currently in the waste basket or no basket.
+2 ; Save it to an appropriate (not waste) basket.
+3 NEW XMKTO
+4 SET XMKTO=0
+5 DO CHEKBSKT^XMTDL2(XMDUZ,.XMKTO,XMSUBJ,XMFROM,$GET(XMINSTR("RCPT BSKT")))
+6 if XMKTO=.5
SET XMKTO=1
+7 SET XMKN=$PIECE(^XMB(3.7,XMDUZ,2,XMKTO,0),U,1)
+8 IF 'XMK
Begin DoDot:1
+9 DO PUTMSG^XMXMSGS2(XMDUZ,XMKTO,XMKN,XMZ)
End DoDot:1
+10 IF '$TEST
Begin DoDot:1
+11 ; Message is in waste basket
+12 DO COPYIT^XMXMSGS2(XMDUZ,.5,XMZ,XMKTO)
+13 DO ZAPIT^XMXMSGS2(XMDUZ,.5,XMZ)
End DoDot:1
+14 SET XMK=XMKTO
+15 ; Message saved to _XMKN_ basket.
WRITE !,$$EZBLD^DIALOG(34325.9,XMKN)
+16 QUIT
