Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBOHRL

IBOHRL.m

Go to the documentation of this file.
  1. 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
  1. ;;Per VHA Directive 6402, this routine should not be modified.
  1. ;
  1. ;
  1. EN ;
  1. N DFN,IBDT,IBDUZ,IBDYS,IBEND,IBGRP,IBN,IBND,IBNOS,IBNUM,IBRCOUNT
  1. N IBSEQNO,IBSTJB,IBT,IBTO,X,X1,X2,XMDUZ,XMSUB,XMTEXT,XMY
  1. S IBQUIT=0
  1. ;
  1. D NOW^%DTC S IBSTJB=$$DAT2^IBOUTL(%)
  1. ;***
  1. K ^TMP($J)
  1. D CHRGS
  1. D:'$G(IBQUIT) REL,MAIL
  1. ;***
  1. EXIT ;
  1. K ^TMP($J)
  1. K DFN,IBDT,IBDUZ,IBDYS,IBEND,IBGRP,IBN,IBND,IBNOS,IBNUM,IBRCOUNT,IBDIFROM
  1. K IBQUIT,IBSEQNO,IBSTJB,IBT,IBTO,X,X1,X2,XMDUZ,XMSUB,XMTEXT,XMY
  1. Q
  1. ;
  1. 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. ;
  1. S IBDYS=$P($G(^IBE(350.9,1,7)),U,4)
  1. I IBDYS="" S IBQUIT=1 D E4^IBAERR Q ;quit/send notice if number of days held is unknown
  1. S X1=DT,X2=-(IBDYS+1) D C^%DTC S IBTO=X
  1. 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
  1. .S IBND=$G(^IB(IBN,0)) Q:'IBND
  1. .Q:$P(IBND,"^",5)'=8
  1. .S ^TMP($J,"IBHOLD",DFN,IBN)=""
  1. .Q
  1. Q
  1. REL ; release charges to AR
  1. S (DFN,IBNUM,IBSEQNO,IBNOS)="",IBSEQNO=1,IBRCOUNT=0
  1. 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
  1. .S IBNOS=IBNUM
  1. .S IBDUZ=$P($G(^IB(IBNOS,1)),U) I IBDUZ="" S IBDUZ=DUZ
  1. .D ^IBR
  1. .D UPDUCDB^IBRREL(IBNOS) ;IB*2.0*663 allow for update of UC Visit DB
  1. .I $P($G(^IB(IBNUM,0)),"^",5)=3 D
  1. ..S IBRCOUNT=IBRCOUNT+1
  1. ..I $G(IBR60) S IBNDE=^IB(IBNUM,0) D IVM^IBAMTV32(IBNDE) K IBNDE
  1. .Q
  1. Q
  1. ;
  1. MAIL ; send bulletin when job is complete
  1. D NOW^%DTC S IBEND=$$DAT2^IBOUTL(%)
  1. S XMSUB=$S($G(IBR60):"CHARGES PENDING REVIEW",1:"HELD CHARGES")_" PASSED TO AR "_$P(IBSTJB,"@",1)
  1. S XMDUZ="INTEGRATED BILLING PACKAGE",IBDUZ=DUZ
  1. K IBT,XMY
  1. S IBGRP=$P($G(^XMB(3.8,+$P($G(^IBE(350.9,1,0)),"^",11),0)),"^")
  1. I IBGRP]"" S XMY("G."_IBGRP_"@"_^XMB("NETNAME"))=""
  1. S XMTEXT="IBT("
  1. S XMY(IBDUZ)=""
  1. S IBT(1)="The job that passes "_$S($G(IBR60):"charges pending review",1:"held charges")_" to accounts receivable is complete."
  1. S IBT(2)="[ "_IBRCOUNT_" ] charge"_$S(IBRCOUNT=1:" has",1:"s have")_" been passed to accounts receivable."
  1. S IBT(3)=" "
  1. S IBT(4)="Job started on "_$P(IBSTJB,"@",1)_" at "_$P(IBSTJB,"@",2)
  1. S IBT(5)="Job finished on "_$P(IBEND,"@",1)_" at "_$P(IBEND,"@",2)
  1. S IBT(6)=" "
  1. S IBT(7)=" "
  1. I IBRCOUNT>0 D
  1. .S IBT(8)="* Use option 'On Hold/Hold-Review Charges Released to AR' to print a detailed"
  1. .S IBT(9)=" list of charges auto-released by this tasked job."
  1. ;
  1. I $G(DIFROM) S IBDIFROM=DIFROM K DIFROM
  1. D ^XMD
  1. I $G(IBDIFROM) S DIFROM=IBDIFROM
  1. Q