- 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 Jan 18, 2025@03:26:56 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