IB20P564 ;ALB/CXW - IB*2.0*564 POST INIT: TIMEFRAME OF BILL UPDATE ;06-19-2017
;;2.0;INTEGRATED BILLING;**564**;21-MAR-94;Build 25
;;Per VA Directive 6402, this routine should not be modified.
Q
;
POST ; replace 'O' with '0' for timeframe of bill in #.06/399 & #.26/399
TBU ; old data stores in XTMP for tracking for 30 days from install date
N IBA,IBC,IBCNT,IBIFN,IBTF,IBTFUB,IBRCD,IB564,DA,DIE,DR,DT,X,X1,X2
S (IBC,IBCNT)=0,IB564="IB20P564"
K ^XTMP(IB564)
S DT=$$DT^XLFDT,X1=DT,X2=30 D C^%DTC
S ^XTMP(IB564,0)=X_U_DT_U_"IB*2.0*564 POST INIT"
D MSG(" Timeframe of Bill Fix Post-Install .....")
S IBIFN=0 F S IBIFN=$O(^DGCR(399,IBIFN)) Q:'IBIFN S DR="" D
. S IBRCD=$G(^DGCR(399,IBIFN,0))
. S IBTF=$P(IBRCD,U,6)
. S IBTFUB=$P(IBRCD,U,26)
. S IBC=IBC+1
. I IBC#1000=0 W "."
. I IBTF="O" S DR=".06///0"
. I IBTFUB="O" S DR=DR_";.26///0"
. I DR'="" D
.. S DIE="^DGCR(399,",DA=IBIFN D ^DIE
.. S IBCNT=IBCNT+1,^XTMP(IB564,IBIFN)=IBRCD
S ^XTMP(IB564,0)=^XTMP(IB564,0)_U_IBCNT
D MSG(">>>>Total "_IBCNT_" bill"_$S(IBCNT'=1:"s",1:"")_" updated in the Bill/Claims (#399) file")
;
RCP ; input template compilation for timeframe of bill
N DMAX,IBN,IBX
S DMAX=$$ROUSIZE^DILF
F IBN=1:1 S IBX=$P($T(TMPL+IBN),";;",2) Q:IBX="" D COMP(IBX,DMAX)
D MSG(" Timeframe of Bill Fix Post-Install Complete")
Q
;
COMP(IBX,DMAX) ;
N IBIEN,IBRTN,X,Y
S IBIEN=$O(^DIE("B",IBX,0)) Q:'IBIEN
S IBRTN=$P($G(^DIE(IBIEN,"ROUOLD")),U) Q:IBRTN=""
S X=IBRTN,Y=IBIEN
D EN^DIEZ
Q
TMPL ;
;;IB SCREEN6
;;IB SCREEN7
;;
MSG(IBA) ;
D MES^XPDUTL(IBA)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIB20P564 1602 printed Nov 22, 2024@17:13:52 Page 2
IB20P564 ;ALB/CXW - IB*2.0*564 POST INIT: TIMEFRAME OF BILL UPDATE ;06-19-2017
+1 ;;2.0;INTEGRATED BILLING;**564**;21-MAR-94;Build 25
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
POST ; replace 'O' with '0' for timeframe of bill in #.06/399 & #.26/399
TBU ; old data stores in XTMP for tracking for 30 days from install date
+1 NEW IBA,IBC,IBCNT,IBIFN,IBTF,IBTFUB,IBRCD,IB564,DA,DIE,DR,DT,X,X1,X2
+2 SET (IBC,IBCNT)=0
SET IB564="IB20P564"
+3 KILL ^XTMP(IB564)
+4 SET DT=$$DT^XLFDT
SET X1=DT
SET X2=30
DO C^%DTC
+5 SET ^XTMP(IB564,0)=X_U_DT_U_"IB*2.0*564 POST INIT"
+6 DO MSG(" Timeframe of Bill Fix Post-Install .....")
+7 SET IBIFN=0
FOR
SET IBIFN=$ORDER(^DGCR(399,IBIFN))
if 'IBIFN
QUIT
SET DR=""
Begin DoDot:1
+8 SET IBRCD=$GET(^DGCR(399,IBIFN,0))
+9 SET IBTF=$PIECE(IBRCD,U,6)
+10 SET IBTFUB=$PIECE(IBRCD,U,26)
+11 SET IBC=IBC+1
+12 IF IBC#1000=0
WRITE "."
+13 IF IBTF="O"
SET DR=".06///0"
+14 IF IBTFUB="O"
SET DR=DR_";.26///0"
+15 IF DR'=""
Begin DoDot:2
+16 SET DIE="^DGCR(399,"
SET DA=IBIFN
DO ^DIE
+17 SET IBCNT=IBCNT+1
SET ^XTMP(IB564,IBIFN)=IBRCD
End DoDot:2
End DoDot:1
+18 SET ^XTMP(IB564,0)=^XTMP(IB564,0)_U_IBCNT
+19 DO MSG(">>>>Total "_IBCNT_" bill"_$SELECT(IBCNT'=1:"s",1:"")_" updated in the Bill/Claims (#399) file")
+20 ;
RCP ; input template compilation for timeframe of bill
+1 NEW DMAX,IBN,IBX
+2 SET DMAX=$$ROUSIZE^DILF
+3 FOR IBN=1:1
SET IBX=$PIECE($TEXT(TMPL+IBN),";;",2)
if IBX=""
QUIT
DO COMP(IBX,DMAX)
+4 DO MSG(" Timeframe of Bill Fix Post-Install Complete")
+5 QUIT
+6 ;
COMP(IBX,DMAX) ;
+1 NEW IBIEN,IBRTN,X,Y
+2 SET IBIEN=$ORDER(^DIE("B",IBX,0))
if 'IBIEN
QUIT
+3 SET IBRTN=$PIECE($GET(^DIE(IBIEN,"ROUOLD")),U)
if IBRTN=""
QUIT
+4 SET X=IBRTN
SET Y=IBIEN
+5 DO EN^DIEZ
+6 QUIT
TMPL ;
+1 ;;IB SCREEN6
+2 ;;IB SCREEN7
+3 ;;
MSG(IBA) ;
+1 DO MES^XPDUTL(IBA)
+2 QUIT
