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  Sep 23, 2025@20:10:32                                                                                                                                                                                                    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       ;