Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ACHS3120

ACHS3120.m

Go to the documentation of this file. 
  1. ACHS3120 ;IHS/OIT/FCJ - ACHS 3.1 PATCH 20 ;7/30/10  08:37
  1.  ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**20**;JUNE 11,2001
  1.  ;3.1*16 12/1/2009;IHS/OIT/FCJ - ORIG RTN P15 MOVED ENV CHECK TO ACHS31E1
  1.  ;
  1. PRE ;EP - From KIDS.
  1.  I $$NEWCP^XPDUTL("PRE1","AUDS^ACHS3120")
  1.  Q
  1.  ;
  1. POST ;EP - From KIDS.
  1.  ;
  1.  ; --- Restore dd audit settings.
  1.  S %="AUDR^ACHS3120"
  1.  I $$NEWCP^XPDUTL("POS2-"_%,%)
  1.  ; --- Send mail message of install.
  1.  S %="MAIL^ACHS3120"
  1.  I $$NEWCP^XPDUTL("POS3-"_%,%)
  1.  ;
  1.  Q
  1. MAIL ;
  1.  D BMES^XPDUTL("BEGIN Delivering MailMan message to select users.")
  1.  NEW DIFROM,XMSUB,XMDUZ,XMTEXT,XMY
  1.  KILL ^TMP("ACHS3120",$J)
  1.  D RSLT(" --- ACHS v 3.1 Patch 20, has been installed into this namespace ---")
  1.  F %=1:1 D RSLT($P($T(GREET+%),";",3)) Q:$P($T(GREET+%+1),";",3)="###"
  1.  S %=0
  1.  F  S %=$O(^XTMP("XPDI",XPDA,"BLD",XPDBLD,1,%)) Q:'%   D RSLT(^(%,0))
  1.  S XMSUB=$P($P($T(+1),";",2)," ",3,99),XMDUZ=$S($G(DUZ):DUZ,1:.5),XMTEXT="^TMP(""ACHS3120"",$J,",XMY(1)="",XMY(DUZ)=""
  1.  F %="ACHSZMENU","XUMGR","XUPROG","XUPROGMODE" D SINGLE(%)
  1.  D ^XMD
  1.  KILL ^TMP("ACHS3120",$J)
  1.  D MES^XPDUTL("END Delivering MailMan message to select users.")
  1.  Q
  1.  ;
  1. RSLT(%) S ^(0)=$G(^TMP("ACHS3120",$J,0))+1,^(^(0))=%
  1.  Q
  1.  ;
  1. SINGLE(K) ; Get holders of a key
  1.  NEW Y
  1.  S Y=0
  1.  Q:'$D(^XUSEC(K))
  1.  F  S Y=$O(^XUSEC(K,Y)) Q:'Y  S XMY(Y)=""
  1.  Q
  1.  ;
  1. GREET ;;To add to mail message.
  1.  ;;  
  1.  ;;Standard Routines on your RPMS system have been updated.
  1.  ;;  
  1.  ;;You are receiving this message because of the RPMS
  1.  ;;security keys that you hold.  This is for your information.
  1.  ;;Do not respond to this message.
  1.  ;;  
  1.  ;;Questions about this patch may be directed to
  1.  ;;the ITSC Support Center, at 505-248-4297,
  1.  ;;refer to patch "ACHS*3.1*20".
  1.  ;;  
  1.  ;;###;NOTE: This line end of text.
  1.  ; ---------------------------------------------
  1.  ; The global location for dictionary audit is:
  1.  ;           ^DD(FILE,0,"DDA")
  1.  ; value = "Y", dd audit is on.  Any other value, or the
  1.  ; absence of the node, means dd audit is off.
  1.  ;
  1. AUDS ;EP - From KIDS.
  1.  D BMES^XPDUTL("Saving current DD AUDIT settings for files in this patch")
  1.  D MES^XPDUTL("and turning DD AUDIT to 'Y'.")
  1.  S ^XTMP("ACHS3120",0)=$$FMADD^XLFDT(DT,10)_"^"_DT_"^"_$P($P($T(+1),";",2)," ",3,99)
  1.  NEW ACHS
  1.  S ACHS=0
  1.  F  S ACHS=$O(^XTMP("XPDI",XPDA,"FIA",ACHS)) Q:'ACHS  D
  1.  . I '$D(^XTMP("ACHS3120",ACHS,"DDA")) S ^XTMP("ACHS3120",ACHS,"DDA")=$G(^DD(ACHS,0,"DDA"))
  1.  . D MES^XPDUTL(" File "_$$RJ^XLFSTR(ACHS,12)_" - "_$$LJ^XLFSTR(^XTMP("XPDI",XPDA,"FIA",ACHS),30)_"- DD audit was '"_$G(^XTMP("ACHS3120",ACHS,"DDA"))_"'"),MES^XPDUTL($$RJ^XLFSTR("Set to 'Y'",69))
  1.  . S ^DD(ACHS,0,"DDA")="Y"
  1.  D MES^XPDUTL("DD AUDIT settings saved in ^XTMP(.")
  1.  Q
  1.  ;
  1. AUDR ; Restore the file data audit values to their original values.
  1.  D BMES^XPDUTL("Restoring DD AUDIT settings for files in this patch.")
  1.  NEW ACHS
  1.  S ACHS=0
  1.  F  S ACHS=$O(^XTMP("ACHS3120",ACHS)) Q:'ACHS  D
  1.  . S ^DD(ACHS,0,"DDA")=^XTMP("ACHS3120",ACHS,"DDA")
  1.  . D MES^XPDUTL(" File "_$$RJ^XLFSTR(ACHS,12)_" - "_$$LJ^XLFSTR($$GET1^DID(ACHS,"","","NAME"),30)_"- DD AUDIT Set to '"_^DD(ACHS,0,"DDA")_"'")
  1.  .Q
  1.  KILL ^XTMP("ACHS3120")
  1.  D MES^XPDUTL("DD AUDIT settings restored.")
  1.  Q
  1.  ;