ECX3P149 ;ALB/DAN - DSS FY2015 Conversion, Post-init ;7/29/14 09:57
;;3.0;DSS EXTRACTS;**149**;Dec 22, 1997;Build 27
;
POST ;Post-install items
D TEST ;Set testing site information
D MENU ;update menus
D FIXBBC ;Fix blood bank "C" xref
D INACT ;Inactivate Nutrition (NUT) in extract file definitions 727.1
D UPDATE ;Update routine for blood bank extract
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,"FY2015")
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
;
N DA,DIE,DR,MENU,OPTION,CHECK,IEN
D BMES^XPDUTL("Updating option ECX NATIONAL CLINIC...")
S DA=$$LKOPT^XPDMENU("ECX NATIONAL CLINIC")
I 'DA D MES^XPDUTL("Update failed - contact product support for assistance!")
S DIE="^DIC(19,",DR="4///R;25///ECXNCL;60///@;62///@;63///@;64///@"
D ^DIE
D MES^XPDUTL("Update successful.")
S OPTION="ECXNUT",MENU="ECXMENU"
S CHECK=$$DELETE^XPDMENU(MENU,OPTION)
D BMES^XPDUTL(">>> "_OPTION_" OPTION "_$S(CHECK:"REMOVED FROM ",1:"DOES NOT EXIST IN ")_MENU_" <<<")
D OUT^XPDMENU(OPTION,"OUT OF ORDER, DO NOT USE THIS OPTION!!!")
D BMES^XPDUTL(">>> "_OPTION_" OPTION PLACED OUT ORDER <<<")
S OPTION="ECX NUTRITION WORKSHEETS",MENU="ECX MAINTENANCE"
S CHECK=$$DELETE^XPDMENU(MENU,OPTION)
D BMES^XPDUTL(">>> "_OPTION_" OPTION "_$S(CHECK:"REMOVED FROM ",1:"DOES NOT EXIST IN ")_MENU_" <<<")
D OUT^XPDMENU(OPTION,"OUT OF ORDER, DO NOT USE THIS OPTION!!!")
D BMES^XPDUTL(">>> "_OPTION_" OPTION PLACED OUT ORDER <<<")
S OPTION="ECX NUT SOURCE AUDIT",MENU="ECX SOURCE AUDITS"
S CHECK=$$DELETE^XPDMENU(MENU,OPTION)
D BMES^XPDUTL(">>> "_OPTION_" OPTION "_$S(CHECK:"REMOVED FROM ",1:"DOES NOT EXIST IN ")_MENU_" <<<")
D OUT^XPDMENU(OPTION,"OUT OF ORDER, DO NOT USE THIS OPTION!!!")
D BMES^XPDUTL(">>> "_OPTION_" OPTION PLACED OUT ORDER <<<")
D BMES^XPDUTL("Updating routine information for option ECXLBB - Blood Bank Extract")
S DA=$$LKOPT^XPDMENU("ECXLBB")
I 'DA D BMES^XPDUTL("** ECXLBB Blood Bank Extract item not found **")
I DA S DR="25///BEG^ECXLBB1" S DIE="^DIC(19," D ^DIE
Q
;
FIXBBC ;Find any bad transfusion date/times and correct them. This will fix the "C" xref in the file as well
N DATE,IEN,DR,DIE,DA
D BMES^XPDUTL("Reviewing transfusion date/time entries in the VBECS DSS EXTRACT file...")
S DATE=" " F S DATE=$O(^VBEC(6002.03,"C",DATE)) Q:'+DATE S IEN=0 F S IEN=$O(^VBEC(6002.03,"C",DATE,IEN)) Q:'+IEN S DA=IEN,DIE=6002.03,DR="9///"_+DATE D ^DIE
D MES^XPDUTL("Done")
Q
UPDATE ;update LBB in EXTRACT DEFINITION file (#727.1)
N ECXFDA,ECXERR,ECXMSG,ECXDA,ECXHDR,ECXOFF
D MES^XPDUTL(" Updating LBB entry ...")
F ECXOFF=1:1 S ECXHDR=$P($T(HDRS1+ECXOFF),";;",2) Q:ECXHDR="" D
.S ECXDA=+$O(^ECX(727.1,"C",ECXHDR,0))
.I 'ECXDA D Q
..K ECXMSG
..S ECXMSG(1)=" "
..S ECXMSG(2)=" ** ERROR UPDATING "_ECXHDR_" **"
..S ECXMSG(3)=" Entry not found in file"
..D MES^XPDUTL(.ECXMSG)
.K ECXFDA,ECXERR
.S ^ECX(727.1,ECXDA,"ROU")="ECXLBB1"
D BMES^XPDUTL("- Done -")
Q
INACT ; Inactivate NUT in EXTRACT DEFINITION file (#727.1)
N ECXFDA,ECXERR,ECXMSG,ECXDA,ECXOFF
D MES^XPDUTL(" Inactivating NUT entry ...")
S ECXDA=+$O(^ECX(727.1,"C","NUT",0))
I 'ECXDA D Q
.K ECXMSG
.S ECXMSG(1)=" "
.S ECXMSG(2)=" ** ERROR INACTIVATING NUT **"
.S ECXMSG(3)=" Entry not found in file"
.D MES^XPDUTL(.ECXMSG)
K ECXFDA,ECXERR
S ECXFDA(727.1,ECXDA_",",13)=1
D FILE^DIE("","ECXFDA","ECXERR")
Q:'$D(ECXERR)
D BMES^XPDUTL(" ** ERROR INACTIVING NUT **")
K ECXMSG D MSG^DIALOG("AE",.ECXMSG,65,6,"ECXERR")
D MES^XPDUTL(.ECXERR)
D BMES^XPDUTL("- Done -")
Q
HDRS1 ;List of headers to be updated
;;LBB
;;
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECX3P149 4003 printed Dec 13, 2024@01:50:14 Page 2
ECX3P149 ;ALB/DAN - DSS FY2015 Conversion, Post-init ;7/29/14 09:57
+1 ;;3.0;DSS EXTRACTS;**149**;Dec 22, 1997;Build 27
+2 ;
POST ;Post-install items
+1 ;Set testing site information
DO TEST
+2 ;update menus
DO MENU
+3 ;Fix blood bank "C" xref
DO FIXBBC
+4 ;Inactivate Nutrition (NUT) in extract file definitions 727.1
DO INACT
+5 ;Update routine for blood bank extract
DO UPDATE
+6 QUIT
+7 ;
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,"FY2015")
+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 ;
+1 NEW DA,DIE,DR,MENU,OPTION,CHECK,IEN
+2 DO BMES^XPDUTL("Updating option ECX NATIONAL CLINIC...")
+3 SET DA=$$LKOPT^XPDMENU("ECX NATIONAL CLINIC")
+4 IF 'DA
DO MES^XPDUTL("Update failed - contact product support for assistance!")
+5 SET DIE="^DIC(19,"
SET DR="4///R;25///ECXNCL;60///@;62///@;63///@;64///@"
+6 DO ^DIE
+7 DO MES^XPDUTL("Update successful.")
+8 SET OPTION="ECXNUT"
SET MENU="ECXMENU"
+9 SET CHECK=$$DELETE^XPDMENU(MENU,OPTION)
+10 DO BMES^XPDUTL(">>> "_OPTION_" OPTION "_$SELECT(CHECK:"REMOVED FROM ",1:"DOES NOT EXIST IN ")_MENU_" <<<")
+11 DO OUT^XPDMENU(OPTION,"OUT OF ORDER, DO NOT USE THIS OPTION!!!")
+12 DO BMES^XPDUTL(">>> "_OPTION_" OPTION PLACED OUT ORDER <<<")
+13 SET OPTION="ECX NUTRITION WORKSHEETS"
SET MENU="ECX MAINTENANCE"
+14 SET CHECK=$$DELETE^XPDMENU(MENU,OPTION)
+15 DO BMES^XPDUTL(">>> "_OPTION_" OPTION "_$SELECT(CHECK:"REMOVED FROM ",1:"DOES NOT EXIST IN ")_MENU_" <<<")
+16 DO OUT^XPDMENU(OPTION,"OUT OF ORDER, DO NOT USE THIS OPTION!!!")
+17 DO BMES^XPDUTL(">>> "_OPTION_" OPTION PLACED OUT ORDER <<<")
+18 SET OPTION="ECX NUT SOURCE AUDIT"
SET MENU="ECX SOURCE AUDITS"
+19 SET CHECK=$$DELETE^XPDMENU(MENU,OPTION)
+20 DO BMES^XPDUTL(">>> "_OPTION_" OPTION "_$SELECT(CHECK:"REMOVED FROM ",1:"DOES NOT EXIST IN ")_MENU_" <<<")
+21 DO OUT^XPDMENU(OPTION,"OUT OF ORDER, DO NOT USE THIS OPTION!!!")
+22 DO BMES^XPDUTL(">>> "_OPTION_" OPTION PLACED OUT ORDER <<<")
+23 DO BMES^XPDUTL("Updating routine information for option ECXLBB - Blood Bank Extract")
+24 SET DA=$$LKOPT^XPDMENU("ECXLBB")
+25 IF 'DA
DO BMES^XPDUTL("** ECXLBB Blood Bank Extract item not found **")
+26 IF DA
SET DR="25///BEG^ECXLBB1"
SET DIE="^DIC(19,"
DO ^DIE
+27 QUIT
+28 ;
FIXBBC ;Find any bad transfusion date/times and correct them. This will fix the "C" xref in the file as well
+1 NEW DATE,IEN,DR,DIE,DA
+2 DO BMES^XPDUTL("Reviewing transfusion date/time entries in the VBECS DSS EXTRACT file...")
+3 SET DATE=" "
FOR
SET DATE=$ORDER(^VBEC(6002.03,"C",DATE))
if '+DATE
QUIT
SET IEN=0
FOR
SET IEN=$ORDER(^VBEC(6002.03,"C",DATE,IEN))
if '+IEN
QUIT
SET DA=IEN
SET DIE=6002.03
SET DR="9///"_+DATE
DO ^DIE
+4 DO MES^XPDUTL("Done")
+5 QUIT
UPDATE ;update LBB in EXTRACT DEFINITION file (#727.1)
+1 NEW ECXFDA,ECXERR,ECXMSG,ECXDA,ECXHDR,ECXOFF
+2 DO MES^XPDUTL(" Updating LBB entry ...")
+3 FOR ECXOFF=1:1
SET ECXHDR=$PIECE($TEXT(HDRS1+ECXOFF),";;",2)
if ECXHDR=""
QUIT
Begin DoDot:1
+4 SET ECXDA=+$ORDER(^ECX(727.1,"C",ECXHDR,0))
+5 IF 'ECXDA
Begin DoDot:2
+6 KILL ECXMSG
+7 SET ECXMSG(1)=" "
+8 SET ECXMSG(2)=" ** ERROR UPDATING "_ECXHDR_" **"
+9 SET ECXMSG(3)=" Entry not found in file"
+10 DO MES^XPDUTL(.ECXMSG)
End DoDot:2
QUIT
+11 KILL ECXFDA,ECXERR
+12 SET ^ECX(727.1,ECXDA,"ROU")="ECXLBB1"
End DoDot:1
+13 DO BMES^XPDUTL("- Done -")
+14 QUIT
INACT ; Inactivate NUT in EXTRACT DEFINITION file (#727.1)
+1 NEW ECXFDA,ECXERR,ECXMSG,ECXDA,ECXOFF
+2 DO MES^XPDUTL(" Inactivating NUT entry ...")
+3 SET ECXDA=+$ORDER(^ECX(727.1,"C","NUT",0))
+4 IF 'ECXDA
Begin DoDot:1
+5 KILL ECXMSG
+6 SET ECXMSG(1)=" "
+7 SET ECXMSG(2)=" ** ERROR INACTIVATING NUT **"
+8 SET ECXMSG(3)=" Entry not found in file"
+9 DO MES^XPDUTL(.ECXMSG)
End DoDot:1
QUIT
+10 KILL ECXFDA,ECXERR
+11 SET ECXFDA(727.1,ECXDA_",",13)=1
+12 DO FILE^DIE("","ECXFDA","ECXERR")
+13 if '$DATA(ECXERR)
QUIT
+14 DO BMES^XPDUTL(" ** ERROR INACTIVING NUT **")
+15 KILL ECXMSG
DO MSG^DIALOG("AE",.ECXMSG,65,6,"ECXERR")
+16 DO MES^XPDUTL(.ECXERR)
+17 DO BMES^XPDUTL("- Done -")
+18 QUIT
HDRS1 ;List of headers to be updated
+1 ;;LBB
+2 ;;
+3 QUIT
