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
;
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
;
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 ---[H[J[2J[HECX3P136 3591 printed Dec 13, 2024@01:50:11 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 ;
+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 ;
+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
