IB20P569 ;ALB/CXW - IB*2.0*569 Post Init: Administrative Charge Update;06-27-2016
;;2.0;INTEGRATED BILLING;**569**;21-MAR-94;Build 6
;;Per VA Directive 6402, this routine should not be modified.
Q
;
POST ; post-install of patch installation
; use default rate type of rx 3rd party bill to update RS in #363
;
N U,IBA,IBCT,IBI,IBJ,IBT,IBX,IBY,IBRS,IBRSIN,IBRATY,IBEFFDT,IBADFE,IBDISP,IBADJUST,Y
D MSG("Patch IB*2.0*569 Post-Install starts...")
D MSG("")
S IBADFE="",IBCT=0,U="^"
D MSG(" >>>Effect. JAN 01, 2016 of RX Rate Schedule Adjustment for the Rate Type:")
F IBX=1:1 S IBT=$P($T(RSF+IBX),";",3) Q:'$L(IBT) D
. S IBRS=""
. S IBRATY=$P(IBT,U),IBRATY=$TR(IBRATY,"/",U)
. S IBDISP=$P(IBT,U,2)
. S IBADJUST=$P(IBT,U,3)
. S IBEFFDT=$P(IBT,U,4)
. F IBI=1:1 S IBJ=$P(IBRATY,U,IBI) Q:IBJ="" D
.. S IBRSIN=$O(^DGCR(399.3,"B",IBJ,0))
.. I 'IBRSIN D MSG(" "_IBJ_" not defined in the Rate Type file (#399.3), not added") Q
.. ; find the latest ien if multiple
.. I $P($G(^DGCR(399.3,+IBRSIN,0)),U,3) S IBRSIN=$O(^DGCR(399.3,"B",IBJ,999999),-1)
.. I $P($G(^DGCR(399.3,+IBRSIN,0)),U,3) D MSG(" "_IBJ_" inactivated in the Rate Type file (#399.3), not added") Q
.. I $$RSEXIST(IBEFFDT,IBRSIN) D MSG(" "_IBJ_" already exists") Q
.. ; add new entry for cy2016 and inactivate date for cy2015
.. D ENT^IB3PSOU(IBJ,IBEFFDT,IBADFE,IBDISP,IBADJUST)
.. ; double check
.. I '$$RSEXIST(IBEFFDT,IBRSIN) D MSG(" "_IBJ_" not added") Q
.. S IBCT=IBCT+1 D MSG(" "_IBJ_" added")
D MSG("")
D MSG(" Total "_IBCT_$S(IBCT=1:" entry",1:" entries")_" added to the Rate Schedule file (#363)")
D MSG("")
D MSG("Patch IB*2.0*569 Post-Install is complete.")
Q
;
RSEXIST(IBEFFDT,IBRSIN) ; return RS IFN if Rate Schedule exists for Effective Date
N IBX,IBRSFN,IBRS0 S IBX=0
S IBRSFN=0 F S IBRSFN=$O(^IBE(363,IBRSFN)) Q:'IBRSFN D I IBX Q
. S IBRS0=$G(^IBE(363,IBRSFN,0))
. I $P(IBRS0,U,2)=IBRSIN,$P(IBRS0,U,5)=IBEFFDT S IBX=IBRSFN
Q IBX
;
MSG(IBA) ;
D MES^XPDUTL(IBA)
Q
;
RSF ; rate type separated by '/'^dispensing fee^adjustment^effective date
;;HUMANITARIAN/INELIGIBLE/INTERAGENCY/NO FAULT INS./REIMBURSABLE INS./TORT FEASOR/WORKERS' COMP.^14.29^S X=X+14.29^3160101
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIB20P569 2270 printed Dec 13, 2024@02:03:48 Page 2
IB20P569 ;ALB/CXW - IB*2.0*569 Post Init: Administrative Charge Update;06-27-2016
+1 ;;2.0;INTEGRATED BILLING;**569**;21-MAR-94;Build 6
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
POST ; post-install of patch installation
+1 ; use default rate type of rx 3rd party bill to update RS in #363
+2 ;
+3 NEW U,IBA,IBCT,IBI,IBJ,IBT,IBX,IBY,IBRS,IBRSIN,IBRATY,IBEFFDT,IBADFE,IBDISP,IBADJUST,Y
+4 DO MSG("Patch IB*2.0*569 Post-Install starts...")
+5 DO MSG("")
+6 SET IBADFE=""
SET IBCT=0
SET U="^"
+7 DO MSG(" >>>Effect. JAN 01, 2016 of RX Rate Schedule Adjustment for the Rate Type:")
+8 FOR IBX=1:1
SET IBT=$PIECE($TEXT(RSF+IBX),";",3)
if '$LENGTH(IBT)
QUIT
Begin DoDot:1
+9 SET IBRS=""
+10 SET IBRATY=$PIECE(IBT,U)
SET IBRATY=$TRANSLATE(IBRATY,"/",U)
+11 SET IBDISP=$PIECE(IBT,U,2)
+12 SET IBADJUST=$PIECE(IBT,U,3)
+13 SET IBEFFDT=$PIECE(IBT,U,4)
+14 FOR IBI=1:1
SET IBJ=$PIECE(IBRATY,U,IBI)
if IBJ=""
QUIT
Begin DoDot:2
+15 SET IBRSIN=$ORDER(^DGCR(399.3,"B",IBJ,0))
+16 IF 'IBRSIN
DO MSG(" "_IBJ_" not defined in the Rate Type file (#399.3), not added")
QUIT
+17 ; find the latest ien if multiple
+18 IF $PIECE($GET(^DGCR(399.3,+IBRSIN,0)),U,3)
SET IBRSIN=$ORDER(^DGCR(399.3,"B",IBJ,999999),-1)
+19 IF $PIECE($GET(^DGCR(399.3,+IBRSIN,0)),U,3)
DO MSG(" "_IBJ_" inactivated in the Rate Type file (#399.3), not added")
QUIT
+20 IF $$RSEXIST(IBEFFDT,IBRSIN)
DO MSG(" "_IBJ_" already exists")
QUIT
+21 ; add new entry for cy2016 and inactivate date for cy2015
+22 DO ENT^IB3PSOU(IBJ,IBEFFDT,IBADFE,IBDISP,IBADJUST)
+23 ; double check
+24 IF '$$RSEXIST(IBEFFDT,IBRSIN)
DO MSG(" "_IBJ_" not added")
QUIT
+25 SET IBCT=IBCT+1
DO MSG(" "_IBJ_" added")
End DoDot:2
End DoDot:1
+26 DO MSG("")
+27 DO MSG(" Total "_IBCT_$SELECT(IBCT=1:" entry",1:" entries")_" added to the Rate Schedule file (#363)")
+28 DO MSG("")
+29 DO MSG("Patch IB*2.0*569 Post-Install is complete.")
+30 QUIT
+31 ;
RSEXIST(IBEFFDT,IBRSIN) ; return RS IFN if Rate Schedule exists for Effective Date
+1 NEW IBX,IBRSFN,IBRS0
SET IBX=0
+2 SET IBRSFN=0
FOR
SET IBRSFN=$ORDER(^IBE(363,IBRSFN))
if 'IBRSFN
QUIT
Begin DoDot:1
+3 SET IBRS0=$GET(^IBE(363,IBRSFN,0))
+4 IF $PIECE(IBRS0,U,2)=IBRSIN
IF $PIECE(IBRS0,U,5)=IBEFFDT
SET IBX=IBRSFN
End DoDot:1
IF IBX
QUIT
+5 QUIT IBX
+6 ;
MSG(IBA) ;
+1 DO MES^XPDUTL(IBA)
+2 QUIT
+3 ;
RSF ; rate type separated by '/'^dispensing fee^adjustment^effective date
+1 ;;HUMANITARIAN/INELIGIBLE/INTERAGENCY/NO FAULT INS./REIMBURSABLE INS./TORT FEASOR/WORKERS' COMP.^14.29^S X=X+14.29^3160101
+2 ;
