175 lines
7.4 KiB
Mathematica
175 lines
7.4 KiB
Mathematica
XMJMQ ;ISC-SF/GMB-Q,QD,QN Query recipients ;12/04/2002 11:21
|
|
;;8.0;MailMan;**10**;Jun 28, 2002
|
|
; Replaces ^XMA5,^XMA5A (ISC-WASH/THM/CAP)
|
|
Q(XMDUZ,XMK,XMKN,XMZ) ; Query
|
|
N XMRESPM,XMABORT
|
|
D QINIT^XMJMQ1(XMDUZ,XMK,XMKN,XMZ,.XMRESPM,.XMABORT)
|
|
D SUMMARY^XMJMQ1(XMZ,0,"","","",.XMABORT)
|
|
Q
|
|
QD(XMDUZ,XMK,XMKN,XMZ) ; Query Detail
|
|
N XMRESPM,XMABORT
|
|
D QINIT^XMJMQ1(XMDUZ,XMK,XMKN,XMZ,.XMRESPM,.XMABORT)
|
|
D DETAIL(XMZ,0,"","","",.XMABORT)
|
|
Q
|
|
QN(XMDUZ,XMK,XMKN,XMZ) ; Query Network
|
|
N XMRESPM,XMABORT
|
|
D QINIT^XMJMQ1(XMDUZ,XMK,XMKN,XMZ,.XMRESPM,.XMABORT)
|
|
D NETWORK^XMJMQ1(XMZ,.XMABORT) Q:XMABORT
|
|
D DETAIL(XMZ,0,"","","",.XMABORT)
|
|
Q
|
|
QX(XMDUZ,XMK,XMKN,XMZ,XMWHAT) ; Query Special
|
|
; XMWHAT = "QC" - show local users who are current
|
|
; "QNC" - show local users who are not current
|
|
; "QT" - show local users who have terminated
|
|
N XMRESPM,XMABORT,XMTO,XMIEN,XMTYPE,XMRESPS,XMCNT,XMTOTAL,XMPHDR
|
|
D QINIT^XMJMQ1(XMDUZ,XMK,XMKN,XMZ,.XMRESPM,.XMABORT)
|
|
I $Y+3>IOSL D PAGE(.XMABORT) Q:XMABORT
|
|
S XMRESPS=+$P($G(^XMB(3.9,XMZ,3,0)),U,4)
|
|
W !
|
|
S (XMPHDR,XMCNT,XMTOTAL,XMTO)=0
|
|
F S XMTO=$O(^XMB(3.9,XMZ,1,"C",XMTO)) Q:+XMTO'=XMTO D Q:XMABORT
|
|
. S XMTOTAL=XMTOTAL+1
|
|
. S XMIEN=$O(^XMB(3.9,XMZ,1,"C",XMTO,""))
|
|
. I XMWHAT="QC",$P(^XMB(3.9,XMZ,1,XMIEN,0),U,2)'=XMRESPS Q ; not current
|
|
. I XMWHAT="QNC",$P(^XMB(3.9,XMZ,1,XMIEN,0),U,2)=XMRESPS Q ; current
|
|
. I XMWHAT="QT",'$G(^XMB(3.9,XMZ,1,XMIEN,"D")) Q ; not terminated
|
|
. S XMCNT=XMCNT+1
|
|
. D WNAME(XMZ,$$NAME^XMXUTIL(XMTO),XMIEN,XMRESPM,.XMTYPE,.XMABORT)
|
|
Q:XMABORT
|
|
I $Y+3+(XMCNT>0)>IOSL D PAGE(.XMABORT) Q:XMABORT
|
|
N XMTEXT,XMPARM
|
|
I XMCNT W !
|
|
S XMPARM(1)=XMCNT,XMPARM(2)=XMTOTAL
|
|
D BLD^DIALOG($S(XMWHAT="QC":37431.9,XMWHAT="QNC":37432.9,1:37433.9),.XMPARM,"","XMTEXT","F")
|
|
D MSG^DIALOG("WM","",IOM,"","XMTEXT")
|
|
; Local recipients who are (not) current: |1| of |2|
|
|
; Local recipients who have terminated: |1| of |2|
|
|
Q
|
|
QNAME(XMDUZ,XMK,XMKN,XMZ) ; Query someone's name
|
|
N XMRESPM,XMABORT,DIR,Y,DIRUT,XMNAME
|
|
F D Q:$D(DIRUT)
|
|
. S DIR(0)="FO^1:30^K:"", ""[$E(X) X"
|
|
. S DIR("A")=$$EZBLD^DIALOG(34555) ; Enter the person's name or partial name
|
|
. D BLD^DIALOG(34556,"","","DIR(""?"")")
|
|
. ;Name must be from 1 to 30 characters,
|
|
. ;and must not contain ^, or begin with comma or space.
|
|
. D ^DIR Q:$D(DIRUT)
|
|
. S XMNAME=Y
|
|
. D QINIT^XMJMQ1(XMDUZ,XMK,XMKN,XMZ,.XMRESPM,.XMABORT)
|
|
. D SEARCH^XMJMQ1(XMZ,XMNAME,XMRESPM)
|
|
Q
|
|
QNAMEX(XMDUZ,XMK,XMKN,XMZ,XMNAME) ; Query someone's name (name is supplied)
|
|
N XMRESPM,XMABORT
|
|
I ($L(XMNAME)<1)!($L(XMNAME)>30)!(XMNAME[U)!(", "[$E(XMNAME,1)) D Q
|
|
. N XMTEXT
|
|
. W $C(7)
|
|
. D BLD^DIALOG(34556,"","","XMTEXT","F")
|
|
. D MSG^DIALOG("WH","","","","XMTEXT")
|
|
. ;Name must be from 1 to 30 characters,
|
|
. ;and must not contain ^, or begin with comma or space.
|
|
D QINIT^XMJMQ1(XMDUZ,XMK,XMKN,XMZ,.XMRESPM,.XMABORT)
|
|
D SEARCH^XMJMQ1(XMZ,XMNAME,XMRESPM)
|
|
Q
|
|
DETAIL(XMZ,XMPHDR,XMSUBJ,XMZSTR,XMPAGE,XMABORT) ;
|
|
; XMRESPM Last part msg: of Number of responses in msg
|
|
N XMTO,XMRESPM,XMNAME,XMIEN,XMTYPE
|
|
I $Y+3>IOSL D PAGE(.XMABORT) Q:XMABORT
|
|
W !
|
|
S XMRESPM=+$P($G(^XMB(3.9,XMZ,3,0)),U,4)
|
|
S XMRESPM=$$EZBLD^DIALOG($S(XMRESPM=1:34557.1,1:34557),XMRESPM) ; XMRESPM_ response / responses
|
|
S XMTO="*" ; Show broadcast first.
|
|
F S XMTO=$O(^XMB(3.9,XMZ,1,"C",XMTO)) Q:$E(XMTO,1,1)'="*" D Q:XMABORT
|
|
. S XMIEN=$O(^XMB(3.9,XMZ,1,"C",XMTO,""))
|
|
. S XMNAME=$P(^XMB(3.9,XMZ,1,XMIEN,0),U,1)
|
|
. D WNAME(XMZ,XMNAME,XMIEN,XMRESPM,.XMTYPE,.XMABORT)
|
|
Q:XMABORT
|
|
S XMTO=""
|
|
F S XMTO=$O(^XMB(3.9,XMZ,1,"C",XMTO)) Q:XMTO="" D Q:XMABORT
|
|
. S XMIEN=$O(^XMB(3.9,XMZ,1,"C",XMTO,""))
|
|
. I XMTO=+XMTO D
|
|
. . S XMNAME=$$NAME^XMXUTIL(XMTO)
|
|
. E D Q:$E(XMTO,1,1)="*"
|
|
. . I $L(XMTO)>29 S XMNAME=$P(^XMB(3.9,XMZ,1,XMIEN,0),U,1) Q
|
|
. . S XMNAME=XMTO
|
|
. D WNAME(XMZ,XMNAME,XMIEN,XMRESPM,.XMTYPE,.XMABORT)
|
|
Q
|
|
WNAME(XMZ,XMNAME,XMIEN,XMRESPM,XMTYPE,XMABORT) ;
|
|
N XMREC
|
|
S XMREC=^XMB(3.9,XMZ,1,XMIEN,0)
|
|
I $Y+3>IOSL D PAGE(.XMABORT) Q:XMABORT
|
|
W !
|
|
I $D(^XMB(3.9,XMZ,1,XMIEN,"T")) D ; CC: Info: Thru:
|
|
. S XMTYPE=$P(^XMB(3.9,XMZ,1,XMIEN,"T"),U,1)
|
|
. Q:XMTYPE=""
|
|
. S:'$D(XMTYPE(XMTYPE)) XMTYPE(XMTYPE)=$$EXTERNAL^DILFD(3.91,6.5,"",XMTYPE)
|
|
. W XMTYPE(XMTYPE),": "
|
|
W XMNAME
|
|
W:$X<18 ?18
|
|
I +$P(XMREC,U,1)=$P(XMREC,U,1) D Q ; local user
|
|
. I $P(XMREC,U,3)="" D
|
|
. . W $$EZBLD^DIALOG(34574) ; " Not read."
|
|
. E D Q:XMABORT
|
|
. . D W3(34575,$$MMDT^XMXUTIL1($P(XMREC,U,3)),.XMABORT) Q:XMABORT ; Last read:
|
|
. . I $P(XMREC,U,2) D Q:XMABORT
|
|
. . . N XMPARM
|
|
. . . S XMPARM(1)=$P(XMREC,U,2),XMPARM(2)=XMRESPM
|
|
. . . D W3(34576,.XMPARM,.XMABORT) ; (x of y responses)
|
|
. . I $P(XMREC,U,10)'="" D W3(34577,$$MMDT^XMXUTIL1($P(XMREC,U,10)),.XMABORT) Q:XMABORT ; [First read: x]
|
|
. . I $D(^XMB(3.9,XMZ,1,XMIEN,"C")) D W3(34578,$$MMDT^XMXUTIL1(^("C")),.XMABORT) Q:XMABORT ; Copied:
|
|
. . I $D(^XMB(3.9,XMZ,1,XMIEN,"S")) D W3(34580,^("S"),.XMABORT) Q:XMABORT ; Surrogate:
|
|
. . I $D(^XMB(3.9,XMZ,1,XMIEN,"D")),^("D") D W3(34581,$$MMDT^XMXUTIL1(^("D")),.XMABORT) Q:XMABORT ; Terminated:
|
|
. I $D(^XMB(3.9,XMZ,1,XMIEN,"F")) D FWD(XMZ,XMIEN,.XMABORT) Q:XMABORT
|
|
I $E(XMNAME,1,2)="F.",$P(XMREC,U,12)'=""!$P(XMREC,U,11) D Q
|
|
. I $P(XMREC,U,5)'="" D W3(34582,$$MMDT^XMXUTIL1($P(XMREC,U,5)),.XMABORT) Q:XMABORT ; Sent to fax:
|
|
. I $P(XMREC,U,6)'="" D W3(34583,$P(XMREC,U,6),.XMABORT) Q:XMABORT ; Status:
|
|
. I $P(XMREC,U,12)'="" D W3(34584,$P(XMREC,U,12),.XMABORT) Q:XMABORT ; Fax ID:
|
|
. I $D(^XMB(3.9,XMZ,1,XMIEN,"F")) D FWD(XMZ,XMIEN,.XMABORT) Q:XMABORT
|
|
I XMNAME["@" D Q
|
|
. I $P(XMREC,U,5)'="" D W3(34585,$$MMDT^XMXUTIL1($P(XMREC,U,5)),.XMABORT) Q:XMABORT ; Sent:
|
|
. I $P(XMREC,U,8)'="" D W3($S($P(XMREC,U,8)=1:34586,1:34587),$P(XMREC,U,8),.XMABORT) Q:XMABORT ; Time: x seconds
|
|
. I $P(XMREC,U,7)'="",$D(^DIC(4.2,$P(XMREC,U,7),0)) D W3(34588,$P(^(0),U),.XMABORT) Q:XMABORT ; Path:
|
|
. I $P(XMREC,U,4)'="" D W3(34590,$P(XMREC,U,4),.XMABORT) Q:XMABORT ; Message ID:
|
|
. I $P(XMREC,U,6)'="" D W3(34583,$P(XMREC,U,6),.XMABORT) Q:XMABORT ; Status:
|
|
. I $D(^XMB(3.9,XMZ,1,XMIEN,"F")) D FWD(XMZ,XMIEN,.XMABORT) Q:XMABORT
|
|
I $E(XMNAME,1,3)="* (" D Q ; Broadcast
|
|
. I $D(^XMB(3.9,XMZ,1,XMIEN,"F")) D FWD(XMZ,XMIEN,.XMABORT)
|
|
I ".D.H.S."[("."_$E(XMNAME,1,2)) D Q
|
|
. I $P(XMREC,U,3)'="" D W3(34591,$$MMDT^XMXUTIL1($P(XMREC,U,3)),.XMABORT) Q:XMABORT ; Date:
|
|
. I $P(XMREC,U,6)'="" D W3(34583,$P(XMREC,U,6),.XMABORT) Q:XMABORT ; Status:
|
|
. I $D(^XMB(3.9,XMZ,1,XMIEN,"F")) D FWD(XMZ,XMIEN,.XMABORT) Q:XMABORT
|
|
Q
|
|
FWD(XMZ,XMIEN,XMABORT) ;
|
|
N XMFWDREC,XMFWDBY,XMFWDTYP
|
|
S XMFWDREC=^XMB(3.9,XMZ,1,XMIEN,"F")
|
|
S XMFWDBY=$P(XMFWDREC,U)
|
|
I $E(XMFWDBY,1)=" " D W3(34592,XMFWDBY,.XMABORT) Q ; Forwarded on:
|
|
I $E(XMFWDBY,1)?1N!($E(XMFWDBY,1)=".") D W3(34593,$$NAME^XMXUTIL(+XMFWDBY)_" "_$P(XMFWDBY," ",2,99),.XMABORT) Q ; Forwarded by:
|
|
S XMFWDTYP=$P(XMFWDREC,U,3)
|
|
D W3($S(XMFWDTYP="A":34593.1,XMFWDTYP="F":34593.2,1:34593),XMFWDBY,.XMABORT) ; Auto-Forwarded / Filter-Forwarded / Forwarded by:
|
|
Q:$P(XMFWDREC,U,4)=""
|
|
N XMPARM
|
|
S XMPARM(1)=$$NAME^XMXUTIL($P(XMFWDREC,U,2))
|
|
S XMPARM(2)=$P(XMFWDREC,U,4)
|
|
S XMFWDTYP=$P(XMFWDREC,U,5)
|
|
; Filter-Forwarded / Forwarded to |1| by: |2|
|
|
D W3($S(XMFWDTYP="F":34594.1,1:34594),.XMPARM,.XMABORT)
|
|
Q
|
|
W3(XMPIECE,XMPARM,XMABORT) ;
|
|
S XMPIECE=$$EZBLD^DIALOG(XMPIECE,.XMPARM)
|
|
I 1+$L(XMPIECE)+$X>IOM D Q:XMABORT
|
|
. I $Y+3+($L(XMPIECE)-1\60)>IOSL D PAGE(.XMABORT) Q:XMABORT
|
|
. W !,?18
|
|
. Q:$L(XMPIECE)<61
|
|
. F D Q:$L(XMPIECE)<61
|
|
. . W " ",$E(XMPIECE,1,60),!,?18
|
|
. . S XMPIECE=$E(XMPIECE,61,999)
|
|
W " ",XMPIECE
|
|
Q
|
|
;PAGE(XMPHDR,XMSUBJ,XMZSTR,XMPAGE,XMABORT);
|
|
PAGE(XMABORT) ;
|
|
I $E($G(IOST),1,2)="C-" D PAGE^XMXUTIL(.XMABORT) Q:XMABORT
|
|
W @IOF
|
|
Q:'XMPHDR
|
|
D PAGE2HDR^XMJMP1(XMSUBJ,XMZSTR,.XMPAGE)
|
|
Q
|