source: WorldVistAEHR/trunk/r/MAILMAN-XM/XMJMORX1.m@ 1608

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

initial load of WorldVistAEHR
File size: 5.2 KB
RevLine 
[613]1XMJMORX1 ;ISC-SF/GMB-^XMJMORX (cont.) ;09/16/2002 11:16
2 ;;8.0;MailMan;**5**;Jun 28, 2002
3 ;DELMSG(XMDUZ,XMK,XMKZ,XMZ,XMCNT)
4XDEL ;
5 Q:'XMK
6 K XMERR,^TMP("XMERR",$J)
7 D DEL^XMXMSGS2(XMDUZ,XMK,XMZ,.XMCNT)
8 I $D(XMERR) D ZSHOW^XMJERR Q
9 I XMKALL,$G(XMTYPE)'["N" D Q
10 . S ^TMP("XM",$J,"MSG",XMKZ)=$S(XMK'=.5:".5^"_$$EZBLD^DIALOG(37004),1:"0^"_$$EZBLD^DIALOG(34014))_U_XMZ ; "WASTE" / "* N/A *"
11 K:XMTMP ^TMP("XM",$J,"MSG",XMKZ)
12 K:$D(^TMP("XM",$J,".",XMKZ)) ^TMP("XM",$J,".",XMKZ)
13 Q
14 ;FLTRMSG(XMDUZ,XMK,XMKZ,XMZ,XMCNT)
15XFLTR ;
16 N XMKN,XMKTO,XMKNTO
17 S XMKN=$P(^TMP("XM",$J,"MSG",XMKZ),U,2)
18 D FLTR^XMXMSGS2(XMDUZ,XMK,XMKN,XMZ,.XMCNT,.XMKTO,.XMKNTO)
19 I $D(XMERR) D ZSHOW^XMJERR Q
20 I XMKALL D Q
21 . S:XMKN'=XMKNTO ^TMP("XM",$J,"MSG",XMKZ)=XMKTO_U_XMKNTO_U_XMZ
22 Q:XMKN=XMKNTO
23 K ^TMP("XM",$J,"MSG",XMKZ)
24 K:$D(^TMP("XM",$J,".",XMKZ)) ^TMP("XM",$J,".",XMKZ)
25 Q
26 ;NTOGLMSG(XMDUZ,XMK,XMKZ,XMZ,XMCNT)
27XNTOGL ;
28 N XMKN,XMKTO,XMKNTO
29 S XMKN=$P(^TMP("XM",$J,"MSG",XMKZ),U,2)
30 D NTOGL^XMXMSGS2(XMDUZ,XMK,XMKN,XMZ,.XMCNT,.XMKTO,.XMKNTO)
31 I $D(XMERR) D ZSHOW^XMJERR Q
32 I XMKALL D Q
33 . S:XMKN'=XMKNTO ^TMP("XM",$J,"MSG",XMKZ)=XMKTO_U_XMKNTO_U_XMZ
34 Q:XMKN=XMKNTO
35 K ^TMP("XM",$J,"MSG",XMKZ)
36 K:$D(^TMP("XM",$J,".",XMKZ)) ^TMP("XM",$J,".",XMKZ)
37 Q
38 ;SAVEMSG(XMDUZ,XMK,XMKTO,XMKNTO,XMKZ,XMZ,XMCNT)
39XSAVE ;
40 Q:XMK=XMKTO
41 D MOVE^XMXMSGS2(XMDUZ,XMK,XMZ,XMKTO,.XMCNT)
42 I $D(XMERR) D ZSHOW^XMJERR Q
43 I XMKALL D Q
44 . S ^TMP("XM",$J,"MSG",XMKZ)=XMKTO_U_XMKNTO_U_XMZ
45 K ^TMP("XM",$J,"MSG",XMKZ)
46 ;K:$D(^TMP("XM",$J,".",XMKZ)) ^TMP("XM",$J,".",XMKZ)
47 Q
48 ;TERMMSG(XMDUZ,XMK,XMKZ,XMZ,XMCNT)
49XTERM ;
50 Q:'XMK
51 K XMERR,^TMP("XMERR",$J)
52 D TERM^XMXMSGS2(XMDUZ,XMK,XMZ,.XMCNT)
53 I $D(XMERR) D ZSHOW^XMJERR Q
54 I XMKALL,$G(XMTYPE)'["N" D Q
55 . S ^TMP("XM",$J,"MSG",XMKZ)=$S(XMK'=.5:".5^"_$$EZBLD^DIALOG(37004),1:"0^"_$$EZBLD^DIALOG(34014))_U_XMZ ; "WASTE" / "* N/A *"
56 K:XMTMP ^TMP("XM",$J,"MSG",XMKZ)
57 K:$D(^TMP("XM",$J,".",XMKZ)) ^TMP("XM",$J,".",XMKZ)
58 Q
59LISTSEL(XMZLIST) ;
60 N XMKZ,J,XMZ
61 S (XMKZ,J)=0
62 F S XMKZ=$O(^TMP("XM",$J,".",XMKZ)) Q:'XMKZ D
63 . S XMZ=$P(^TMP("XM",$J,"MSG",XMKZ),U,3)
64 . I J=0 S J=1,XMZLIST(1)=XMZ Q
65 . I $L(XMZLIST(J))+$L(XMZ)>240 S J=J+1,XMZLIST(J)=XMZ Q
66 . S XMZLIST(J)=XMZLIST(J)_","_XMZ
67 Q
68LIST(XMWHICH,XMZLIST) ;
69 N I,J,XMRANGE,XMKZ,XMZ
70 S J=0
71 F I=1:1:$L(XMWHICH,",") D
72 . S XMRANGE=$P(XMWHICH,",",I)
73 . Q:'XMRANGE
74 . F XMKZ=$P(XMRANGE,"-",1):1:$S(XMRANGE["-":$P(XMRANGE,"-",2),1:XMRANGE) D
75 . . S XMZ=$P($G(^TMP("XM",$J,"MSG",XMKZ)),U,3) Q:'XMZ
76 . . I J=0 S J=1,XMZLIST(1)=XMZ Q
77 . . I $L(XMZLIST(J))+$L(XMZ)>240 S J=J+1,XMZLIST(J)=XMZ Q
78 . . S XMZLIST(J)=XMZLIST(J)_","_XMZ
79 Q
80ACTWHICH(XMDUZ,XMTMP,XMKALL,XMK,XMRTN,XMPROMPT,XMSUM,XMCONFRM,XMMSG,XMABORT) ;,XMKTO)
81 N XMWHICH
82 D WHICH(XMPROMPT,XMCONFRM,.XMWHICH,.XMABORT) Q:XMABORT
83 D ACTMSG(XMDUZ,XMTMP,XMKALL,XMK,XMWHICH,XMRTN,XMSUM,.XMMSG)
84 Q
85WHICH(XMPROMPT,XMCONFRM,XMWHICH,XMABORT) ;
86 N DIR,Y,XMHI,XMLO
87 S XMLO=$O(^TMP("XM",$J,"MSG",""))
88 S XMHI=$O(^TMP("XM",$J,"MSG",""),-1)
89 S DIR("A")=$$EZBLD^DIALOG(XMPROMPT) ; ... which messages?
90 S DIR("??")="XM-U-M-CHOOSE RANGE"
91 S DIR(0)="LC^"_XMLO_":"_XMHI
92 D ^DIR I $D(DIRUT) S XMABORT=1 Q
93 S XMWHICH=Y
94 I XMCONFRM D CONFIRM^XMJMOR(XMCONFRM,.XMABORT)
95 Q
96ACTMSG(XMDUZ,XMTMP,XMKALL,XMK,XMKZA,XMRTN,XMSUM,XMMSG) ;,XMKTO)
97 ; XMKZA Array of msg numbers DEL("1-3,7,11-15")
98 ; XMKZL List of msg numbers 1-3,7,11-15
99 ; (It is OK if the list ends with a comma)
100 ; XMKZR Range of msg numbers 1-3
101 ; XMKZ1 First number in range 1
102 ; XMKZN Last number in range 3
103 N XMKZ,XMREC,XMKZL,XMKZR,XMI,XMKZ1,XMKZN,XMZ,XMCNT,XMPIECES
104 S XMCNT=0
105 ; is this an array or a variable?
106 I $G(XMKZA)]"",$O(XMKZA(""))="" S XMKZA(XMKZA)=""
107 S XMKZL=""
108 F S XMKZL=$O(XMKZA(XMKZL)) Q:XMKZL="" D
109 . S XMPIECES=$L(XMKZL,",")
110 . S:'$P(XMKZL,",",XMPIECES) XMPIECES=XMPIECES-1
111 . F XMI=1:1:XMPIECES D
112 . . S XMKZR=$P(XMKZL,",",XMI)
113 . . I XMKZR["-" D Q
114 . . . ; deal with a range of msg #s
115 . . . S XMKZ1=$P(XMKZR,"-",1)
116 . . . S XMKZN=$P(XMKZR,"-",2)
117 . . . S XMKZ=XMKZ1-.1
118 . . . I XMTMP D Q
119 . . . . F S XMKZ=$O(^TMP("XM",$J,"MSG",XMKZ)) Q:XMKZ>XMKZN!'XMKZ D
120 . . . . . S XMREC=^TMP("XM",$J,"MSG",XMKZ)
121 . . . . . S:XMKALL XMK=$P(XMREC,U,1)
122 . . . . . S XMZ=$P(XMREC,U,3) Q:'XMZ
123 . . . . . D @XMRTN ;(XMDUZ,XMK,XMZ)
124 . . . F S XMKZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ)) Q:XMKZ>XMKZN!'XMKZ D
125 . . . . S XMZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ,0)) Q:'XMZ
126 . . . . D @XMRTN ;(XMDUZ,XMK,XMZ)
127 . . S XMKZ=XMKZR
128 . . I XMTMP D Q
129 . . . S XMREC=$G(^TMP("XM",$J,"MSG",XMKZ))
130 . . . I XMREC="" S XMZ=0 Q
131 . . . S:XMKALL XMK=$P(XMREC,U,1)
132 . . . S XMZ=$P(XMREC,U,3) Q:'XMZ
133 . . . D @XMRTN ;(XMDUZ,XMK,XMZ)
134 . . S XMZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ,0)) Q:'XMZ
135 . . D @XMRTN ;(XMDUZ,XMK,XMZ)
136 S XMMSG=$$EZBLD^DIALOG($S(XMCNT=1:XMSUM+.1,1:XMSUM),XMCNT)
137 D INCRDECR^XMXMSGS(XMDUZ,.XMCNT)
138 Q
139SELMSG(XMDUZ,XMTMP,XMKALL,XMK,XMRTN,XMSUM,XMCONFRM,XMMSG,XMABORT) ;,XMKTO,XMWHEN)
140 I XMCONFRM D CONFIRM^XMJMOR(XMCONFRM,.XMABORT) Q:XMABORT
141 N XMCNT,XMKZ,XMREC,XMZ
142 S (XMCNT,XMKZ)=0
143 F S XMKZ=$O(^TMP("XM",$J,".",XMKZ)) Q:'XMKZ D
144 . I XMTMP D Q
145 . . S XMREC=^TMP("XM",$J,"MSG",XMKZ)
146 . . S:XMKALL XMK=$P(XMREC,U,1)
147 . . S XMZ=$P(XMREC,U,3) Q:'XMZ
148 . . D @XMRTN ;(XMDUZ,XMK,XMZ)
149 . S XMZ=$O(^XMB(3.7,XMDUZ,2,XMK,1,"C",XMKZ,"")) Q:'XMZ
150 . D @XMRTN ;(XMDUZ,XMK,XMZ)
151 S XMMSG=$$EZBLD^DIALOG($S(XMCNT=1:XMSUM+.1,1:XMSUM),XMCNT)
152 D INCRDECR^XMXMSGS(XMDUZ,.XMCNT)
153 Q
Note: See TracBrowser for help on using the repository browser.