- IBY434PO ;ALB/ESG - Post Install for IB patch 434 ;5-Aug-2010
- ;;2.0;INTEGRATED BILLING;**434**;21-MAR-94;Build 16
- ;;Per VHA Directive 2004-038, this routine should not be modified.
- ;
- ; ePharmacy TRICARE Active Duty - patch 434 post installation routine
- ;
- EN ; entry point
- N XPDIDTOT
- S XPDIDTOT=1
- D CT(1) ; 1. add a new Claims Tracking Reason Not Billable
- ;
- EX ; exit point
- Q
- ;
- CT(IBXPD) ; add a new CT RNB
- N DA,DIC,DO,X,Y
- D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
- D MES^XPDUTL("-------------")
- D MES^XPDUTL("Add a new Claims Tracking RNB ... ")
- ;
- F X="TRICARE INPATIENT/DISCHARGE" D
- . I $D(^IBE(356.8,"B",X)) D MES^XPDUTL("Already there...no action") Q
- . S DIC="^IBE(356.8,",DIC(0)="F"
- . S DIC("DR")=".04///RX16"
- . D FILE^DICN
- . I Y=-1 D MES^XPDUTL("ERROR when adding a new RNB to CT. Please log a Remedy ticket!") Q
- . D MES^XPDUTL("Entry added successfully")
- . Q
- ;
- CTX ;
- D MES^XPDUTL(" Done.")
- D UPDATE^XPDID(IBXPD)
- Q
- ;
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBY434PO 1002 printed Mar 13, 2025@21:39:18 Page 2
- IBY434PO ;ALB/ESG - Post Install for IB patch 434 ;5-Aug-2010
- +1 ;;2.0;INTEGRATED BILLING;**434**;21-MAR-94;Build 16
- +2 ;;Per VHA Directive 2004-038, this routine should not be modified.
- +3 ;
- +4 ; ePharmacy TRICARE Active Duty - patch 434 post installation routine
- +5 ;
- EN ; entry point
- +1 NEW XPDIDTOT
- +2 SET XPDIDTOT=1
- +3 ; 1. add a new Claims Tracking Reason Not Billable
- DO CT(1)
- +4 ;
- EX ; exit point
- +1 QUIT
- +2 ;
- CT(IBXPD) ; add a new CT RNB
- +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 Claims Tracking RNB ... ")
- +5 ;
- +6 FOR X="TRICARE INPATIENT/DISCHARGE"
- Begin DoDot:1
- +7 IF $DATA(^IBE(356.8,"B",X))
- DO MES^XPDUTL("Already there...no action")
- QUIT
- +8 SET DIC="^IBE(356.8,"
- SET DIC(0)="F"
- +9 SET DIC("DR")=".04///RX16"
- +10 DO FILE^DICN
- +11 IF Y=-1
- DO MES^XPDUTL("ERROR when adding a new RNB to CT. Please log a Remedy ticket!")
- QUIT
- +12 DO MES^XPDUTL("Entry added successfully")
- +13 QUIT
- End DoDot:1
- +14 ;
- CTX ;
- +1 DO MES^XPDUTL(" Done.")
- +2 DO UPDATE^XPDID(IBXPD)
- +3 QUIT
- +4 ;
