LEX2I04P.m

LEX2I04P ;IHS/OIT/FCJ - LEXICON UTILITY PATCH 1004 ; 14 Mar 2012  12:44 PM

 ;;2.0;LEXICON UTILITY;**1004**;Sep 23, 1996;Build 5

 ;=================================================================

 ;Original routine from LEX2I02P

 ;

POST ;EP FROM KERNAL

 ;

MAIL ;

 D BMES^XPDUTL("BEGIN Delivering MailMan message to select users.")

 NEW DIFROM,XMSUB,XMDUZ,XMTEXT,XMY

 KILL ^TMP("LEX1004",$J)

 D RSLT(" --- LEX v 2.0 Patch 1004, have been installed into this namespace ---")

 F %=1:1 D RSLT($P($T(GREET+%),";",3)) Q:$P($T(GREET+%+1),";",3)="###"

 S %=0

 F  S %=$O(^XTMP("XPDI",XPDA,"BLD",XPDBLD,1,%)) Q:'%   D RSLT(^(%,0))

 S XMSUB=$P($P($T(+1),";",2)," ",3,99),XMDUZ=$S($G(DUZ):DUZ,1:.5),XMTEXT="^TMP(""LEX1004"",$J,",XMY(1)="",XMY(DUZ)=""

 F %="LEXZMENU","XUMGR","XUPROG","XUPROGMODE" D SINGLE(%)

 D ^XMD

 KILL ^TMP("LEX1004",$J)

 D MES^XPDUTL("END Delivering MailMan message to select users.")

 Q

 ;

RSLT(%) S ^(0)=$G(^TMP("LEX1004",$J,0))+1,^(^(0))=%

 Q

 ;

SINGLE(K) ; Get holders of a key

 NEW Y

 S Y=0

 Q:'$D(^XUSEC(K))

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

 Q

 ;

GREET ;;To add to mail message.

 ;;  

 ;;Routines and/or data dictionaries on your RPMS system have been updated.

 ;;  

 ;;You are receiving this message because of the RPMS

 ;;security keys that you hold.  This is for your information.

 ;;Do not respond to this message.

 ;;  

 ;;Questions about this patch may be directed to

 ;;the ITSC Support Center, at 505-248-4371,

 ;;refer to patch "LEX*2.1*1004".

 ;;  

 ;;###;NOTE: This line end of text.

 ;

LEX2I04P  ;IHS/OIT/FCJ - LEXICON UTILITY PATCH 1004 ; 14 Mar 2012  12:44 PM

 +1       ;;2.0;LEXICON UTILITY;**1004**;Sep 23, 1996;Build 5

 +2       ;=================================================================

 +3       ;Original routine from LEX2I02P

 +4       ;

POST      ;EP FROM KERNAL

 +1       ;

MAIL      ;

 +1        DO BMES^XPDUTL("BEGIN Delivering MailMan message to select users.")

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

 +3        KILL ^TMP("LEX1004",$JOB)

 +4        DO RSLT(" --- LEX v 2.0 Patch 1004, have been installed into this namespace ---")

 +5        FOR %=1:1

               DO RSLT($PIECE($TEXT(GREET+%),";",3))

               IF $PIECE($TEXT(GREET+%+1),";",3)="###"

                   QUIT 

 +6        SET %=0

 +7        FOR 

               SET %=$ORDER(^XTMP("XPDI",XPDA,"BLD",XPDBLD,1,%))

               IF '%

                   QUIT 

               DO RSLT(^(%,0))

 +8        SET XMSUB=$PIECE($PIECE($TEXT(+1),";",2)," ",3,99)

           SET XMDUZ=$SELECT($GET(DUZ):DUZ,1:.5)

           SET XMTEXT="^TMP(""LEX1004"",$J,"

           SET XMY(1)=""

           SET XMY(DUZ)=""

 +9        FOR %="LEXZMENU","XUMGR","XUPROG","XUPROGMODE"

               DO SINGLE(%)

 +10       DO ^XMD

 +11       KILL ^TMP("LEX1004",$JOB)

 +12       DO MES^XPDUTL("END Delivering MailMan message to select users.")

 +13       QUIT 

 +14      ;

RSLT(%)    SET ^(0)=$GET(^TMP("LEX1004",$JOB,0))+1

           SET ^(^(0))=%

 +1        QUIT 

 +2       ;

SINGLE(K) ; Get holders of a key

 +1        NEW Y

 +2        SET Y=0

 +3        IF '$DATA(^XUSEC(K))

               QUIT 

 +4        FOR 

               SET Y=$ORDER(^XUSEC(K,Y))

               IF 'Y

                   QUIT 

               SET XMY(Y)=""

 +5        QUIT 

 +6       ;

GREET     ;;To add to mail message.

 +1       ;;  

 +2       ;;Routines and/or data dictionaries on your RPMS system have been updated.

 +3       ;;  

 +4       ;;You are receiving this message because of the RPMS

 +5       ;;security keys that you hold.  This is for your information.

 +6       ;;Do not respond to this message.

 +7       ;;  

 +8       ;;Questions about this patch may be directed to

 +9       ;;the ITSC Support Center, at 505-248-4371,

 +10      ;;refer to patch "LEX*2.1*1004".

 +11      ;;  

 +12      ;;###;NOTE: This line end of text.

 +13      ;