- 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.")
