- 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 Feb 18, 2025@23:16:06 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 ;;