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 Nov 22, 2024@17:00:23 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
