ECX3P136.m

ECX3P136 ;ALB/DAN - DSS FY2013 Conversion, Post-init ;6/7/12  15:04

 ;;3.0;DSS EXTRACTS;**136**;Dec 22, 1997;Build 28

 ;

 ;****************************************

 ;Every year: Populate FY Year's version

 ; TESTON^ECXTREX(XPDNM,"FY2013")

 ;****************************************

 ;

PRE ;Pre-install tasks

 ;Delete file 727.833 so that we start with a fresh data dictionary install

 N DIU

 S DIU=727.833,DIU(0)="D" ;D denotes that we're deleting data as well

 D EN^DIU2

 Q

POST ;post-init

 D TEST,REMENU,UPDMENU,ACT,QINDEX

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

 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

 ;

REMENU ;Remove options from menu and place out of order

 N MENU,OPTION,CHECK,IEN

 S OPTION="ECX PHA 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 <<<")

 Q

 ;

UPDMENU ;Update Audit Menu Option

 N MENU,SMENU,PTR,DA,DIK

 S (MENU,SMENU,PTR)=""

 S ECXMSG(1)=" "

 S ECXMSG(2)="** Looking for ECX LBB SOURCE AUDIT menu **"

 S ECXMSG(3)="     If found, the submenu item will be updated  "

 D MES^XPDUTL(.ECXMSG)

 ;Order thru option file and find ECX DSSDEPT MGMT and retrieve IEN

 S MENU=$O(^DIC(19,"B","ECX LBB SOURCE AUDIT",MENU))

 I 'MENU D BMES^XPDUTL("** ECX LBB SOURCE AUDIT item not found **") Q

 S DR="1///Laboratory Blood Bank (LBB) Pre-Extract Audit",DIE="^DIC(19,",DA=MENU

 D ^DIE

 N ECXMSG

 S ECXMSG(1)=" "

 S ECXMSG(2)="*** ECX LBB SOURCE AUDIT menu has been updated. ***"

 D MES^XPDUTL(.ECXMSG)

 D BMES^XPDUTL("Updating extract menu display order...")

 S DA=$$ADD^XPDMENU("ECXMENU","ECXLBB",,10)

 S DA=$$ADD^XPDMENU("ECXMENU","ECXBCM",,8)

 S DA=$$ADD^XPDMENU("ECXMENU","ECXPRO",,60)

 S DA=$$ADD^XPDMENU("ECXMENU","ECXQSR",,63)

 D MES^XPDUTL("Display order updated")

 Q

 ;

INDEX ;Set the new "AO" index on file 728.904

 N DIK

 S DIK="^ECX(728.904,",DIK(1)=2.5

 D ENALL^DIK

 Q

 ;

