- 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 Feb 19, 2025@00:00:38 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 ;