- ACHS3126 ;IHS/OIT/FCJ - ACHS 3.1 PATCH 26 ;7/30/10 08:37
- ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**26**;JUNE 11,2001;Build 37
- ;IHS/OIT/FCJ - COPY OF P25
- ;ENV CHECK TO ACHS31E1
- ;
- PRE ;EP - From KIDS.
- I $$NEWCP^XPDUTL("PRE1","AUDS^ACHS3126")
- Q
- ;
- POST ;EP - From KIDS.
- ;
- ;PATCH 21 AREA UPDATES
- S %="P21^ACHS3126"
- I $$NEWCP^XPDUTL("POS2-"_%,%)
- ;
- ;PATCH 22 NEW ICD9 REPORT MENU OPTION
- S %="P22^ACHS3126"
- I $$NEWCP^XPDUTL("POS3-"_%,%)
- ;
- ;PATCH 24 Set ICD10 Parameters
- S %="P24^ACHS3126"
- I $$NEWCP^XPDUTL("POS4-"_%,%)
- ;
- ;PATCH 25 Clean up the option
- S %="P25^ACHS3126"
- I $$NEWCP^XPDUTL("POS5-"_%,%)
- ;
- ;PATCH 26 New report options
- S %="P26^ACHS3126"
- I $$NEWCP^XPDUTL("POS6-"_%,%)
- ;
- ; --- Restore dd audit settings.
- S %="AUDR^ACHS3126"
- I $$NEWCP^XPDUTL("POS7-"_%,%)
- ;
- ; --- Send mail message of install.
- S %="MAIL^ACHS3126"
- I $$NEWCP^XPDUTL("POS8-"_%,%)
- ;
- Q
- MAIL ;
- D BMES^XPDUTL("BEGIN Delivering MailMan message to select users.")
- NEW DIFROM,XMSUB,XMDUZ,XMTEXT,XMY
- KILL ^TMP("ACHS3126",$J)
- D RSLT(" --- ACHS v 3.1 Patch 26, 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(""ACHS3126"",$J,",XMY(1)="",XMY(DUZ)=""
- F %="ACHSZMENU","XUMGR","XUPROG","XUPROGMODE" D SINGLE(%)
- D ^XMD
- KILL ^TMP("ACHS3126",$J)
- D MES^XPDUTL("END Delivering MailMan message to select users.")
- Q
- ;
- RSLT(%) S ^(0)=$G(^TMP("ACHS3126",$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*26".
- ;;
- ;;###;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("ACHS3126",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("ACHS3126",ACHS,"DDA")) S ^XTMP("ACHS3126",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("ACHS3126",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("ACHS3126",ACHS)) Q:'ACHS D
- . S ^DD(ACHS,0,"DDA")=^XTMP("ACHS3126",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("ACHS3126")
- 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
- ACHS3126 ;IHS/OIT/FCJ - ACHS 3.1 PATCH 26 ;7/30/10 08:37
- +1 ;;3.1;CONTRACT HEALTH MGMT SYSTEM;**26**;JUNE 11,2001;Build 37
- +2 ;IHS/OIT/FCJ - COPY OF P25
- +3 ;ENV CHECK TO ACHS31E1
- +4 ;
- PRE ;EP - From KIDS.
- +1 IF $$NEWCP^XPDUTL("PRE1","AUDS^ACHS3126")
- +2 QUIT
- +3 ;
- POST ;EP - From KIDS.
- +1 ;
- +2 ;PATCH 21 AREA UPDATES
- +3 SET %="P21^ACHS3126"
- +4 IF $$NEWCP^XPDUTL("POS2-"_%,%)
- +5 ;
- +6 ;PATCH 22 NEW ICD9 REPORT MENU OPTION
- +7 SET %="P22^ACHS3126"
- +8 IF $$NEWCP^XPDUTL("POS3-"_%,%)
- +9 ;
- +10 ;PATCH 24 Set ICD10 Parameters
- +11 SET %="P24^ACHS3126"
- +12 IF $$NEWCP^XPDUTL("POS4-"_%,%)
- +13 ;
- +14 ;PATCH 25 Clean up the option
- +15 SET %="P25^ACHS3126"
- +16 IF $$NEWCP^XPDUTL("POS5-"_%,%)
- +17 ;
- +18 ;PATCH 26 New report options
- +19 SET %="P26^ACHS3126"
- +20 IF $$NEWCP^XPDUTL("POS6-"_%,%)
- +21 ;
- +22 ; --- Restore dd audit settings.
- +23 SET %="AUDR^ACHS3126"
- +24 IF $$NEWCP^XPDUTL("POS7-"_%,%)
- +25 ;
- +26 ; --- Send mail message of install.
- +27 SET %="MAIL^ACHS3126"
- +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("ACHS3126",$JOB)
- +4 DO RSLT(" --- ACHS v 3.1 Patch 26, 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(""ACHS3126"",$J,"
- SET XMY(1)=""
- SET XMY(DUZ)=""
- +9 FOR %="ACHSZMENU","XUMGR","XUPROG","XUPROGMODE"
- DO SINGLE(%)
- +10 DO ^XMD
- +11 KILL ^TMP("ACHS3126",$JOB)
- +12 DO MES^XPDUTL("END Delivering MailMan message to select users.")
- +13 QUIT
- +14 ;
- RSLT(%) SET ^(0)=$GET(^TMP("ACHS3126",$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*26".
- +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("ACHS3126",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("ACHS3126",ACHS,"DDA"))
- SET ^XTMP("ACHS3126",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("ACHS3126",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("ACHS3126",ACHS))
- IF 'ACHS
- QUIT
- Begin DoDot:1
- +5 SET ^DD(ACHS,0,"DDA")=^XTMP("ACHS3126",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("ACHS3126")
- +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
