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 Nov 22, 2024@17:44:10 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 ;
