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

XMJMP1.m

Go to the documentation of this file. 
  1. XMJMP1 ;ISC-SF/GMB-Print,Backup (cont.) ;12/04/2002  10:57
  1.  ;;8.0;MailMan;**9**;Jun 28, 2002
  1. BSKT(XMDUZ,XMZ,XMK,XMKN) ;
  1.  I +$G(XMK),$D(^XMB(3.7,"M",XMZ,XMDUZ,XMK)) S XMKN=$$BSKTNAME^XMXUTIL(XMDUZ,XMK) Q
  1.  N XMKSTR
  1.  S XMKSTR=$$BSKT^XMXUTIL2(XMDUZ,XMZ,1)
  1.  S XMK=$P(XMKSTR,U,1),XMKN=$S(XMK:$P(XMKSTR,U,2),1:$$EZBLD^DIALOG(34014)) ; * N/A *
  1.  Q
  1. HOWMUCH(XMZ,XMRESPS,XMWHICH,XMABORT) ;
  1.  N DIR,DIRUT,Y,XMRESP,XMTEXT
  1.  ; There is 1 response. / There are X responses. Response 0 is the original message.  (?? shows index)
  1.  D BLD^DIALOG($S(XMRESPS=1:34514,1:34515),XMRESPS,"","XMTEXT")
  1.  M DIR("A")=XMTEXT
  1.  I XMWHICH<XMRESPS,XMWHICH'="" D  ; (On broadcasts with responses, XMWHICH will usually be null.)
  1.  . S DIR("A")=$$EZBLD^DIALOG(34518) ; Backup to:
  1.  . S DIR("B")=+$O(^XMB(3.9,XMZ,3,XMWHICH)) ; (XMWHICH+1)
  1.  E  D
  1.  . S DIR("A")=$$EZBLD^DIALOG(34519) ; Backup to: Original message
  1.  . S DIR("B")=0
  1.  S DIR(0)="NA^-"_XMRESPS_":"_XMRESPS
  1.  D BLD^DIALOG(34520,"","","DIR(""?"")")
  1.  ;If you select 0, you will Backup to the original message.
  1.  ;If you select one of the responses, you will Backup to it.
  1.  S DIR("??")="^D HELPRESP^XMJMP1(XMZ,XMRESPS)"
  1.  D ^DIR I $D(DIRUT) S XMABORT=1 Q
  1.  S XMRESP=$S(Y<0:XMRESPS+Y+1,1:Y)
  1.  S XMWHICH=$S(XMRESP=XMRESPS:XMRESP,1:XMRESP_"-"_XMRESPS)
  1.  Q
  1. HELPRESP(XMZ,XMRESPS) ;
  1.  N XMRESP,XMLEN,XMABORT
  1.  S XMABORT=0
  1.  W @IOF,$$EZBLD^DIALOG($S(XMRESPS=1:34530,1:34531),XMRESPS)
  1.  ;There is 1 response / There are _XMRESPS_ responses.  Response 0 is the original message.
  1.  S XMRESP=$S(XMV("ORDER")=1:0,1:XMRESPS+1)
  1.  W ! D HRHDR(XMRESPS,XMRESP,.XMLEN)
  1.  D:XMV("ORDER")=1 HRLINE(XMZ,0)
  1.  F  S XMRESP=$O(^XMB(3.9,XMZ,3,XMRESP),XMV("ORDER")) Q:XMRESP'>0  D  Q:XMABORT
  1.  . I $Y+3>IOSL D PAGE^XMXUTIL(.XMABORT) Q:XMABORT  D 
  1.  . . W @IOF D HRHDR(XMRESPS,XMRESP,.XMLEN)
  1.  . D HRLINE($P(^XMB(3.9,XMZ,3,XMRESP,0),U),XMRESP)
  1.  Q:XMABORT
  1.  Q:XMV("ORDER")=1
  1.  I $Y+3>IOSL D PAGE^XMXUTIL(.XMABORT) Q:XMABORT  D
  1.  . W @IOF D HRHDR(XMRESPS,XMRESP,.XMLEN)
  1.  D HRLINE(XMZ,0)
  1.  Q
  1. HRHDR(XMRESPS,XMRESP,XMLEN) ;
  1.  S XMLEN("RESP")=$S(XMV("ORDER")=1:$L($$MIN^XLFMTH(XMRESPS,XMRESP+IOSL)),1:$L(XMRESP))
  1.  S XMLEN("DATE")=$L($$MMDT^XMXUTIL1(DT))
  1.  S XMLEN("LINE")=5
  1.  S XMLEN("FROM")=79-XMLEN("RESP")-XMLEN("DATE")-XMLEN("LINE")-3
  1.  W $$LJ^XLFSTR($$EZBLD^DIALOG(34532),XMLEN("RESP")+XMLEN("DATE")+3,"."),$$LJ^XLFSTR($$EZBLD^DIALOG(34006),XMLEN("FROM"),"."),$$EZBLD^DIALOG(34003.1) ; "Response"/"From"/"Lines"
  1.  Q
  1. HRLINE(XMZ,XMRESP) ;
  1.  N XMZREC
  1.  S XMZREC=$G(^XMB(3.9,XMZ,0))
  1.  W !,$J(XMRESP,XMLEN("RESP")),") ",$$DATE^XMXUTIL2(XMZREC,0)," ",$$MELD^XMXUTIL1($$NAME^XMXUTIL($P(XMZREC,U,2),1),+$P($G(^XMB(3.9,XMZ,2,0)),U,4),XMLEN("FROM")+XMLEN("LINE"))
  1.  Q
  1. RESPHDR(XMZ,XMRESP) ;
  1.  N XMZREC
  1.  S XMZREC=$G(^XMB(3.9,XMZ,0))
  1.  D WL(XMRESP_") "_$$NAME^XMXUTIL($P(XMZREC,U,2),1))
  1.  D:$P(XMZREC,U,4)'="" W(" ",$$EZBLD^DIALOG(34533,$$NAME^XMXUTIL($P(XMZREC,U,4),1))) ; (Sender: x)
  1.  D W("  ",$$DATE($P(XMZREC,U,3)))
  1.  D W("  ",$$LINES(XMZ))
  1.  Q
  1. DATE(XMDT) ;
  1.  Q:XMDT'=+XMDT XMDT
  1.  Q $$MMDT^XMXUTIL1(XMDT)
  1. LINES(XMZ) ;
  1.  N XMLINES
  1.  S XMLINES=+$P($G(^XMB(3.9,XMZ,2,0)),U,4)
  1.  Q $$EZBLD^DIALOG($S(XMLINES=1:34534.1,1:34534),XMLINES)  ; line/lines
  1. PRINTIT(XMDUZ,XMK,XMKN,XMZ,XMZREC,XMRESPS,XMPTR,XMWHICH,XMRECIPS,XMDISP,XMPRTHDR,XMMULT,XMABORT) ;
  1.  N XMSUBJ,XMPAGE,XMZSTR,I,XMRESP,XMRANGE,XMREMMSG
  1.  S:'$D(XMABORT) XMABORT=0
  1.  S XMSUBJ=$P(XMZREC,U,1) S:XMSUBJ["~U~" XMSUBJ=$$DECODEUP^XMXUTIL1(XMSUBJ)
  1.  S XMSUBJ=$$EZBLD^DIALOG(34536,XMSUBJ),XMZSTR=$$EZBLD^DIALOG(34537,XMZ) ; Subj: x / [#x]
  1.  S XMREMMSG=($P(XMZREC,U,2)["@")
  1.  S XMPAGE=1
  1.  D:XMPRTHDR HEADER(XMDUZ,XMK,XMKN,XMZ,XMRESPS,XMZREC,XMSUBJ,XMZSTR)
  1.  I XMWHICH>XMRESPS D:$D(^XMB(3.7,XMDUZ,"N0",XMK,XMZ)) NONEW^XMXUTIL(XMDUZ,XMK,XMZ,1) Q
  1.  F I=1:1:$L(XMWHICH,",") D  Q:XMABORT
  1.  . S XMRANGE=$P(XMWHICH,",",I)
  1.  . S:$E(XMRANGE,$L(XMRANGE))="-" XMRANGE=XMRANGE_XMRESPS
  1.  . F XMRESP=$P(XMRANGE,"-",1):1:$S(XMRANGE["-":$P(XMRANGE,"-",2),1:XMRANGE) D  Q:XMABORT
  1.  . . I XMRESP>0 D RESPONSE(XMZ,.XMRESP,XMSUBJ,XMZSTR,XMDISP,XMPRTHDR,XMREMMSG,.XMPAGE,.XMABORT) Q
  1.  . . D BODY(XMZ,XMSUBJ,XMZSTR,XMDISP,XMPRTHDR,.XMPAGE,.XMABORT)
  1.  D:XMPTR LASTACC(XMDUZ,XMK,XMZ,XMZREC,XMSUBJ,XMPTR,XMRESP,+$G(XMMULT))
  1.  Q:XMABORT
  1.  D:XMRECIPS PRECIPS(XMDUZ,XMK,XMZ,XMRECIPS,XMSUBJ,XMZSTR,XMPRTHDR,.XMPAGE,.XMABORT)
  1.  I XMK,$D(^XMB(3.7,XMDUZ,"N0",XMK,XMZ)),+XMRESP=+$P($G(^XMB(3.9,XMZ,3,0)),U,4) D NONEW^XMXUTIL(XMDUZ,XMK,XMZ,1)
  1.  Q
  1. LASTACC(XMDUZ,XMK,XMZ,XMZREC,XMSUBJ,XMPTR,XMRESP,XMMULT) ; Note first, last accesses, number of responses read
  1.  N XMIM,XMIU,XMINSTR,XMCONFRM
  1.  S XMIM("SUBJ")=$P(XMSUBJ," ",2,99)
  1.  S XMIM("FROM")=$P(XMZREC,U,2)
  1.  S XMINSTR("FLAGS")=$S("^Y^y^"[(U_$P(XMZREC,U,5)_U):"R",1:"")
  1.  S XMIU("IEN")=XMPTR
  1.  S XMIU("RESP")=XMRESP
  1.  D LASTACC^XMXUTIL(XMDUZ,XMK,XMZ,XMRESP,.XMIM,.XMINSTR,.XMIU,.XMCONFRM)
  1.  Q:'XMCONFRM!$D(ZTQUEUED)
  1.  U IO(0)
  1.  D:XMMULT NOGOID^XMJMP2(XMZ,XMZREC)
  1.  W !,$$EZBLD^DIALOG(34540) ; >> Confirmation message sent to sender. <<
  1.  U IO
  1.  Q
  1. PRECIPS(XMDUZ,XMK,XMZ,XMRECIPS,XMSUBJ,XMZSTR,XMPRTHDR,XMPAGE,XMABORT) ; Print recipients (replaces QE2^XMA5)
  1.  D INFO^XMJMQ1(XMDUZ,XMK,XMZ,XMPRTHDR,XMSUBJ,XMZSTR,.XMPAGE,.XMABORT) Q:XMABORT
  1.  D LATER^XMJMQ1(XMDUZ,XMZ,XMPRTHDR,XMSUBJ,XMZSTR,.XMPAGE,.XMABORT) Q:XMABORT
  1.  I XMRECIPS=1 D
  1.  . D SUMMARY^XMJMQ1(XMZ,XMPRTHDR,XMSUBJ,XMZSTR,.XMPAGE,.XMABORT)
  1.  E  D DETAIL^XMJMQ(XMZ,XMPRTHDR,XMSUBJ,XMZSTR,.XMPAGE,.XMABORT)
  1.  Q
  1.  D PAGE1HDR(XMDUZ,XMK,XMKN,XMZ,XMRESPS,XMZREC,XMSUBJ,XMZSTR)
  1.  D W("   ",$$EZBLD^DIALOG(34541)) ; Page 1
  1.  I XMK,$D(^XMB(3.7,XMDUZ,"N0",XMK,XMZ)) D W("  ",$$EZBLD^DIALOG($S($D(^XMB(3.7,XMDUZ,"N",XMK,XMZ)):34543,1:34544))) ; Priority! /  *New*
  1.  D LINE
  1.  Q
  1. LINE ;
  1.  W !,"-------------------------------------------------------------------------------"
  1.  Q
  1. PAGE1HDR(XMDUZ,XMK,XMKN,XMZ,XMRESPS,XMZREC,XMSUBJ,XMZSTR) ;
  1.  W XMSUBJ
  1.  D W("  ",XMZSTR)
  1.  D W(" ",$$DATE($P(XMZREC,U,3)))
  1.  D W("  ",$$LINES(XMZ))
  1.  ;D:$O(^XMB(3.9,XMZ,2005,0)) W(" ",$$EZBLD^DIALOG(34573)) ; Attachment(s).
  1.  D WL($$EZBLD^DIALOG(34538,$$NAME^XMXUTIL($P(XMZREC,U,2),1))) ; From:
  1.  D:$P(XMZREC,U,4)'="" W(" ",$$EZBLD^DIALOG(34533,$$NAME^XMXUTIL($P(XMZREC,U,4),1))) ; (Sender: x)
  1.  I XMRESPS>0 D
  1.  . N XMPTR,XMRESP,XMPARM
  1.  . ;S XMPTR=+$O(^XMB(3.9,XMZ,1,"C",$S(XMDUZ=.6:DUZ,1:XMDUZ),0))
  1.  . S XMPTR=+$O(^XMB(3.9,XMZ,1,"C",XMDUZ,0))
  1.  . S XMRESP=+$P($G(^XMB(3.9,XMZ,1,XMPTR,0)),U,2)
  1.  . S XMPARM(1)=XMRESP,XMPARM(2)=XMRESPS
  1.  . D W("  ",$$EZBLD^DIALOG($S(XMRESPS=1:34545,1:34546),.XMPARM)) ; XMRESP_ of _XMRESPS_ response(s) read.
  1.  D W("  ",$$EZBLD^DIALOG(34539,XMKN)) ; In '_XMKN_' basket.
  1.  I $O(^XMB(3.73,"AC",XMZ,XMDUZ,0)) D W("  ",$$EZBLD^DIALOG(34595.1)) ; Message will be NEW Later.
  1.  I XMK D
  1.  . N XMVAPOR
  1.  . S XMVAPOR=$P($G(^XMB(3.7,XMDUZ,2,XMK,1,XMZ,0)),U,5)
  1.  . I XMVAPOR D W("  ",$$EZBLD^DIALOG(34572,$$FMTE^XLFDT(XMVAPOR))) ; Automatic Deletion Date:
  1.  Q
  1. WL(XMSTRING) ;
  1.  I $L(XMSTRING)'<IOM,IOM>1 F  D  Q:$L(XMSTRING)<IOM
  1.  . W !,$E(XMSTRING,1,IOM-1)
  1.  . S XMSTRING=$E(XMSTRING,IOM,999)
  1.  W !,XMSTRING
  1.  Q
  1. W(XMSPACE,XMSTRING) ;
  1.  I $X+$L(XMSPACE)+$L(XMSTRING)>IOM D WL(XMSTRING) Q
  1.  W XMSPACE,XMSTRING
  1.  Q
  1. BODY(XMZ,XMSUBJ,XMZSTR,XMDISP,XMPRTHDR,XMPAGE,XMABORT) ;
  1.  N XMTEXT,I,J
  1.  S I=.999999
  1.  F  S I=$O(^XMB(3.9,XMZ,2,I)) Q:I'>0  D  Q:XMABORT
  1.  . S XMTEXT=^XMB(3.9,XMZ,2,I,0)
  1.  . I $D(XMSECURE),'$G(XMPAKMAN) S XMTEXT=$$DECSTR^XMJMCODE(XMTEXT) ; PackMan messages are never scrambled, just "secured".
  1.  . I $E(XMTEXT,1)="$",$F("$TXT$END",$E(XMTEXT,1,4))#4=1 S XMTEXT=$P(XMTEXT,U) ; hide code for secured packman msg.
  1.  . I XMTEXT["|TAB|" F  S J=$F(XMTEXT,"|TAB|")-6 Q:J<0  S XMTEXT=$E(XMTEXT,1,J)_$E("         ",1,9-(J-(J\9*9)))_$E(XMTEXT,J+6,999)
  1.  . ; A site was sending a print to a device whose IOM was 0.
  1.  . ; In such a case, we should ignore IOM.
  1.  . F  D  Q:$L(XMTEXT)<IOM!XMABORT!(IOM<2)  S XMTEXT=$E(XMTEXT,IOM,999)
  1.  . . I $Y+3+($E($G(IOST),1,2)="C-")>IOSL D  Q:XMABORT
  1.  . . . D PAGE(XMZ,XMSUBJ,XMZSTR,XMDISP,XMPRTHDR,.XMPAGE,.XMABORT)
  1.  . . E  W !
  1.  . . W $S(IOM>1:$E(XMTEXT,1,IOM-1),1:XMTEXT)
  1.  Q
  1. PAGE(XMZ,XMSUBJ,XMZSTR,XMDISP,XMPRTHDR,XMPAGE,XMABORT) ;
  1.  I $E($G(IOST),1,2)="C-",XMDISP W ! D PAGE^XMXUTIL(.XMABORT) Q:XMABORT
  1.  W @IOF
  1.  D:XMPRTHDR PAGE2HDR(XMSUBJ,XMZSTR,.XMPAGE)
  1.  Q
  1. PAGE2HDR(XMSUBJ,XMZSTR,XMPAGE) ;
  1.  S XMPAGE=XMPAGE+1
  1.  W XMSUBJ
  1.  D W("  ",XMZSTR)
  1.  D W("   ",$$EZBLD^DIALOG(34542,XMPAGE)) ; Page x
  1.  D LINE
  1.  W !
  1.  Q
  1. RESPONSE(XMZ,XMRESP,XMSUBJ,XMZSTR,XMDISP,XMPRTHDR,XMREMMSG,XMPAGE,XMABORT) ;
  1.  N XMZR,XMRSUBJ,XMREMREP
  1.  S XMZR=+$P($G(^XMB(3.9,XMZ,3,XMRESP,0)),U)
  1.  ;I '$D(^XMB(3.9,XMZR,0)) D  Q
  1.  ;. ;N DA,DIK
  1.  ;. ;S DA(1)=XMZ,DA=XMRESP
  1.  ;. ;S DIK="^XMB(3.9,XMZ,3,"
  1.  ;. ;D ^DIK
  1.  S XMRSUBJ=$P($G(^XMB(3.9,XMZR,0)),U)
  1.  S XMREMREP=$S(XMRSUBJ?1"R"1.N:0,XMRSUBJ="":0,1:1) ; Reply is to or from a remote site
  1.  I $Y+(XMREMMSG!XMREMREP)+7+($E($G(IOST),1,2)="C-")>IOSL D  Q:XMABORT
  1.  . D PAGE(XMZR,XMSUBJ,XMZSTR,XMDISP,XMPRTHDR,.XMPAGE,.XMABORT)
  1.  . S:XMABORT XMRESP=XMRESP-1
  1.  E  W !
  1.  D RESPHDR(XMZR,XMRESP)
  1.  I XMREMREP D
  1.  . W !,"   ",$$EZBLD^DIALOG(34536,$S(XMRSUBJ["~U~":$$DECODEUP^XMXUTIL1(XMRSUBJ),1:XMRSUBJ)) ; Subj:
  1.  E  I XMREMMSG D
  1.  . W !,"   ",$$EZBLD^DIALOG(34535) ; <Local Reply>
  1.  W !
  1.  D BODY(XMZR,XMSUBJ,XMZSTR,XMDISP,XMPRTHDR,.XMPAGE,.XMABORT)
  1.  Q