XMJMSO ;ISC-SF/GMB-Options at 'send' transmit prompt ;07/17/2003 14:06
;;8.0;MailMan;**20**;Jun 28, 2002
; Replaces ^XMA22 (ISC-WASH/CAP/THM)
SENDMSG(XMDUZ,XMZ,XMSUBJ,XMINSTR,XMRESTR,XMABORT) ;
N XMFINISH,XMDIR,XMY,XMOPT,XMOX
I $$BCAST,'$D(XMINSTR("VAPOR")),$$QVAPOR D V
S XMFINISH=0
F D Q:XMFINISH!XMABORT
. D SENDSET(.XMINSTR,.XMOPT,.XMOX,.XMDIR)
. D XMDIR^XMJDIR(.XMDIR,.XMOPT,.XMOX,.XMY,.XMABORT) Q:XMABORT
. K XMDIR,XMOPT,XMOX
. D @XMY
Q
SENDSET(XMINSTR,XMOPT,XMOX,XMDIR) ;
D OPTEDIT^XMXSEC2(.XMINSTR,.XMOPT,.XMOX,1)
D SET^XMXSEC2("B",37331,.XMOPT,.XMOX) ; Backup to review message
D SET^XMXSEC2("ER",37332,.XMOPT,.XMOX) ; Edit Recipients
D SET^XMXSEC2("L",37333,.XMOPT,.XMOX) ; Transmit later
D SET^XMXSEC2("IM",37445,.XMOPT,.XMOX) ; Include responses from another message
D SET^XMXSEC2("T",37334,.XMOPT,.XMOX) ; Transmit now
I $G(XMOPT("NS","?"))=37309.1 K XMOPT("NS","?") ; You have no Network Signature.
S XMDIR("A")=$$EZBLD^DIALOG(34067) ; Select Message option:
S XMDIR("B")=XMOX("O","T")_":"_XMOPT("T") ; Transmit now
S XMDIR("??")="XM-U-MO-SEND"
Q
B ; Backup to review message
D BACKUP^XMJMP(XMDUZ,0,"",XMZ)
; OR D PRINTIT^XMJMP1(....)
Q
FLAGTOGL(XMINSTR,XMFLAG,XMSET,XMREMOVE) ; Flag Toggle
I $G(XMINSTR("FLAGS"))[XMFLAG D
. S XMINSTR("FLAGS")=$TR(XMINSTR("FLAGS"),XMFLAG)
. W !,$$EZBLD^DIALOG(XMREMOVE)
E D
. S XMINSTR("FLAGS")=$G(XMINSTR("FLAGS"))_XMFLAG
. W !,$$EZBLD^DIALOG(XMSET)
Q
C ; Confidential msg
D FLAGTOGL(.XMINSTR,"C",37301.9,37302.9)
Q
D ; Deliver to recipient basket
I $D(XMINSTR("RCPT BSKT")) D Q
. K XMINSTR("RCPT BSKT")
. W !,$$EZBLD^DIALOG(37304.9) ; Delivery basket removed.
N XMTEXT
W !
D BLD^DIALOG(37303.1,"","","XMTEXT","F")
D MSG^DIALOG("WM","",80,"","XMTEXT")
W !
;The delivery basket is the basket to which this message should be delivered
;for all recipients (even future ones, should the message be forwarded).
;Any message filters, which the recipient might have, are ignored."
;If the basket does not exist, it will be created."
;Note: The recipients must have chosen to allow delivery baskets by setting
;ACCEPT DELIVERY BASKET? under 'Personal Preferences|Delivery Basket Edit'
;to one of the following:
; YES - If basket doesn't exist, create it, and deliver the message to it.
; EXIST - If the basket already exists, then deliver the message to it.
; Else, just deliver the message as usual.
; SELECT - If the basket already exists AND accepts such messages,
; then deliver the message to it.
; Else, just deliver the message as usual.
;If the recipient has not set this field or has set it to NO, then
;the message would be delivered as usual.
N XMDIC,XMK,XMKN
S XMDIC("B")="@"
S XMDIC("S")="I Y>1"
D SELBSKT^XMJBU(XMDUZ,$$EZBLD^DIALOG(37303.2),"L",.XMDIC,.XMK,.XMKN) ; Select delivery basket:
Q:XMK=U
S XMINSTR("RCPT BSKT")=XMKN
Q
ER ; Additional Recipients
D TOWHOM^XMJMT(XMDUZ,$$EZBLD^DIALOG(34110),.XMINSTR,.XMRESTR,.XMABORT) ; Send
Q
ES ; Edit Subject
N XMOLDSUB,XMABORT
S XMOLDSUB=XMSUBJ,XMABORT=0
D SUBJ^XMJMS(.XMSUBJ,.XMABORT) Q:XMABORT
Q:XMSUBJ=XMOLDSUB
N XMFDA
S XMFDA(3.9,XMZ_",",.01)=XMSUBJ
D FILE^DIE("","XMFDA")
Q
ET ; Edit msg
I $G(XMPAKMAN) Q:$$NOPAKEDT
D BODY^XMJMS(XMDUZ,XMZ,XMSUBJ,.XMRESTR,.XMABORT)
Q
NOPAKEDT() ; Function returns 0 if OK to edit; 1, if not OK.
I $D(XMSECURE) W !,$$EZBLD^DIALOG(37405.4) Q 1 ; You may not edit a secure KIDS or PackMan message.
N DIR,X,Y,DIRUT
W @IOF
N XMTEXT
D BLD^DIALOG(37306.1,"","","XMTEXT","F")
D MSG^DIALOG("WM","",80,"","XMTEXT")
; W A R N I N G
; You are about to edit what appears to be a PackMan message.
; Please note the following:
; 1. If you edit this message you may compromise its integrity.
; 2. If you must edit it,
; - Do not edit the code.
; - Confine your editing to the text (the lines between $TXT and $ENDTXT).
; - You may insert lines in the text.
; - Do not begin any line with a '$' (dollar sign).
; - Be careful!
S DIR(0)="Y"
S DIR("A")=$$EZBLD^DIALOG(37306.2) ; Are you sure you want to edit this message
S DIR("B")=$$EZBLD^DIALOG(39053) ; NO
D ^DIR
Q 'Y
I ; Information only msg
D FLAGTOGL(.XMINSTR,"I",37307.9,37308.9)
Q
IM ; Include responses from another message
I $G(XMPAKMAN) D Q
. W !,$$EZBLD^DIALOG(37445.4) ; You may not Include anything into a KIDS or PackMan message.
D INCL^XMJMRO(XMDUZ,XMZ,XMZ,XMSUBJ,.XMRESTR,2,.XMABORT)
Q
L ; Transmit Later
N DIR,X,Y,XMWHEN,ZTRTN,ZTDTH,ZTDESC,ZTIO,ZTSAVE,ZTSK,XMROOT,I,DIRUT
I $E($O(^TMP("XMY0",$J,"G.")),1,2)="G." D
. ;Note: When you send a message Later, it is sent to all members of
. ;the groups to which you addressed it, even if you 'minus'ed anyone.
. ;To have your 'minus'es honored, you must ^-out of this and Transmit
. ;Now, not Later. If you didn't 'minus' anyone from the groups, just
. ;ignore this note, and continue ...
. N XMTEXT
. W !
. D BLD^DIALOG(37333.3,"","","XMTEXT","F")
. D MSG^DIALOG("WM","",80,"","XMTEXT")
. W !
S DIR(0)="D^NOW:"_$$SCH^XLFDT("12M",DT)_":ETX"
S DIR("A")=$$EZBLD^DIALOG(37333.1) ; Enter Date@time at which to send this message
D ^DIR Q:$D(DIRUT)
S XMWHEN=Y
W !,$$EZBLD^DIALOG(37333.2) ; Latering ...
S ZTIO=""
S ZTRTN="LATER^XMXSEND"
S ZTDTH=$$FMTH^XLFDT(XMWHEN)
S ZTDESC=$$EZBLD^DIALOG(39310) ; MailMan: Send Message Later
S XMROOT=$$GET1^DIQ(3.9,XMZ_",",3,"","^TMP(""XM"",$J,""BODY"")")
F I="DUZ","XMDUZ","XMSUBJ","^TMP(""XMY0"",$J,","^TMP(""XM"",$J,""BODY"",","XMINSTR(" S ZTSAVE(I)=""
D ^%ZTLOAD
;D HOME^%ZIS call this only if preceded by call to ^%ZIS
I $D(ZTSK) D
. S XMFINISH=1
. W $$EZBLD^DIALOG(37333.9,ZTSK) ; Latered (Task #_ZTSK_)
. D KILLMSG^XMXUTIL(XMZ)
. D CLEANUP^XMXADDR
E D
. W !,$C(7),$$EZBLD^DIALOG(37333.8) ; Latering was not successful. Try again or transmit now.
K ^TMP("XM",$J,"BODY")
Q
NS ; Add Network Signature
I '$$GOTNS^XMVVITA(XMDUZ) D Q:'$$GOTNS^XMVVITA(XMDUZ)
. W !!,$$EZBLD^DIALOG(37309.1) ; You have no Network Signature.
. D CRE8NS^XMVVITA
N XMMSG
D NETSIG^XMXEDIT(XMDUZ,XMZ,.XMINSTR,.XMMSG)
W !,XMMSG
Q
P ; Priority msg
D FLAGTOGL(.XMINSTR,"P",37311.9,37312.9)
Q
R ; Confirm receipt of msg
D FLAGTOGL(.XMINSTR,"R",37313.9,37314.9)
Q
S ; Scramble text
I $D(XMINSTR("SCR KEY")) D Q
. K XMINSTR("SCR KEY"),XMINSTR("SCR HINT")
. W !,$$EZBLD^DIALOG(37316.8) ; Scramble removed
N XMKEY,XMHINT,XMABORT
S XMABORT=0
D CRE8KEY^XMJMCODE(.XMKEY,.XMHINT,.XMABORT)
I XMABORT W !,$$EZBLD^DIALOG(37315.8) Q ; Scramble aborted.
S XMINSTR("SCR KEY")=XMKEY
S XMINSTR("SCR HINT")=XMHINT
Q
T ; Transmit now
S XMFINISH=1
W $$EZBLD^DIALOG(34217,XMZ) ; Sending [_XMZ_]...
D MOVEPART^XMXSEND(XMDUZ,XMZ,.XMINSTR)
D SEND^XMKP(XMDUZ,XMZ,.XMINSTR)
D CHECK^XMKPL
W !,$$EZBLD^DIALOG(34213) ; Sent
Q
V ; Vaporize date
I $G(XMINSTR("VAPOR")) D Q
. K XMINSTR("VAPOR")
. W !,$$EZBLD^DIALOG(37318.9) ; Vaporize Date removed
N DIR,X,Y,DIRUT,XMTP1
S XMTP1=$$FMADD^XLFDT($$NOW^XLFDT,,1)
S DIR(0)="3.9,1.6"
S DIR("A")=$$EZBLD^DIALOG(37317.1) ; Enter Vaporize Date
S DIR("B")=$$MMDT^XMXUTIL1($$FMADD^XLFDT(DT,30))
V2 D ^DIR Q:$D(DIRUT)
I Y<XMTP1 D G V2
. W " ??",$C(7),!,$$EZBLD^DIALOG(37317.2),! ; Must be no earlier than 1 hour from now.
S XMINSTR("VAPOR")=Y
Q
X ; Closed msg
D FLAGTOGL(.XMINSTR,"X",37319.9,37320.9)
Q
BCAST() ; Is this a broadcast (regular or limited)?
N XMTO
S XMTO=$O(^TMP("XMY0",$J,"*"))
I $E(XMTO)="*" Q 1
Q 0
QVAPOR() ;
N DIR
W !
S DIR(0)="Y"
D BLD^DIALOG(37350,"","","DIR(""A"")")
D BLD^DIALOG(37351,"","","DIR(""?"")")
S DIR("??")="XM-U-M-VAPORIZE DATE SEND"
S DIR("B")=$$EZBLD^DIALOG(39054) ; Yes
D ^DIR Q:$D(DIRUT) 0
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXMJMSO 7878 printed Oct 16, 2024@18:13:05 Page 2
XMJMSO ;ISC-SF/GMB-Options at 'send' transmit prompt ;07/17/2003 14:06
+1 ;;8.0;MailMan;**20**;Jun 28, 2002
+2 ; Replaces ^XMA22 (ISC-WASH/CAP/THM)
SENDMSG(XMDUZ,XMZ,XMSUBJ,XMINSTR,XMRESTR,XMABORT) ;
+1 NEW XMFINISH,XMDIR,XMY,XMOPT,XMOX
+2 IF $$BCAST
IF '$DATA(XMINSTR("VAPOR"))
IF $$QVAPOR
DO V
+3 SET XMFINISH=0
+4 FOR
Begin DoDot:1
+5 DO SENDSET(.XMINSTR,.XMOPT,.XMOX,.XMDIR)
+6 DO XMDIR^XMJDIR(.XMDIR,.XMOPT,.XMOX,.XMY,.XMABORT)
if XMABORT
QUIT
+7 KILL XMDIR,XMOPT,XMOX
+8 DO @XMY
End DoDot:1
if XMFINISH!XMABORT
QUIT
+9 QUIT
SENDSET(XMINSTR,XMOPT,XMOX,XMDIR) ;
+1 DO OPTEDIT^XMXSEC2(.XMINSTR,.XMOPT,.XMOX,1)
+2 ; Backup to review message
DO SET^XMXSEC2("B",37331,.XMOPT,.XMOX)
+3 ; Edit Recipients
DO SET^XMXSEC2("ER",37332,.XMOPT,.XMOX)
+4 ; Transmit later
DO SET^XMXSEC2("L",37333,.XMOPT,.XMOX)
+5 ; Include responses from another message
DO SET^XMXSEC2("IM",37445,.XMOPT,.XMOX)
+6 ; Transmit now
DO SET^XMXSEC2("T",37334,.XMOPT,.XMOX)
+7 ; You have no Network Signature.
IF $GET(XMOPT("NS","?"))=37309.1
KILL XMOPT("NS","?")
+8 ; Select Message option:
SET XMDIR("A")=$$EZBLD^DIALOG(34067)
+9 ; Transmit now
SET XMDIR("B")=XMOX("O","T")_":"_XMOPT("T")
+10 SET XMDIR("??")="XM-U-MO-SEND"
+11 QUIT
B ; Backup to review message
+1 DO BACKUP^XMJMP(XMDUZ,0,"",XMZ)
+2 ; OR D PRINTIT^XMJMP1(....)
+3 QUIT
FLAGTOGL(XMINSTR,XMFLAG,XMSET,XMREMOVE) ; Flag Toggle
+1 IF $GET(XMINSTR("FLAGS"))[XMFLAG
Begin DoDot:1
+2 SET XMINSTR("FLAGS")=$TRANSLATE(XMINSTR("FLAGS"),XMFLAG)
+3 WRITE !,$$EZBLD^DIALOG(XMREMOVE)
End DoDot:1
+4 IF '$TEST
Begin DoDot:1
+5 SET XMINSTR("FLAGS")=$GET(XMINSTR("FLAGS"))_XMFLAG
+6 WRITE !,$$EZBLD^DIALOG(XMSET)
End DoDot:1
+7 QUIT
C ; Confidential msg
+1 DO FLAGTOGL(.XMINSTR,"C",37301.9,37302.9)
+2 QUIT
D ; Deliver to recipient basket
+1 IF $DATA(XMINSTR("RCPT BSKT"))
Begin DoDot:1
+2 KILL XMINSTR("RCPT BSKT")
+3 ; Delivery basket removed.
WRITE !,$$EZBLD^DIALOG(37304.9)
End DoDot:1
QUIT
+4 NEW XMTEXT
+5 WRITE !
+6 DO BLD^DIALOG(37303.1,"","","XMTEXT","F")
+7 DO MSG^DIALOG("WM","",80,"","XMTEXT")
+8 WRITE !
+9 ;The delivery basket is the basket to which this message should be delivered
+10 ;for all recipients (even future ones, should the message be forwarded).
+11 ;Any message filters, which the recipient might have, are ignored."
+12 ;If the basket does not exist, it will be created."
+13 ;Note: The recipients must have chosen to allow delivery baskets by setting
+14 ;ACCEPT DELIVERY BASKET? under 'Personal Preferences|Delivery Basket Edit'
+15 ;to one of the following:
+16 ; YES - If basket doesn't exist, create it, and deliver the message to it.
+17 ; EXIST - If the basket already exists, then deliver the message to it.
+18 ; Else, just deliver the message as usual.
+19 ; SELECT - If the basket already exists AND accepts such messages,
+20 ; then deliver the message to it.
+21 ; Else, just deliver the message as usual.
+22 ;If the recipient has not set this field or has set it to NO, then
+23 ;the message would be delivered as usual.
+24 NEW XMDIC,XMK,XMKN
+25 SET XMDIC("B")="@"
+26 SET XMDIC("S")="I Y>1"
+27 ; Select delivery basket:
DO SELBSKT^XMJBU(XMDUZ,$$EZBLD^DIALOG(37303.2),"L",.XMDIC,.XMK,.XMKN)
+28 if XMK=U
QUIT
+29 SET XMINSTR("RCPT BSKT")=XMKN
+30 QUIT
ER ; Additional Recipients
+1 ; Send
DO TOWHOM^XMJMT(XMDUZ,$$EZBLD^DIALOG(34110),.XMINSTR,.XMRESTR,.XMABORT)
+2 QUIT
ES ; Edit Subject
+1 NEW XMOLDSUB,XMABORT
+2 SET XMOLDSUB=XMSUBJ
SET XMABORT=0
+3 DO SUBJ^XMJMS(.XMSUBJ,.XMABORT)
if XMABORT
QUIT
+4 if XMSUBJ=XMOLDSUB
QUIT
+5 NEW XMFDA
+6 SET XMFDA(3.9,XMZ_",",.01)=XMSUBJ
+7 DO FILE^DIE("","XMFDA")
+8 QUIT
ET ; Edit msg
+1 IF $GET(XMPAKMAN)
if $$NOPAKEDT
QUIT
+2 DO BODY^XMJMS(XMDUZ,XMZ,XMSUBJ,.XMRESTR,.XMABORT)
+3 QUIT
NOPAKEDT() ; Function returns 0 if OK to edit; 1, if not OK.
+1 ; You may not edit a secure KIDS or PackMan message.
IF $DATA(XMSECURE)
WRITE !,$$EZBLD^DIALOG(37405.4)
QUIT 1
+2 NEW DIR,X,Y,DIRUT
+3 WRITE @IOF
+4 NEW XMTEXT
+5 DO BLD^DIALOG(37306.1,"","","XMTEXT","F")
+6 DO MSG^DIALOG("WM","",80,"","XMTEXT")
+7 ; W A R N I N G
+8 ; You are about to edit what appears to be a PackMan message.
+9 ; Please note the following:
+10 ; 1. If you edit this message you may compromise its integrity.
+11 ; 2. If you must edit it,
+12 ; - Do not edit the code.
+13 ; - Confine your editing to the text (the lines between $TXT and $ENDTXT).
+14 ; - You may insert lines in the text.
+15 ; - Do not begin any line with a '$' (dollar sign).
+16 ; - Be careful!
+17 SET DIR(0)="Y"
+18 ; Are you sure you want to edit this message
SET DIR("A")=$$EZBLD^DIALOG(37306.2)
+19 ; NO
SET DIR("B")=$$EZBLD^DIALOG(39053)
+20 DO ^DIR
+21 QUIT 'Y
I ; Information only msg
+1 DO FLAGTOGL(.XMINSTR,"I",37307.9,37308.9)
+2 QUIT
IM ; Include responses from another message
+1 IF $GET(XMPAKMAN)
Begin DoDot:1
+2 ; You may not Include anything into a KIDS or PackMan message.
WRITE !,$$EZBLD^DIALOG(37445.4)
End DoDot:1
QUIT
+3 DO INCL^XMJMRO(XMDUZ,XMZ,XMZ,XMSUBJ,.XMRESTR,2,.XMABORT)
+4 QUIT
L ; Transmit Later
+1 NEW DIR,X,Y,XMWHEN,ZTRTN,ZTDTH,ZTDESC,ZTIO,ZTSAVE,ZTSK,XMROOT,I,DIRUT
+2 IF $EXTRACT($ORDER(^TMP("XMY0",$JOB,"G.")),1,2)="G."
Begin DoDot:1
+3 ;Note: When you send a message Later, it is sent to all members of
+4 ;the groups to which you addressed it, even if you 'minus'ed anyone.
+5 ;To have your 'minus'es honored, you must ^-out of this and Transmit
+6 ;Now, not Later. If you didn't 'minus' anyone from the groups, just
+7 ;ignore this note, and continue ...
+8 NEW XMTEXT
+9 WRITE !
+10 DO BLD^DIALOG(37333.3,"","","XMTEXT","F")
+11 DO MSG^DIALOG("WM","",80,"","XMTEXT")
+12 WRITE !
End DoDot:1
+13 SET DIR(0)="D^NOW:"_$$SCH^XLFDT("12M",DT)_":ETX"
+14 ; Enter Date@time at which to send this message
SET DIR("A")=$$EZBLD^DIALOG(37333.1)
+15 DO ^DIR
if $DATA(DIRUT)
QUIT
+16 SET XMWHEN=Y
+17 ; Latering ...
WRITE !,$$EZBLD^DIALOG(37333.2)
+18 SET ZTIO=""
+19 SET ZTRTN="LATER^XMXSEND"
+20 SET ZTDTH=$$FMTH^XLFDT(XMWHEN)
+21 ; MailMan: Send Message Later
SET ZTDESC=$$EZBLD^DIALOG(39310)
+22 SET XMROOT=$$GET1^DIQ(3.9,XMZ_",",3,"","^TMP(""XM"",$J,""BODY"")")
+23 FOR I="DUZ","XMDUZ","XMSUBJ","^TMP(""XMY0"",$J,","^TMP(""XM"",$J,""BODY"",","XMINSTR("
SET ZTSAVE(I)=""
+24 DO ^%ZTLOAD
+25 ;D HOME^%ZIS call this only if preceded by call to ^%ZIS
+26 IF $DATA(ZTSK)
Begin DoDot:1
+27 SET XMFINISH=1
+28 ; Latered (Task #_ZTSK_)
WRITE $$EZBLD^DIALOG(37333.9,ZTSK)
+29 DO KILLMSG^XMXUTIL(XMZ)
+30 DO CLEANUP^XMXADDR
End DoDot:1
+31 IF '$TEST
Begin DoDot:1
+32 ; Latering was not successful. Try again or transmit now.
WRITE !,$CHAR(7),$$EZBLD^DIALOG(37333.8)
End DoDot:1
+33 KILL ^TMP("XM",$JOB,"BODY")
+34 QUIT
NS ; Add Network Signature
+1 IF '$$GOTNS^XMVVITA(XMDUZ)
Begin DoDot:1
+2 ; You have no Network Signature.
WRITE !!,$$EZBLD^DIALOG(37309.1)
+3 DO CRE8NS^XMVVITA
End DoDot:1
if '$$GOTNS^XMVVITA(XMDUZ)
QUIT
+4 NEW XMMSG
+5 DO NETSIG^XMXEDIT(XMDUZ,XMZ,.XMINSTR,.XMMSG)
+6 WRITE !,XMMSG
+7 QUIT
P ; Priority msg
+1 DO FLAGTOGL(.XMINSTR,"P",37311.9,37312.9)
+2 QUIT
R ; Confirm receipt of msg
+1 DO FLAGTOGL(.XMINSTR,"R",37313.9,37314.9)
+2 QUIT
S ; Scramble text
+1 IF $DATA(XMINSTR("SCR KEY"))
Begin DoDot:1
+2 KILL XMINSTR("SCR KEY"),XMINSTR("SCR HINT")
+3 ; Scramble removed
WRITE !,$$EZBLD^DIALOG(37316.8)
End DoDot:1
QUIT
+4 NEW XMKEY,XMHINT,XMABORT
+5 SET XMABORT=0
+6 DO CRE8KEY^XMJMCODE(.XMKEY,.XMHINT,.XMABORT)
+7 ; Scramble aborted.
IF XMABORT
WRITE !,$$EZBLD^DIALOG(37315.8)
QUIT
+8 SET XMINSTR("SCR KEY")=XMKEY
+9 SET XMINSTR("SCR HINT")=XMHINT
+10 QUIT
T ; Transmit now
+1 SET XMFINISH=1
+2 ; Sending [_XMZ_]...
WRITE $$EZBLD^DIALOG(34217,XMZ)
+3 DO MOVEPART^XMXSEND(XMDUZ,XMZ,.XMINSTR)
+4 DO SEND^XMKP(XMDUZ,XMZ,.XMINSTR)
+5 DO CHECK^XMKPL
+6 ; Sent
WRITE !,$$EZBLD^DIALOG(34213)
+7 QUIT
V ; Vaporize date
+1 IF $GET(XMINSTR("VAPOR"))
Begin DoDot:1
+2 KILL XMINSTR("VAPOR")
+3 ; Vaporize Date removed
WRITE !,$$EZBLD^DIALOG(37318.9)
End DoDot:1
QUIT
+4 NEW DIR,X,Y,DIRUT,XMTP1
+5 SET XMTP1=$$FMADD^XLFDT($$NOW^XLFDT,,1)
+6 SET DIR(0)="3.9,1.6"
+7 ; Enter Vaporize Date
SET DIR("A")=$$EZBLD^DIALOG(37317.1)
+8 SET DIR("B")=$$MMDT^XMXUTIL1($$FMADD^XLFDT(DT,30))
V2 DO ^DIR
if $DATA(DIRUT)
QUIT
+1 IF Y<XMTP1
Begin DoDot:1
+2 ; Must be no earlier than 1 hour from now.
WRITE " ??",$CHAR(7),!,$$EZBLD^DIALOG(37317.2),!
End DoDot:1
GOTO V2
+3 SET XMINSTR("VAPOR")=Y
+4 QUIT
X ; Closed msg
+1 DO FLAGTOGL(.XMINSTR,"X",37319.9,37320.9)
+2 QUIT
BCAST() ; Is this a broadcast (regular or limited)?
+1 NEW XMTO
+2 SET XMTO=$ORDER(^TMP("XMY0",$JOB,"*"))
+3 IF $EXTRACT(XMTO)="*"
QUIT 1
+4 QUIT 0
QVAPOR() ;
+1 NEW DIR
+2 WRITE !
+3 SET DIR(0)="Y"
+4 DO BLD^DIALOG(37350,"","","DIR(""A"")")
+5 DO BLD^DIALOG(37351,"","","DIR(""?"")")
+6 SET DIR("??")="XM-U-M-VAPORIZE DATE SEND"
+7 ; Yes
SET DIR("B")=$$EZBLD^DIALOG(39054)
+8 DO ^DIR
if $DATA(DIRUT)
QUIT 0
+9 QUIT Y
