Routine: ECX3P149

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

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

MENU ;update menus

 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

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")

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 -")

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 -")

HDRS1 ;List of headers to be updated

 ;;LBB

;;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECX3P149   4003     printed  Mar 13, 2025@20:54:54                                                                                                                                                                                                    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       ;

MENU      ;update menus

 +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

ECX3P149.m