source: WorldVistAEHR/trunk/r/DSS_EXTRACTS-ECX/ECX3049.m@ 1800

Last change on this file since 1800 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR
File size: 3.9 KB
RevLine 
[613]1ECX3049 ;BPFO/JRP - PRE/PORT INIT FOR ECX*3.0*49;7/11/2003 ; 10/17/03 6:55am
2 ;;3.0;DSS EXTRACTS;**49**;Dec 22, 1997
3 ;
4 Q
5POST ;Main entry point for post init
6 D MENUS
7 D LOG
8 D DEFINE
9 D EXTRACT
10 Q
11 ;
12MENUS ;Remove erroneous entry from'ECX MAINTENANCE MENU'
13 ;Set variables
14 N MENU,SMENU,PTR
15 S (MENU,SMENU,PTR)=""
16 S ECXMSG(1)=" "
17 S ECXMSG(2)="** Looking for ECX PHA VOL menu under ECX MAINTENANCE **"
18 S ECXMSG(3)=" If found, the submenu item will be deleted "
19 D MES^XPDUTL(.ECXMSG)
20 ;Order thru option file and find ECX MAINTENANCE and retrieve IEN
21 S MENU=$O(^DIC(19,"B","ECX MAINTENANCE",MENU))
22 I 'MENU D BMES^XPDUTL("** ECX MAINTENANCE MENU item not found **") Q
23 ;Order thru option file and find ECX PHA VOL and retrieve IEN
24 S SMENU=$O(^DIC(19,"B","ECX PHA VOL",SMENU))
25 I 'SMENU D BMES^XPDUTL("** ECX PHA VOL menu item not found **") Q
26 ;Order thru ECX MAINTENANCE menu subfile check for ECX PHA VOL
27 S PTR=($O(^DIC(19,MENU,10,"B",SMENU,PTR)))
28 I 'PTR D BMES^XPDUTL("** ECX PHA VOL was not found as a submenu, nothing deleted **") Q
29 D BMES^XPDUTL("** ECX PHA VOL menu found under ECX MAINTENANCE menu **")
30 S DA(1)=MENU,DIK="^DIC(19,"_DA(1)_","_10_",",DA=PTR
31 D ^DIK
32 N ECXMSG
33 S ECXMSG(1)=" "
34 S ECXMSG(2)="** ECX PHA VOL menu deleted from ECX MAINTENANCE menu **"
35 D MES^XPDUTL(.ECXMSG)
36 Q
37LOG ;Seed new field in DSS EXTRACT LOG file (#727)
38 N ECXFDA,ECXERR,ECXMSG,ECXDA,ECXSD
39 S ECXMSG(1)=" "
40 S ECXMSG(2)="Seeding newly created EXTRACT LOGIC field"
41 S ECXMSG(3)="(#14) of the DSS EXTRACT LOG file (#727)"
42 D MES^XPDUTL(.ECXMSG)
43 S ECXDA=0 F S ECXDA=+$O(^ECX(727,ECXDA)) Q:'ECXDA D
44 .S ECXSD=$P($G(^ECX(727,ECXDA,0)),"^",4)
45 .S ECXSD=$$FISCAL^ECXUTL1(ECXSD)
46 .K ECXFDA,ECXERR
47 .S ECXFDA(727,ECXDA_",",14)=ECXSD
48 .D FILE^DIE("","ECXFDA","ECXERR")
49 .Q:'$D(ECXERR)
50 .D BMES^XPDUTL(" ** ERROR SEEDING FIELD FOR ENTRY ENTRY #"_ECXDA_" **")
51 .K ECXMSG D MSG^DIALOG("AE",.ECXMSG,65,6,"ECXERR")
52 .D MES^XPDUTL(.ECXERR)
53 D BMES^XPDUTL("- Done -")
54 Q
55 ;
56DEFINE ;Seed new field in EXTRACT DEFINITION file (#727.1)
57 N ECXFDA,ECXERR,ECXMSG,ECXDA,ECXHDR,ECXOFF
58 S ECXMSG(1)=" "
59 S ECXMSG(2)="Seeding newly created INACTIVE field (#13)"
60 S ECXMSG(3)="of the EXTRACT DEFINITIONS file (#727.1)"
61 D MES^XPDUTL(.ECXMSG)
62 D BMES^XPDUTL(" Inactivating all entries ...")
63 S ECXDA=0 F S ECXDA=+$O(^ECX(727.1,ECXDA)) Q:'ECXDA D
64 .K ECXFDA,ECXERR
65 .S ECXFDA(727.1,ECXDA_",",13)=1
66 .D FILE^DIE("","ECXFDA","ECXERR")
67 .Q:'$D(ECXERR)
68 .D BMES^XPDUTL(" ** ERROR INACTIVING ENTRY #"_ECXDA_" **")
69 .K ECXMSG D MSG^DIALOG("AE",.ECXMSG,65,6,"ECXERR")
70 .D MES^XPDUTL(.ECXERR)
71 D MES^XPDUTL(" Activating all nationally supported entries ...")
72 F ECXOFF=1:1 S ECXHDR=$P($T(NTLHDR+ECXOFF),";;",2) Q:ECXHDR="" D
73 .S ECXDA=+$O(^ECX(727.1,"C",ECXHDR,0))
74 .I 'ECXDA D Q
75 ..K ECXMSG
76 ..S ECXMSG(1)=" "
77 ..S ECXMSG(2)=" ** ERROR ACTIVATING "_ECXHDR_" **"
78 ..S ECXMSG(3)=" Entry not found in file"
79 ..D MES^XPDUTL(.ECXMSG)
80 .K ECXFDA,ECXERR
81 .S ECXFDA(727.1,ECXDA_",",13)=0
82 .D FILE^DIE("","ECXFDA","ECXERR")
83 .Q:'$D(ECXERR)
84 .D BMES^XPDUTL(" ** ERROR ACTIVING "_ECXHDR_" **")
85 .K ECXMSG D MSG^DIALOG("AE",.ECXMSG,65,6,"ECXERR")
86 .D MES^XPDUTL(.ECXERR)
87 D BMES^XPDUTL("- Done -")
88 Q
89 ;
90EXTRACT ;Seed new field in DSS EXTRACTS file (#728)
91 N ECXFDA,ECXERR,ECXMSG
92 S ECXMSG(1)=" "
93 S ECXMSG(2)="Seeding newly created AUSTIN TEST QUEUE NAME"
94 S ECXMSG(3)="field (#67) of the DSS EXTRACTS file (#728)"
95 D MES^XPDUTL(.ECXMSG)
96 I '$D(^ECX(728,1)) D Q
97 .D BMES^XPDUTL("** FILE DOES NOT HAVE AN ENTRY #1. SEEDING OF FIELD NOT DONE. **")
98 S ECXFDA(728,"1,",67)="DMT"
99 D FILE^DIE("","ECXFDA","ECXERR")
100 I $D(ECXERR) D
101 .D BMES^XPDUTL("** ERROR OCCURRED WHILE SEEDING FIELD **")
102 .K ECXMSG D MSG^DIALOG("AE",.ECXMSG,70,5,"ECXERR")
103 .D MES^XPDUTL(.ECXERR)
104 D BMES^XPDUTL("- Done -")
105 Q
106 ;
107NTLHDR ;List of nationally supported headers
108 ;;ADM
109 ;;CLI
110 ;;DEN
111 ;;ECQ
112 ;;ECS
113 ;;IVP
114 ;;LAB
115 ;;LAR
116 ;;MTL
117 ;;MOV
118 ;;NUR
119 ;;PAS
120 ;;PRE
121 ;;PRO
122 ;;RAD
123 ;;SUR
124 ;;TRT
125 ;;UDP
126 ;;
Note: See TracBrowser for help on using the repository browser.