ECX3P144 ;ALB/DAN - DSS FY2014 Conversion, Post-init ;8/16/13  10:07
 ;;3.0;DSS EXTRACTS;**144**;Dec 22, 1997;Build 9
PRETRAN ;Loads gold 4 char codes into KIDS build
 M @XPDGREF@("ECX4CHAR")=^XTMP("ECX4CHAR")
 Q
 ;
POST ;Post-install items
 N UPDATE
 D TEST ;Set testing site information
 D CLEAN ;Delete values no longer needed
 D UPDATEDD("O") ;allow editing of fields during post install
 D LOADG4CH ;Load gold 4 char codes into XTMP
 I +$G(XPDQUIT) Q  ;abort installation if error loading gold codes
 D UPDCODES ;Compare gold codes to site change as needed
 D UPDATEDD("C") ;put restrictions back on file
 D MAIL ;send mail to holders of ECXMGR
 D MENU ;add new transmission menu option, update order and titles
 Q
 ;
TEST ;turn-on fld #73 in file #728 for Field Test Site;
 ;allows use of option ECX FISCAL YEAR EXTRACT by test sites;
 D MES^XPDUTL(" ")
 D MES^XPDUTL("Providing special menu option access for DSS FY Conversion test sites.")
 D TESTON^ECXTREX(XPDNM,"FY2014")
 D MES^XPDUTL(" ")
 ;if this is the national released version, then fld #73 will be turned-off
 ;the first time any user attempts to use ECX FISCAL YEAR EXTRACT option
 Q
 ;
CLEAN ;Delete dates from the last date clinic visits and last date clinic II fields
 ;Delete the CLINIC and CLINIC II fields so the "running" flag is removed
 N DIE,DA,IEN
 D BMES^XPDUTL("Clearing Last Date Clinic II and Last Date Clinic Visit fields.")
 D BMES^XPDUTL("Clearing CLINIC and CLINIC II fields.")
 S IEN=0 F  S IEN=$O(^ECX(728,IEN)) Q:'+IEN  D
 .S DIE="^ECX(728,",DA=IEN,DR="17///@;65///@;32///@;66///@"
 .D ^DIE
 D BMES^XPDUTL("Last Date Clinic II and Last Date Clinic Visit fields cleared.")
 D BMES^XPDUTL("CLINIC and CLINIC II fields cleared.")
 Q
 ;
LOADG4CH ;Put gold codes in local XTMP
 K ^XTMP("ECX4CHAR")
 M ^XTMP("ECX4CHAR")=@XPDGREF@("ECX4CHAR")
 I '$D(^XTMP("ECX4CHAR")) D BMES^XPDUTL("Gold code table not loaded - INSTALLATION ABORTED") S XPDQUIT=2 Q
 Q
 ;
