IB20P501 ;ALB/CXW - IB*2.0*501 Post Init: Administrative Charge Update; 04-23-2013
;;2.0;INTEGRATED BILLING;**501**;21-MAR-94;Build 10
;;Per VHA Directive 2004-038, this routine should not be modified.
Q
;
;
POST ; post-install of patch installation
; update the dispensing fee/adjustment for rx rate types in file #363
; default rate types for 3rd party pharmacy claims
; ibraty=rate type names from file #399.3
; ibeffdt=effective external date (mm/dd/yyyy)
; ibadfe=administrative fee (dollar.cent)
; ibdisp=dispensing fee (dollar.cent)
; ibadjust=adjustment mumps code (+ibadjust to screen out an zero cent)
;
N IBI,IBJ,IBRATY,IBEFFDT,IBADFE,IBDISP,IBADJUST
D MES^XPDUTL("Patch Post-Install starts...")
S IBRATY="REIMBURSABLE INS.^NO FAULT INS.^WORKERS' COMP.^TORT FEASOR"
S IBEFFDT="01/01/2013"
S IBADFE=""
S IBDISP="13.18"
S IBADJUST="S X=X+"_(+IBDISP+IBADFE)
F IBI=1:1 S IBJ=$P(IBRATY,U,IBI) Q:IBJ="" I '$O(^DGCR(399.3,"B",IBJ,0)) D MES^XPDUTL("The Rate Type "_IBJ_" not defined, the rate schedule adjustments not updated")
D ENT^IB3PSOU(IBRATY,IBEFFDT,IBADFE,IBDISP,IBADJUST)
D MES^XPDUTL("Patch Post-Install is complete.")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIB20P501 1190 printed Dec 13, 2024@02:03:17 Page 2
IB20P501 ;ALB/CXW - IB*2.0*501 Post Init: Administrative Charge Update; 04-23-2013
+1 ;;2.0;INTEGRATED BILLING;**501**;21-MAR-94;Build 10
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
POST ; post-install of patch installation
+1 ; update the dispensing fee/adjustment for rx rate types in file #363
+2 ; default rate types for 3rd party pharmacy claims
+3 ; ibraty=rate type names from file #399.3
+4 ; ibeffdt=effective external date (mm/dd/yyyy)
+5 ; ibadfe=administrative fee (dollar.cent)
+6 ; ibdisp=dispensing fee (dollar.cent)
+7 ; ibadjust=adjustment mumps code (+ibadjust to screen out an zero cent)
+8 ;
+9 NEW IBI,IBJ,IBRATY,IBEFFDT,IBADFE,IBDISP,IBADJUST
+10 DO MES^XPDUTL("Patch Post-Install starts...")
+11 SET IBRATY="REIMBURSABLE INS.^NO FAULT INS.^WORKERS' COMP.^TORT FEASOR"
+12 SET IBEFFDT="01/01/2013"
+13 SET IBADFE=""
+14 SET IBDISP="13.18"
+15 SET IBADJUST="S X=X+"_(+IBDISP+IBADFE)
+16 FOR IBI=1:1
SET IBJ=$PIECE(IBRATY,U,IBI)
if IBJ=""
QUIT
IF '$ORDER(^DGCR(399.3,"B",IBJ,0))
DO MES^XPDUTL("The Rate Type "_IBJ_" not defined, the rate schedule adjustments not updated")
+17 DO ENT^IB3PSOU(IBRATY,IBEFFDT,IBADFE,IBDISP,IBADJUST)
+18 DO MES^XPDUTL("Patch Post-Install is complete.")
+19 QUIT
+20 ;
