BPS20PST ;ALB/ESG - Post-install for BPS*1.0*20 ;08/26/2015
;;1.0;E CLAIMS MGMT ENGINE;**20**;JUN 2004;Build 27
;;Per VA Directive 6402, this routine should not be modified.
;
; MCCF ePharmacy Compliance Phase 3 - BPS*1*20 patch post install
;
Q
;
POST ; Entry Point for post-install
;
D BMES^XPDUTL(" Starting post-install of BPS*1*20")
N XPDIDTOT
S XPDIDTOT=7
D MENU(1) ; 1. remove the cached hidden menu protocol for the ECME User Screen
D UPDPRTCL(2) ; 2. update the protocols on the ECME user screen
D DNSBPS(3) ; 3. delete the IP address & enter the DNS Domain in BPS NCPDP link
D DNSEPH(4) ; 4. delete the IP address & enter the DNS Domain in EPHARM OUT link
D VERSION(5) ; 5. update the Vitria interface version and do the registration
D TRICARE(6) ; 6. rename the BPS COB RPT TRICARE CLAIMS option
D COBMNE(7) ; 7. rename the TRI mnemonic in BPS COB MENU option
;
EX ; exit point
;
D BMES^XPDUTL(" Finished post-install of BPS*1*20")
Q
;
N BPSORD,XQORM
D BMES^XPDUTL(" STEP "_BPSXPD_" of "_XPDIDTOT)
D MES^XPDUTL("-------------")
D MES^XPDUTL("Removing the cached hidden parent menu for the ECME User Screen ... ")
;
S BPSORD=$O(^ORD(101,"B","BPS PRTCL USRSCR HIDDEN ACTIONS",0))
S XQORM=BPSORD_";ORD(101,"
K ^XUTL("XQORM",XQORM)
;
D MES^XPDUTL(" Done.")
D UPDATE^XPDID(BPSXPD)
Q
;
UPDPRTCL(BPSXPD) ; Update protocols
N BPSDELP,BPSADDP,X,BPSDATA,BPSPUPD
D BMES^XPDUTL(" STEP "_BPSXPD_" of "_XPDIDTOT)
D MES^XPDUTL("-------------")
D MES^XPDUTL("Updating actions on the ECME User Screen ... ")
;
S BPSDELP(1)="BPS PRTCL ECME USRSCR^BPS PRTCL USRSCR CONTINUOUS"
S BPSDELP(2)="BPS PRTCL ECME USRSCR^BPS PRTCL USRSCR UPDATE"
S BPSDELP(3)="BPS PRTCL ECME USRSCR^BPS PRTCL USRSCR CLAIM LOG"
S BPSDELP(4)="BPS PRTCL ECME USRSCR^BPS PRTCL USRSCR EXIT"
S BPSDELP(5)="BPS PRTCL USRSCR HIDDEN ACTIONS^BPS PRTCL USRSCR VIEW ECME RX"
;
S BPSADDP(1)="BPS PRTCL ECME USRSCR^BPS PRTCL USRSCR CHANGE VIEW^CV^11"
S BPSADDP(2)="BPS PRTCL ECME USRSCR^BPS PRTCL USRSCR SORTLIST^SO^12"
S BPSADDP(3)="BPS PRTCL ECME USRSCR^BPS PRTCL USRSCR COMMENT^CMT^13"
S BPSADDP(4)="BPS PRTCL ECME USRSCR^BPS PRTCL USRSCR REVERSE^REV^21"
S BPSADDP(5)="BPS PRTCL ECME USRSCR^BPS PRTCL USRSCR RESUBMIT^RES^22"
S BPSADDP(6)="BPS PRTCL ECME USRSCR^BPS PRTCL USRSCR CLOSE^CLO^23"
S BPSADDP(7)="BPS PRTCL ECME USRSCR^BPS PRTCL USRSCR RESEARCH MENU^FR^31"
S BPSADDP(8)="BPS PRTCL ECME USRSCR^BPS PRTCL USRSCR VIEW ECME RX^VER^32"
S BPSADDP(9)="BPS PRTCL ECME USRSCR^BPS PRTCL USRSCR PHARM WRKLST^WRK^33"
S BPSADDP(10)="BPS PRTCL USRSCR HIDDEN ACTIONS^BPS PRTCL USRSCR UPDATE^UD"
S BPSADDP(11)="BPS PRTCL USRSCR HIDDEN ACTIONS^BPS PRTCL USRSCR CLAIM LOG^LOG"
S BPSADDP(12)="BPS PRTCL USRSCR HIDDEN ACTIONS^BPS PRTCL USRSCR EXIT^EX"
;
I '+$$LKPROT^XPDPROT("BPS PRTCL ECME USRSCR") G UPDPRTX
I '+$$LKPROT^XPDPROT("BPS PRTCL USRSCR HIDDEN ACTIONS") G UPDPRTX
;
; Delete protocols
F X=1:1:5 D
.S BPSDATA=BPSDELP(X)
.Q:'+$$LKPROT^XPDPROT($P(BPSDATA,"^",2))
.S BPSPUPD=$$DELETE^XPDPROT($P(BPSDATA,"^"),$P(BPSDATA,"^",2))
.I 'BPSPUPD D Q
..D MES^XPDUTL($P(BPSDATA,"^",2)_" protocol already deleted from "_$P(BPSDATA,"^")_".")
;
; Add protocols
F X=1:1:12 D
.S BPSDATA=BPSADDP(X)
.Q:'+$$LKPROT^XPDPROT($P(BPSDATA,"^",2))
.S BPSPUPD=$$ADD^XPDPROT($P(BPSDATA,"^"),$P(BPSDATA,"^",2),$P(BPSDATA,"^",3),$S($P(BPSDATA,"^",4)'="":$P(BPSDATA,"^",4),1:""))
.I 'BPSPUPD D Q
..D MES^XPDUTL(" Unable to add "_$P(BPSDATA,"^",2)_" protocol to "_$P(BPSDATA,"^")_".")
;
UPDPRTX ;
D MES^XPDUTL(" Done.")
D UPDATE^XPDID(BPSXPD)
Q
TRICARE(BPSXPD) ; Rename BPS COB RPT TRICARE CLAIMS option
N BPSOLDNM,BPSNEWNM,BPSIEN19,DR,DIE,DA
D BMES^XPDUTL(" STEP "_BPSXPD_" of "_XPDIDTOT)
D MES^XPDUTL("-------------")
D MES^XPDUTL("Renaming BPS COB RPT TRICARE CLAIMS option ... ")
;
S BPSOLDNM="BPS COB RPT TRICARE CLAIMS"
S BPSNEWNM="BPS POTENTIAL CLAIMS RPT DUAL"
S BPSIEN19=+$$LKOPT^XPDMENU(BPSOLDNM)
I 'BPSIEN19 D MES^XPDUTL(BPSOLDNM_" has already been renamed.") G TRICX
;
D RENAME^XPDMENU(BPSOLDNM,BPSNEWNM)
S BPSIEN19=+$$LKOPT^XPDMENU(BPSNEWNM)
I BPSIEN19 D
.S DR="1///Potential Claims Report for Dual Eligible"
.S DIE="^DIC(19,",DA=BPSIEN19
.D ^DIE
;
TRICX ;
D MES^XPDUTL(" Done.")
D UPDATE^XPDID(BPSXPD)
Q
;
COBMNE(BPSXPD) ; Rename mnemonic in BPS COB MENU option
N BPSOPT,BPSIEN19,BPSITEM,DR,DIE,DA
D BMES^XPDUTL(" STEP "_BPSXPD_" of "_XPDIDTOT)
D MES^XPDUTL("-------------")
D MES^XPDUTL("Renaming mnemonic in BPS COB MENU option ... ")
;
S BPSOPT="BPS COB MENU"
S BPSIEN19=+$$LKOPT^XPDMENU(BPSOPT)
I 'BPSIEN19 D MES^XPDUTL(BPSOPT_" option not found.") G COBMNEX
S BPSITEM=+$O(^DIC(19,BPSIEN19,10,"C","PCR",0))
I BPSITEM D MES^XPDUTL(BPSOPT_" has already been renamed.") G COBMNEX
;
S BPSITEM=+$O(^DIC(19,BPSIEN19,10,"C","TRI",0))
I BPSITEM D
.S DR="2///PCR"
.S DIE="^DIC(19,"_BPSIEN19_",10,",DA(1)=BPSIEN19,DA=BPSITEM
.D ^DIE
;
COBMNEX ;
D MES^XPDUTL(" Done.")
D UPDATE^XPDID(BPSXPD)
Q
;
DNSBPS(BPSXPD) ; Delete the TCP/IP ADDRESS if it exists in the BPS NCPDP
; logical link & enter the FSC DNS DOMAIN in File #870
N DA,DIE,DLAYGO,DR,X,Y
D BMES^XPDUTL(" STEP "_BPSXPD_" of "_XPDIDTOT)
D MES^XPDUTL("-------------")
D MES^XPDUTL("Deleting the TCP/IP ADDRESS and entering the Financial Services Center")
D MES^XPDUTL("DNS DOMAIN in the 'BPS NCPDP' link of the HL LOGICAL LINK File #870...")
;
S IBPRD=$S($$PROD^XUPROD(1)=1:"P",1:"T")
S DIC="^HLCS(870,",DLAYGO=870,DIC(0)="LS",X="BPS NCPDP" D ^DIC
;
; For Test environments use the FSC TEST domain
I IBPRD="T",Y'=-1 D
. S DIE=DIC,DA=+Y,DR=".08///EPHARMACY.VITRIA-EDI-TEST.AAC.DOMAIN.EXT;400.01///@"
. K DIC D ^DIE
;
; For Production environments, use the FSC PRD domain
I IBPRD="P",Y'=-1 D
. S DIE=DIC,DA=+Y,DR=".08///EPHARMACY.VITRIA-EDI.AAC.DOMAIN.EXT;400.01///@"
. K DIC D ^DIE
;
DNSX ;
D MES^XPDUTL(" Done.")
D UPDATE^XPDID(BPSXPD)
Q
;
DNSEPH(BPSXPD) ; Delete the TCP/IP ADDRESS if it exists in the EPHARM OUT
; logical link & enter the FSC DNS DOMAIN in File #870
N DA,DIE,DLAYGO,DR,X,Y
D BMES^XPDUTL(" STEP "_BPSXPD_" of "_XPDIDTOT)
D MES^XPDUTL("-------------")
D MES^XPDUTL("Deleting the TCP/IP ADDRESS and entering the Financial Services Center")
D MES^XPDUTL("DNS DOMAIN in the 'EPHARM OUT' link of the HL LOGICAL LINK File #870...")
S IBPRD=$S($$PROD^XUPROD(1)=1:"P",1:"T")
S DIC="^HLCS(870,",DLAYGO=870,DIC(0)="LS",X="EPHARM OUT" D ^DIC
;
; For Test environments use the FSC TEST domain
I IBPRD="T",Y'=-1 D
. S DIE=DIC,DA=+Y,DR=".08///EPHARMACY.VITRIA-EDI-TEST.AAC.DOMAIN.EXT;400.01///@"
. K DIC D ^DIE
;
; For Production environments, use the FSC PRD domain
I IBPRD="P",Y'=-1 D
. S DIE=DIC,DA=+Y,DR=".08///EPHARMACY.VITRIA-EDI.AAC.DOMAIN.EXT;400.01///@"
. K DIC D ^DIE
;
EPHX ;
D MES^XPDUTL(" Done.")
D UPDATE^XPDID(BPSXPD)
Q
;
VERSION(BPSXPD) ; Update Vitria Interface Version and do automatic registration
N DR,DIE,DA
D BMES^XPDUTL(" STEP "_BPSXPD_" of "_XPDIDTOT)
D MES^XPDUTL("-------------")
D MES^XPDUTL("Updating the Vitria ePharmacy Interface Version ... ")
;
I $$GET1^DIQ(9002313.99,1,6003)'<5 D MES^XPDUTL("Vitria Interface version has already been updated.") G VERX
;
S DR="6003///5" ; update to version 5 with BPS*1*20
S DIE="^BPS(9002313.99,",DA=1
D ^DIE
D TASKMAN^BPSJAREG ; perform registration with AITC
VERX ;
D MES^XPDUTL(" Done.")
D UPDATE^XPDID(BPSXPD)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HBPS20PST 7708 printed Dec 13, 2024@01:50:25 Page 2
BPS20PST ;ALB/ESG - Post-install for BPS*1.0*20 ;08/26/2015
+1 ;;1.0;E CLAIMS MGMT ENGINE;**20**;JUN 2004;Build 27
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; MCCF ePharmacy Compliance Phase 3 - BPS*1*20 patch post install
+5 ;
+6 QUIT
+7 ;
POST ; Entry Point for post-install
+1 ;
+2 DO BMES^XPDUTL(" Starting post-install of BPS*1*20")
+3 NEW XPDIDTOT
+4 SET XPDIDTOT=7
+5 ; 1. remove the cached hidden menu protocol for the ECME User Screen
DO MENU(1)
+6 ; 2. update the protocols on the ECME user screen
DO UPDPRTCL(2)
+7 ; 3. delete the IP address & enter the DNS Domain in BPS NCPDP link
DO DNSBPS(3)
+8 ; 4. delete the IP address & enter the DNS Domain in EPHARM OUT link
DO DNSEPH(4)
+9 ; 5. update the Vitria interface version and do the registration
DO VERSION(5)
+10 ; 6. rename the BPS COB RPT TRICARE CLAIMS option
DO TRICARE(6)
+11 ; 7. rename the TRI mnemonic in BPS COB MENU option
DO COBMNE(7)
+12 ;
EX ; exit point
+1 ;
+2 DO BMES^XPDUTL(" Finished post-install of BPS*1*20")
+3 QUIT
+4 ;
+1 NEW BPSORD,XQORM
+2 DO BMES^XPDUTL(" STEP "_BPSXPD_" of "_XPDIDTOT)
+3 DO MES^XPDUTL("-------------")
+4 DO MES^XPDUTL("Removing the cached hidden parent menu for the ECME User Screen ... ")
+5 ;
+6 SET BPSORD=$ORDER(^ORD(101,"B","BPS PRTCL USRSCR HIDDEN ACTIONS",0))
+7 SET XQORM=BPSORD_";ORD(101,"
+8 KILL ^XUTL("XQORM",XQORM)
+9 ;
+1 DO MES^XPDUTL(" Done.")
+2 DO UPDATE^XPDID(BPSXPD)
+3 QUIT
+4 ;
UPDPRTCL(BPSXPD) ; Update protocols
+1 NEW BPSDELP,BPSADDP,X,BPSDATA,BPSPUPD
+2 DO BMES^XPDUTL(" STEP "_BPSXPD_" of "_XPDIDTOT)
+3 DO MES^XPDUTL("-------------")
+4 DO MES^XPDUTL("Updating actions on the ECME User Screen ... ")
+5 ;
+6 SET BPSDELP(1)="BPS PRTCL ECME USRSCR^BPS PRTCL USRSCR CONTINUOUS"
+7 SET BPSDELP(2)="BPS PRTCL ECME USRSCR^BPS PRTCL USRSCR UPDATE"
+8 SET BPSDELP(3)="BPS PRTCL ECME USRSCR^BPS PRTCL USRSCR CLAIM LOG"
+9 SET BPSDELP(4)="BPS PRTCL ECME USRSCR^BPS PRTCL USRSCR EXIT"
+10 SET BPSDELP(5)="BPS PRTCL USRSCR HIDDEN ACTIONS^BPS PRTCL USRSCR VIEW ECME RX"
+11 ;
+12 SET BPSADDP(1)="BPS PRTCL ECME USRSCR^BPS PRTCL USRSCR CHANGE VIEW^CV^11"
+13 SET BPSADDP(2)="BPS PRTCL ECME USRSCR^BPS PRTCL USRSCR SORTLIST^SO^12"
+14 SET BPSADDP(3)="BPS PRTCL ECME USRSCR^BPS PRTCL USRSCR COMMENT^CMT^13"
+15 SET BPSADDP(4)="BPS PRTCL ECME USRSCR^BPS PRTCL USRSCR REVERSE^REV^21"
+16 SET BPSADDP(5)="BPS PRTCL ECME USRSCR^BPS PRTCL USRSCR RESUBMIT^RES^22"
+17 SET BPSADDP(6)="BPS PRTCL ECME USRSCR^BPS PRTCL USRSCR CLOSE^CLO^23"
+18 SET BPSADDP(7)="BPS PRTCL ECME USRSCR^BPS PRTCL USRSCR RESEARCH MENU^FR^31"
+19 SET BPSADDP(8)="BPS PRTCL ECME USRSCR^BPS PRTCL USRSCR VIEW ECME RX^VER^32"
+20 SET BPSADDP(9)="BPS PRTCL ECME USRSCR^BPS PRTCL USRSCR PHARM WRKLST^WRK^33"
+21 SET BPSADDP(10)="BPS PRTCL USRSCR HIDDEN ACTIONS^BPS PRTCL USRSCR UPDATE^UD"
+22 SET BPSADDP(11)="BPS PRTCL USRSCR HIDDEN ACTIONS^BPS PRTCL USRSCR CLAIM LOG^LOG"
+23 SET BPSADDP(12)="BPS PRTCL USRSCR HIDDEN ACTIONS^BPS PRTCL USRSCR EXIT^EX"
+24 ;
+25 IF '+$$LKPROT^XPDPROT("BPS PRTCL ECME USRSCR")
GOTO UPDPRTX
+26 IF '+$$LKPROT^XPDPROT("BPS PRTCL USRSCR HIDDEN ACTIONS")
GOTO UPDPRTX
+27 ;
+28 ; Delete protocols
+29 FOR X=1:1:5
Begin DoDot:1
+30 SET BPSDATA=BPSDELP(X)
+31 if '+$$LKPROT^XPDPROT($PIECE(BPSDATA,"^",2))
QUIT
+32 SET BPSPUPD=$$DELETE^XPDPROT($PIECE(BPSDATA,"^"),$PIECE(BPSDATA,"^",2))
+33 IF 'BPSPUPD
Begin DoDot:2
+34 DO MES^XPDUTL($PIECE(BPSDATA,"^",2)_" protocol already deleted from "_$PIECE(BPSDATA,"^")_".")
End DoDot:2
QUIT
End DoDot:1
+35 ;
+36 ; Add protocols
+37 FOR X=1:1:12
Begin DoDot:1
+38 SET BPSDATA=BPSADDP(X)
+39 if '+$$LKPROT^XPDPROT($PIECE(BPSDATA,"^",2))
QUIT
+40 SET BPSPUPD=$$ADD^XPDPROT($PIECE(BPSDATA,"^"),$PIECE(BPSDATA,"^",2),$PIECE(BPSDATA,"^",3),$SELECT($PIECE(BPSDATA,"^",4)'="":$PIECE(BPSDATA,"^",4),1:""))
+41 IF 'BPSPUPD
Begin DoDot:2
+42 DO MES^XPDUTL(" Unable to add "_$PIECE(BPSDATA,"^",2)_" protocol to "_$PIECE(BPSDATA,"^")_".")
End DoDot:2
QUIT
End DoDot:1
+43 ;
UPDPRTX ;
+1 DO MES^XPDUTL(" Done.")
+2 DO UPDATE^XPDID(BPSXPD)
+3 QUIT
TRICARE(BPSXPD) ; Rename BPS COB RPT TRICARE CLAIMS option
+1 NEW BPSOLDNM,BPSNEWNM,BPSIEN19,DR,DIE,DA
+2 DO BMES^XPDUTL(" STEP "_BPSXPD_" of "_XPDIDTOT)
+3 DO MES^XPDUTL("-------------")
+4 DO MES^XPDUTL("Renaming BPS COB RPT TRICARE CLAIMS option ... ")
+5 ;
+6 SET BPSOLDNM="BPS COB RPT TRICARE CLAIMS"
+7 SET BPSNEWNM="BPS POTENTIAL CLAIMS RPT DUAL"
+8 SET BPSIEN19=+$$LKOPT^XPDMENU(BPSOLDNM)
+9 IF 'BPSIEN19
DO MES^XPDUTL(BPSOLDNM_" has already been renamed.")
GOTO TRICX
+10 ;
+11 DO RENAME^XPDMENU(BPSOLDNM,BPSNEWNM)
+12 SET BPSIEN19=+$$LKOPT^XPDMENU(BPSNEWNM)
+13 IF BPSIEN19
Begin DoDot:1
+14 SET DR="1///Potential Claims Report for Dual Eligible"
+15 SET DIE="^DIC(19,"
SET DA=BPSIEN19
+16 DO ^DIE
End DoDot:1
+17 ;
TRICX ;
+1 DO MES^XPDUTL(" Done.")
+2 DO UPDATE^XPDID(BPSXPD)
+3 QUIT
+4 ;
COBMNE(BPSXPD) ; Rename mnemonic in BPS COB MENU option
+1 NEW BPSOPT,BPSIEN19,BPSITEM,DR,DIE,DA
+2 DO BMES^XPDUTL(" STEP "_BPSXPD_" of "_XPDIDTOT)
+3 DO MES^XPDUTL("-------------")
+4 DO MES^XPDUTL("Renaming mnemonic in BPS COB MENU option ... ")
+5 ;
+6 SET BPSOPT="BPS COB MENU"
+7 SET BPSIEN19=+$$LKOPT^XPDMENU(BPSOPT)
+8 IF 'BPSIEN19
DO MES^XPDUTL(BPSOPT_" option not found.")
GOTO COBMNEX
+9 SET BPSITEM=+$ORDER(^DIC(19,BPSIEN19,10,"C","PCR",0))
+10 IF BPSITEM
DO MES^XPDUTL(BPSOPT_" has already been renamed.")
GOTO COBMNEX
+11 ;
+12 SET BPSITEM=+$ORDER(^DIC(19,BPSIEN19,10,"C","TRI",0))
+13 IF BPSITEM
Begin DoDot:1
+14 SET DR="2///PCR"
+15 SET DIE="^DIC(19,"_BPSIEN19_",10,"
SET DA(1)=BPSIEN19
SET DA=BPSITEM
+16 DO ^DIE
End DoDot:1
+17 ;
COBMNEX ;
+1 DO MES^XPDUTL(" Done.")
+2 DO UPDATE^XPDID(BPSXPD)
+3 QUIT
+4 ;
DNSBPS(BPSXPD) ; Delete the TCP/IP ADDRESS if it exists in the BPS NCPDP
+1 ; logical link & enter the FSC DNS DOMAIN in File #870
+2 NEW DA,DIE,DLAYGO,DR,X,Y
+3 DO BMES^XPDUTL(" STEP "_BPSXPD_" of "_XPDIDTOT)
+4 DO MES^XPDUTL("-------------")
+5 DO MES^XPDUTL("Deleting the TCP/IP ADDRESS and entering the Financial Services Center")
+6 DO MES^XPDUTL("DNS DOMAIN in the 'BPS NCPDP' link of the HL LOGICAL LINK File #870...")
+7 ;
+8 SET IBPRD=$SELECT($$PROD^XUPROD(1)=1:"P",1:"T")
+9 SET DIC="^HLCS(870,"
SET DLAYGO=870
SET DIC(0)="LS"
SET X="BPS NCPDP"
DO ^DIC
+10 ;
+11 ; For Test environments use the FSC TEST domain
+12 IF IBPRD="T"
IF Y'=-1
Begin DoDot:1
+13 SET DIE=DIC
SET DA=+Y
SET DR=".08///EPHARMACY.VITRIA-EDI-TEST.AAC.DOMAIN.EXT;400.01///@"
+14 KILL DIC
DO ^DIE
End DoDot:1
+15 ;
+16 ; For Production environments, use the FSC PRD domain
+17 IF IBPRD="P"
IF Y'=-1
Begin DoDot:1
+18 SET DIE=DIC
SET DA=+Y
SET DR=".08///EPHARMACY.VITRIA-EDI.AAC.DOMAIN.EXT;400.01///@"
+19 KILL DIC
DO ^DIE
End DoDot:1
+20 ;
DNSX ;
+1 DO MES^XPDUTL(" Done.")
+2 DO UPDATE^XPDID(BPSXPD)
+3 QUIT
+4 ;
DNSEPH(BPSXPD) ; Delete the TCP/IP ADDRESS if it exists in the EPHARM OUT
+1 ; logical link & enter the FSC DNS DOMAIN in File #870
+2 NEW DA,DIE,DLAYGO,DR,X,Y
+3 DO BMES^XPDUTL(" STEP "_BPSXPD_" of "_XPDIDTOT)
+4 DO MES^XPDUTL("-------------")
+5 DO MES^XPDUTL("Deleting the TCP/IP ADDRESS and entering the Financial Services Center")
+6 DO MES^XPDUTL("DNS DOMAIN in the 'EPHARM OUT' link of the HL LOGICAL LINK File #870...")
+7 SET IBPRD=$SELECT($$PROD^XUPROD(1)=1:"P",1:"T")
+8 SET DIC="^HLCS(870,"
SET DLAYGO=870
SET DIC(0)="LS"
SET X="EPHARM OUT"
DO ^DIC
+9 ;
+10 ; For Test environments use the FSC TEST domain
+11 IF IBPRD="T"
IF Y'=-1
Begin DoDot:1
+12 SET DIE=DIC
SET DA=+Y
SET DR=".08///EPHARMACY.VITRIA-EDI-TEST.AAC.DOMAIN.EXT;400.01///@"
+13 KILL DIC
DO ^DIE
End DoDot:1
+14 ;
+15 ; For Production environments, use the FSC PRD domain
+16 IF IBPRD="P"
IF Y'=-1
Begin DoDot:1
+17 SET DIE=DIC
SET DA=+Y
SET DR=".08///EPHARMACY.VITRIA-EDI.AAC.DOMAIN.EXT;400.01///@"
+18 KILL DIC
DO ^DIE
End DoDot:1
+19 ;
EPHX ;
+1 DO MES^XPDUTL(" Done.")
+2 DO UPDATE^XPDID(BPSXPD)
+3 QUIT
+4 ;
VERSION(BPSXPD) ; Update Vitria Interface Version and do automatic registration
+1 NEW DR,DIE,DA
+2 DO BMES^XPDUTL(" STEP "_BPSXPD_" of "_XPDIDTOT)
+3 DO MES^XPDUTL("-------------")
+4 DO MES^XPDUTL("Updating the Vitria ePharmacy Interface Version ... ")
+5 ;
+6 IF $$GET1^DIQ(9002313.99,1,6003)'<5
DO MES^XPDUTL("Vitria Interface version has already been updated.")
GOTO VERX
+7 ;
+8 ; update to version 5 with BPS*1*20
SET DR="6003///5"
+9 SET DIE="^BPS(9002313.99,"
SET DA=1
+10 DO ^DIE
+11 ; perform registration with AITC
DO TASKMAN^BPSJAREG
VERX ;
+1 DO MES^XPDUTL(" Done.")
+2 DO UPDATE^XPDID(BPSXPD)
+3 QUIT
