ACDPSRV0.m

ACDPSRV0 ;IHS/ADC/EDE/KML - UPLOAD EXTRACT GLOBAL TO MAIL MESSAGE VIA ^XMD; 

 ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998

 ;***********************************************************

 ;This routine will move the CDMIS extraction global into

 ;a mail message. The mail message will be sent to a server

 ;at the area or headquarters.

 ;***********************************************************

EN ;EP ENTRY

 ;//^ACDPSAVE

 W !!,"Creating mail message now. Mail server."

 ;

 ;Ck for new data found...or not

 I '$D(^ACDPTMP) W !!,"No new data found." Q

 ;

 ;Set message count.

 ;Set global to $Q on.

 S ACDCNT=1,ACDGLO="^ACDPTMP"

 ;

 ;Set header record.

 ;Set encryption key

 S ^ACDPMESS(ACDCNT,0)="PROGRAM DATA"_U_"PROGRAM DATA"_U_$P(^AUTTLOC($P(^AUTTSITE(1,0),U),0),U,2)_U_$P(^(0),U,10)_U_"$P($G(ACDZIP),U)"

 ;

 ;Load ^ACDPMESS in form: data node data node data node

 ;%RCR will move ^ACDPMESS into ^XMB (obsolete in K7)

 F  S ACDGLO=$Q(@ACDGLO) Q:ACDGLO=""  D

 .S ACDCNT=ACDCNT+1 S ^ACDPMESS(ACDCNT,0)=ACDGLO

 .S ACDCNT=ACDCNT+1 S ^ACDPMESS(ACDCNT,0)=@ACDGLO

 ;

SEND ;

 ;Send the new mail message just created to the remote server(s)

 ;Variable ACDOMAIN is a site parameter pre-set

 S XMTEXT="^ACDPMESS("

 S XMDUZ=.5

 S XMSUB="EXTRACTION GLOBAL"

 D ^XMD

K ;

 K ACDCNT,ACDGLO,XMTEXT,XMSUB,XMY

 K ^ACDPMESS ;      kill of scratch global  SAC EXEMPTION (2.3.2.3  killing of unsubscripted globals is prohibited)

 ;

 ;Future enhancement listed below:

 ;K7 will allow the developer to create a new message directly

 ;into ^XMB so cpu time of %RCR is avoided.

 ;

 ;D XMZ^XMA2        ;Get new message number in variable XMZ

 ;=>                ;S ^XMB(3.9,XMZ,2,0)="^3.92A^"_ACDCNT_"^"_ACDCNT

 ;D ENT1^XMD        ;Call here after loading ^XMB directly

 ;See page 54 of the 1992 Paragon Training Manual 'INSIDE KERNAL 7'

ACDPSRV0  ;IHS/ADC/EDE/KML - UPLOAD EXTRACT GLOBAL TO MAIL MESSAGE VIA ^XMD; 

 +1       ;;4.1;CHEMICAL DEPENDENCY MIS;;MAY 11, 1998

 +2       ;***********************************************************

 +3       ;This routine will move the CDMIS extraction global into

 +4       ;a mail message. The mail message will be sent to a server

 +5       ;at the area or headquarters.

 +6       ;***********************************************************

EN        ;EP ENTRY

 +1       ;//^ACDPSAVE

 +2        WRITE !!,"Creating mail message now. Mail server."

 +3       ;

 +4       ;Ck for new data found...or not

 +5        IF '$DATA(^ACDPTMP)

               WRITE !!,"No new data found."

               QUIT 

 +6       ;

 +7       ;Set message count.

 +8       ;Set global to $Q on.

 +9        SET ACDCNT=1

           SET ACDGLO="^ACDPTMP"

 +10      ;

 +11      ;Set header record.

 +12      ;Set encryption key

 +13       SET ^ACDPMESS(ACDCNT,0)="PROGRAM DATA"_U_"PROGRAM DATA"_U_$PIECE(^AUTTLOC($PIECE(^AUTTSITE(1,0),U),0),U,2)_U_$PIECE(^(0),U,10)_U_"$P($G(ACDZIP),U)"

 +14      ;

 +15      ;Load ^ACDPMESS in form: data node data node data node

 +16      ;%RCR will move ^ACDPMESS into ^XMB (obsolete in K7)

 +17       FOR 

               SET ACDGLO=$QUERY(@ACDGLO)

               IF ACDGLO=""

                   QUIT 

               Begin DoDot:1

 +18               SET ACDCNT=ACDCNT+1

                   SET ^ACDPMESS(ACDCNT,0)=ACDGLO

 +19               SET ACDCNT=ACDCNT+1

                   SET ^ACDPMESS(ACDCNT,0)=@ACDGLO

               End DoDot:1

 +20      ;

SEND      ;

 +1       ;Send the new mail message just created to the remote server(s)

 +2       ;Variable ACDOMAIN is a site parameter pre-set

 +3        SET XMTEXT="^ACDPMESS("

 +4        SET XMDUZ=.5

 +5        SET XMSUB="EXTRACTION GLOBAL"

 +6        DO ^XMD

K         ;

 +1        KILL ACDCNT,ACDGLO,XMTEXT,XMSUB,XMY

 +2       ;      kill of scratch global  SAC EXEMPTION (2.3.2.3  killing of unsubscripted globals is prohibited)

           KILL ^ACDPMESS

 +3       ;

 +4       ;Future enhancement listed below:

 +5       ;K7 will allow the developer to create a new message directly

 +6       ;into ^XMB so cpu time of %RCR is avoided.

 +7       ;

 +8       ;D XMZ^XMA2        ;Get new message number in variable XMZ

 +9       ;=>                ;S ^XMB(3.9,XMZ,2,0)="^3.92A^"_ACDCNT_"^"_ACDCNT

 +10      ;D ENT1^XMD        ;Call here after loading ^XMB directly

 +11      ;See page 54 of the 1992 Paragon Training Manual 'INSIDE KERNAL 7'