ACHS3121 ;IHS/OIT/FCJ - ACHS 3.1 PATCH 21 ;7/30/10 08:37
;;3.1;CONTRACT HEALTH MGMT SYSTEM;**21**;JUNE 11,2001
;3.1*16 12/1/2009;IHS/OIT/FCJ - ORIG RTN P15 MOVED ENV CHECK TO ACHS31E1
;
PRE ;EP - From KIDS.
I $$NEWCP^XPDUTL("PRE1","AUDS^ACHS3121")
Q
;
POST ;EP - From KIDS.
;
; --- Restore dd audit settings.
S %="AUDR^ACHS3121"
I $$NEWCP^XPDUTL("POS2-"_%,%)
S %="P21^ACHS3121"
I $$NEWCP^XPDUTL("POS3-"_%,%)
; --- Send mail message of install.
S %="MAIL^ACHS3121"
I $$NEWCP^XPDUTL("POS4-"_%,%)
;
Q
MAIL ;
D BMES^XPDUTL("BEGIN Delivering MailMan message to select users.")
NEW DIFROM,XMSUB,XMDUZ,XMTEXT,XMY
KILL ^TMP("ACHS3121",$J)
D RSLT(" --- ACHS v 3.1 Patch 20, has 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(""ACHS3121"",$J,",XMY(1)="",XMY(DUZ)=""
F %="ACHSZMENU","XUMGR","XUPROG","XUPROGMODE" D SINGLE(%)
D ^XMD
KILL ^TMP("ACHS3121",$J)
D MES^XPDUTL("END Delivering MailMan message to select users.")
Q
;
RSLT(%) S ^(0)=$G(^TMP("ACHS3121",$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.
;;
;;Standard Routines 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-4297,
;;refer to patch "ACHS*3.1*21".
;;
;;###;NOTE: This line end of text.
; ---------------------------------------------
; The global location for dictionary audit is:
; ^DD(FILE,0,"DDA")
; value = "Y", dd audit is on. Any other value, or the
; absence of the node, means dd audit is off.
;
AUDS ;EP - From KIDS.
D BMES^XPDUTL("Saving current DD AUDIT settings for files in this patch")
D MES^XPDUTL("and turning DD AUDIT to 'Y'.")
S ^XTMP("ACHS3121",0)=$$FMADD^XLFDT(DT,10)_"^"_DT_"^"_$P($P($T(+1),";",2)," ",3,99)
NEW ACHS
S ACHS=0
F S ACHS=$O(^XTMP("XPDI",XPDA,"FIA",ACHS)) Q:'ACHS D
. I '$D(^XTMP("ACHS3121",ACHS,"DDA")) S ^XTMP("ACHS3121",ACHS,"DDA")=$G(^DD(ACHS,0,"DDA"))
. D MES^XPDUTL(" File "_$$RJ^XLFSTR(ACHS,12)_" - "_$$LJ^XLFSTR(^XTMP("XPDI",XPDA,"FIA",ACHS),30)_"- DD audit was '"_$G(^XTMP("ACHS3121",ACHS,"DDA"))_"'"),MES^XPDUTL($$RJ^XLFSTR("Set to 'Y'",69))
. S ^DD(ACHS,0,"DDA")="Y"
D MES^XPDUTL("DD AUDIT settings saved in ^XTMP(.")
Q
;
AUDR ; Restore the file data audit values to their original values.
D BMES^XPDUTL("Restoring DD AUDIT settings for files in this patch.")
NEW ACHS
S ACHS=0
F S ACHS=$O(^XTMP("ACHS3121",ACHS)) Q:'ACHS D
. S ^DD(ACHS,0,"DDA")=^XTMP("ACHS3121",ACHS,"DDA")
. D MES^XPDUTL(" File "_$$RJ^XLFSTR(ACHS,12)_" - "_$$LJ^XLFSTR($$GET1^DID(ACHS,"","","NAME"),30)_"- DD AUDIT Set to '"_^DD(ACHS,0,"DDA")_"'")
.Q
KILL ^XTMP("ACHS3121")
D MES^XPDUTL("DD AUDIT settings restored.")
Q
;
P21 ;PATCH 21
;REMOVE 2 SPLITOUT MENU OPT NOW COMBINED WITH THE PROCESSING OPTIONS
D BMES^XPDUTL("Begin Removing split out options.")
I $$DELETE^XPDMENU("ACHSAREA","ACHSAREA SP/EX") D MES^XPDUTL($J("",5)_"Removed Option: Area CHS Splitout / Export To HAS/FI/CORE")
I $$DELETE^XPDMENU("ACHSAREAEOBRPROC","ACHSAREAEOBROUT") D MES^XPDUTL($J("",5)_"Remove Option: Area CHS Generate Facility EOBR Files")
D MES^XPDUTL("END updating options.")
;SET PRINT EOBR PARAMETER TO NO
S ACHS=0
F S ACHS=$O(^ACHSF("B",ACHS)) Q:ACHS'?1N.N D
.S DA=ACHS,DIE="^ACHSF("
.S DR="14.14///N"
.D ^DIE
Q
;
ACHS3121 ;IHS/OIT/FCJ - ACHS 3.1 PATCH 21 ;7/30/10 08:37
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**21**;JUNE 11,2001
+2 ;3.1*16 12/1/2009;IHS/OIT/FCJ - ORIG RTN P15 MOVED ENV CHECK TO ACHS31E1
+3 ;
PRE ;EP - From KIDS.
+1 IF $$NEWCP^XPDUTL("PRE1","AUDS^ACHS3121")
+2 QUIT
+3 ;
POST ;EP - From KIDS.
+1 ;
+2 ; --- Restore dd audit settings.
+3 SET %="AUDR^ACHS3121"
+4 IF $$NEWCP^XPDUTL("POS2-"_%,%)
+5 SET %="P21^ACHS3121"
+6 IF $$NEWCP^XPDUTL("POS3-"_%,%)
+7 ; --- Send mail message of install.
+8 SET %="MAIL^ACHS3121"
+9 IF $$NEWCP^XPDUTL("POS4-"_%,%)
+10 ;
+11 QUIT
MAIL ;
+1 DO BMES^XPDUTL("BEGIN Delivering MailMan message to select users.")
+2 NEW DIFROM,XMSUB,XMDUZ,XMTEXT,XMY
+3 KILL ^TMP("ACHS3121",$JOB)
+4 DO RSLT(" --- ACHS v 3.1 Patch 20, has 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(""ACHS3121"",$J,"
SET XMY(1)=""
SET XMY(DUZ)=""
+9 FOR %="ACHSZMENU","XUMGR","XUPROG","XUPROGMODE"
DO SINGLE(%)
+10 DO ^XMD
+11 KILL ^TMP("ACHS3121",$JOB)
+12 DO MES^XPDUTL("END Delivering MailMan message to select users.")
+13 QUIT
+14 ;
RSLT(%) SET ^(0)=$GET(^TMP("ACHS3121",$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 ;;Standard Routines 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-4297,
+10 ;;refer to patch "ACHS*3.1*21".
+11 ;;
+12 ;;###;NOTE: This line end of text.
+13 ; ---------------------------------------------
+14 ; The global location for dictionary audit is:
+15 ; ^DD(FILE,0,"DDA")
+16 ; value = "Y", dd audit is on. Any other value, or the
+17 ; absence of the node, means dd audit is off.
+18 ;
AUDS ;EP - From KIDS.
+1 DO BMES^XPDUTL("Saving current DD AUDIT settings for files in this patch")
+2 DO MES^XPDUTL("and turning DD AUDIT to 'Y'.")
+3 SET ^XTMP("ACHS3121",0)=$$FMADD^XLFDT(DT,10)_"^"_DT_"^"_$PIECE($PIECE($TEXT(+1),";",2)," ",3,99)
+4 NEW ACHS
+5 SET ACHS=0
+6 FOR
SET ACHS=$ORDER(^XTMP("XPDI",XPDA,"FIA",ACHS))
IF 'ACHS
QUIT
Begin DoDot:1
+7 IF '$DATA(^XTMP("ACHS3121",ACHS,"DDA"))
SET ^XTMP("ACHS3121",ACHS,"DDA")=$GET(^DD(ACHS,0,"DDA"))
+8 DO MES^XPDUTL(" File "_$$RJ^XLFSTR(ACHS,12)_" - "_$$LJ^XLFSTR(^XTMP("XPDI",XPDA,"FIA",ACHS),30)_"- DD audit was '"_$GET(^XTMP("ACHS3121",ACHS,"DDA"))_"'")
DO MES^XPDUTL($$RJ^XLFSTR("Set to 'Y'",69))
+9 SET ^DD(ACHS,0,"DDA")="Y"
End DoDot:1
+10 DO MES^XPDUTL("DD AUDIT settings saved in ^XTMP(.")
+11 QUIT
+12 ;
AUDR ; Restore the file data audit values to their original values.
+1 DO BMES^XPDUTL("Restoring DD AUDIT settings for files in this patch.")
+2 NEW ACHS
+3 SET ACHS=0
+4 FOR
SET ACHS=$ORDER(^XTMP("ACHS3121",ACHS))
IF 'ACHS
QUIT
Begin DoDot:1
+5 SET ^DD(ACHS,0,"DDA")=^XTMP("ACHS3121",ACHS,"DDA")
+6 DO MES^XPDUTL(" File "_$$RJ^XLFSTR(ACHS,12)_" - "_$$LJ^XLFSTR($$GET1^DID(ACHS,"","","NAME"),30)_"- DD AUDIT Set to '"_^DD(ACHS,0,"DDA")_"'")
+7 QUIT
End DoDot:1
+8 KILL ^XTMP("ACHS3121")
+9 DO MES^XPDUTL("DD AUDIT settings restored.")
+10 QUIT
+11 ;
P21 ;PATCH 21
+1 ;REMOVE 2 SPLITOUT MENU OPT NOW COMBINED WITH THE PROCESSING OPTIONS
+2 DO BMES^XPDUTL("Begin Removing split out options.")
+3 IF $$DELETE^XPDMENU("ACHSAREA","ACHSAREA SP/EX")
DO MES^XPDUTL($JUSTIFY("",5)_"Removed Option: Area CHS Splitout / Export To HAS/FI/CORE")
+4 IF $$DELETE^XPDMENU("ACHSAREAEOBRPROC","ACHSAREAEOBROUT")
DO MES^XPDUTL($JUSTIFY("",5)_"Remove Option: Area CHS Generate Facility EOBR Files")
+5 DO MES^XPDUTL("END updating options.")
+6 ;SET PRINT EOBR PARAMETER TO NO
+7 SET ACHS=0
+8 FOR
SET ACHS=$ORDER(^ACHSF("B",ACHS))
IF ACHS'?1N.N
QUIT
Begin DoDot:1
+9 SET DA=ACHS
SET DIE="^ACHSF("
+10 SET DR="14.14///N"
+11 DO ^DIE
End DoDot:1
+12 QUIT
+13 ;
