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

XPDTP.m

Go to the documentation of this file.
  1. XPDTP ;SFISC/RSD - Transport using a Packman Message ;09/23/96 13:54
  1. ;;8.0;KERNEL;**21,40,44,713,738**;Jul 05, 1995;Build 5
  1. ;Per VHA Directive 2004-038, this routine should not be modified.
  1. N DIFROM,DIR,DIRUT,DWPK,DWLW,DIC,I,J,XCN,XCNP,XMDISPI,XMDUN,XMDUZ,XMKEY,XMSCR,XMSUB,XMY,XMZ,X,Y,%
  1. S DIFROM=1,DIR(0)="F^3:65",DIR("A")="Subject",DIR("?")="Enter the subject for this Packman Message",DIR("B")=XPDH
  1. D ^DIR Q:$D(DIRUT)
  1. S XMSUB=Y,XMDUZ=+DUZ
  1. K ^TMP("XMP",$J)
  1. W !,"Please enter description of Packman Message",!
  1. S DWPK=1,DWLW=75,DIC="^TMP(""XMP"",$J," D EN^DIWE
  1. KD D KIDS^XMP ;p713
  1. S XCNP=XCNP+1,^XMB(3.9,XMZ,2,XCNP,0)="$KID "_XPDNM,XCNP=XCNP+1
  1. D GS K:'$G(^XTMP("XPDT",XPDA)) ^(XPDA)
  1. S $P(^XMB(3.9,XMZ,2,0),U,3,4)=XCNP_U_XCNP
  1. ;secure message & then send
  1. D ^XMASEC Q:$D(DTOUT)!$D(DUOUT) D EN3^XMD
  1. K ^TMP("XMP",$J)
  1. Q
  1. GS N GR,GCK,GL
  1. S GCK="^XTMP(""XPDT"","_XPDA,GR=GCK_")",GCK=GCK_",",GL=$L(GCK)
  1. ;INSTALL NAME line will mark the begining of global for all lines until
  1. ;the next INSTALL NAME
  1. S ^XMB(3.9,XMZ,2,XCNP,0)="**INSTALL NAME**",XCNP=XCNP+1,^XMB(3.9,XMZ,2,XCNP,0)=XPDNM,XCNP=XCNP+1
  1. F S GR=$Q(@GR) Q:GR=""!($E(GR,1,GL)'=GCK) S ^XMB(3.9,XMZ,2,XCNP,0)=$P(GR,GCK,2),XCNP=XCNP+1,^XMB(3.9,XMZ,2,XCNP,0)=@GR,XCNP=XCNP+1
  1. S ^XMB(3.9,XMZ,2,XCNP,0)="$END KID "_XPDNM
  1. Q