ACT ; Activate BCM in EXTRACT DEFINITION file (#727.1)

 N ECXFDA,ECXERR,ECXMSG,ECXDA,ECXOFF

 D MES^XPDUTL("   Activating BCM entry ...")

 S ECXDA=+$O(^ECX(727.1,"C","BCM",0))

 I 'ECXDA D  Q

 .K ECXMSG

 .S ECXMSG(1)=" "

 .S ECXMSG(2)="   ** ERROR ACTIVATING BCM **"

 .S ECXMSG(3)="      Entry not found in file"

 .D MES^XPDUTL(.ECXMSG)

 K ECXFDA,ECXERR

 S ECXFDA(727.1,ECXDA_",",13)=0

 D FILE^DIE("","ECXFDA","ECXERR")

 Q:'$D(ECXERR)

 D BMES^XPDUTL("   ** ERROR ACTIVING BCM **")

 K ECXMSG D MSG^DIALOG("AE",.ECXMSG,65,6,"ECXERR")

 D MES^XPDUTL(.ECXERR)

 D BMES^XPDUTL("- Done -")

 Q

 ;

QINDEX ;Queue building of 'AO' xref of file 728.904 to the background

 N ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSK

 S ZTRTN="INDEX^ECX3P136",ZTDESC="ECX*3*136 POST INSTALL ROUTINE",ZTIO="",ZTDTH=$H

 D MES^XPDUTL(" ")

 D MES^XPDUTL("Sending building of 'AO' cross-reference of file 728.904 to the background")

 D ^%ZTLOAD I '$G(ZTSK) D BMES^XPDUTL("Cross-reference build not started - run INDEX^ECX3P136 after install finishes") Q

 D BMES^XPDUTL("Cross-reference build queued as task # "_$G(ZTSK))

 D BMES^XPDUTL(" ")

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---ECX3P136   3591     printed  Apr 09, 2024@20:56:37                                                                                                                                                                                                    Page 2

ECX3P136  ;ALB/DAN - DSS FY2013 Conversion, Post-init ;6/7/12  15:04

 +1       ;;3.0;DSS EXTRACTS;**136**;Dec 22, 1997;Build 28

 +2       ;

 +3       ;****************************************

 +4       ;Every year: Populate FY Year's version

 +5       ; TESTON^ECXTREX(XPDNM,"FY2013")

 +6       ;****************************************

 +7       ;

PRE       ;Pre-install tasks

 +1       ;Delete file 727.833 so that we start with a fresh data dictionary install

 +2        NEW DIU

 +3       ;D denotes that we're deleting data as well

           SET DIU=727.833

           SET DIU(0)="D"

 +4        DO EN^DIU2

 +5        QUIT 

POST      ;post-init

 +1        DO TEST

           DO REMENU

           DO UPDMENU

           DO ACT

           DO QINDEX

 +2        QUIT 

 +3       ;

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

 +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       ;

REMENU    ;Remove options from menu and place out of order

 +1        NEW MENU,OPTION,CHECK,IEN

 +2        SET OPTION="ECX PHA SOURCE AUDIT"

           SET MENU="ECX SOURCE AUDITS"

 +3        SET CHECK=$$DELETE^XPDMENU(MENU,OPTION)

 +4        DO BMES^XPDUTL(">>> "_OPTION_" OPTION "_$SELECT(CHECK:"REMOVED FROM ",1:"DOES NOT EXIST IN ")_MENU_" <<<")

 +5        DO OUT^XPDMENU(OPTION,"OUT OF ORDER, DO NOT USE THIS OPTION!!!")

 +6        DO BMES^XPDUTL(">>> "_OPTION_" OPTION PLACED OUT ORDER <<<")

 +7        QUIT 

 +8       ;

UPDMENU   ;Update Audit Menu Option

 +1        NEW MENU,SMENU,PTR,DA,DIK

 +2        SET (MENU,SMENU,PTR)=""

 +3        SET ECXMSG(1)=" "

 +4        SET ECXMSG(2)="** Looking for ECX LBB SOURCE AUDIT menu **"

 +5        SET ECXMSG(3)="     If found, the submenu item will be updated  "

 +6        DO MES^XPDUTL(.ECXMSG)

 +7       ;Order thru option file and find ECX DSSDEPT MGMT and retrieve IEN

 +8        SET MENU=$ORDER(^DIC(19,"B","ECX LBB SOURCE AUDIT",MENU))

 +9        IF 'MENU

               DO BMES^XPDUTL("** ECX LBB SOURCE AUDIT item not found **")

               QUIT 

 +10       SET DR="1///Laboratory Blood Bank (LBB) Pre-Extract Audit"

           SET DIE="^DIC(19,"

           SET DA=MENU

 +11       DO ^DIE

 +12       NEW ECXMSG

 +13       SET ECXMSG(1)=" "

 +14       SET ECXMSG(2)="*** ECX LBB SOURCE AUDIT menu has been updated. ***"

 +15       DO MES^XPDUTL(.ECXMSG)

 +16       DO BMES^XPDUTL("Updating extract menu display order...")

 +17       SET DA=$$ADD^XPDMENU("ECXMENU","ECXLBB",,10)

 +18       SET DA=$$ADD^XPDMENU("ECXMENU","ECXBCM",,8)

 +19       SET DA=$$ADD^XPDMENU("ECXMENU","ECXPRO",,60)

 +20       SET DA=$$ADD^XPDMENU("ECXMENU","ECXQSR",,63)

 +21       DO MES^XPDUTL("Display order updated")

 +22       QUIT 

 +23      ;

INDEX     ;Set the new "AO" index on file 728.904

 +1        NEW DIK

 +2        SET DIK="^ECX(728.904,"

           SET DIK(1)=2.5

 +3        DO ENALL^DIK

 +4        QUIT 

 +5       ;

ACT       ; Activate BCM in EXTRACT DEFINITION file (#727.1)

 +1        NEW ECXFDA,ECXERR,ECXMSG,ECXDA,ECXOFF

 +2        DO MES^XPDUTL("   Activating BCM entry ...")

 +3        SET ECXDA=+$ORDER(^ECX(727.1,"C","BCM",0))

 +4        IF 'ECXDA

               Begin DoDot:1

 +5                KILL ECXMSG

 +6                SET ECXMSG(1)=" "

 +7                SET ECXMSG(2)="   ** ERROR ACTIVATING BCM **"

 +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)=0

 +12       DO FILE^DIE("","ECXFDA","ECXERR")

 +13       if '$DATA(ECXERR)

               QUIT 

 +14       DO BMES^XPDUTL("   ** ERROR ACTIVING BCM **")

 +15       KILL ECXMSG

           DO MSG^DIALOG("AE",.ECXMSG,65,6,"ECXERR")

 +16       DO MES^XPDUTL(.ECXERR)

 +17       DO BMES^XPDUTL("- Done -")

 +18       QUIT 

 +19      ;

QINDEX    ;Queue building of 'AO' xref of file 728.904 to the background

 +1        NEW ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSK

 +2        SET ZTRTN="INDEX^ECX3P136"

           SET ZTDESC="ECX*3*136 POST INSTALL ROUTINE"

           SET ZTIO=""

           SET ZTDTH=$HOROLOG

 +3        DO MES^XPDUTL(" ")

 +4        DO MES^XPDUTL("Sending building of 'AO' cross-reference of file 728.904 to the background")

 +5        DO ^%ZTLOAD

           IF '$GET(ZTSK)

               DO BMES^XPDUTL("Cross-reference build not started - run INDEX^ECX3P136 after install finishes")

               QUIT 

 +6        DO BMES^XPDUTL("Cross-reference build queued as task # "_$GET(ZTSK))

 +7        DO BMES^XPDUTL(" ")

 +8        QUIT