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