IBOHRL ;ALB/EMG-AUTO-RELEASE CHARGES ON HOLD > 90 DAYS ;APR 11 1997
;;2.0;INTEGRATED BILLING;**70,215,464,663,675**;21-MAR-94;Build 6
;;Per VHA Directive 6402, this routine should not be modified.
;
;
EN ;
N DFN,IBDT,IBDUZ,IBDYS,IBEND,IBGRP,IBN,IBND,IBNOS,IBNUM,IBRCOUNT
N IBSEQNO,IBSTJB,IBT,IBTO,X,X1,X2,XMDUZ,XMSUB,XMTEXT,XMY
S IBQUIT=0
;
D NOW^%DTC S IBSTJB=$$DAT2^IBOUTL(%)
;***
K ^TMP($J)
D CHRGS
D:'$G(IBQUIT) REL,MAIL
;***
EXIT ;
K ^TMP($J)
K DFN,IBDT,IBDUZ,IBDYS,IBEND,IBGRP,IBN,IBND,IBNOS,IBNUM,IBRCOUNT,IBDIFROM
K IBQUIT,IBSEQNO,IBSTJB,IBT,IBTO,X,X1,X2,XMDUZ,XMSUB,XMTEXT,XMY
Q
;
CHRGS ; indexes charges on hold longer than the number specified in the NUMBER OF DAYS PT CHARGES HELD field (#7.04) of file #350.9
;
S IBDYS=$P($G(^IBE(350.9,1,7)),U,4)
I IBDYS="" S IBQUIT=1 D E4^IBAERR Q ;quit/send notice if number of days held is unknown
S X1=DT,X2=-(IBDYS+1) D C^%DTC S IBTO=X
S DFN=0 F S DFN=$O(^IB("AHDT",DFN)) Q:'DFN S IBDT=0 F S IBDT=$O(^IB("AHDT",DFN,8,IBDT)) Q:'IBDT!(IBDT>IBTO) S IBN=0 F S IBN=$O(^IB("AHDT",DFN,8,IBDT,IBN)) Q:IBN="" D
.S IBND=$G(^IB(IBN,0)) Q:'IBND
.Q:$P(IBND,"^",5)'=8
.S ^TMP($J,"IBHOLD",DFN,IBN)=""
.Q
Q
REL ; release charges to AR
S (DFN,IBNUM,IBSEQNO,IBNOS)="",IBSEQNO=1,IBRCOUNT=0
S DFN=0 F S DFN=$O(^TMP($J,"IBHOLD",DFN)) Q:'DFN S IBNUM=0 F S IBNUM=$O(^TMP($J,"IBHOLD",DFN,IBNUM)) Q:'IBNUM D
.S IBNOS=IBNUM
.S IBDUZ=$P($G(^IB(IBNOS,1)),U) I IBDUZ="" S IBDUZ=DUZ
.D ^IBR
.D UPDUCDB^IBRREL(IBNOS) ;IB*2.0*663 allow for update of UC Visit DB
.I $P($G(^IB(IBNUM,0)),"^",5)=3 D
..S IBRCOUNT=IBRCOUNT+1
..I $G(IBR60) S IBNDE=^IB(IBNUM,0) D IVM^IBAMTV32(IBNDE) K IBNDE
.Q
Q
;
MAIL ; send bulletin when job is complete
D NOW^%DTC S IBEND=$$DAT2^IBOUTL(%)
S XMSUB=$S($G(IBR60):"CHARGES PENDING REVIEW",1:"HELD CHARGES")_" PASSED TO AR "_$P(IBSTJB,"@",1)
S XMDUZ="INTEGRATED BILLING PACKAGE",IBDUZ=DUZ
K IBT,XMY
S IBGRP=$P($G(^XMB(3.8,+$P($G(^IBE(350.9,1,0)),"^",11),0)),"^")
I IBGRP]"" S XMY("G."_IBGRP_"@"_^XMB("NETNAME"))=""
S XMTEXT="IBT("
S XMY(IBDUZ)=""
S IBT(1)="The job that passes "_$S($G(IBR60):"charges pending review",1:"held charges")_" to accounts receivable is complete."
S IBT(2)="[ "_IBRCOUNT_" ] charge"_$S(IBRCOUNT=1:" has",1:"s have")_" been passed to accounts receivable."
S IBT(3)=" "
S IBT(4)="Job started on "_$P(IBSTJB,"@",1)_" at "_$P(IBSTJB,"@",2)
S IBT(5)="Job finished on "_$P(IBEND,"@",1)_" at "_$P(IBEND,"@",2)
S IBT(6)=" "
S IBT(7)=" "
I IBRCOUNT>0 D
.S IBT(8)="* Use option 'On Hold/Hold-Review Charges Released to AR' to print a detailed"
.S IBT(9)=" list of charges auto-released by this tasked job."
;
I $G(DIFROM) S IBDIFROM=DIFROM K DIFROM
D ^XMD
I $G(IBDIFROM) S DIFROM=IBDIFROM
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBOHRL 2803 printed Nov 22, 2024@17:35:48 Page 2
IBOHRL ;ALB/EMG-AUTO-RELEASE CHARGES ON HOLD > 90 DAYS ;APR 11 1997
+1 ;;2.0;INTEGRATED BILLING;**70,215,464,663,675**;21-MAR-94;Build 6
+2 ;;Per VHA Directive 6402, this routine should not be modified.
+3 ;
+4 ;
EN ;
+1 NEW DFN,IBDT,IBDUZ,IBDYS,IBEND,IBGRP,IBN,IBND,IBNOS,IBNUM,IBRCOUNT
+2 NEW IBSEQNO,IBSTJB,IBT,IBTO,X,X1,X2,XMDUZ,XMSUB,XMTEXT,XMY
+3 SET IBQUIT=0
+4 ;
+5 DO NOW^%DTC
SET IBSTJB=$$DAT2^IBOUTL(%)
+6 ;***
+7 KILL ^TMP($JOB)
+8 DO CHRGS
+9 if '$GET(IBQUIT)
DO REL
DO MAIL
+10 ;***
EXIT ;
+1 KILL ^TMP($JOB)
+2 KILL DFN,IBDT,IBDUZ,IBDYS,IBEND,IBGRP,IBN,IBND,IBNOS,IBNUM,IBRCOUNT,IBDIFROM
+3 KILL IBQUIT,IBSEQNO,IBSTJB,IBT,IBTO,X,X1,X2,XMDUZ,XMSUB,XMTEXT,XMY
+4 QUIT
+5 ;
CHRGS ; indexes charges on hold longer than the number specified in the NUMBER OF DAYS PT CHARGES HELD field (#7.04) of file #350.9
+1 ;
+2 SET IBDYS=$PIECE($GET(^IBE(350.9,1,7)),U,4)
+3 ;quit/send notice if number of days held is unknown
IF IBDYS=""
SET IBQUIT=1
DO E4^IBAERR
QUIT
+4 SET X1=DT
SET X2=-(IBDYS+1)
DO C^%DTC
SET IBTO=X
+5 SET DFN=0
FOR
SET DFN=$ORDER(^IB("AHDT",DFN))
if 'DFN
QUIT
SET IBDT=0
FOR
SET IBDT=$ORDER(^IB("AHDT",DFN,8,IBDT))
if 'IBDT!(IBDT>IBTO)
QUIT
SET IBN=0
FOR
SET IBN=$ORDER(^IB("AHDT",DFN,8,IBDT,IBN))
if IBN=""
QUIT
Begin DoDot:1
+6 SET IBND=$GET(^IB(IBN,0))
if 'IBND
QUIT
+7 if $PIECE(IBND,"^",5)'=8
QUIT
+8 SET ^TMP($JOB,"IBHOLD",DFN,IBN)=""
+9 QUIT
End DoDot:1
+10 QUIT
REL ; release charges to AR
+1 SET (DFN,IBNUM,IBSEQNO,IBNOS)=""
SET IBSEQNO=1
SET IBRCOUNT=0
+2 SET DFN=0
FOR
SET DFN=$ORDER(^TMP($JOB,"IBHOLD",DFN))
if 'DFN
QUIT
SET IBNUM=0
FOR
SET IBNUM=$ORDER(^TMP($JOB,"IBHOLD",DFN,IBNUM))
if 'IBNUM
QUIT
Begin DoDot:1
+3 SET IBNOS=IBNUM
+4 SET IBDUZ=$PIECE($GET(^IB(IBNOS,1)),U)
IF IBDUZ=""
SET IBDUZ=DUZ
+5 DO ^IBR
+6 ;IB*2.0*663 allow for update of UC Visit DB
DO UPDUCDB^IBRREL(IBNOS)
+7 IF $PIECE($GET(^IB(IBNUM,0)),"^",5)=3
Begin DoDot:2
+8 SET IBRCOUNT=IBRCOUNT+1
+9 IF $GET(IBR60)
SET IBNDE=^IB(IBNUM,0)
DO IVM^IBAMTV32(IBNDE)
KILL IBNDE
End DoDot:2
+10 QUIT
End DoDot:1
+11 QUIT
+12 ;
MAIL ; send bulletin when job is complete
+1 DO NOW^%DTC
SET IBEND=$$DAT2^IBOUTL(%)
+2 SET XMSUB=$SELECT($GET(IBR60):"CHARGES PENDING REVIEW",1:"HELD CHARGES")_" PASSED TO AR "_$PIECE(IBSTJB,"@",1)
+3 SET XMDUZ="INTEGRATED BILLING PACKAGE"
SET IBDUZ=DUZ
+4 KILL IBT,XMY
+5 SET IBGRP=$PIECE($GET(^XMB(3.8,+$PIECE($GET(^IBE(350.9,1,0)),"^",11),0)),"^")
+6 IF IBGRP]""
SET XMY("G."_IBGRP_"@"_^XMB("NETNAME"))=""
+7 SET XMTEXT="IBT("
+8 SET XMY(IBDUZ)=""
+9 SET IBT(1)="The job that passes "_$SELECT($GET(IBR60):"charges pending review",1:"held charges")_" to accounts receivable is complete."
+10 SET IBT(2)="[ "_IBRCOUNT_" ] charge"_$SELECT(IBRCOUNT=1:" has",1:"s have")_" been passed to accounts receivable."
+11 SET IBT(3)=" "
+12 SET IBT(4)="Job started on "_$PIECE(IBSTJB,"@",1)_" at "_$PIECE(IBSTJB,"@",2)
+13 SET IBT(5)="Job finished on "_$PIECE(IBEND,"@",1)_" at "_$PIECE(IBEND,"@",2)
+14 SET IBT(6)=" "
+15 SET IBT(7)=" "
+16 IF IBRCOUNT>0
Begin DoDot:1
+17 SET IBT(8)="* Use option 'On Hold/Hold-Review Charges Released to AR' to print a detailed"
+18 SET IBT(9)=" list of charges auto-released by this tasked job."
End DoDot:1
+19 ;
+20 IF $GET(DIFROM)
SET IBDIFROM=DIFROM
KILL DIFROM
+21 DO ^XMD
+22 IF $GET(IBDIFROM)
SET DIFROM=IBDIFROM
+23 QUIT
