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

ACHS3125.m

Go to the documentation of this file. 
  1. ACHS3125 ;IHS/OIT/FCJ - ACHS 3.1 PATCH 25 ;7/30/10  08:37
  1.  ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**25**;JUNE 11,2001;Build 24
  1.  ;3.1*16 12/1/2009;IHS/OIT/FCJ - ORIG RTN P21
  1.  ;ENV CHECK TO ACHS31E1
  1.  ;
  1. PRE ;EP - From KIDS.
  1.  I $$NEWCP^XPDUTL("PRE1","AUDS^ACHS3125")
  1.  Q
  1.  ;
  1. POST ;EP - From KIDS.
  1.  ;
  1.  ;PATCH 21 AREA UPDATES
  1.  S %="P21^ACHS3125"
  1.  I $$NEWCP^XPDUTL("POS2-"_%,%)
  1.  ;
  1.  ;PATCH 22 NEW ICD9 REPORT MENU OPTION
  1.  S %="P22^ACHS3125"
  1.  I $$NEWCP^XPDUTL("POS3-"_%,%)
  1.  ;
  1.  ;PATCH 24 Set ICD10 Parameters
  1.  S %="P24^ACHS3125"
  1.  I $$NEWCP^XPDUTL("POS4-"_%,%)
  1.  ;
  1.  ;PATCH 25 Clean up the option
  1.  S %="P25^ACHS3125"
  1.  I $$NEWCP^XPDUTL("POS5-"_%,%)
  1.  ;
  1.  ; --- Restore dd audit settings.
  1.  S %="AUDR^ACHS3125"
  1.  I $$NEWCP^XPDUTL("POS6-"_%,%)
  1.  ;
  1.  ; --- Send mail message of install.
  1.  S %="MAIL^ACHS3125"
  1.  I $$NEWCP^XPDUTL("POS7-"_%,%)
  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("ACHS3125",$J)
  1.  D RSLT(" --- ACHS v 3.1 Patch 25, 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(""ACHS3125"",$J,",XMY(1)="",XMY(DUZ)=""
  1.  F %="ACHSZMENU","XUMGR","XUPROG","XUPROGMODE" D SINGLE(%)
  1.  D ^XMD
  1.  KILL ^TMP("ACHS3125",$J)
  1.  D MES^XPDUTL("END Delivering MailMan message to select users.")
  1.  Q
  1.  ;
  1. RSLT(%) S ^(0)=$G(^TMP("ACHS3125",$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*24".
  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("ACHS3125",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("ACHS3125",ACHS,"DDA")) S ^XTMP("ACHS3125",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("ACHS3125",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("ACHS3125",ACHS)) Q:'ACHS  D
  1.  . S ^DD(ACHS,0,"DDA")=^XTMP("ACHS3125",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("ACHS3125")
  1.  D MES^XPDUTL("DD AUDIT settings restored.")
  1.  Q
  1.  ;
  1. P21 ;PATCH 21
  1.  ;REMOVE 2 SPLITOUT MENU OPT NOW COMBINED WITH THE PROCESSING OPTIONS
  1.  Q:$$INSTALLD^ACHS31E1("ACHS*3.1*21")
  1.  D BMES^XPDUTL("Begin Removing split out options.")
  1.  I $$DELETE^XPDMENU("ACHSAREA","ACHSAREA SP/EX") D MES^XPDUTL($J("",5)_"Removed Option: Area CHS Splitout / Export To HAS/FI/CORE")
  1.  I $$DELETE^XPDMENU("ACHSAREAEOBRPROC","ACHSAREAEOBROUT") D MES^XPDUTL($J("",5)_"Remove Option: Area CHS Generate Facility EOBR Files")
  1.  D MES^XPDUTL("END updating options.")
  1.  ;SET PRINT EOBR PARAMETER TO NO
  1.  S ACHS=0
  1.  F  S ACHS=$O(^ACHSF("B",ACHS)) Q:ACHS'?1N.N  D
  1.  .S DA=ACHS,DIE="^ACHSF("
  1.  .S DR="14.14///N"
  1.  .D ^DIE
  1.  Q
  1.  ;
  1. P22 ;PATCH 22
  1.  Q:$$INSTALLD^ACHS31E1("ACHS*3.1*22")
  1.  ;ADD NEW OPTIONS - P22-ICD9 REPORT OPTION
  1.  D BMES^XPDUTL("Begin adding new option.")
  1.  I $$ADD^XPDMENU("ACHSREPORTS","ACHSRPTICDERROR","ICDR") D MES^XPDUTL($J("",5)_"Added ICD9 Report - to reports option")
  1.  D MES^XPDUTL("END updating options.")
  1.  ;SET UP ICD GLOBALS
  1.  D SET^ACHSIC2
  1.  Q
  1.  ;
  1. P24 ;PATCH 24
  1.  ;Q:$$INSTALLD^ACHS31E1("ACHS*3.1*24")
  1.  ;ADD ICD START DATE IN PARAMETERS
  1.  D BMES^XPDUTL("Checking/Updating ICD10 PARAMETERS.")
  1.  S L=0
  1.  F  S L=$O(^ACHSF(L)) Q:L'?1N.N  D
  1.  .S $P(^ACHSF(L,0),U,17,18)="3151001^3151001"
  1.  ;
  1.  D MES^XPDUTL("END updating Parameters.")
  1.  K L
  1.  Q
  1.  ;
  1. P25 ;PATCH 25
  1.  ;Q:$$INSTALLD^ACHS31E1("ACHS*3.1*25")
  1.  Q:'$D(^DIC(19,"B","ACHS DEN REP-CARE NOT MED PRI"))
  1.  S L=0,L=$O(^DIC(19,"B","ACHS DEN REP-CARE NOT MED PRI",L))
  1.  S (^DIC(19,L,20),^DIC(19,L,60),^DIC(19,L,62),^DIC(19,L,63),^DIC(19,L,64),^DIC(19,L,69))=""
  1.  Q