IBY435PO ;ALB/ESG - Post Install for IB patch 435 ;4-Oct-2010
;;2.0;INTEGRATED BILLING;**435**;21-MAR-94;Build 27
;;Per VHA Directive 2004-038, this routine should not be modified.
;
; ePharmacy Phase 5 - patch 435 post install
;
EN ; entry point
N XPDIDTOT
S XPDIDTOT=2
D SOI(1) ; 1. add a new Source of Information for insurance
D EPI(2) ; 2. change a menu synonym
;
EX ; exit point
Q
;
SOI(IBXPD) ; add a new Source of Information for insurance
N DA,DIC,DO,X,Y
D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
D MES^XPDUTL("-------------")
D MES^XPDUTL("Add a new Source of Information for Insurance ... ")
;
F X=10 D
. I $D(^IBE(355.12,"B",X)) D MES^XPDUTL("Already there...no action") Q
. S DIC="^IBE(355.12,",DIC(0)="F"
. S DIC("DR")=".02///E-PHARMACY;.03///eRxEL"
. D FILE^DICN
. I Y=-1 D MES^XPDUTL("ERROR when adding a new Ins. Source of Information. Log a Remedy ticket!") Q
. D MES^XPDUTL("Entry added successfully")
. Q
;
SOIX ;
D MES^XPDUTL(" Done.")
D UPDATE^XPDID(IBXPD)
Q
;
EPI(IBXPD) ; change a menu synonym
N DIE,DA,DR,X,Y,MENUIEN,ITEMIEN
D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
D MES^XPDUTL("-------------")
D MES^XPDUTL("Modify an ePharmacy menu synonym ... ")
S MENUIEN=$O(^DIC(19,"B","IBCNR E-PHARMACY MENU",0)) I 'MENUIEN D MES^XPDUTL("Parent menu not found.") G EPIX
S ITEMIEN=$O(^DIC(19,"B","IBCNR ELIGIBILITY INQUIRY",0)) I 'ITEMIEN D MES^XPDUTL("ePharm Menu item not found.") G EPIX
S DA=+$O(^DIC(19,MENUIEN,10,"B",ITEMIEN,0)) I 'DA D MES^XPDUTL("ePharm Menu item not found on Parent Menu.") G EPIX
S DIE="^DIC(19,"_MENUIEN_",10,"
S DA(1)=MENUIEN
S DR="2////EPI"
D ^DIE
D MES^XPDUTL("ePharmacy Menu synonym has been updated.")
;
EPIX ;
D MES^XPDUTL(" Done.")
D UPDATE^XPDID(IBXPD)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBY435PO 1843 printed Dec 13, 2024@02:34:09 Page 2
IBY435PO ;ALB/ESG - Post Install for IB patch 435 ;4-Oct-2010
+1 ;;2.0;INTEGRATED BILLING;**435**;21-MAR-94;Build 27
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
+4 ; ePharmacy Phase 5 - patch 435 post install
+5 ;
EN ; entry point
+1 NEW XPDIDTOT
+2 SET XPDIDTOT=2
+3 ; 1. add a new Source of Information for insurance
DO SOI(1)
+4 ; 2. change a menu synonym
DO EPI(2)
+5 ;
EX ; exit point
+1 QUIT
+2 ;
SOI(IBXPD) ; add a new Source of Information for insurance
+1 NEW DA,DIC,DO,X,Y
+2 DO BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
+3 DO MES^XPDUTL("-------------")
+4 DO MES^XPDUTL("Add a new Source of Information for Insurance ... ")
+5 ;
+6 FOR X=10
Begin DoDot:1
+7 IF $DATA(^IBE(355.12,"B",X))
DO MES^XPDUTL("Already there...no action")
QUIT
+8 SET DIC="^IBE(355.12,"
SET DIC(0)="F"
+9 SET DIC("DR")=".02///E-PHARMACY;.03///eRxEL"
+10 DO FILE^DICN
+11 IF Y=-1
DO MES^XPDUTL("ERROR when adding a new Ins. Source of Information. Log a Remedy ticket!")
QUIT
+12 DO MES^XPDUTL("Entry added successfully")
+13 QUIT
End DoDot:1
+14 ;
SOIX ;
+1 DO MES^XPDUTL(" Done.")
+2 DO UPDATE^XPDID(IBXPD)
+3 QUIT
+4 ;
EPI(IBXPD) ; change a menu synonym
+1 NEW DIE,DA,DR,X,Y,MENUIEN,ITEMIEN
+2 DO BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
+3 DO MES^XPDUTL("-------------")
+4 DO MES^XPDUTL("Modify an ePharmacy menu synonym ... ")
+5 SET MENUIEN=$ORDER(^DIC(19,"B","IBCNR E-PHARMACY MENU",0))
IF 'MENUIEN
DO MES^XPDUTL("Parent menu not found.")
GOTO EPIX
+6 SET ITEMIEN=$ORDER(^DIC(19,"B","IBCNR ELIGIBILITY INQUIRY",0))
IF 'ITEMIEN
DO MES^XPDUTL("ePharm Menu item not found.")
GOTO EPIX
+7 SET DA=+$ORDER(^DIC(19,MENUIEN,10,"B",ITEMIEN,0))
IF 'DA
DO MES^XPDUTL("ePharm Menu item not found on Parent Menu.")
GOTO EPIX
+8 SET DIE="^DIC(19,"_MENUIEN_",10,"
+9 SET DA(1)=MENUIEN
+10 SET DR="2////EPI"
+11 DO ^DIE
+12 DO MES^XPDUTL("ePharmacy Menu synonym has been updated.")
+13 ;
EPIX ;
+1 DO MES^XPDUTL(" Done.")
+2 DO UPDATE^XPDID(IBXPD)
+3 QUIT
+4 ;