LEX2I02P ;IHS/OIT/FCJ - LEXICON UTILITY PATCH 1002 ; 14 Mar 2012 12:44 PM
;;2.0;LEXICON UTILITY;**1002**;Sep 23, 1996;Build 10
;=================================================================
;
;
POST ;EP FROM KERNAL
S %="HIST^LEX2I02P"
I $$NEWCP^XPDUTL("POS4-"_%,%)
S %="OPT^LEX2I02P"
I $$NEWCP^XPDUTL("POS5-"_%,%)
S %="MAIL^LEX2I02P"
I $$NEWCP^XPDUTL("POS6-"_%,%)
;
Q
MAIL ;
D BMES^XPDUTL("BEGIN Delivering MailMan message to select users.")
NEW DIFROM,XMSUB,XMDUZ,XMTEXT,XMY
KILL ^TMP("LEX1002",$J)
D RSLT(" --- LEX v 2.0 Patch 1002, 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(""LEX1002"",$J,",XMY(1)="",XMY(DUZ)=""
F %="LEXZMENU","XUMGR","XUPROG","XUPROGMODE" D SINGLE(%)
D ^XMD
KILL ^TMP("LEX1002",$J)
D MES^XPDUTL("END Delivering MailMan message to select users.")
Q
;
RSLT(%) S ^(0)=$G(^TMP("LEX1002",$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*1002".
;;
;;###;NOTE: This line end of text.
;
HIST ;PATCH HISTORY UPDATE
D MES^XPDUTL("Begin adding patches to package file.")
S DDLM=";;",DLM="|",TAG="LEX"
S PKGNM="LEXICON UTILITY"
I '$D(^DIC(9.4,"B",PKGNM)) D MES^XPDUTL("Problem with package name.") Q
S PKGIEN=$O(^DIC(9.4,"B",PKGNM,0))
F I=1:1 D Q:TEXT["END"
.S TEXT=$T(@TAG+I) Q:TEXT["END"
.S DATA=$P(TEXT,DDLM,2)
.S VERSION=$P(DATA,DLM,2),PATCH=$P(DATA,DLM,3)
.S VSB=$O(^DIC(9.4,PKGIEN,22,"B",VERSION,0))
.Q:'VSB
.K FDA
.; Do not update if the patch is already in the patch history
.Q:$D(^DIC(9.4,PKGIEN,22,VSB,"PAH","B",PATCH))
.S FDA(9.4901,"+1,"_VSB_","_PKGIEN_",",.01)=$G(PATCH)
.S FDA(9.4901,"+1,"_VSB_","_PKGIEN_",",.02)=DT
.S FDA(9.4901,"+1,"_VSB_","_PKGIEN_",",.03)=DUZ
.D UPDATE^DIE(,"FDA")
.D:$G(DIERR)'="" MES^XPDUTL("Error adding patch "_PATCH_" to package file.")
D MES^XPDUTL("Completed adding patches to package file.")
Q
;;;;FORMAT - Package name|Version|Patch|Sequence
LEX ;
;;LEXICON UTILITY|2.0|56 SEQ #52
;;LEXICON UTILITY|2.0|41 SEQ #53
;;LEXICON UTILITY|2.0|60 SEQ #54
;;LEXICON UTILITY|2.0|59 SEQ #55
;;LEXICON UTILITY|2.0|61 SEQ #56
;;LEXICON UTILITY|2.0|63 SEQ #57
;;LEXICON UTILITY|2.0|65 SEQ #58
;;LEXICON UTILITY|2.0|62 SEQ #59
;;LEXICON UTILITY|2.0|66 SEQ #60
;;LEXICON UTILITY|2.0|55 SEQ #61
;;LEXICON UTILITY|2.0|67 SEQ #62
;;LEXICON UTILITY|2.0|68 SEQ #63
;;LEXICON UTILITY|2.0|69 SEQ #64
;;LEXICON UTILITY|2.0|70 SEQ #65
;;LEXICON UTILITY|2.0|72 SEQ #66
;;LEXICON UTILITY|2.0|74 SEQ #67
;;LEXICON UTILITY|2.0|76 SEQ #68
;;LEXICON UTILITY|2.0|73 SEQ #69
;;LEXICON UTILITY|2.0|77 SEQ #70
;;LEXICON UTILITY|2.0|78 SEQ #71
;;LEXICON UTILITY|2.0|81 SEQ #73
;END
OPT ;ADD LEXICON OPTION TO AKMOCORE
D BMES^XPDUTL("BEGIN Adding Lexicon menu to AKMOCORE.")
I $$ADD^XPDMENU("LEX MGT MENU","Lexicon Management Menu","LEX") D
.D MES^XPDUTL($J("",5)_"Lexicon Menu added to the IHS Core menu.")
.D MES^XPDUTL($J("",5)_"Note that the security lock was *NOT* allocated.") I 1
E D MES^XPDUTL($J("",5)_"ERROR: Lexicon menu add FAILED, may already be assigned to CORE.")
D MES^XPDUTL("END Adding Lexicon menu.")
LEX2I02P ;IHS/OIT/FCJ - LEXICON UTILITY PATCH 1002 ; 14 Mar 2012 12:44 PM
+1 ;;2.0;LEXICON UTILITY;**1002**;Sep 23, 1996;Build 10
+2 ;=================================================================
+3 ;
+4 ;
POST ;EP FROM KERNAL
+1 SET %="HIST^LEX2I02P"
+2 IF $$NEWCP^XPDUTL("POS4-"_%,%)
+3 SET %="OPT^LEX2I02P"
+4 IF $$NEWCP^XPDUTL("POS5-"_%,%)
+5 SET %="MAIL^LEX2I02P"
+6 IF $$NEWCP^XPDUTL("POS6-"_%,%)
+7 ;
+8 QUIT
MAIL ;
+1 DO BMES^XPDUTL("BEGIN Delivering MailMan message to select users.")
+2 NEW DIFROM,XMSUB,XMDUZ,XMTEXT,XMY
+3 KILL ^TMP("LEX1002",$JOB)
+4 DO RSLT(" --- LEX v 2.0 Patch 1002, 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(""LEX1002"",$J,"
SET XMY(1)=""
SET XMY(DUZ)=""
+9 FOR %="LEXZMENU","XUMGR","XUPROG","XUPROGMODE"
DO SINGLE(%)
+10 DO ^XMD
+11 KILL ^TMP("LEX1002",$JOB)
+12 DO MES^XPDUTL("END Delivering MailMan message to select users.")
+13 QUIT
+14 ;
RSLT(%) SET ^(0)=$GET(^TMP("LEX1002",$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*1002".
+11 ;;
+12 ;;###;NOTE: This line end of text.
+13 ;
HIST ;PATCH HISTORY UPDATE
+1 DO MES^XPDUTL("Begin adding patches to package file.")
+2 SET DDLM=";;"
SET DLM="|"
SET TAG="LEX"
+3 SET PKGNM="LEXICON UTILITY"
+4 IF '$DATA(^DIC(9.4,"B",PKGNM))
DO MES^XPDUTL("Problem with package name.")
QUIT
+5 SET PKGIEN=$ORDER(^DIC(9.4,"B",PKGNM,0))
+6 FOR I=1:1
Begin DoDot:1
+7 SET TEXT=$TEXT(@TAG+I)
IF TEXT["END"
QUIT
+8 SET DATA=$PIECE(TEXT,DDLM,2)
+9 SET VERSION=$PIECE(DATA,DLM,2)
SET PATCH=$PIECE(DATA,DLM,3)
+10 SET VSB=$ORDER(^DIC(9.4,PKGIEN,22,"B",VERSION,0))
+11 IF 'VSB
QUIT
+12 KILL FDA
+13 ; Do not update if the patch is already in the patch history
+14 IF $DATA(^DIC(9.4,PKGIEN,22,VSB,"PAH","B",PATCH))
QUIT
+15 SET FDA(9.4901,"+1,"_VSB_","_PKGIEN_",",.01)=$GET(PATCH)
+16 SET FDA(9.4901,"+1,"_VSB_","_PKGIEN_",",.02)=DT
+17 SET FDA(9.4901,"+1,"_VSB_","_PKGIEN_",",.03)=DUZ
+18 DO UPDATE^DIE(,"FDA")
+19 IF $GET(DIERR)'=""
DO MES^XPDUTL("Error adding patch "_PATCH_" to package file.")
End DoDot:1
IF TEXT["END"
QUIT
+20 DO MES^XPDUTL("Completed adding patches to package file.")
+21 QUIT
+22 ;;;;FORMAT - Package name|Version|Patch|Sequence
LEX ;
+1 ;;LEXICON UTILITY|2.0|56 SEQ #52
+2 ;;LEXICON UTILITY|2.0|41 SEQ #53
+3 ;;LEXICON UTILITY|2.0|60 SEQ #54
+4 ;;LEXICON UTILITY|2.0|59 SEQ #55
+5 ;;LEXICON UTILITY|2.0|61 SEQ #56
+6 ;;LEXICON UTILITY|2.0|63 SEQ #57
+7 ;;LEXICON UTILITY|2.0|65 SEQ #58
+8 ;;LEXICON UTILITY|2.0|62 SEQ #59
+9 ;;LEXICON UTILITY|2.0|66 SEQ #60
+10 ;;LEXICON UTILITY|2.0|55 SEQ #61
+11 ;;LEXICON UTILITY|2.0|67 SEQ #62
+12 ;;LEXICON UTILITY|2.0|68 SEQ #63
+13 ;;LEXICON UTILITY|2.0|69 SEQ #64
+14 ;;LEXICON UTILITY|2.0|70 SEQ #65
+15 ;;LEXICON UTILITY|2.0|72 SEQ #66
+16 ;;LEXICON UTILITY|2.0|74 SEQ #67
+17 ;;LEXICON UTILITY|2.0|76 SEQ #68
+18 ;;LEXICON UTILITY|2.0|73 SEQ #69
+19 ;;LEXICON UTILITY|2.0|77 SEQ #70
+20 ;;LEXICON UTILITY|2.0|78 SEQ #71
+21 ;;LEXICON UTILITY|2.0|81 SEQ #73
+22 ;END
OPT ;ADD LEXICON OPTION TO AKMOCORE
+1 DO BMES^XPDUTL("BEGIN Adding Lexicon menu to AKMOCORE.")
+2 IF $$ADD^XPDMENU("LEX MGT MENU","Lexicon Management Menu","LEX")
Begin DoDot:1
+3 DO MES^XPDUTL($JUSTIFY("",5)_"Lexicon Menu added to the IHS Core menu.")
+4 DO MES^XPDUTL($JUSTIFY("",5)_"Note that the security lock was *NOT* allocated.")
IF 1
End DoDot:1
+5 IF '$TEST
DO MES^XPDUTL($JUSTIFY("",5)_"ERROR: Lexicon menu add FAILED, may already be assigned to CORE.")
+6 DO MES^XPDUTL("END Adding Lexicon menu.")
