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. ;