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

XMJMP.m

Go to the documentation of this file.
XMJMP ;ISC-SF/GMB-Print,Backup messages ;12/04/2002  10:53
 ;;8.0;MailMan;**9**;Jun 28, 2002
 ; PRINT  Replaces ENTPRT^XMA0,^XMA02,ENTPRT^XMAP,QE2^XMA5
 ; BACKUP Replaces E^XMA1,ENT8^XMAH,ENTR^XMAP,ENTBCK^XMAP
 ; (ISC-WASH/CAP/THM)
PRINT(XMDUZ,XMK,XMZ,XMPRTHDR,XMBROWSE) ; Print
 ; XMPRTHDR 1=Print header
 ;          0=don't (headerless print)
 ; XMRECIPS 0=Don't print recipients
 ;          1=Print summary recipients
 ;          2=Print detail recipients
 ; XMBROWSE 0=Print normally
 ;          1=Direct the print to the VA FileMan Browser
 N XMWHICH,XMRESPS,XMABORT,XMRECIPS,XMSAVE,ZTSK
 S XMABORT=0
 I $G(XMBROWSE) S XMRECIPS=0
 E  D QRECIP(.XMRECIPS,.XMABORT) Q:XMABORT
 S XMRESPS=$$RESP^XMXUTIL2(XMZ)
 I XMRESPS D  Q:XMABORT
 . S XMWHICH="0-"_XMRESPS
 . D WHICH(XMZ,XMRESPS,$$EZBLD^DIALOG(34500),.XMWHICH,.XMABORT) ; Print
 . ; If responses includes from x through the end, then set it so that
 . ; if the user queues for later printing, any new add'l responses
 . ; will be printed, too.
 . I XMWHICH["-",$P(XMWHICH,"-",$L(XMWHICH,"-"))=XMRESPS S XMWHICH=$P(XMWHICH,"-",1,$L(XMWHICH,"-")-1)_"-"
 E  S XMWHICH="0-"
 S:$G(XMPRTHDR)="" XMPRTHDR=1  ; default is to print with headers
 F I="DUZ","XMDUZ","XMV(","XMK","XMZ","XMWHICH","XMRECIPS","XMPRTHDR" S XMSAVE(I)=""
 I $D(XMSECURE) F I="XMPAKMAN","XMSECURE","XMSECURE(" S XMSAVE(I)=""
 I $G(XMBROWSE) N IOP,DDBDMSG S IOP="BROWSER",DDBDMSG=$$EZBLD^DIALOG(34537,XMZ)_" "_$$ZSUBJ^XMXUTIL2(XMZ) ; (Instead of "VA FileMan Browser")
 D EN^XUTMDEVQ("PRTMSGX^XMJMP",$$EZBLD^DIALOG(34501),.XMSAVE,,1) ; MailMan: Print
 I $D(ZTSK) W !,$$EZBLD^DIALOG(34501.1,ZTSK) ; Request queued.  Task number: |1|
 Q
PRTMSG(XMDUZ,XMK,XMZ,XMWHICH,XMRECIPS,XMPRTHDR) ;
PRTMSGX ;
PRINTMSG ;
 N XMKN,XMRESPS,XMZREC,XMPTR
 S XMZREC=$G(^XMB(3.9,XMZ,0)) Q:XMZREC=""
 D BSKT^XMJMP1(XMDUZ,XMZ,.XMK,.XMKN)
 D RESPONSE(XMDUZ,XMZ,.XMRESPS,.XMPTR)
 W:$E($G(IOST),1,2)="C-" @IOF
 D:XMPRTHDR IDHDR(XMDUZ)
 D PRINTIT^XMJMP1(XMDUZ,XMK,XMKN,XMZ,XMZREC,XMRESPS,XMPTR,XMWHICH,XMRECIPS,0,XMPRTHDR)
 I $D(ZTQUEUED) S ZTREQ="@" D ^%ZISC ; This close device is needed to preserve the temp global used by p-message.
 Q
IDHDR(XMDUZ) ; Header: "MailMan msg for..."
 N XMREC,XMPARM
 S XMREC=$G(^VA(200,XMDUZ,0))
 W $C(13),$$EZBLD^DIALOG(34502,XMV("NAME")) ; MailMan message for
 I $P(XMREC,U,9)'="",$D(^DIC(3.1,+$P(XMREC,U,9),0)) W "  ",$P(^(0),U,1) ; VA TITLE
 S XMPARM(1)=^XMB("NETNAME"),XMPARM(2)=$$MMDT^XMXUTIL1($$NOW^XLFDT)
 W !,$$EZBLD^DIALOG(34503,.XMPARM),! ; Printed at site  date
 Q
QRECIP(XMRECIPS,XMABORT) ;
 N DIR,DIRUT,Y,XMSUMRY
 S DIR(0)="Y"
 S DIR("A")=$$EZBLD^DIALOG(34504) ; Print recipient list
 S DIR("B")=$$EZBLD^DIALOG(39053) ; No
 D BLD^DIALOG(34505,"","","DIR(""?"")")
 D ^DIR I $D(DIRUT) S XMABORT=1 Q
 I Y=0 S XMRECIPS=0 Q
 S XMSUMRY=$$EZBLD^DIALOG(34507)
 S DIR(0)="SM^"_$$EZBLD^DIALOG(34506)_";"_XMSUMRY
 S DIR("A")=$$EZBLD^DIALOG(34508) ; Print Detail or Summary recipient chain
 S DIR("B")=$P(XMSUMRY,":",2,99) ; Summary
 D ^DIR I $D(DIRUT) S XMABORT=1 Q
 S XMRECIPS=$S(Y=$P(XMSUMRY,":",1):1,1:2)
 Q
DISPMSG(XMDUZ,XMK,XMKN,XMZ,XMSECBAD,XMNOBACK) ; Display message
 N XMRESPS,XMRESP,XMPTR,XMZREC,XMBACKUP
 S XMZREC=^XMB(3.9,XMZ,0)
 S XMPAKMAN=$$PAKMAN^XMXSEC1(XMZ,XMZREC)
 D RESPONSE(XMDUZ,XMZ,.XMRESPS,.XMPTR,.XMRESP)
 I XMRESP'="",XMRESPS S XMRESP=XMRESP+1 I XMRESP>XMRESPS,'$G(XMNOBACK) S XMBACKUP=1
 I XMDUZ=.5,XMK>999 S XMRESP=XMRESPS+1 K:$D(XMBACKUP) XMBACKUP
 E  I $D(^XMB(3.9,XMZ,"K")),'$D(XMSECURE),'$$KEYOK^XMJMCODE(XMZ,$P(XMZREC,U,10)) S XMSECBAD=1 Q
 W @IOF
 D PRINTIT^XMJMP1(XMDUZ,XMK,XMKN,XMZ,XMZREC,XMRESPS,XMPTR,+XMRESP_"-",0,1,1)
 I $G(XMBACKUP) W !!,$$EZBLD^DIALOG(34509) ; You are at the end of this message.  Enter 'B' to Backup and review it.
 Q
RESPONSE(XMDUZ,XMZ,XMRESPS,XMPTR,XMRESP) ;
 ; XMRESP="" if the user hasn't read the message at all
 ;        0  if the user has read the original message only
 ;        n  if the user has read thru response n
 S XMRESPS=+$P($G(^XMB(3.9,XMZ,3,0)),U,4)
 ;S XMPTR=+$O(^XMB(3.9,XMZ,1,"C",$S(XMDUZ=.6:DUZ,1:XMDUZ),0))
 S XMPTR=+$O(^XMB(3.9,XMZ,1,"C",XMDUZ,0))
 S XMRESP=$P($G(^XMB(3.9,XMZ,1,XMPTR,0)),U,2)
 Q
CHKRESP(XMDUZ,XMZO,XMRESPSO,XMRESP) ;
 N XMRESPS
 S XMRESPS=+$P($G(^XMB(3.9,XMZO,3,0)),U,4)
 Q:XMRESPS=+XMRESP  ; No new responses
 I XMRESPSO>XMRESP D  Q:XMRESPSO=XMRESPS
 . I XMRESPSO-1>XMRESP D
 . . ; >> You haven't read responses |1|-|2|.  You may backup to see them. <<
 . . N XMPARM
 . . S XMPARM(1)=XMRESP+1,XMPARM(2)=XMRESPSO
 . . W !,$$EZBLD^DIALOG(34510,.XMPARM)
 . E  W !,$$EZBLD^DIALOG(34511,XMRESP+1) ; >> You haven't read response |1|.  You may backup to see it. <<
 . S XMRESP=XMRESPSO
 N XMZ
 F  S XMRESP=$O(^XMB(3.9,XMZO,3,XMRESP)) Q:'XMRESP  S XMZ=$P($G(^(XMRESP,0)),U,1) I XMZ,$P($G(^XMB(3.9,XMZ,0)),U,2)'=XMDUZ Q
 Q:'XMRESP
 W !,$$EZBLD^DIALOG(34512,XMRESP) ; >> Response |1| has arrived - you may backup to see it. <<
 Q
BACKUP(XMDUZ,XMK,XMKN,XMZ) ; Backup
 N XMWHICH,XMRESPS,XMABORT,XMZREC,XMPTR
 S XMZREC=^XMB(3.9,XMZ,0)
 I $D(^XMB(3.9,XMZ,"K")),'$D(XMSECURE) Q:'$$KEYOK^XMJMCODE(XMZ,$P(XMZREC,U,10))
 S XMABORT=0
 D RESPONSE(XMDUZ,XMZ,.XMRESPS,.XMPTR,.XMWHICH)
 I XMRESPS D HOWMUCH^XMJMP1(XMZ,XMRESPS,.XMWHICH,.XMABORT) Q:XMABORT
 W @IOF
 D PRINTIT^XMJMP1(XMDUZ,XMK,XMKN,XMZ,XMZREC,XMRESPS,XMPTR,XMWHICH,0,1,1)
 Q
WHICH(XMZ,XMRESPS,XMVERB,XMWHICH,XMABORT) ;
 N DIR,DIRUT,Y,XMTEXT
 ; There is 1 response. / There are X responses. Response 0 is the original message.  (?? shows index)
 D BLD^DIALOG($S(XMRESPS=1:34514,1:34515),XMRESPS,"","XMTEXT")
 M DIR("A")=XMTEXT
 S DIR("A")=$$EZBLD^DIALOG(34516,XMVERB) ; Select the responses to |1|:
 S:$D(XMWHICH) DIR("B")=XMWHICH
 S DIR("PRE")="I X?.E1N1""-"" S X=X_XMRESPS W XMRESPS"
 S DIR(0)="LACO^0:"_XMRESPS
 S DIR("??")="^D HELPRESP^XMJMP1(XMZ,XMRESPS)"
 D ^DIR I $D(DTOUT)!$D(DUOUT) S XMABORT=1 Q
 S:X'="" XMWHICH=$E(Y,1,$L(Y)-1)
 Q
PONE(XMDUZ,XMK,XMZ,XMPRTHDR,XMABORT) ;
PONEX ; Print one message.  Check it to see if
 ; the user is allowed to see it.  (confidential, scrambled)
 ; If not, print an error message.
 N XMZREC
 I $G(XMK)="" S XMK=$$BSKT^XMXUTIL2(XMDUZ,XMZ)
 I '$D(^XMB(3.9,XMZ,0)),XMK D ZAPIT^XMJBM(XMDUZ,XMK,XMZ) S XMABORT=1 Q
 S XMZREC=^XMB(3.9,XMZ,0)
 I XMDUZ'=DUZ,'$$SURRACC^XMXSEC(XMDUZ,"",XMZ,XMZREC) D  Q  ; "access"
 . D SHOW^XMJERR
 . S XMABORT=1
 N XMSECURE,XMPAKMAN ; Important 'new' - part of scramble and packman handling
 S XMPAKMAN=$$PAKMAN^XMXSEC1(XMZ,XMZREC)
 I $D(^XMB(3.9,XMZ,"K")),'$$KEYOK^XMJMCODE(XMZ,$P(XMZREC,U,10)) S XMABORT=1 Q
 N XMRECIPS,XMRESPS,XMWHICH
 D QRECIP(.XMRECIPS,.XMABORT) Q:XMABORT
 D RESPONSE(XMDUZ,XMZ,.XMRESPS,"",.XMWHICH)
 I XMRESPS D  Q:XMABORT
 . N XMRESP
 . S XMRESP=XMWHICH
 . I $D(^XMB(3.7,XMDUZ,"N0",XMK,XMZ)),XMRESP S:XMRESP'=XMRESPS XMRESP=XMRESP+1
 . E  S XMRESP=0
 . I XMRESP=XMRESPS S XMWHICH=XMRESP
 . E  S XMWHICH=XMRESP_"-"_XMRESPS
 . D WHICH(XMZ,XMRESPS,$$EZBLD^DIALOG(34500),.XMWHICH,.XMABORT) ; Print
 E  S XMWHICH=0
 F I="DUZ","XMDUZ","XMV(","XMK","XMZ","XMWHICH","XMRECIPS","XMPRTHDR" S XMSAVE(I)=""
 I $D(XMSECURE) F I="XMPAKMAN","XMSECURE","XMSECURE(" S XMSAVE(I)=""
 D EN^XUTMDEVQ("PRTMSGX^XMJMP",$$EZBLD^DIALOG(34501),.XMSAVE) ; MailMan: Print
 I $G(POP) S XMABORT=1
 Q
 ;PLIST(XMDUZ,XMZLIST,XMRECIPS,XMPRTHDR,XMMSG)
PLISTX ;
 ; Print a list of messages.
 ; Check each message as we come to it to see if
 ; the user is allowed to see it.  (confidential, scrambled)
 ; If not, print an error message.
 N I,J,XMK,XMKN,XMZ,XMFIRST,XMCNT,XMABORT
 S XMFIRST=1,(XMCNT,XMABORT,I)=0
 F  S I=$O(XMZLIST(I)) Q:'I  D  Q:XMABORT
 . F J=1:1:$L(XMZLIST(I),",") D  Q:XMABORT
 . . S XMZ=$P(XMZLIST(I),",",J)
 . . Q:'$D(^XMB(3.9,XMZ,0))
 . . D BSKT^XMJMP1(XMDUZ,XMZ,.XMK,.XMKN)
 . . D PRTMULT(XMDUZ,XMK,XMKN,XMZ,XMRECIPS,XMPRTHDR,.XMFIRST,.XMCNT,.XMABORT)
 Q:$D(ZTQUEUED)
 S XMMSG=$$EZBLD^DIALOG($S(XMCNT=1:34318.1,1:34318),XMCNT)
 Q
PRTMULT(XMDUZ,XMK,XMKN,XMZ,XMRECIPS,XMPRTHDR,XMFIRST,XMCNT,XMABORT) ; Multiple message print
 N XMNOGO,XMZREC,XMRESPS,XMRESP,XMPTR,XMSECURE,XMPAKMAN
 I $D(ZTQUEUED) S ZTREQ="@"
 S XMNOGO=0
 S XMZREC=$G(^XMB(3.9,XMZ,0))
 I XMZREC="" D ZAPIT^XMXMSGS2(XMDUZ,XMK,XMZ) Q
 S XMPAKMAN=$$PAKMAN^XMXSEC1(XMZ,XMZREC)
 D CHECK^XMJMP2(XMDUZ,XMZ,XMZREC,.XMNOGO)  Q:XMNOGO&'$D(ZTQUEUED)
 I $E(IOST,1,2)="C-"!'XMFIRST W @IOF
 S XMFIRST=0
 D:XMPRTHDR IDHDR(XMDUZ)
 I XMNOGO D NOGOMSG^XMJMP2(XMDUZ,XMZ,XMZREC,.XMNOGO) Q
 D RESPONSE(XMDUZ,XMZ,.XMRESPS,.XMPTR,.XMRESP)
 I $D(^XMB(3.7,XMDUZ,"N0",XMK,XMZ)),XMRESP S:XMRESP'=XMRESPS XMRESP=XMRESP+1
 E  S XMRESP=0
 D PRINTIT^XMJMP1(XMDUZ,XMK,XMKN,XMZ,XMZREC,XMRESPS,XMPTR,XMRESP_"-",XMRECIPS,0,XMPRTHDR,1,.XMABORT)
 S XMCNT=XMCNT+1
 ;Q:XMABORT
 ;I $E(IOST,1,2)="C-" D PAGE^XMXUTIL(.XMABORT)
 Q