UPDATEDD(TYPE) ;Update DD for 728.441 to either unrestrict edits or restrict edits
 N I
 I TYPE="C" D  ;restrict file
 .S ^DD(728.441,.01,7.5)="I $G(DIC(0))[""L"",'$D(ECX4CHAR) D EN^DDIOL(""Entries can only be added by CHAR4 Council."","""",""!?5"") K X"
 .F I=.01,1,3 I $P(^DD(728.441,I,0),U,2)'["I" S $P(^DD(728.441,I,0),U,2)=$P(^DD(728.441,I,0),U,2)_"I" ;Makes all fields uneditable
 I TYPE="O" D  ;remove restrictions
 .K ^DD(728.441,.01,7.5)
 .F I=.01,1,3 S $P(^DD(728.441,I,0),U,2)=$TR($P(^DD(728.441,I,0),U,2),"I","")
 Q
 ;
UPDCODES ;Compare gold to existing and edit as needed
 N GOLD,LINE,CODE,DIE,DA,DR,DIC,IEN,X,Y
 ;Check "gold" file against existing and add new entries or update differences
 S CODE=0 F  S CODE=$O(^XTMP("ECX4CHAR",CODE)) Q:CODE=""  D
 .S GOLD=^XTMP("ECX4CHAR",CODE)
 .I '$D(^ECX(728.441,"B",CODE)) D  Q  ;Entry not found in site file, add it
 ..S DIC=728.441,DIC(0)="LX",X=CODE,DIC("DR")="1////"_$P(GOLD,U) D ^DIC
 ..I Y=-1!('+$P(Y,U,3)) S UPDATE("NA",CODE)="" ;Entry failed to be added to system, will report in findings
 ..S UPDATE("N",CODE)=$P(GOLD,U) ;new entry added
 .I $D(^ECX(728.441,"B",CODE)) S IEN=$O(^ECX(728.441,"B",CODE,0)) S LINE=^ECX(728.441,IEN,0) D
 ..I $P(LINE,U,2)'=$P(GOLD,U) S $P(^ECX(728.441,IEN,0),U,2)=$P(GOLD,U) S UPDATE("U",CODE)=$P(LINE,U,2)_"^"_$P(GOLD,U) ;Update short description if it doesn't match
 ;Check for entries in local site that aren't in gold and inactivate
 S CODE="" F  S CODE=$O(^ECX(728.441,"B",CODE)) Q:CODE=""  D
 .I $D(^XTMP("ECX4CHAR",CODE)) Q  ;Code is in gold, no update needed
 .S IEN=$O(^ECX(728.441,"B",CODE,0)) Q:'+IEN  ;Can't get IEN for record
 .S DIE="^ECX(728.441,",DA=IEN,DR="3////"_$S(DT'<3131031:3131101,1:DT) D ^DIE
 .S UPDATE("I",CODE)="" ;Note inactivated entry
 Q
 ;
MAIL ;Send email with results to holders of the ECXMGR key
 N XMSUB,XMTEXT,XMDUZ,XMY,XMZ,CNT,DIFROM,ECXTEXT
 S XMDUZ="PATCH ECX*3*144 POST-INSTALL"
 D GETXMY("ECXMGR",.XMY)
 S ECXTEXT(1)="The update to the NATIONAL CLINIC file (#728.441), commonly referred to as",ECXTEXT(2)="the 4CHAR code, has completed.  Below are the results."
 S ECXTEXT(3)=""
 I '$D(UPDATE) S ECXTEXT(4)="No updates to your file were necessary.  No further action is required."
 S CNT=4 ;start with line 4 to add to message
 I $D(UPDATE("N")) D  S ECXTEXT(CNT)="",CNT=CNT+1 ;Report entries that were added
 .S ECXTEXT(CNT)="The following entries were added to your system:",CNT=CNT+1,ECXTEXT(CNT)=$$REPEAT^XLFSTR("-",79),CNT=CNT+1,ECXTEXT(CNT)="",CNT=CNT+1
 .S CODE="" F  S CODE=$O(UPDATE("N",CODE)) Q:CODE=""  S ECXTEXT(CNT)=CODE_" - "_UPDATE("N",CODE),CNT=CNT+1
 I $D(UPDATE("U")) D  S ECXTEXT(CNT)="",CNT=CNT+1 ;Report entries that were updated
 .S ECXTEXT(CNT)="The following entries had their short description updated:",CNT=CNT+1,ECXTEXT(CNT)=$$REPEAT^XLFSTR("-",79),CNT=CNT+1,ECXTEXT(CNT)="",CNT=CNT+1
 .S CODE="" F  S CODE=$O(UPDATE("U",CODE)) Q:CODE=""  S ECXTEXT(CNT)="CODE: "_CODE_" from "_$P(UPDATE("U",CODE),U)_" to "_$P(UPDATE("U",CODE),U,2) S CNT=CNT+1
 I $D(UPDATE("I")) D  S ECXTEXT(CNT)="",CNT=CNT+1 ;Report entries that were inactivated
 .S ECXTEXT(CNT)="The following entries were inactivated with a date of "_$$FMTE^XLFDT($S(DT'<3131031:3131101,1:DT))_" and will no",CNT=CNT+1,ECXTEXT(CNT)="longer be available for use after that date:",CNT=CNT+1
 .S ECXTEXT(CNT)=$$REPEAT^XLFSTR("-",79),CNT=CNT+1,ECXTEXT(CNT)="",CNT=CNT+1
 .S CODE="" F  S CODE=$O(UPDATE("I",CODE)) Q:CODE=""  S ECXTEXT(CNT)=CODE,CNT=CNT+1
 I $D(UPDATE("NA")) D  ;Report any codes that couldn't be added
 .S ECXTEXT(CNT)="The following entries could NOT be added to your system.  Please log a remedy",CNT=CNT+1,ECXTEXT(CNT)="ticket for assistance with adding these codes.",CNT=CNT+1
 .S ECXTEXT(CNT)=$$REPEAT^XLFSTR("-",79),CNT=CNT+1,ECXTEXT(CNT)="",CNT=CNT+1
 .S CODE="" F  S CODE=$O(UPDATE("NA",CODE)) Q:CODE=""  S ECXTEXT(CNT)=CODE
 S XMTEXT="ECXTEXT(",XMSUB="National Clinic file (#728.441) standardization"
 D ^XMD
 ;
GETXMY(KEY,XMY) ;Put holders of the KEY into the XMY array to be recipients of the email
 I $G(KEY)'="" M XMY=^XUSEC(KEY)
 S:$G(DUZ) XMY(DUZ)="" ;Make sure there's at least one recipient
 Q
 ;Add new option and update order of options for pharmacy maintenance menu
 N MENU,DA,CHECK,ECXMSG
 S MENU=""
 S ECXMSG(1)=" "
 S ECXMSG(2)="** Looking for PURGE DATA FROM EXTRACT FILES menu **"
 S ECXMSG(3)="     If found, title will be updated  "
 D MES^XPDUTL(.ECXMSG)
 ;Order thru option file and find ECXPURG and retrieve IEN
 S MENU=$O(^DIC(19,"B","ECXPURG",MENU))
 I 'MENU D BMES^XPDUTL("** ECXPURG item not found **")
 I MENU D
 .S DR="1///Purge Extract Holding Files",DIE="^DIC(19,",DA=MENU D ^DIE
 .K ECXMSG
 .S ECXMSG(1)=" "
 .S ECXMSG(2)="*** PURGE DATA FROM EXTRACT FILES menu has been updated.. ***"
 .D MES^XPDUTL(.ECXMSG)
 ;add new menu option to ECX TRANSMISSION
 S CHECK=$$ADD^XPDMENU("ECX TRANSMISSION","ECXDELEF","D")
 D BMES^XPDUTL("ECXDELEF option "_$S('+$G(CHECK):"NOT ",1:"")_"added to menu ECX TRANSMISSION")
 D BMES^XPDUTL("Updating ECX TRANSMISSION menu display order...")
 S DA=$$ADD^XPDMENU("ECX TRANSMISSION","ECX EXTRACT LOG REVIEW",,5)
 S DA=$$ADD^XPDMENU("ECX TRANSMISSION","ECXTRANS",,10)
 S DA=$$ADD^XPDMENU("ECX TRANSMISSION","ECX EXTRACT LOG SUMMARY",,15)
 S DA=$$ADD^XPDMENU("ECX TRANSMISSION","ECXDELEF",,20)
 S DA=$$ADD^XPDMENU("ECX TRANSMISSION","ECXPURG",,25)
 S DA=$$ADD^XPDMENU("ECX TRANSMISSION","ECXRXHF",,30)
 D MES^XPDUTL("Display order updated")
 D BMES^XPDUTL("Removing 'DISPLAY OPTION' setting from ECX CLN STOP REP option")
 S MENU=$O(^DIC(19,"B","ECX CLN STOP REP",0))
 I MENU S DR="11///@",DIE="^DIC(19,",DA=MENU D ^DIE
 D BMES^XPDUTL("Moving routine information from ENTRY ACTION to ROUTINE field") D MES^XPDUTL("for option ECX STOP CODE VALIDITY")
 S MENU=$O(^DIC(19,"B","ECX STOP CODE VALIDITY",0))
 I MENU S DR="20///@;25///EN^ECXSCX3" S DA=MENU,DIE="^DIC(19," D ^DIE
 D BMES^XPDUTL("Updating Pharmacy Maintenance Menu")
 S CHECK=$$ADD^XPDMENU("ECX PHARMACY MAINTENANCE","ECX PHA COST",3)
 D BMES^XPDUTL("ECX PHA COST option "_$S('+$G(CHECK):"NOT ",1:"")_"added to menu ECX PHARMACY MAINTENACE")
 S DA=$$ADD^XPDMENU("ECX PHARMACY MAINTENANCE","ECX PHA VOL",4)
 S DA=$$ADD^XPDMENU("ECX PHARMACY MAINTENANCE","ECX PHA UDP/IVP SOURCE AUDIT",5)
 D BMES^XPDUTL("Option order updated on the ECX PHARMACY MAINTENANCE menu")
 Q
 
--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECX3P144   8600     printed  Sep 23, 2025@19:26:15                                                                                                                                                                                                    Page 2
ECX3P144  ;ALB/DAN - DSS FY2014 Conversion, Post-init ;8/16/13  10:07
 +1       ;;3.0;DSS EXTRACTS;**144**;Dec 22, 1997;Build 9
PRETRAN   ;Loads gold 4 char codes into KIDS build
 +1        MERGE @XPDGREF@("ECX4CHAR")=^XTMP("ECX4CHAR")
 +2        QUIT 
 +3       ;
POST      ;Post-install items
 +1        NEW UPDATE
 +2       ;Set testing site information
           DO TEST
 +3       ;Delete values no longer needed
           DO CLEAN
 +4       ;allow editing of fields during post install
           DO UPDATEDD("O")
 +5       ;Load gold 4 char codes into XTMP
           DO LOADG4CH
 +6       ;abort installation if error loading gold codes
           IF +$GET(XPDQUIT)
               QUIT 
 +7       ;Compare gold codes to site change as needed
           DO UPDCODES
 +8       ;put restrictions back on file
           DO UPDATEDD("C")
 +9       ;send mail to holders of ECXMGR
           DO MAIL
 +10      ;add new transmission menu option, update order and titles
           DO MENU
 +11       QUIT 
 +12      ;
TEST      ;turn-on fld #73 in file #728 for Field Test Site;
 +1       ;allows use of option ECX FISCAL YEAR EXTRACT by test sites;
 +2        DO MES^XPDUTL(" ")
 +3        DO MES^XPDUTL("Providing special menu option access for DSS FY Conversion test sites.")
 +4        DO TESTON^ECXTREX(XPDNM,"FY2014")
 +5        DO MES^XPDUTL(" ")
 +6       ;if this is the national released version, then fld #73 will be turned-off
 +7       ;the first time any user attempts to use ECX FISCAL YEAR EXTRACT option
 +8        QUIT 
 +9       ;
CLEAN     ;Delete dates from the last date clinic visits and last date clinic II fields
 +1       ;Delete the CLINIC and CLINIC II fields so the "running" flag is removed
 +2        NEW DIE,DA,IEN
 +3        DO BMES^XPDUTL("Clearing Last Date Clinic II and Last Date Clinic Visit fields.")
 +4        DO BMES^XPDUTL("Clearing CLINIC and CLINIC II fields.")
 +5        SET IEN=0
           FOR 
               SET IEN=$ORDER(^ECX(728,IEN))
               if '+IEN
                   QUIT 
               Begin DoDot:1
 +6                SET DIE="^ECX(728,"
                   SET DA=IEN
                   SET DR="17///@;65///@;32///@;66///@"
 +7                DO ^DIE
               End DoDot:1
 +8        DO BMES^XPDUTL("Last Date Clinic II and Last Date Clinic Visit fields cleared.")
 +9        DO BMES^XPDUTL("CLINIC and CLINIC II fields cleared.")
 +10       QUIT 
 +11      ;
LOADG4CH  ;Put gold codes in local XTMP
 +1        KILL ^XTMP("ECX4CHAR")
 +2        MERGE ^XTMP("ECX4CHAR")=@XPDGREF@("ECX4CHAR")
 +3        IF '$DATA(^XTMP("ECX4CHAR"))
               DO BMES^XPDUTL("Gold code table not loaded - INSTALLATION ABORTED")
               SET XPDQUIT=2
               QUIT 
 +4        QUIT 
 +5       ;
UPDATEDD(TYPE) ;Update DD for 728.441 to either unrestrict edits or restrict edits
 +1        NEW I
 +2       ;restrict file
           IF TYPE="C"
               Begin DoDot:1
 +3                SET ^DD(728.441,.01,7.5)="I $G(DIC(0))[""L"",'$D(ECX4CHAR) D EN^DDIOL(""Entries can only be added by CHAR4 Council."","""",""!?5"") K X"
 +4       ;Makes all fields uneditable
                   FOR I=.01,1,3
                       IF $PIECE(^DD(728.441,I,0),U,2)'["I"
                           SET $PIECE(^DD(728.441,I,0),U,2)=$PIECE(^DD(728.441,I,0),U,2)_"I"
               End DoDot:1
 +5       ;remove restrictions
           IF TYPE="O"
               Begin DoDot:1
 +6                KILL ^DD(728.441,.01,7.5)
 +7                FOR I=.01,1,3
                       SET $PIECE(^DD(728.441,I,0),U,2)=$TRANSLATE($PIECE(^DD(728.441,I,0),U,2),"I","")
               End DoDot:1
 +8        QUIT 
 +9       ;
