ACHS3127 ;IHS/OIT/FCJ - ACHS 3.1 PATCH 27 ;7/30/10 08:37
;;3.1;CONTRACT HEALTH MGMT SYSTEM;**27**;JUNE 11,2001;Build 43
;IHS/OIT/FCJ - COPY OF P25
;ENV CHECK TO ACHS31E1
;
PRE ;EP - From KIDS.
I $$NEWCP^XPDUTL("PRE1","AUDS^ACHS3127")
Q
;
POST ;EP - From KIDS.
;
;PATCH 21 AREA UPDATES
S %="P21^ACHS3127"
I $$NEWCP^XPDUTL("POS2-"_%,%)
;
;PATCH 22 NEW ICD9 REPORT MENU OPTION
S %="P22^ACHS3127"
I $$NEWCP^XPDUTL("POS3-"_%,%)
;
;PATCH 24 Set ICD10 Parameters
S %="P24^ACHS3127"
I $$NEWCP^XPDUTL("POS4-"_%,%)
;
;PATCH 25 Clean up the option
S %="P25^ACHS3127"
I $$NEWCP^XPDUTL("POS5-"_%,%)
;
;PATCH 26 New report options
S %="P26^ACHS3127"
I $$NEWCP^XPDUTL("POS6-"_%,%)
;
; --- Restore dd audit settings.
S %="AUDR^ACHS3127"
I $$NEWCP^XPDUTL("POS7-"_%,%)
;
; --- Send mail message of install.
S %="MAIL^ACHS3127"
I $$NEWCP^XPDUTL("POS8-"_%,%)
;
Q
MAIL ;
D BMES^XPDUTL("BEGIN Delivering MailMan message to select users.")
NEW DIFROM,XMSUB,XMDUZ,XMTEXT,XMY
KILL ^TMP("ACHS3127",$J)
D RSLT(" --- ACHS v 3.1 Patch 27, 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(""ACHS3127"",$J,",XMY(1)="",XMY(DUZ)=""
F %="ACHSZMENU","XUMGR","XUPROG","XUPROGMODE" D SINGLE(%)
D ^XMD
KILL ^TMP("ACHS3127",$J)
D MES^XPDUTL("END Delivering MailMan message to select users.")
Q
;
RSLT(%) S ^(0)=$G(^TMP("ACHS3127",$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 999-999-9999,
;;refer to patch "ACHS*3.1*27".
;;
;;###;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("ACHS3127",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("ACHS3127",ACHS,"DDA")) S ^XTMP("ACHS3127",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("ACHS3127",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("ACHS3127",ACHS)) Q:'ACHS D
. S ^DD(ACHS,0,"DDA")=^XTMP("ACHS3127",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("ACHS3127")
D MES^XPDUTL("DD AUDIT settings restored.")
Q
;
P21 ;PATCH 21
;REMOVE 2 SPLITOUT MENU OPT NOW COMBINED WITH THE PROCESSING OPTIONS
Q:$$INSTALLD^ACHS31E1("ACHS*3.1*21")
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
;
P22 ;PATCH 22
Q:$$INSTALLD^ACHS31E1("ACHS*3.1*22")
;ADD NEW OPTIONS - P22-ICD9 REPORT OPTION
D BMES^XPDUTL("Begin adding new option.")
I $$ADD^XPDMENU("ACHSREPORTS","ACHSRPTICDERROR","ICDR") D MES^XPDUTL($J("",5)_"Added ICD9 Report - to reports option")
D MES^XPDUTL("END updating options.")
;SET UP ICD GLOBALS
D SET^ACHSIC2
Q
;
P24 ;PATCH 24
Q:$$INSTALLD^ACHS31E1("ACHS*3.1*24")
;ADD ICD START DATE IN PARAMETERS
D BMES^XPDUTL("Checking/Updating ICD10 PARAMETERS.")
S L=0
F S L=$O(^ACHSF(L)) Q:L'?1N.N D
.S $P(^ACHSF(L,0),U,17,18)="3151001^3151001"
;
D MES^XPDUTL("END updating Parameters.")
K L
Q
;
P25 ;PATCH 25
Q:$$INSTALLD^ACHS31E1("ACHS*3.1*25")
Q:'$D(^DIC(19,"B","ACHS DEN REP-CARE NOT MED PRI"))
S L=0,L=$O(^DIC(19,"B","ACHS DEN REP-CARE NOT MED PRI",L))
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))=""
Q
P26 ;PATCH 26
Q:$$INSTALLD^ACHS31E1("ACHS*3.1*26")
;ADD NEW REPORT OPTIONS
D BMES^XPDUTL("Begin adding new option.")
I $$ADD^XPDMENU("ACHSREPORTS","ACHS MENU SPEC REPORTS","SPEC") D MES^XPDUTL($J("",5)_"Added Special Reports option")
I $$ADD^XPDMENU("ACHS MENU SPEC REPORTS","ACHSDOCSTATUSREPFY-FILE","DSFY") D MES^XPDUTL($J("",5)_"Added Document Status Report by FY with option to create file")
I $$ADD^XPDMENU("ACHS MENU SPEC REPORTS","ACHSDOCSTATUSREPFYTOT","DSFT") D MES^XPDUTL($J("",5)_"Added Document Status Report with totals by FY selected")
I $$ADD^XPDMENU("ACHS MENU SPEC REPORTS","ACHS REPORT DOS","DOSR") D MES^XPDUTL($J("",5)_"Added Report for Estimated and Actual DOS with issue date")
I $$ADD^XPDMENU("ACHS MENU SPEC REPORTS","ACHSDOCSTATUSSPLOC","DSSP") D MES^XPDUTL($J("",5)_"Added Document Status Report for Special local PO's")
I $$ADD^XPDMENU("ACHS MENU SPEC REPORTS","ACHSDOCSTATUSREPEOBR","DSEB") D MES^XPDUTL($J("",5)_"Added Document Status Report for Paid PO's with EOBR date")
I $$ADD^XPDMENU("ACHS MENU VENDOR REPORTS","ACHSVNDRUSAGE-SPECIFIC","VURS") D MES^XPDUTL($J("",5)_"Added Vendor Usage Report by Vendor with option to create file")
I $$ADD^XPDMENU("ACHS MENU VENDOR REPORTS","ACHSVNDRUSAGEFY","VFY") D MES^XPDUTL($J("",5)_"Added FY Vendor usage report by selected Vendor")
I $$ADD^XPDMENU("ACHS DEFDEN MENU DEN REPORTS","ACHS DEN PVDRLIST-SPECIFIED","PVDS") D MES^XPDUTL($J("",5)_"Added Denial Report by selected Vendor")
I $$ADD^XPDMENU("ACHSAD","ACHSDOCUMENTTRANS","TRD") D MES^XPDUTL($J("",5)_"Added Document Transaction report")
D MES^XPDUTL("END updating options.")
;ADD ENTRY TO ZISH PARAMETER FILE
S X="ACHS REPORTS",DIC="^%ZIB(9888888.93,",DIC(0)="L"
D ^DIC
I Y<0 W !,"ZISH SEND PARAMETER FOR THE ACHS UFMS ENTRY COULD NOT BE ADDED, YOU WILL NEED TO THROUGH FILEMAN" Q
S DA=+Y,DIE=DIC
S DR=".07////"_"B"_";.08////"_"sendto"
D ^DIE
K D,D0,D1,DI,DIADD,DIC,DICR,DIE,DLAYGO,DQ,DR,DINUM,DA
Q
ACHS3127 ;IHS/OIT/FCJ - ACHS 3.1 PATCH 27 ;7/30/10 08:37
+1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**27**;JUNE 11,2001;Build 43
+2 ;IHS/OIT/FCJ - COPY OF P25
+3 ;ENV CHECK TO ACHS31E1
+4 ;
PRE ;EP - From KIDS.
+1 IF $$NEWCP^XPDUTL("PRE1","AUDS^ACHS3127")
+2 QUIT
+3 ;
POST ;EP - From KIDS.
+1 ;
+2 ;PATCH 21 AREA UPDATES
+3 SET %="P21^ACHS3127"
+4 IF $$NEWCP^XPDUTL("POS2-"_%,%)
+5 ;
+6 ;PATCH 22 NEW ICD9 REPORT MENU OPTION
+7 SET %="P22^ACHS3127"
+8 IF $$NEWCP^XPDUTL("POS3-"_%,%)
+9 ;
+10 ;PATCH 24 Set ICD10 Parameters
+11 SET %="P24^ACHS3127"
+12 IF $$NEWCP^XPDUTL("POS4-"_%,%)
+13 ;
+14 ;PATCH 25 Clean up the option
+15 SET %="P25^ACHS3127"
+16 IF $$NEWCP^XPDUTL("POS5-"_%,%)
+17 ;
+18 ;PATCH 26 New report options
+19 SET %="P26^ACHS3127"
+20 IF $$NEWCP^XPDUTL("POS6-"_%,%)
+21 ;
+22 ; --- Restore dd audit settings.
+23 SET %="AUDR^ACHS3127"
+24 IF $$NEWCP^XPDUTL("POS7-"_%,%)
+25 ;
+26 ; --- Send mail message of install.
+27 SET %="MAIL^ACHS3127"
+28 IF $$NEWCP^XPDUTL("POS8-"_%,%)
+29 ;
+30 QUIT
MAIL ;
+1 DO BMES^XPDUTL("BEGIN Delivering MailMan message to select users.")
+2 NEW DIFROM,XMSUB,XMDUZ,XMTEXT,XMY
+3 KILL ^TMP("ACHS3127",$JOB)
+4 DO RSLT(" --- ACHS v 3.1 Patch 27, 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(""ACHS3127"",$J,"
SET XMY(1)=""
SET XMY(DUZ)=""
+9 FOR %="ACHSZMENU","XUMGR","XUPROG","XUPROGMODE"
DO SINGLE(%)
+10 DO ^XMD
+11 KILL ^TMP("ACHS3127",$JOB)
+12 DO MES^XPDUTL("END Delivering MailMan message to select users.")
+13 QUIT
+14 ;
RSLT(%) SET ^(0)=$GET(^TMP("ACHS3127",$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 999-999-9999,
+10 ;;refer to patch "ACHS*3.1*27".
+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("ACHS3127",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("ACHS3127",ACHS,"DDA"))
SET ^XTMP("ACHS3127",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("ACHS3127",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("ACHS3127",ACHS))
IF 'ACHS
QUIT
Begin DoDot:1
+5 SET ^DD(ACHS,0,"DDA")=^XTMP("ACHS3127",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("ACHS3127")
+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 IF $$INSTALLD^ACHS31E1("ACHS*3.1*21")
QUIT
+3 DO BMES^XPDUTL("Begin Removing split out options.")
+4 IF $$DELETE^XPDMENU("ACHSAREA","ACHSAREA SP/EX")
DO MES^XPDUTL($JUSTIFY("",5)_"Removed Option: Area CHS Splitout / Export To HAS/FI/CORE")
+5 IF $$DELETE^XPDMENU("ACHSAREAEOBRPROC","ACHSAREAEOBROUT")
DO MES^XPDUTL($JUSTIFY("",5)_"Remove Option: Area CHS Generate Facility EOBR Files")
+6 DO MES^XPDUTL("END updating options.")
+7 ;SET PRINT EOBR PARAMETER TO NO
+8 SET ACHS=0
+9 FOR
SET ACHS=$ORDER(^ACHSF("B",ACHS))
IF ACHS'?1N.N
QUIT
Begin DoDot:1
+10 SET DA=ACHS
SET DIE="^ACHSF("
+11 SET DR="14.14///N"
+12 DO ^DIE
End DoDot:1
+13 QUIT
+14 ;
P22 ;PATCH 22
+1 IF $$INSTALLD^ACHS31E1("ACHS*3.1*22")
QUIT
+2 ;ADD NEW OPTIONS - P22-ICD9 REPORT OPTION
+3 DO BMES^XPDUTL("Begin adding new option.")
+4 IF $$ADD^XPDMENU("ACHSREPORTS","ACHSRPTICDERROR","ICDR")
DO MES^XPDUTL($JUSTIFY("",5)_"Added ICD9 Report - to reports option")
+5 DO MES^XPDUTL("END updating options.")
+6 ;SET UP ICD GLOBALS
+7 DO SET^ACHSIC2
+8 QUIT
+9 ;
P24 ;PATCH 24
+1 IF $$INSTALLD^ACHS31E1("ACHS*3.1*24")
QUIT
+2 ;ADD ICD START DATE IN PARAMETERS
+3 DO BMES^XPDUTL("Checking/Updating ICD10 PARAMETERS.")
+4 SET L=0
+5 FOR
SET L=$ORDER(^ACHSF(L))
IF L'?1N.N
QUIT
Begin DoDot:1
+6 SET $PIECE(^ACHSF(L,0),U,17,18)="3151001^3151001"
End DoDot:1
+7 ;
+8 DO MES^XPDUTL("END updating Parameters.")
+9 KILL L
+10 QUIT
+11 ;
P25 ;PATCH 25
+1 IF $$INSTALLD^ACHS31E1("ACHS*3.1*25")
QUIT
+2 IF '$DATA(^DIC(19,"B","ACHS DEN REP-CARE NOT MED PRI"))
QUIT
+3 SET L=0
SET L=$ORDER(^DIC(19,"B","ACHS DEN REP-CARE NOT MED PRI",L))
+4 SET (^DIC(19,L,20),^DIC(19,L,60),^DIC(19,L,62),^DIC(19,L,63),^DIC(19,L,64),^DIC(19,L,69))=""
+5 QUIT
P26 ;PATCH 26
+1 IF $$INSTALLD^ACHS31E1("ACHS*3.1*26")
QUIT
+2 ;ADD NEW REPORT OPTIONS
+3 DO BMES^XPDUTL("Begin adding new option.")
+4 IF $$ADD^XPDMENU("ACHSREPORTS","ACHS MENU SPEC REPORTS","SPEC")
DO MES^XPDUTL($JUSTIFY("",5)_"Added Special Reports option")
+5 IF $$ADD^XPDMENU("ACHS MENU SPEC REPORTS","ACHSDOCSTATUSREPFY-FILE","DSFY")
DO MES^XPDUTL($JUSTIFY("",5)_"Added Document Status Report by FY with option to create file")
+6 IF $$ADD^XPDMENU("ACHS MENU SPEC REPORTS","ACHSDOCSTATUSREPFYTOT","DSFT")
DO MES^XPDUTL($JUSTIFY("",5)_"Added Document Status Report with totals by FY selected")
+7 IF $$ADD^XPDMENU("ACHS MENU SPEC REPORTS","ACHS REPORT DOS","DOSR")
DO MES^XPDUTL($JUSTIFY("",5)_"Added Report for Estimated and Actual DOS with issue date")
+8 IF $$ADD^XPDMENU("ACHS MENU SPEC REPORTS","ACHSDOCSTATUSSPLOC","DSSP")
DO MES^XPDUTL($JUSTIFY("",5)_"Added Document Status Report for Special local PO's")
+9 IF $$ADD^XPDMENU("ACHS MENU SPEC REPORTS","ACHSDOCSTATUSREPEOBR","DSEB")
DO MES^XPDUTL($JUSTIFY("",5)_"Added Document Status Report for Paid PO's with EOBR date")
+10 IF $$ADD^XPDMENU("ACHS MENU VENDOR REPORTS","ACHSVNDRUSAGE-SPECIFIC","VURS")
DO MES^XPDUTL($JUSTIFY("",5)_"Added Vendor Usage Report by Vendor with option to create file")
+11 IF $$ADD^XPDMENU("ACHS MENU VENDOR REPORTS","ACHSVNDRUSAGEFY","VFY")
DO MES^XPDUTL($JUSTIFY("",5)_"Added FY Vendor usage report by selected Vendor")
+12 IF $$ADD^XPDMENU("ACHS DEFDEN MENU DEN REPORTS","ACHS DEN PVDRLIST-SPECIFIED","PVDS")
DO MES^XPDUTL($JUSTIFY("",5)_"Added Denial Report by selected Vendor")
+13 IF $$ADD^XPDMENU("ACHSAD","ACHSDOCUMENTTRANS","TRD")
DO MES^XPDUTL($JUSTIFY("",5)_"Added Document Transaction report")
+14 DO MES^XPDUTL("END updating options.")
+15 ;ADD ENTRY TO ZISH PARAMETER FILE
+16 SET X="ACHS REPORTS"
SET DIC="^%ZIB(9888888.93,"
SET DIC(0)="L"
+17 DO ^DIC
+18 IF Y<0
WRITE !,"ZISH SEND PARAMETER FOR THE ACHS UFMS ENTRY COULD NOT BE ADDED, YOU WILL NEED TO THROUGH FILEMAN"
QUIT
+19 SET DA=+Y
SET DIE=DIC
+20 SET DR=".07////"_"B"_";.08////"_"sendto"
+21 DO ^DIE
+22 KILL D,D0,D1,DI,DIADD,DIC,DICR,DIE,DLAYGO,DQ,DR,DINUM,DA
+23 QUIT
