Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XMRPCTS1

XMRPCTS1.m

Go to the documentation of this file.
  1. XMRPCTS1 ;(KC-VAMC)/XXX-Simple PCTS front end to MailMan ;02/06/99 10:32
  1. ;;8.0;MailMan;;Jun 28, 2002
  1. N XMUS,XMFM,XMSTR,XMRI,XMTO,XMABORT
  1. ;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  1. ;All should be sent to XXX@VHA.DMIA the local PCTS Domain
  1. ;Edit these for your site.
  1. S XMUS="XXXX" ;Local routing indicator
  1. S XMFM="YYYY" ;from line
  1. I XMUS="XXXX"!(XMFM="YYYY") S %="FIX Routing codes !!!"_XMPCTS0("ERR")
  1. ;-------------------------------------------------------------
  1. S XMABORT=0
  1. D INIT(.XMDUZ,XMUS,.XMSTR,.XMRI,.XMTO,.XMABORT) Q:XMABORT
  1. D CRE8XMZ^XMXSEND("Local PCTS Transmission.",.XMZ,1) I XMZ<1 S XMABORT=1 Q
  1. D EDITON^XMJMS(XMDUZ,XMZ)
  1. D PROCESS(XMDUZ,XMSTR,XMFM,XMRI,XMTO,.XMZ,.XMABORT)
  1. D EDITOFF^XMJMS(XMDUZ)
  1. Q:'XMABORT
  1. W !!,"TWIX Send aborted !",$C(7)
  1. H 2
  1. D KILLMSG^XMXUTIL(XMZ)
  1. Q
  1. INIT(XMDUZ,XMUS,XMSTR,XMRI,XMTO,XMABORT) ;
  1. N XMSEQ
  1. I '$D(DUZ)#2 D Q
  1. . W !!,"DUZ not defined..."
  1. . S XMABORT=1
  1. D EN^XM
  1. W !!,"Create PCTS/AMS message.",!
  1. ;Making this the pseudo-sequence number - meaningless.
  1. S XMSEQ=$P(^XMB(3.9,0),U,3),XMSEQ=$$RJ^XLFSTR($E(XMSEQ,$L(XMSEQ)-3,99),4,"0")
  1. ;Build the Header
  1. S XMSTR="PAAUIJAZ "_XMUS_XMSEQ_" "_$$JD^XMRPCTS0_"-UUUU--"
  1. D RI(.XMRI,.XMABORT) Q:XMABORT
  1. D TO(.XMTO,.XMABORT)
  1. Q
  1. RI(XMRI,XMABORT) ;
  1. N DIR,DIRUT,Y,X,DTOUT,DUOUT
  1. S DIR(0)="FO^3:30^K X'?1UP.UP X"
  1. S DIR("A")="Destination RI"
  1. S DIR("?")="Enter the Destination Routing Indicator, like RUCHJBO."
  1. D ^DIR I $D(DTOUT)!$D(DUOUT) S XMABORT=1 Q
  1. I Y="" S Y="<RI>" W "<blank>"
  1. S XMRI=Y
  1. S:$E(XMRI,$L(XMRI))'="." XMRI=XMRI_"."
  1. Q
  1. TO(XMTO,XMABORT) ;
  1. N DIR,DIRUT,Y,X,DTOUT,DUOUT
  1. S DIR(0)="F^3:60"
  1. S DIR("A")="Destination TO line"
  1. S DIR("?")="Enter the content of the TO line of the message."
  1. D ^DIR I $D(DTOUT)!$D(DUOUT) S XMABORT=1 Q
  1. S XMTO=Y
  1. Q
  1. PROCESS(XMDUZ,XMSTR,XMFM,XMRI,XMTO,XMZ,XMABORT) ;
  1. N I,%,XMTEXT,XMINSTR,XMRESTR
  1. S %="ZNR UUUUU"
  1. F I="RUCH","RUEV","RUWL","RUGS" I XMRI[I S %="VADM"
  1. S I=0
  1. S I=I+1,XMTEXT(I)=XMSTR_XMRI ;header line
  1. S I=I+1,XMTEXT(I)=%
  1. S I=I+1,XMTEXT(I)="FM "_XMFM ;from line
  1. S I=I+1,XMTEXT(I)="TO "_XMTO ;to line
  1. S I=I+1,XMTEXT(I)="BT"
  1. S I=I+1,XMTEXT(I)=""
  1. S I=I+1,XMTEXT(I)="<text>"
  1. S I=I+1,XMTEXT(I)=""
  1. S I=I+1,XMTEXT(I)="BT"
  1. S I=I+1,XMTEXT(I)=""
  1. S I=I+1,XMTEXT(I)="NNNN"
  1. D MOVEBODY^XMXSEND(XMZ,"XMTEXT")
  1. D E Q:XMABORT
  1. D INIT^XMXADDR
  1. D READY(XMDUZ,.XMINSTR,.XMRESTR,.XMABORT) Q:XMABORT
  1. W !,"You may add recipients to this message."
  1. D TOWHOM^XMJMT(XMDUZ,"Send",.XMINSTR,.XMRESTR,.XMABORT)
  1. D:'XMABORT XMIT(XMDUZ,XMZ,.XMINSTR,.XMABORT)
  1. D CLEANUP^XMXADDR
  1. Q
  1. XMIT(XMDUZ,XMZ,XMINSTR,XMABORT) ;
  1. N DIR,Y,X,DIRUT,XMFINISH
  1. S XMFINISH=0
  1. F D Q:XMFINISH!XMABORT
  1. . S DIR(0)="SAM^E:Edit Text;T:Transmit now"
  1. . S DIR("A")="Select Message option: "
  1. . S DIR("B")="Transmit now"
  1. . S DIR("??")="^D Q^XMRPCTS1"
  1. . D ^DIR I $D(DIRUT) S XMABORT=1 Q
  1. . D @Y
  1. Q
  1. E ; Edit Text
  1. F D BODY^XMJMS(XMDUZ,XMZ,.XMRESTR,.XMABORT) Q:XMABORT!$$NCHECK(XMZ)
  1. Q
  1. NCHECK(XMZ) ; If "NNNN" found in text, issue error
  1. N NCNT,I
  1. S (NCNT,I)=0
  1. F S I=$O(^XMB(3.9,XMZ,2,I)) Q:'I I ^XMB(3.9,XMZ,2,I,0)["NNNN" S NCNT=NCNT+1
  1. Q:NCNT'>1 1
  1. W !!,"<< 4 CONSECUTIVE N's ARE NOT ALLOWED IN THE MSG TEXT !!! >>",!!,$C(7)
  1. H 5
  1. Q 0
  1. T ; Transmit
  1. S XMFINISH=1
  1. D BLDNSND^XMXSEND(XMDUZ,XMZ,.XMINSTR)
  1. Q
  1. Q W !,"Answer: ",!
  1. W !,"T (or just return) to PERMANENTLY transmit the message."
  1. W !,"E to Edit the text of the message."
  1. W !,"'^' to cancel the message."
  1. Q
  1. READY(XMDUZ,XMINSTR,XMRESTR,XMABORT) ;
  1. N DIR,DIRUT,Y
  1. S DIR(0)="Y"
  1. S DIR("A")="Ready to send to the Austin AMS System"
  1. S DIR("?",1)="'YES' will place the message in the queue for transmission through the AMS System."
  1. S DIR("?")="'NO' will place the message only in your IN basket."
  1. D ^DIR I $D(DIRUT) S XMABORT=1 Q
  1. Q:'Y
  1. W !,"Send to: XXX@VHA.DMIA"
  1. D ADDR^XMXADDR(XMDUZ,"XXX@VHA.DMIA",.XMINSTR,.XMRESTR)
  1. Q
  1. EXIT ;
  1. K I,XMTO,XMFM,XMSTR,XMUS,XMTM,XMRI,DIC,XCNP,XMXUSEC,ZTPAR,XMSEQ,XMOUT,DTOUT
  1. K ^TMP("XMY",$J),^TMP("XMY0",$J)
  1. Q