AMH30P4B.m

AMH30P4B ; IHS/BJI/GRL - Routine to create bulletin [ 10/05/04  1:09 PM ]

 ;;3.0;IHS BEHAVIORAL HEALTH;**4**;JAN 27, 2003

 ;;Borrowed from ACHSP1, ACHSP1A

 ;;

 ;;Here's how to make this work:

 ;;

 ;;1. Create your message in subroutine WRITEMSG

 ;;2. Identify recipients in GETRECIP by setting AMHKEY

 ;;3. Make changes in SUBJECT and SENDER as desired

 ;;4. Rename this routine in appropriate namespace and 

 ;;   call on completion of patch or upgrade

 ;

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

 D HOME^%ZIS,DT^DICRW

 ;

 NEW XMSUB,XMDUZ,XMTEXT,XMY,DIFROM

 KILL ^TMP($J,"AMHBUL")

 D WRITEMSG,GETRECIP

 ;Change following lines as desired

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

SENDER S XMDUZ="Cimarron Medical Informatics"

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

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

 D ^XMD

 KILL ^TMP($J,"AMHBUL"),AMHKEY

 Q

 ;

WRITEMSG ;

 S AMHIEN=$O(^AMHPATCH("AA",3,4,0))

 I AMHIEN="" Q

 S AMHX=0,AMHC=0 F  S AMHX=$O(^AMHPATCH(AMHIEN,11,AMHX)) Q:AMHX'=+AMHX  S AMHC=AMHC+1,^TMP($J,"AMHBUL",AMHC)=^AMHPATCH(AMHIEN,11,AMHX,0)

 Q

GETRECIP ;

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

 ;

 S CTR=0,AMHKEY="AMHZMENU"

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

 Q

AMH30P4B  ; IHS/BJI/GRL - Routine to create bulletin [ 10/05/04  1:09 PM ]

 +1       ;;3.0;IHS BEHAVIORAL HEALTH;**4**;JAN 27, 2003

 +2       ;;Borrowed from ACHSP1, ACHSP1A

 +3       ;;

 +4       ;;Here's how to make this work:

 +5       ;;

 +6       ;;1. Create your message in subroutine WRITEMSG

 +7       ;;2. Identify recipients in GETRECIP by setting AMHKEY

 +8       ;;3. Make changes in SUBJECT and SENDER as desired

 +9       ;;4. Rename this routine in appropriate namespace and 

 +10      ;;   call on completion of patch or upgrade

 +11      ;

 +12       IF '$GET(DUZ)

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

               QUIT 

 +13       DO HOME^%ZIS

           DO DT^DICRW

 +14      ;

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

 +16       KILL ^TMP($JOB,"AMHBUL")

 +17       DO WRITEMSG

           DO GETRECIP

 +18      ;Change following lines as desired

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

SENDER     SET XMDUZ="Cimarron Medical Informatics"

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

           SET XMY(1)=""

           SET XMY(DUZ)=""

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

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

 +3        DO ^XMD

 +4        KILL ^TMP($JOB,"AMHBUL"),AMHKEY

 +5        QUIT 

 +6       ;

WRITEMSG  ;

 +1        SET AMHIEN=$ORDER(^AMHPATCH("AA",3,4,0))

 +2        IF AMHIEN=""

               QUIT 

 +3        SET AMHX=0

           SET AMHC=0

           FOR 

               SET AMHX=$ORDER(^AMHPATCH(AMHIEN,11,AMHX))

               IF AMHX'=+AMHX

                   QUIT 

               SET AMHC=AMHC+1

               SET ^TMP($JOB,"AMHBUL",AMHC)=^AMHPATCH(AMHIEN,11,AMHX,0)

 +4        QUIT 

GETRECIP  ;

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

 +2       ;

 +3        SET CTR=0

           SET AMHKEY="AMHZMENU"

 +4        FOR 

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

               IF 'CTR

                   QUIT 

               SET Y=CTR

               SET XMY(Y)=""

 +5        QUIT