- ACHS3120 ;IHS/OIT/FCJ - ACHS 3.1 PATCH 20 ;7/30/10 08:37
- ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**20**;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^ACHS3120")
- Q
- ;
- POST ;EP - From KIDS.
- ;
- ; --- Restore dd audit settings.
- S %="AUDR^ACHS3120"
- I $$NEWCP^XPDUTL("POS2-"_%,%)
- ; --- Send mail message of install.
- S %="MAIL^ACHS3120"
- I $$NEWCP^XPDUTL("POS3-"_%,%)
- ;
- Q
- MAIL ;
- D BMES^XPDUTL("BEGIN Delivering MailMan message to select users.")
- NEW DIFROM,XMSUB,XMDUZ,XMTEXT,XMY
- KILL ^TMP("ACHS3120",$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(""ACHS3120"",$J,",XMY(1)="",XMY(DUZ)=""
- F %="ACHSZMENU","XUMGR","XUPROG","XUPROGMODE" D SINGLE(%)
- D ^XMD
- KILL ^TMP("ACHS3120",$J)
- D MES^XPDUTL("END Delivering MailMan message to select users.")
- Q
- ;
- RSLT(%) S ^(0)=$G(^TMP("ACHS3120",$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*20".
- ;;
- ;;###;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("ACHS3120",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("ACHS3120",ACHS,"DDA")) S ^XTMP("ACHS3120",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("ACHS3120",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("ACHS3120",ACHS)) Q:'ACHS D
- . S ^DD(ACHS,0,"DDA")=^XTMP("ACHS3120",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("ACHS3120")
- D MES^XPDUTL("DD AUDIT settings restored.")
- Q
- ;
- 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
- +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^ACHS3120")
- +2 QUIT
- +3 ;
- POST ;EP - From KIDS.
- +1 ;
- +2 ; --- Restore dd audit settings.
- +3 SET %="AUDR^ACHS3120"
- +4 IF $$NEWCP^XPDUTL("POS2-"_%,%)
- +5 ; --- Send mail message of install.
- +6 SET %="MAIL^ACHS3120"
- +7 IF $$NEWCP^XPDUTL("POS3-"_%,%)
- +8 ;
- +9 QUIT
- MAIL ;
- +1 DO BMES^XPDUTL("BEGIN Delivering MailMan message to select users.")
- +2 NEW DIFROM,XMSUB,XMDUZ,XMTEXT,XMY
- +3 KILL ^TMP("ACHS3120",$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(""ACHS3120"",$J,"
- SET XMY(1)=""
- SET XMY(DUZ)=""
- +9 FOR %="ACHSZMENU","XUMGR","XUPROG","XUPROGMODE"
- DO SINGLE(%)
- +10 DO ^XMD
- +11 KILL ^TMP("ACHS3120",$JOB)
- +12 DO MES^XPDUTL("END Delivering MailMan message to select users.")
- +13 QUIT
- +14 ;
- RSLT(%) SET ^(0)=$GET(^TMP("ACHS3120",$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*20".
- +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("ACHS3120",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("ACHS3120",ACHS,"DDA"))
- SET ^XTMP("ACHS3120",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("ACHS3120",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("ACHS3120",ACHS))
- IF 'ACHS
- QUIT
- Begin DoDot:1
- +5 SET ^DD(ACHS,0,"DDA")=^XTMP("ACHS3120",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("ACHS3120")
- +9 DO MES^XPDUTL("DD AUDIT settings restored.")
- +10 QUIT
- +11 ;