Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: ECX3049

ECX3049.m

Go to the documentation of this file.
  1. ECX3049 ;BPFO/JRP - PRE/PORT INIT FOR ECX*3.0*49;7/11/2003 ; 10/17/03 6:55am
  1. ;;3.0;DSS EXTRACTS;**49**;Dec 22, 1997
  1. ;
  1. Q
  1. POST ;Main entry point for post init
  1. D MENUS
  1. D LOG
  1. D DEFINE
  1. D EXTRACT
  1. Q
  1. ;
  1. ;Set variables
  1. N MENU,SMENU,PTR
  1. S (MENU,SMENU,PTR)=""
  1. S ECXMSG(1)=" "
  1. S ECXMSG(2)="** Looking for ECX PHA VOL menu under ECX MAINTENANCE **"
  1. S ECXMSG(3)=" If found, the submenu item will be deleted "
  1. D MES^XPDUTL(.ECXMSG)
  1. ;Order thru option file and find ECX MAINTENANCE and retrieve IEN
  1. S MENU=$O(^DIC(19,"B","ECX MAINTENANCE",MENU))
  1. I 'MENU D BMES^XPDUTL("** ECX MAINTENANCE MENU item not found **") Q
  1. ;Order thru option file and find ECX PHA VOL and retrieve IEN
  1. S SMENU=$O(^DIC(19,"B","ECX PHA VOL",SMENU))
  1. I 'SMENU D BMES^XPDUTL("** ECX PHA VOL menu item not found **") Q
  1. ;Order thru ECX MAINTENANCE menu subfile check for ECX PHA VOL
  1. S PTR=($O(^DIC(19,MENU,10,"B",SMENU,PTR)))
  1. I 'PTR D BMES^XPDUTL("** ECX PHA VOL was not found as a submenu, nothing deleted **") Q
  1. D BMES^XPDUTL("** ECX PHA VOL menu found under ECX MAINTENANCE menu **")
  1. S DA(1)=MENU,DIK="^DIC(19,"_DA(1)_","_10_",",DA=PTR
  1. D ^DIK
  1. N ECXMSG
  1. S ECXMSG(1)=" "
  1. S ECXMSG(2)="** ECX PHA VOL menu deleted from ECX MAINTENANCE menu **"
  1. D MES^XPDUTL(.ECXMSG)
  1. Q
  1. LOG ;Seed new field in DSS EXTRACT LOG file (#727)
  1. N ECXFDA,ECXERR,ECXMSG,ECXDA,ECXSD
  1. S ECXMSG(1)=" "
  1. S ECXMSG(2)="Seeding newly created EXTRACT LOGIC field"
  1. S ECXMSG(3)="(#14) of the DSS EXTRACT LOG file (#727)"
  1. D MES^XPDUTL(.ECXMSG)
  1. S ECXDA=0 F S ECXDA=+$O(^ECX(727,ECXDA)) Q:'ECXDA D
  1. .S ECXSD=$P($G(^ECX(727,ECXDA,0)),"^",4)
  1. .S ECXSD=$$FISCAL^ECXUTL1(ECXSD)
  1. .K ECXFDA,ECXERR
  1. .S ECXFDA(727,ECXDA_",",14)=ECXSD
  1. .D FILE^DIE("","ECXFDA","ECXERR")
  1. .Q:'$D(ECXERR)
  1. .D BMES^XPDUTL(" ** ERROR SEEDING FIELD FOR ENTRY ENTRY #"_ECXDA_" **")
  1. .K ECXMSG D MSG^DIALOG("AE",.ECXMSG,65,6,"ECXERR")
  1. .D MES^XPDUTL(.ECXERR)
  1. D BMES^XPDUTL("- Done -")
  1. Q
  1. ;
  1. DEFINE ;Seed new field in EXTRACT DEFINITION file (#727.1)
  1. N ECXFDA,ECXERR,ECXMSG,ECXDA,ECXHDR,ECXOFF
  1. S ECXMSG(1)=" "
  1. S ECXMSG(2)="Seeding newly created INACTIVE field (#13)"
  1. S ECXMSG(3)="of the EXTRACT DEFINITIONS file (#727.1)"
  1. D MES^XPDUTL(.ECXMSG)
  1. D BMES^XPDUTL(" Inactivating all entries ...")
  1. S ECXDA=0 F S ECXDA=+$O(^ECX(727.1,ECXDA)) Q:'ECXDA D
  1. .K ECXFDA,ECXERR
  1. .S ECXFDA(727.1,ECXDA_",",13)=1
  1. .D FILE^DIE("","ECXFDA","ECXERR")
  1. .Q:'$D(ECXERR)
  1. .D BMES^XPDUTL(" ** ERROR INACTIVING ENTRY #"_ECXDA_" **")
  1. .K ECXMSG D MSG^DIALOG("AE",.ECXMSG,65,6,"ECXERR")
  1. .D MES^XPDUTL(.ECXERR)
  1. D MES^XPDUTL(" Activating all nationally supported entries ...")
  1. F ECXOFF=1:1 S ECXHDR=$P($T(NTLHDR+ECXOFF),";;",2) Q:ECXHDR="" D
  1. .S ECXDA=+$O(^ECX(727.1,"C",ECXHDR,0))
  1. .I 'ECXDA D Q
  1. ..K ECXMSG
  1. ..S ECXMSG(1)=" "
  1. ..S ECXMSG(2)=" ** ERROR ACTIVATING "_ECXHDR_" **"
  1. ..S ECXMSG(3)=" Entry not found in file"
  1. ..D MES^XPDUTL(.ECXMSG)
  1. .K ECXFDA,ECXERR
  1. .S ECXFDA(727.1,ECXDA_",",13)=0
  1. .D FILE^DIE("","ECXFDA","ECXERR")
  1. .Q:'$D(ECXERR)
  1. .D BMES^XPDUTL(" ** ERROR ACTIVING "_ECXHDR_" **")
  1. .K ECXMSG D MSG^DIALOG("AE",.ECXMSG,65,6,"ECXERR")
  1. .D MES^XPDUTL(.ECXERR)
  1. D BMES^XPDUTL("- Done -")
  1. Q
  1. ;
  1. EXTRACT ;Seed new field in DSS EXTRACTS file (#728)
  1. N ECXFDA,ECXERR,ECXMSG
  1. S ECXMSG(1)=" "
  1. S ECXMSG(2)="Seeding newly created AUSTIN TEST QUEUE NAME"
  1. S ECXMSG(3)="field (#67) of the DSS EXTRACTS file (#728)"
  1. D MES^XPDUTL(.ECXMSG)
  1. I '$D(^ECX(728,1)) D Q
  1. .D BMES^XPDUTL("** FILE DOES NOT HAVE AN ENTRY #1. SEEDING OF FIELD NOT DONE. **")
  1. S ECXFDA(728,"1,",67)="DMT"
  1. D FILE^DIE("","ECXFDA","ECXERR")
  1. I $D(ECXERR) D
  1. .D BMES^XPDUTL("** ERROR OCCURRED WHILE SEEDING FIELD **")
  1. .K ECXMSG D MSG^DIALOG("AE",.ECXMSG,70,5,"ECXERR")
  1. .D MES^XPDUTL(.ECXERR)
  1. D BMES^XPDUTL("- Done -")
  1. Q
  1. ;
  1. NTLHDR ;List of nationally supported headers
  1. ;;ADM
  1. ;;CLI
  1. ;;DEN
  1. ;;ECQ
  1. ;;ECS
  1. ;;IVP
  1. ;;LAB
  1. ;;LAR
  1. ;;MTL
  1. ;;MOV
  1. ;;NUR
  1. ;;PAS
  1. ;;PRE
  1. ;;PRO
  1. ;;RAD
  1. ;;SUR
  1. ;;TRT
  1. ;;UDP
  1. ;;