XPDTP.m

XPDTP ;SFISC/RSD - Transport using a Packman Message ;07/18/96  13:19 [ 04/02/2003   8:29 AM ]

 ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003

 ;;8.0;KERNEL;**21,40,44**;Jul 05, 1995

 N DIFROM,DIR,DIRUT,DWPK,DWLW,DIC,I,J,XCN,XCNP,XMDISPI,XMDUN,XMDUZ,XMKEY,XMSCR,XMSUB,XMY,XMZ,X,Y,%

 S DIFROM=1,DIR(0)="F^3:65",DIR("A")="Subject",DIR("?")="Enter the subject for this Packman Message"

 D ^DIR Q:$D(DIRUT)

 S XMSUB=Y,XMDUZ=+DUZ

 K ^TMP("XMP",$J)

 W !,"Please enter description of Packman Message",!

 S DWPK=1,DWLW=75,DIC="^TMP(""XMP"",$J," D EN^DIWE

 D KIDS^XMP

 S XCNP=XCNP+1,^XMB(3.9,XMZ,2,XCNP,0)="$KID "_XPDNM,XCNP=XCNP+1

 ;for multiple packages, this would be a for loop

 D GS K ^XTMP("XPDT",XPDA)

 S $P(^XMB(3.9,XMZ,2,0),U,3,4)=XCNP_U_XCNP

 ;secure message & then send

 D ^XMASEC Q:$D(DTOUT)!$D(DUOUT)  D EN3^XMD

 K ^TMP("XMP",$J)

 Q

GS N GR,GCK,GL

 S GCK="^XTMP(""XPDT"","_XPDA,GR=GCK_")",GCK=GCK_",",GL=$L(GCK)

 ;INSTALL NAME line will mark the begining of global for all lines until

 ;the next INSTALL NAME

 S ^XMB(3.9,XMZ,2,XCNP,0)="**INSTALL NAME**",XCNP=XCNP+1,^XMB(3.9,XMZ,2,XCNP,0)=XPDNM,XCNP=XCNP+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

 S ^XMB(3.9,XMZ,2,XCNP,0)="$END KID "_XPDNM

 Q

XPDTP     ;SFISC/RSD - Transport using a Packman Message ;07/18/96  13:19 [ 04/02/2003   8:29 AM ]

 +1       ;;8.0;KERNEL;**1002,1003,1004,1005,1007**;APR 1, 2003

 +2       ;;8.0;KERNEL;**21,40,44**;Jul 05, 1995

 +3        NEW DIFROM,DIR,DIRUT,DWPK,DWLW,DIC,I,J,XCN,XCNP,XMDISPI,XMDUN,XMDUZ,XMKEY,XMSCR,XMSUB,XMY,XMZ,X,Y,%

 +4        SET DIFROM=1

           SET DIR(0)="F^3:65"

           SET DIR("A")="Subject"

           SET DIR("?")="Enter the subject for this Packman Message"

 +5        DO ^DIR

           IF $DATA(DIRUT)

               QUIT 

 +6        SET XMSUB=Y

           SET XMDUZ=+DUZ

 +7        KILL ^TMP("XMP",$JOB)

 +8        WRITE !,"Please enter description of Packman Message",!

 +9        SET DWPK=1

           SET DWLW=75

           SET DIC="^TMP(""XMP"",$J,"

           DO EN^DIWE

 +10       DO KIDS^XMP

 +11       SET XCNP=XCNP+1

           SET ^XMB(3.9,XMZ,2,XCNP,0)="$KID "_XPDNM

           SET XCNP=XCNP+1

 +12      ;for multiple packages, this would be a for loop

 +13       DO GS

           KILL ^XTMP("XPDT",XPDA)

 +14       SET $PIECE(^XMB(3.9,XMZ,2,0),U,3,4)=XCNP_U_XCNP

 +15      ;secure message & then send

 +16       DO ^XMASEC

           IF $DATA(DTOUT)!$DATA(DUOUT)

               QUIT 

           DO EN3^XMD

 +17       KILL ^TMP("XMP",$JOB)

 +18       QUIT 

GS         NEW GR,GCK,GL

 +1        SET GCK="^XTMP(""XPDT"","_XPDA

           SET GR=GCK_")"

           SET GCK=GCK_","

           SET GL=$LENGTH(GCK)

 +2       ;INSTALL NAME line will mark the begining of global for all lines until

 +3       ;the next INSTALL NAME

 +4        SET ^XMB(3.9,XMZ,2,XCNP,0)="**INSTALL NAME**"

           SET XCNP=XCNP+1

           SET ^XMB(3.9,XMZ,2,XCNP,0)=XPDNM

           SET XCNP=XCNP+1

 +5        FOR 

               SET GR=$QUERY(@GR)

               IF GR=""!($EXTRACT(GR,1,GL)'=GCK)

                   QUIT 

               SET ^XMB(3.9,XMZ,2,XCNP,0)=$PIECE(GR,GCK,2)

               SET XCNP=XCNP+1

               SET ^XMB(3.9,XMZ,2,XCNP,0)=@GR

               SET XCNP=XCNP+1

 +6        SET ^XMB(3.9,XMZ,2,XCNP,0)="$END KID "_XPDNM

 +7        QUIT