UPDCODES  ;Compare gold to existing and edit as needed
 +1        NEW GOLD,LINE,CODE,DIE,DA,DR,DIC,IEN,X,Y
 +2       ;Check "gold" file against existing and add new entries or update differences
 +3        SET CODE=0
           FOR 
               SET CODE=$ORDER(^XTMP("ECX4CHAR",CODE))
               if CODE=""
                   QUIT 
               Begin DoDot:1
 +4                SET GOLD=^XTMP("ECX4CHAR",CODE)
 +5       ;Entry not found in site file, add it
                   IF '$DATA(^ECX(728.441,"B",CODE))
                       Begin DoDot:2
 +6                        SET DIC=728.441
                           SET DIC(0)="LX"
                           SET X=CODE
                           SET DIC("DR")="1////"_$PIECE(GOLD,U)
                           DO ^DIC
 +7       ;Entry failed to be added to system, will report in findings
                           IF Y=-1!('+$PIECE(Y,U,3))
                               SET UPDATE("NA",CODE)=""
 +8       ;new entry added
                           SET UPDATE("N",CODE)=$PIECE(GOLD,U)
                       End DoDot:2
                       QUIT 
 +9                IF $DATA(^ECX(728.441,"B",CODE))
                       SET IEN=$ORDER(^ECX(728.441,"B",CODE,0))
                       SET LINE=^ECX(728.441,IEN,0)
                       Begin DoDot:2
 +10      ;Update short description if it doesn't match
                           IF $PIECE(LINE,U,2)'=$PIECE(GOLD,U)
                               SET $PIECE(^ECX(728.441,IEN,0),U,2)=$PIECE(GOLD,U)
                               SET UPDATE("U",CODE)=$PIECE(LINE,U,2)_"^"_$PIECE(GOLD,U)
                       End DoDot:2
               End DoDot:1
 +11      ;Check for entries in local site that aren't in gold and inactivate
 +12       SET CODE=""
           FOR 
               SET CODE=$ORDER(^ECX(728.441,"B",CODE))
               if CODE=""
                   QUIT 
               Begin DoDot:1
 +13      ;Code is in gold, no update needed
                   IF $DATA(^XTMP("ECX4CHAR",CODE))
                       QUIT 
 +14      ;Can't get IEN for record
                   SET IEN=$ORDER(^ECX(728.441,"B",CODE,0))
                   if '+IEN
                       QUIT 
 +15               SET DIE="^ECX(728.441,"
                   SET DA=IEN
                   SET DR="3////"_$SELECT(DT'<3131031:3131101,1:DT)
                   DO ^DIE
 +16      ;Note inactivated entry
                   SET UPDATE("I",CODE)=""
               End DoDot:1
 +17       QUIT 
 +18      ;
MAIL      ;Send email with results to holders of the ECXMGR key
 +1        NEW XMSUB,XMTEXT,XMDUZ,XMY,XMZ,CNT,DIFROM,ECXTEXT
 +2        SET XMDUZ="PATCH ECX*3*144 POST-INSTALL"
 +3        DO GETXMY("ECXMGR",.XMY)
 +4        SET ECXTEXT(1)="The update to the NATIONAL CLINIC file (#728.441), commonly referred to as"
           SET ECXTEXT(2)="the 4CHAR code, has completed.  Below are the results."
 +5        SET ECXTEXT(3)=""
 +6        IF '$DATA(UPDATE)
               SET ECXTEXT(4)="No updates to your file were necessary.  No further action is required."
 +7       ;start with line 4 to add to message
           SET CNT=4
 +8       ;Report entries that were added
           IF $DATA(UPDATE("N"))
               Begin DoDot:1
 +9                SET ECXTEXT(CNT)="The following entries were added to your system:"
                   SET CNT=CNT+1
                   SET ECXTEXT(CNT)=$$REPEAT^XLFSTR("-",79)
                   SET CNT=CNT+1
                   SET ECXTEXT(CNT)=""
                   SET CNT=CNT+1
 +10               SET CODE=""
                   FOR 
                       SET CODE=$ORDER(UPDATE("N",CODE))
                       if CODE=""
                           QUIT 
                       SET ECXTEXT(CNT)=CODE_" - "_UPDATE("N",CODE)
                       SET CNT=CNT+1
               End DoDot:1
               SET ECXTEXT(CNT)=""
               SET CNT=CNT+1
 +11      ;Report entries that were updated
           IF $DATA(UPDATE("U"))
               Begin DoDot:1
 +12               SET ECXTEXT(CNT)="The following entries had their short description updated:"
                   SET CNT=CNT+1
                   SET ECXTEXT(CNT)=$$REPEAT^XLFSTR("-",79)
                   SET CNT=CNT+1
                   SET ECXTEXT(CNT)=""
                   SET CNT=CNT+1
 +13               SET CODE=""
                   FOR 
                       SET CODE=$ORDER(UPDATE("U",CODE))
                       if CODE=""
                           QUIT 
                       SET ECXTEXT(CNT)="CODE: "_CODE_" from "_$PIECE(UPDATE("U",CODE),U)_" to "_$PIECE(UPDATE("U",CODE),U,2)
                       SET CNT=CNT+1
               End DoDot:1
               SET ECXTEXT(CNT)=""
               SET CNT=CNT+1
 +14      ;Report entries that were inactivated
           IF $DATA(UPDATE("I"))
               Begin DoDot:1
 +15               SET ECXTEXT(CNT)="The following entries were inactivated with a date of "_$$FMTE^XLFDT($SELECT(DT'<3131031:3131101,1:DT))_" and will no"
                   SET CNT=CNT+1
                   SET ECXTEXT(CNT)="longer be available for use after that date:"
                   SET CNT=CNT+1
 +16               SET ECXTEXT(CNT)=$$REPEAT^XLFSTR("-",79)
                   SET CNT=CNT+1
                   SET ECXTEXT(CNT)=""
                   SET CNT=CNT+1
 +17               SET CODE=""
                   FOR 
                       SET CODE=$ORDER(UPDATE("I",CODE))
                       if CODE=""
                           QUIT 
                       SET ECXTEXT(CNT)=CODE
                       SET CNT=CNT+1
               End DoDot:1
               SET ECXTEXT(CNT)=""
               SET CNT=CNT+1
 +18      ;Report any codes that couldn't be added
           IF $DATA(UPDATE("NA"))
               Begin DoDot:1
 +19               SET ECXTEXT(CNT)="The following entries could NOT be added to your system.  Please log a remedy"
                   SET CNT=CNT+1
                   SET ECXTEXT(CNT)="ticket for assistance with adding these codes."
                   SET CNT=CNT+1
 +20               SET ECXTEXT(CNT)=$$REPEAT^XLFSTR("-",79)
                   SET CNT=CNT+1
                   SET ECXTEXT(CNT)=""
                   SET CNT=CNT+1
 +21               SET CODE=""
                   FOR 
                       SET CODE=$ORDER(UPDATE("NA",CODE))
                       if CODE=""
                           QUIT 
                       SET ECXTEXT(CNT)=CODE
               End DoDot:1
 +22       SET XMTEXT="ECXTEXT("
           SET XMSUB="National Clinic file (#728.441) standardization"
 +23       DO ^XMD
 +24      ;
GETXMY(KEY,XMY) ;Put holders of the KEY into the XMY array to be recipients of the email
 +1        IF $GET(KEY)'=""
               MERGE XMY=^XUSEC(KEY)
 +2       ;Make sure there's at least one recipient
           if $GET(DUZ)
               SET XMY(DUZ)=""
 +3        QUIT 
 +1       ;Add new option and update order of options for pharmacy maintenance menu
 +2        NEW MENU,DA,CHECK,ECXMSG
 +3        SET MENU=""
 +4        SET ECXMSG(1)=" "
 +5        SET ECXMSG(2)="** Looking for PURGE DATA FROM EXTRACT FILES menu **"
 +6        SET ECXMSG(3)="     If found, title will be updated  "
 +7        DO MES^XPDUTL(.ECXMSG)
 +8       ;Order thru option file and find ECXPURG and retrieve IEN
 +9        SET MENU=$ORDER(^DIC(19,"B","ECXPURG",MENU))
 +10       IF 'MENU
               DO BMES^XPDUTL("** ECXPURG item not found **")
 +11       IF MENU
               Begin DoDot:1
 +12               SET DR="1///Purge Extract Holding Files"
                   SET DIE="^DIC(19,"
                   SET DA=MENU
                   DO ^DIE
 +13               KILL ECXMSG
 +14               SET ECXMSG(1)=" "
 +15               SET ECXMSG(2)="*** PURGE DATA FROM EXTRACT FILES menu has been updated.. ***"
 +16               DO MES^XPDUTL(.ECXMSG)
               End DoDot:1
 +17      ;add new menu option to ECX TRANSMISSION
 +18       SET CHECK=$$ADD^XPDMENU("ECX TRANSMISSION","ECXDELEF","D")
 +19       DO BMES^XPDUTL("ECXDELEF option "_$SELECT('+$GET(CHECK):"NOT ",1:"")_"added to menu ECX TRANSMISSION")
 +20       DO BMES^XPDUTL("Updating ECX TRANSMISSION menu display order...")
 +21       SET DA=$$ADD^XPDMENU("ECX TRANSMISSION","ECX EXTRACT LOG REVIEW",,5)
 +22       SET DA=$$ADD^XPDMENU("ECX TRANSMISSION","ECXTRANS",,10)
 +23       SET DA=$$ADD^XPDMENU("ECX TRANSMISSION","ECX EXTRACT LOG SUMMARY",,15)
 +24       SET DA=$$ADD^XPDMENU("ECX TRANSMISSION","ECXDELEF",,20)
 +25       SET DA=$$ADD^XPDMENU("ECX TRANSMISSION","ECXPURG",,25)
 +26       SET DA=$$ADD^XPDMENU("ECX TRANSMISSION","ECXRXHF",,30)
 +27       DO MES^XPDUTL("Display order updated")
 +28       DO BMES^XPDUTL("Removing 'DISPLAY OPTION' setting from ECX CLN STOP REP option")
 +29       SET MENU=$ORDER(^DIC(19,"B","ECX CLN STOP REP",0))
 +30       IF MENU
               SET DR="11///@"
               SET DIE="^DIC(19,"
               SET DA=MENU
               DO ^DIE
 +31       DO BMES^XPDUTL("Moving routine information from ENTRY ACTION to ROUTINE field")
           DO MES^XPDUTL("for option ECX STOP CODE VALIDITY")
 +32       SET MENU=$ORDER(^DIC(19,"B","ECX STOP CODE VALIDITY",0))
 +33       IF MENU
               SET DR="20///@;25///EN^ECXSCX3"
               SET DA=MENU
               SET DIE="^DIC(19,"
               DO ^DIE
 +34       DO BMES^XPDUTL("Updating Pharmacy Maintenance Menu")
 +35       SET CHECK=$$ADD^XPDMENU("ECX PHARMACY MAINTENANCE","ECX PHA COST",3)
 +36       DO BMES^XPDUTL("ECX PHA COST option "_$SELECT('+$GET(CHECK):"NOT ",1:"")_"added to menu ECX PHARMACY MAINTENACE")
 +37       SET DA=$$ADD^XPDMENU("ECX PHARMACY MAINTENANCE","ECX PHA VOL",4)
 +38       SET DA=$$ADD^XPDMENU("ECX PHARMACY MAINTENANCE","ECX PHA UDP/IVP SOURCE AUDIT",5)
 +39       DO BMES^XPDUTL("Option order updated on the ECX PHARMACY MAINTENANCE menu")
 +40       QUIT