source: WorldVistAEHR/trunk/r/CLINICAL_REMINDERS-PXRM/PXRMEXMM.m@ 1166

Last change on this file since 1166 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 5.4 KB
Line 
1PXRMEXMM ; SLC/PKR - Routines to select and deal with MailMan messages ;12/22/2004
2 ;;2.0;CLINICAL REMINDERS;;Feb 04, 2005
3 ;=============================================================
4CMM(SUCCESS,LIST) ;Create a MailMan message containing the repository
5 ;entries in LIST.
6 ;Get a new MailMan message number.
7 N IC,IND,LC,LIEN,RIEN,TEMP,TLC,XMSUB
8 S TEMP=$$GETSUB
9 I (TEMP["^")!(TEMP="") Q
10 S XMSUB="CREX: "_TEMP
11 S TEMP=$$SUBCHK^XMGAPI0(XMSUB,0)
12 I $P(TEMP,U,1)'="" S XMSUB=$E(XMSUB,1,65)
13RETRY ;
14 D XMZ^XMA2
15 I XMZ<1 G RETRY
16 S SUCCESS("XMZ")=XMZ
17 S SUCCESS("SUB")=XMSUB
18 ;
19 S (IC,TLC)=0
20 S LIEN=""
21 F S LIEN=$O(LIST(LIEN)) Q:+LIEN=0 D
22 . S RIEN=$$RIEN^PXRMEXU1(LIEN)
23 . S LC=$O(^PXD(811.8,RIEN,100,""),-1)
24 . S TLC=TLC+LC
25 . F IND=1:1:LC D
26 .. S IC=IC+1
27 .. S ^XMB(3.9,XMZ,2,IC,0)=^PXD(811.8,RIEN,100,IND,0)
28 S ^XMB(3.9,XMZ,2,0)="^3.92^"_TLC_"^"_TLC_"^"_DT
29 ;
30 ;Make the message information only.
31 S $P(^XMB(3.9,XMZ,0),U,12)="Y"
32 ;
33 ;Get a list of who to send it to and send it.
34 D ENT2^XMD
35 Q
36 ;
37 ;=============================================================
38GETMESSN() ;Get the message number.
39 N BSKT,DIC,DIROUT,DIRUT,DTOUT,DUOUT,X,Y,ZN
40 S DIC("A")="Select a MailMan message: "
41 S DIC=3.9
42 S DIC(0)="EQV"
43 ;Look for messages that start with "C" for either CREX or Copy of.
44 S X="CREX:"
45 ;DBIA #2736 for XMXUTIL2
46 S DIC("S")="S BSKT=$$BSKT^XMXUTIL2(DUZ,+Y) I BSKT>0,BSKT'=.5"
47 S DIC("W")="S ZN=$$ZNODE^XMXUTIL2(+Y) W !,"" "",$$FROM^XMXUTIL2(ZN),"" "",$$DATE^XMXUTIL2(ZN),!"
48 W !
49 D ^DIC K DIC
50 I X=(U_U) S DTOUT=1
51 I $D(DIROUT)!$D(DIRUT) Q ""
52 I $D(DTOUT)!$D(DUOUT) Q ""
53 I +Y'=-1 Q $P(Y,U,1)
54 ;
55 S DIC("A")="Select a MailMan message: "
56 S DIC=3.9
57 S DIC(0)="EQV"
58 S X="Copy of: CREX:"
59 ;DBIA #2736 for XMXUTIL2
60 S DIC("S")="S BSKT=$$BSKT^XMXUTIL2(DUZ,+Y) I BSKT>0,BSKT'=.5"
61 S DIC("W")="S ZN=$$ZNODE^XMXUTIL2(+Y) W !,"" "",$$FROM^XMXUTIL2(ZN),"" "",$$DATE^XMXUTIL2(ZN),!"
62 W !
63 D ^DIC K DIC
64 I X=(U_U) S DTOUT=1
65 I $D(DIROUT)!$D(DIRUT) Q ""
66 I $D(DTOUT)!$D(DUOUT) Q ""
67 Q $P(Y,U,1)
68 ;
69 ;=============================================================
70GETSUB() ;Prompt the user for a subject.
71 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
72 S DIR(0)="FAU"_U_"1:59"
73 S DIR("A")="Enter a subject: "
74 D ^DIR
75 I $D(DIROUT)!$D(DIRUT) Q ""
76 I $D(DTOUT)!$D(DUOUT) Q ""
77 Q Y
78 ;
79 ;=============================================================
80LMM(SUCCESS,XMZ) ;Load repository entries from a MailMan message.
81 N CSUM,DATEP,EXTYPE,FDA,FDAIEN,IENROOT,IND,LINE,MSG,NENTRY,NLINES,RETMP
82 N RNAME,SITE,SOURCE,SSOURCE,TEMP,US,USER,VRSN,XMER,XMPOS,XMRG,XMVAR
83 ;Get the message information
84 ;DBIA #1144
85 S TEMP=$$HDR^XMGAPI2(XMZ,.XMVAR,0)
86 I TEMP'=0 D Q
87 . W !,"This MailMan message has a corrupted header."
88 . S SUCCESS=0
89 . H 2
90 ;Load the message
91 W !,"Loading MailMan message number ",XMZ
92 K ^TMP("PXRMEXLMM",$J)
93 S RETMP="^TMP(""PXRMEXLMM"",$J)"
94 S (NENTRY,NLINES,SSOURCE)=0
95 S XMPOS=$$STARTPOS(XMZ)
96 F D REC^XMS3 Q:+$G(XMER)=-1 D
97 . S NLINES=NLINES+1
98 . S ^TMP("PXRMEXLMM",$J,NLINES,0)=XMRG
99 . I XMRG["<PACKAGE_VERSION>" S VRSN=$$GETTAGV^PXRMEXU3(XMRG,"<PACKAGE_VERSION>")
100 . I XMRG["<EXCHANGE_TYPE>" S EXTYPE=$$GETTAGV^PXRMEXU3(XMRG,"<EXCHANGE_TYPE>",1)
101 . I XMRG="<SOURCE>" S SSOURCE=1
102 . I SSOURCE D
103 .. I XMRG["<NAME>" S RNAME=$$GETTAGV^PXRMEXU3(XMRG,"<NAME>",1)
104 .. I XMRG["<USER>" S USER=$$GETTAGV^PXRMEXU3(XMRG,"<USER>",1)
105 .. I XMRG["<SITE>" S SITE=$$GETTAGV^PXRMEXU3(XMRG,"<SITE>",1)
106 .. I XMRG["<DATE_PACKED>" S DATEP=$$GETTAGV^PXRMEXU3(XMRG,"<DATE_PACKED>")
107 . I XMRG="</SOURCE>" D
108 .. S SSOURCE=0
109 .. S SOURCE=USER_" at "_SITE
110 .;See if the entry is loaded into the temporary storage.
111 . I XMRG="</REMINDER_EXCHANGE_FILE_ENTRY>" D
112 .. S NLINES=0
113 .. S NENTRY=NENTRY+1
114 ..;Make sure it has the correct format.
115 .. I (^TMP("PXRMEXLMM",$J,1,0)'["xml")!(^TMP("PXRMEXLMM",$J,2,0)'="<REMINDER_EXCHANGE_FILE_ENTRY>") D Q
116 ... W !,"There is a problem reading this MailMan message for entry ",NENTRY,", try it again."
117 ... W !,"If it fails twice it is not in the proper reminder exchange format."
118 ... S SUCCESS=0
119 ... H 2
120 ... S XMER=-1
121 ..;Make sure this entry does not already exist.
122 .. I $$REXISTS^PXRMEXIU(RNAME,DATEP) D
123 ... W !,RNAME," with a date packed of ",DATEP
124 ... W !,"is already in the Exchange File, it will not be added again."
125 ... S SUCCESS(NENTRY)=0
126 ... H 2
127 .. E D
128 ... K FDA,IENROOT
129 ... S FDA(811.8,"+1,",.01)=RNAME
130 ... S FDA(811.8,"+1,",.02)=SOURCE
131 ... S FDA(811.8,"+1,",.03)=DATEP
132 ... S FDA(811.8,"+1,",115)=$S($G(EXTYPE)="":"REMINDER",1:EXTYPE)
133 ... D UPDATE^PXRMEXPU(.US,.FDA,.IENROOT)
134 ... S SUCCESS(NENTRY)=US
135 ...;Create the description and save the data.
136 ... N DESL,DESCT,KEYWORDT
137 ... D DESC^PXRMEXU3(RETMP,.DESCT)
138 ... D KEYWORD^PXRMEXU3(RETMP,.KEYWORDT)
139 ... S DESL("RNAME")=RNAME,DESL("SOURCE")=SOURCE,DESL("DATEP")=DATEP
140 ... S DESL("VRSN")=VRSN
141 ... D DESC^PXRMEXU1(IENROOT(1),.DESL,"DESCT","KEYWORDT")
142 ... M ^PXD(811.8,IENROOT(1),100)=^TMP("PXRMEXLMM",$J)
143 ... W !,"Added Exchange entry ",RNAME H 2
144 .. K ^TMP("PXRMEXLMM",$J)
145 ;Check the success of the entry installs.
146 S SUCCESS=1
147 S IND=""
148 F S IND=$O(SUCCESS(IND)) Q:+IND=0 D
149 . I 'SUCCESS(IND) S SUCCESS=0 Q
150 Q
151 ;
152 ;=============================================================
153STARTPOS(XMZ) ;Find the starting position by looking for the xml header.
154 ;This will skip over extra header information created by things like
155 ;copying or using p-message.
156 N XMPOS,XMER,XMRG
157 S XMPOS=.99
158 F D REC^XMS3 Q:(XMRG="<?xml version=""1.0"" standalone=""yes""?>")!(+$G(XMER)=-1)
159 S XMPOS=$S($G(XMER)=-1:-1,1:XMPOS-1)
160 Q XMPOS
161 ;
Note: See TracBrowser for help on using the repository browser.