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