APCDBUL8.m

APCDBUL8 ; IHS/CMI/LAB - Routine to create bulletin ;

 ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 ;;Borrowed from ACHSP1, ACHSP1A

 ;;

 ;

 I '$G(DUZ) W !,"DUZ UNDEFINED OR ZERO.",! Q

 D HOME^%ZIS,DT^DICRW

 ;

 NEW XMSUB,XMDUZ,XMTEXT,XMY,DIFROM

 KILL ^TMP($J,"APCDBUL")

 D WRITEMSG,GETRECIP

 ;Change following lines as desired

SUBJECT S XMSUB="* * * IMPORTANT RPMS INFORMATION * * *"

SENDER S XMDUZ="Cimarron Medical Informatics"

 S XMTEXT="^TMP($J,""APCDBUL"",",XMY(1)="",XMY(DUZ)=""

 I $E(IOST)="C" W !,"Sending Mailman message to holders of the"_" "_APCDKEY_" "_"security key."

 D ^XMD

 KILL ^TMP($J,"APCDBUL"),APCDKEY

 Q

 ;

WRITEMSG ;

 S %=0

 S APCDDA=$O(^APCDSUPP("B","APCD*2.0*8",0))

 Q:'APCDDA

 S APCDX=0 F  S APCDX=$O(^APCDSUPP(APCDDA,11,APCDX)) Q:APCDX'=+APCDX  D

 .S %=%+1

 .S ^TMP($J,"APCDBUL",%)=$G(^APCDSUPP(APCDDA,11,APCDX,0))

 Q

 ;;  

 ;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

 ;;+     This message is intended to advise you of changes,        +

 ;;+     upgrades or other important RPMS information

 ;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

 ;;  

 ;;###

 ;

GETRECIP ;

 ;* * * Define key below to identify recipients * * *

 ;

 S CTR=0,APCDKEY="APCDZMENU"

 F  S CTR=$O(^XUSEC(APCDKEY,CTR)) Q:'CTR  S Y=CTR S XMY(Y)=""

 Q

APCDBUL8  ; IHS/CMI/LAB - Routine to create bulletin ;

 +1       ;;2.0;IHS PCC SUITE;;MAY 14, 2009

 +2       ;;Borrowed from ACHSP1, ACHSP1A

 +3       ;;

 +4       ;

 +5        IF '$GET(DUZ)

               WRITE !,"DUZ UNDEFINED OR ZERO.",!

               QUIT 

 +6        DO HOME^%ZIS

           DO DT^DICRW

 +7       ;

 +8        NEW XMSUB,XMDUZ,XMTEXT,XMY,DIFROM

 +9        KILL ^TMP($JOB,"APCDBUL")

 +10       DO WRITEMSG

           DO GETRECIP

 +11      ;Change following lines as desired

SUBJECT    SET XMSUB="* * * IMPORTANT RPMS INFORMATION * * *"

SENDER     SET XMDUZ="Cimarron Medical Informatics"

 +1        SET XMTEXT="^TMP($J,""APCDBUL"","

           SET XMY(1)=""

           SET XMY(DUZ)=""

 +2        IF $EXTRACT(IOST)="C"

               WRITE !,"Sending Mailman message to holders of the"_" "_APCDKEY_" "_"security key."

 +3        DO ^XMD

 +4        KILL ^TMP($JOB,"APCDBUL"),APCDKEY

 +5        QUIT 

 +6       ;

WRITEMSG  ;

 +1        SET %=0

 +2        SET APCDDA=$ORDER(^APCDSUPP("B","APCD*2.0*8",0))

 +3        IF 'APCDDA

               QUIT 

 +4        SET APCDX=0

           FOR 

               SET APCDX=$ORDER(^APCDSUPP(APCDDA,11,APCDX))

               IF APCDX'=+APCDX

                   QUIT 

               Begin DoDot:1

 +5                SET %=%+1

 +6                SET ^TMP($JOB,"APCDBUL",%)=$GET(^APCDSUPP(APCDDA,11,APCDX,0))

               End DoDot:1

 +7        QUIT 

 +8       ;;  

 +9       ;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

 +10      ;;+     This message is intended to advise you of changes,        +

 +11      ;;+     upgrades or other important RPMS information

 +12      ;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

 +13      ;;  

 +14      ;;###

 +15      ;

GETRECIP  ;

 +1       ;* * * Define key below to identify recipients * * *

 +2       ;

 +3        SET CTR=0

           SET APCDKEY="APCDZMENU"

 +4        FOR 

               SET CTR=$ORDER(^XUSEC(APCDKEY,CTR))

               IF 'CTR

                   QUIT 

               SET Y=CTR

               SET XMY(Y)=""

 +5        QUIT