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

PXRMEXMM.m

Go to the documentation of this file. 
  1. PXRMEXMM ; SLC/PKR - Routines to select and deal with MailMan messages ;01/22/2013
  1.  ;;2.0;CLINICAL REMINDERS;**12,26**;Feb 04, 2005;Build 404
  1.  ;=============================================================
  1. CMM(SUCCESS,LIST) ;Create a MailMan message containing the repository
  1.  ;entries in LIST.
  1.  ;Get a new MailMan message number.
  1.  N IC,IND,LC,LEN,LNUM,RIEN,TEMP,TLC,XMSUB
  1.  S TEMP=$$GETSUB
  1.  I (TEMP["^")!(TEMP="") Q
  1.  S XMSUB="CREX: "_TEMP
  1.  S TEMP=$$SUBCHK^XMGAPI0(XMSUB,0)
  1.  I $P(TEMP,U,1)'="" S XMSUB=$E(XMSUB,1,65)
  1. RETRY ;
  1.  D XMZ^XMA2
  1.  I XMZ<1 G RETRY
  1.  S SUCCESS("XMZ")=XMZ
  1.  S SUCCESS("SUB")=XMSUB
  1.  ;
  1.  S (IC,TLC)=0
  1.  S LEN=$L(LIST,",")-1
  1.  F IND=1:1:LEN D
  1.  . S LNUM=$P(LIST,",",IND)
  1.  . S RIEN=$$RIEN^PXRMEXU1(LNUM)
  1.  . S LC=$O(^PXD(811.8,RIEN,100,""),-1)
  1.  . S TLC=TLC+LC
  1.  . F IND=1:1:LC D
  1.  .. S IC=IC+1
  1.  .. S ^XMB(3.9,XMZ,2,IC,0)=^PXD(811.8,RIEN,100,IND,0)
  1.  S ^XMB(3.9,XMZ,2,0)="^3.92^"_TLC_"^"_TLC_"^"_DT
  1.  ;
  1.  ;Make the message information only.
  1.  S $P(^XMB(3.9,XMZ,0),U,12)="Y"
  1.  ;
  1.  ;Get a list of who to send it to and send it.
  1.  D ENT2^XMD
  1.  Q
  1.  ;
  1.  ;=============================================================
  1. GETMESSN() ;Get the message number.
  1.  N BSKT,DIC,DIROUT,DIRUT,DTOUT,DUOUT,X,Y,ZN
  1.  S DIC("A")="Select a MailMan message: "
  1.  S DIC=3.9
  1.  S DIC(0)="EQV"
  1.  ;Look for messages that start with "C" for either CREX or Copy of.
  1.  S X="CREX:"
  1.  ;DBIA #2736 for XMXUTIL2
  1.  S DIC("S")="S BSKT=$$BSKT^XMXUTIL2(DUZ,+Y) I BSKT>0,BSKT'=.5"
  1.  S DIC("W")="S ZN=$$ZNODE^XMXUTIL2(+Y) W !,""         "",$$FROM^XMXUTIL2(ZN),"" "",$$DATE^XMXUTIL2(ZN),!"
  1.  W !
  1.  D ^DIC K DIC
  1.  I X=(U_U) S DTOUT=1
  1.  I $D(DIROUT)!$D(DIRUT) Q ""
  1.  I $D(DTOUT)!$D(DUOUT) Q ""
  1.  I +Y'=-1 Q $P(Y,U,1)
  1.  ;
  1.  S DIC("A")="Select a MailMan message: "
  1.  S DIC=3.9
  1.  S DIC(0)="EQV"
  1.  S X="Copy of: CREX:"
  1.  ;DBIA #2736 for XMXUTIL2
  1.  S DIC("S")="S BSKT=$$BSKT^XMXUTIL2(DUZ,+Y) I BSKT>0,BSKT'=.5"
  1.  S DIC("W")="S ZN=$$ZNODE^XMXUTIL2(+Y) W !,""         "",$$FROM^XMXUTIL2(ZN),"" "",$$DATE^XMXUTIL2(ZN),!"
  1.  W !
  1.  D ^DIC K DIC
  1.  I X=(U_U) S DTOUT=1
  1.  I $D(DIROUT)!$D(DIRUT) Q ""
  1.  I $D(DTOUT)!$D(DUOUT) Q ""
  1.  Q $P(Y,U,1)
  1.  ;
  1.  ;=============================================================
  1. GETSUB() ;Prompt the user for a subject.
  1.  N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
  1.  S DIR(0)="FAU"_U_"1:59"
  1.  S DIR("A")="Enter a subject: "
  1.  D ^DIR
  1.  I $D(DIROUT)!$D(DIRUT) Q ""
  1.  I $D(DTOUT)!$D(DUOUT) Q ""
  1.  Q Y
  1.  ;
  1.  ;=============================================================
  1. LMM(SUCCESS,XMZ) ;Load repository entries from a MailMan message.
  1.  N CSUM,DATEP,EXTYPE,FDA,FDAIEN,IENROOT,IND,LINE,MSG,NENTRY,NLINES,RETMP
  1.  N RNAME,SITE,SOURCE,SSOURCE,TEMP,US,USER,VRSN,XMER,XMPOS,XMRG,XMVAR
  1.  ;Get the message information
  1.  ;DBIA #1144
  1.  S TEMP=$$HDR^XMGAPI2(XMZ,.XMVAR,0)
  1.  I TEMP'=0 D  Q
  1.  . W !,"This MailMan message has a corrupted header."
  1.  . S SUCCESS=0
  1.  . H 2
  1.  ;Load the message
  1.  W !,"Loading MailMan message number ",XMZ
  1.  K ^TMP("PXRMEXLMM",$J)
  1.  S RETMP="^TMP(""PXRMEXLMM"",$J)"
  1.  S (NENTRY,NLINES,SSOURCE)=0
  1.  S XMPOS=$$STARTPOS(XMZ)
  1.  F  D REC^XMS3 Q:+$G(XMER)=-1  D
  1.  . S NLINES=NLINES+1
  1.  . S ^TMP("PXRMEXLMM",$J,NLINES,0)=XMRG
  1.  . I XMRG["<PACKAGE_VERSION>" S VRSN=$$GETTAGV^PXRMEXU3(XMRG,"<PACKAGE_VERSION>")
  1.  . I XMRG["<EXCHANGE_TYPE>" S EXTYPE=$$GETTAGV^PXRMEXU3(XMRG,"<EXCHANGE_TYPE>",1)
  1.  . I XMRG="<SOURCE>" S SSOURCE=1
  1.  . I SSOURCE D
  1.  .. I XMRG["<NAME>" S RNAME=$$GETTAGV^PXRMEXU3(XMRG,"<NAME>",1)
  1.  .. I XMRG["<USER>" S USER=$$GETTAGV^PXRMEXU3(XMRG,"<USER>",1)
  1.  .. I XMRG["<SITE>" S SITE=$$GETTAGV^PXRMEXU3(XMRG,"<SITE>",1)
  1.  .. I XMRG["<DATE_PACKED>" S DATEP=$$GETTAGV^PXRMEXU3(XMRG,"<DATE_PACKED>")
  1.  . I XMRG="</SOURCE>" D
  1.  .. S SSOURCE=0
  1.  .. S SOURCE=USER_" at "_SITE
  1.  .;See if the entry is loaded into the temporary storage.
  1.  . I XMRG="</REMINDER_EXCHANGE_FILE_ENTRY>" D
  1.  .. S NLINES=0
  1.  .. S NENTRY=NENTRY+1
  1.  ..;Make sure it has the correct format.
  1.  .. I (^TMP("PXRMEXLMM",$J,1,0)'["xml")!(^TMP("PXRMEXLMM",$J,2,0)'="<REMINDER_EXCHANGE_FILE_ENTRY>") D  Q
  1.  ... W !,"There is a problem reading this MailMan message for entry ",NENTRY,", try it again."
  1.  ... W !,"If it fails twice it is not in the proper reminder exchange format."
  1.  ... S SUCCESS=0
  1.  ... H 2
  1.  ... S XMER=-1
  1.  ..;Make sure this entry does not already exist.
  1.  .. I $$REXISTS^PXRMEXIU(RNAME,DATEP) D
  1.  ... W !,RNAME," with a date packed of ",DATEP
  1.  ... W !,"is already in the Exchange File, it will not be added again."
  1.  ... S SUCCESS(NENTRY)=0
  1.  ... H 2
  1.  .. E  D
  1.  ... K FDA,IENROOT
  1.  ... S FDA(811.8,"+1,",.01)=RNAME
  1.  ... S FDA(811.8,"+1,",.02)=SOURCE
  1.  ... S FDA(811.8,"+1,",.03)=DATEP
  1.  ... D UPDATE^PXRMEXPU(.US,.FDA,.IENROOT)
  1.  ... S SUCCESS(NENTRY)=US
  1.  ...;Create the description and save the data.
  1.  ... N DESL,DESCT,KEYWORDT
  1.  ... D DESC^PXRMEXU3(RETMP,.DESCT)
  1.  ... D KEYWORD^PXRMEXU3(RETMP,.KEYWORDT)
  1.  ... S DESL("RNAME")=RNAME,DESL("SOURCE")=SOURCE,DESL("DATEP")=DATEP
  1.  ... S DESL("VRSN")=VRSN
  1.  ... D DESC^PXRMEXU1(IENROOT(1),.DESL,"DESCT","KEYWORDT")
  1.  ... M ^PXD(811.8,IENROOT(1),100)=^TMP("PXRMEXLMM",$J)
  1.  ... W !,"Added Exchange entry ",RNAME H 2
  1.  .. K ^TMP("PXRMEXLMM",$J)
  1.  ;Check the success of the entry installs.
  1.  S SUCCESS=1
  1.  S IND=""
  1.  F  S IND=$O(SUCCESS(IND)) Q:+IND=0  D
  1.  . I 'SUCCESS(IND) S SUCCESS=0 Q
  1.  Q
  1.  ;
  1.  ;=============================================================
  1. STARTPOS(XMZ) ;Find the starting position by looking for the xml header.
  1.  ;This will skip over extra header information created by things like
  1.  ;copying or using p-message.
  1.  N XMPOS,XMER,XMRG
  1.  S XMPOS=.99
  1.  F  D REC^XMS3 Q:(XMRG="<?xml version=""1.0"" standalone=""yes""?>")!(+$G(XMER)=-1)
  1.  S XMPOS=$S($G(XMER)=-1:-1,1:XMPOS-1)
  1.  Q XMPOS
  1.  ;