ECX3049 ;BPFO/JRP - PRE/PORT INIT FOR ECX*3.0*49;7/11/2003 ; 10/17/03 6:55am
;;3.0;DSS EXTRACTS;**49**;Dec 22, 1997
;
Q
POST ;Main entry point for post init
D MENUS
D LOG
D DEFINE
D EXTRACT
Q
;
;Set variables
N MENU,SMENU,PTR
S (MENU,SMENU,PTR)=""
S ECXMSG(1)=" "
S ECXMSG(2)="** Looking for ECX PHA VOL menu under ECX MAINTENANCE **"
S ECXMSG(3)=" If found, the submenu item will be deleted "
D MES^XPDUTL(.ECXMSG)
;Order thru option file and find ECX MAINTENANCE and retrieve IEN
S MENU=$O(^DIC(19,"B","ECX MAINTENANCE",MENU))
I 'MENU D BMES^XPDUTL("** ECX MAINTENANCE MENU item not found **") Q
;Order thru option file and find ECX PHA VOL and retrieve IEN
S SMENU=$O(^DIC(19,"B","ECX PHA VOL",SMENU))
I 'SMENU D BMES^XPDUTL("** ECX PHA VOL menu item not found **") Q
;Order thru ECX MAINTENANCE menu subfile check for ECX PHA VOL
S PTR=($O(^DIC(19,MENU,10,"B",SMENU,PTR)))
I 'PTR D BMES^XPDUTL("** ECX PHA VOL was not found as a submenu, nothing deleted **") Q
D BMES^XPDUTL("** ECX PHA VOL menu found under ECX MAINTENANCE menu **")
S DA(1)=MENU,DIK="^DIC(19,"_DA(1)_","_10_",",DA=PTR
D ^DIK
N ECXMSG
S ECXMSG(1)=" "
S ECXMSG(2)="** ECX PHA VOL menu deleted from ECX MAINTENANCE menu **"
D MES^XPDUTL(.ECXMSG)
Q
LOG ;Seed new field in DSS EXTRACT LOG file (#727)
N ECXFDA,ECXERR,ECXMSG,ECXDA,ECXSD
S ECXMSG(1)=" "
S ECXMSG(2)="Seeding newly created EXTRACT LOGIC field"
S ECXMSG(3)="(#14) of the DSS EXTRACT LOG file (#727)"
D MES^XPDUTL(.ECXMSG)
S ECXDA=0 F S ECXDA=+$O(^ECX(727,ECXDA)) Q:'ECXDA D
.S ECXSD=$P($G(^ECX(727,ECXDA,0)),"^",4)
.S ECXSD=$$FISCAL^ECXUTL1(ECXSD)
.K ECXFDA,ECXERR
.S ECXFDA(727,ECXDA_",",14)=ECXSD
.D FILE^DIE("","ECXFDA","ECXERR")
.Q:'$D(ECXERR)
.D BMES^XPDUTL(" ** ERROR SEEDING FIELD FOR ENTRY ENTRY #"_ECXDA_" **")
.K ECXMSG D MSG^DIALOG("AE",.ECXMSG,65,6,"ECXERR")
.D MES^XPDUTL(.ECXERR)
D BMES^XPDUTL("- Done -")
Q
;
DEFINE ;Seed new field in EXTRACT DEFINITION file (#727.1)
N ECXFDA,ECXERR,ECXMSG,ECXDA,ECXHDR,ECXOFF
S ECXMSG(1)=" "
S ECXMSG(2)="Seeding newly created INACTIVE field (#13)"
S ECXMSG(3)="of the EXTRACT DEFINITIONS file (#727.1)"
D MES^XPDUTL(.ECXMSG)
D BMES^XPDUTL(" Inactivating all entries ...")
S ECXDA=0 F S ECXDA=+$O(^ECX(727.1,ECXDA)) Q:'ECXDA D
.K ECXFDA,ECXERR
.S ECXFDA(727.1,ECXDA_",",13)=1
.D FILE^DIE("","ECXFDA","ECXERR")
.Q:'$D(ECXERR)
.D BMES^XPDUTL(" ** ERROR INACTIVING ENTRY #"_ECXDA_" **")
.K ECXMSG D MSG^DIALOG("AE",.ECXMSG,65,6,"ECXERR")
.D MES^XPDUTL(.ECXERR)
D MES^XPDUTL(" Activating all nationally supported entries ...")
F ECXOFF=1:1 S ECXHDR=$P($T(NTLHDR+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 ACTIVATING "_ECXHDR_" **"
..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 "_ECXHDR_" **")
.K ECXMSG D MSG^DIALOG("AE",.ECXMSG,65,6,"ECXERR")
.D MES^XPDUTL(.ECXERR)
D BMES^XPDUTL("- Done -")
Q
;
N ECXFDA,ECXERR,ECXMSG
S ECXMSG(1)=" "
S ECXMSG(2)="Seeding newly created AUSTIN TEST QUEUE NAME"
S ECXMSG(3)="field (#67) of the DSS EXTRACTS file (#728)"
D MES^XPDUTL(.ECXMSG)
I '$D(^ECX(728,1)) D Q
.D BMES^XPDUTL("** FILE DOES NOT HAVE AN ENTRY #1. SEEDING OF FIELD NOT DONE. **")
S ECXFDA(728,"1,",67)="DMT"
D FILE^DIE("","ECXFDA","ECXERR")
I $D(ECXERR) D
.D BMES^XPDUTL("** ERROR OCCURRED WHILE SEEDING FIELD **")
.K ECXMSG D MSG^DIALOG("AE",.ECXMSG,70,5,"ECXERR")
.D MES^XPDUTL(.ECXERR)
D BMES^XPDUTL("- Done -")
Q
;
NTLHDR ;List of nationally supported headers
;;ADM
;;CLI
;;DEN
;;ECQ
;;ECS
;;IVP
;;LAB
;;LAR
;;MTL
;;MOV
;;NUR
;;PAS
;;PRE
;;PRO
;;RAD
;;SUR
;;TRT
;;UDP
;;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HECX3049 4084 printed Dec 13, 2024@01:49:42 Page 2
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
+2 ;
+3 QUIT
POST ;Main entry point for post init
+1 DO MENUS
+2 DO LOG
+3 DO DEFINE
+4 DO EXTRACT
+5 QUIT
+6 ;
+1 ;Set variables
+2 NEW MENU,SMENU,PTR
+3 SET (MENU,SMENU,PTR)=""
+4 SET ECXMSG(1)=" "
+5 SET ECXMSG(2)="** Looking for ECX PHA VOL menu under ECX MAINTENANCE **"
+6 SET ECXMSG(3)=" If found, the submenu item will be deleted "
+7 DO MES^XPDUTL(.ECXMSG)
+8 ;Order thru option file and find ECX MAINTENANCE and retrieve IEN
+9 SET MENU=$ORDER(^DIC(19,"B","ECX MAINTENANCE",MENU))
+10 IF 'MENU
DO BMES^XPDUTL("** ECX MAINTENANCE MENU item not found **")
QUIT
+11 ;Order thru option file and find ECX PHA VOL and retrieve IEN
+12 SET SMENU=$ORDER(^DIC(19,"B","ECX PHA VOL",SMENU))
+13 IF 'SMENU
DO BMES^XPDUTL("** ECX PHA VOL menu item not found **")
QUIT
+14 ;Order thru ECX MAINTENANCE menu subfile check for ECX PHA VOL
+15 SET PTR=($ORDER(^DIC(19,MENU,10,"B",SMENU,PTR)))
+16 IF 'PTR
DO BMES^XPDUTL("** ECX PHA VOL was not found as a submenu, nothing deleted **")
QUIT
+17 DO BMES^XPDUTL("** ECX PHA VOL menu found under ECX MAINTENANCE menu **")
+18 SET DA(1)=MENU
SET DIK="^DIC(19,"_DA(1)_","_10_","
SET DA=PTR
+19 DO ^DIK
+20 NEW ECXMSG
+21 SET ECXMSG(1)=" "
+22 SET ECXMSG(2)="** ECX PHA VOL menu deleted from ECX MAINTENANCE menu **"
+23 DO MES^XPDUTL(.ECXMSG)
+24 QUIT
LOG ;Seed new field in DSS EXTRACT LOG file (#727)
+1 NEW ECXFDA,ECXERR,ECXMSG,ECXDA,ECXSD
+2 SET ECXMSG(1)=" "
+3 SET ECXMSG(2)="Seeding newly created EXTRACT LOGIC field"
+4 SET ECXMSG(3)="(#14) of the DSS EXTRACT LOG file (#727)"
+5 DO MES^XPDUTL(.ECXMSG)
+6 SET ECXDA=0
FOR
SET ECXDA=+$ORDER(^ECX(727,ECXDA))
if 'ECXDA
QUIT
Begin DoDot:1
+7 SET ECXSD=$PIECE($GET(^ECX(727,ECXDA,0)),"^",4)
+8 SET ECXSD=$$FISCAL^ECXUTL1(ECXSD)
+9 KILL ECXFDA,ECXERR
+10 SET ECXFDA(727,ECXDA_",",14)=ECXSD
+11 DO FILE^DIE("","ECXFDA","ECXERR")
+12 if '$DATA(ECXERR)
QUIT
+13 DO BMES^XPDUTL(" ** ERROR SEEDING FIELD FOR ENTRY ENTRY #"_ECXDA_" **")
+14 KILL ECXMSG
DO MSG^DIALOG("AE",.ECXMSG,65,6,"ECXERR")
+15 DO MES^XPDUTL(.ECXERR)
End DoDot:1
+16 DO BMES^XPDUTL("- Done -")
+17 QUIT
+18 ;
DEFINE ;Seed new field in EXTRACT DEFINITION file (#727.1)
+1 NEW ECXFDA,ECXERR,ECXMSG,ECXDA,ECXHDR,ECXOFF
+2 SET ECXMSG(1)=" "
+3 SET ECXMSG(2)="Seeding newly created INACTIVE field (#13)"
+4 SET ECXMSG(3)="of the EXTRACT DEFINITIONS file (#727.1)"
+5 DO MES^XPDUTL(.ECXMSG)
+6 DO BMES^XPDUTL(" Inactivating all entries ...")
+7 SET ECXDA=0
FOR
SET ECXDA=+$ORDER(^ECX(727.1,ECXDA))
if 'ECXDA
QUIT
Begin DoDot:1
+8 KILL ECXFDA,ECXERR
+9 SET ECXFDA(727.1,ECXDA_",",13)=1
+10 DO FILE^DIE("","ECXFDA","ECXERR")
+11 if '$DATA(ECXERR)
QUIT
+12 DO BMES^XPDUTL(" ** ERROR INACTIVING ENTRY #"_ECXDA_" **")
+13 KILL ECXMSG
DO MSG^DIALOG("AE",.ECXMSG,65,6,"ECXERR")
+14 DO MES^XPDUTL(.ECXERR)
End DoDot:1
+15 DO MES^XPDUTL(" Activating all nationally supported entries ...")
+16 FOR ECXOFF=1:1
SET ECXHDR=$PIECE($TEXT(NTLHDR+ECXOFF),";;",2)
if ECXHDR=""
QUIT
Begin DoDot:1
+17 SET ECXDA=+$ORDER(^ECX(727.1,"C",ECXHDR,0))
+18 IF 'ECXDA
Begin DoDot:2
+19 KILL ECXMSG
+20 SET ECXMSG(1)=" "
+21 SET ECXMSG(2)=" ** ERROR ACTIVATING "_ECXHDR_" **"
+22 SET ECXMSG(3)=" Entry not found in file"
+23 DO MES^XPDUTL(.ECXMSG)
End DoDot:2
QUIT
+24 KILL ECXFDA,ECXERR
+25 SET ECXFDA(727.1,ECXDA_",",13)=0
+26 DO FILE^DIE("","ECXFDA","ECXERR")
+27 if '$DATA(ECXERR)
QUIT
+28 DO BMES^XPDUTL(" ** ERROR ACTIVING "_ECXHDR_" **")
+29 KILL ECXMSG
DO MSG^DIALOG("AE",.ECXMSG,65,6,"ECXERR")
+30 DO MES^XPDUTL(.ECXERR)
End DoDot:1
+31 DO BMES^XPDUTL("- Done -")
+32 QUIT
+33 ;
+1 NEW ECXFDA,ECXERR,ECXMSG
+2 SET ECXMSG(1)=" "
+3 SET ECXMSG(2)="Seeding newly created AUSTIN TEST QUEUE NAME"
+4 SET ECXMSG(3)="field (#67) of the DSS EXTRACTS file (#728)"
+5 DO MES^XPDUTL(.ECXMSG)
+6 IF '$DATA(^ECX(728,1))
Begin DoDot:1
+7 DO BMES^XPDUTL("** FILE DOES NOT HAVE AN ENTRY #1. SEEDING OF FIELD NOT DONE. **")
End DoDot:1
QUIT
+8 SET ECXFDA(728,"1,",67)="DMT"
+9 DO FILE^DIE("","ECXFDA","ECXERR")
+10 IF $DATA(ECXERR)
Begin DoDot:1
+11 DO BMES^XPDUTL("** ERROR OCCURRED WHILE SEEDING FIELD **")
+12 KILL ECXMSG
DO MSG^DIALOG("AE",.ECXMSG,70,5,"ECXERR")
+13 DO MES^XPDUTL(.ECXERR)
End DoDot:1
+14 DO BMES^XPDUTL("- Done -")
+15 QUIT
+16 ;
NTLHDR ;List of nationally supported headers
+1 ;;ADM
+2 ;;CLI
+3 ;;DEN
+4 ;;ECQ
+5 ;;ECS
+6 ;;IVP
+7 ;;LAB
+8 ;;LAR
+9 ;;MTL
+10 ;;MOV
+11 ;;NUR
+12 ;;PAS
+13 ;;PRE
+14 ;;PRO
+15 ;;RAD
+16 ;;SUR
+17 ;;TRT
+18 ;;UDP
+19 ;;
