- 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 Feb 18, 2025@23:38:16 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