source: FOIAVistA/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBOHRL.m@ 1806

Last change on this file since 1806 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 2.5 KB
Line 
1IBOHRL ;ALB/EMG-AUTO-RELEASE CHARGES ON HOLD > 90 DAYS ;APR 11 1997
2 ;;2.0;INTEGRATED BILLING;**70,215**;21-MAR-94
3 ;
4 ;
5EN ;
6 N DFN,IBDT,IBDUZ,IBDYS,IBEND,IBGRP,IBN,IBND,IBNOS,IBNUM,IBRCOUNT
7 N IBSEQNO,IBSTJB,IBT,IBTO,X,X1,X2,XMDUZ,XMSUB,XMTEXT,XMY
8 S IBQUIT=0
9 ;
10 D NOW^%DTC S IBSTJB=$$DAT2^IBOUTL(%)
11 ;***
12 K ^TMP($J)
13 D CHRGS
14 D:'$G(IBQUIT) REL,MAIL
15 ;***
16EXIT ;
17 K ^TMP($J)
18 K DFN,IBDT,IBDUZ,IBDYS,IBEND,IBGRP,IBN,IBND,IBNOS,IBNUM,IBRCOUNT,IBDIFROM
19 K IBQUIT,IBSEQNO,IBSTJB,IBT,IBTO,X,X1,X2,XMDUZ,XMSUB,XMTEXT,XMY
20 Q
21 ;
22CHRGS ; indexes charges on hold longer than the number specified in the NUMBER OF DAYS PT CHARGES HELD field (#7.04) of file #350.9
23 ;
24 S IBDYS=$P($G(^IBE(350.9,1,7)),U,4)
25 I IBDYS="" S IBQUIT=1 D E4^IBAERR Q ;quit/send notice if number of days held is unknown
26 S X1=DT,X2=-(IBDYS+1) D C^%DTC S IBTO=X
27 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
28 .S IBND=$G(^IB(IBN,0)) Q:'IBND
29 .Q:$P(IBND,"^",5)'=8
30 .S ^TMP($J,"IBHOLD",DFN,IBN)=""
31 .Q
32 Q
33REL ; release charges to AR
34 S (DFN,IBNUM,IBSEQNO,IBNOS)="",IBSEQNO=1,IBRCOUNT=0
35 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
36 .S IBNOS=IBNUM
37 .S IBDUZ=$P($G(^IB(IBNOS,1)),U) I IBDUZ="" S IBDUZ=DUZ
38 .D ^IBR
39 .I $P($G(^IB(IBNUM,0)),"^",5)=3 D
40 ..S IBRCOUNT=IBRCOUNT+1
41 ..I $G(IBR60) S IBNDE=^IB(IBNUM,0) D IVM^IBAMTV32(IBNDE) K IBNDE
42 .Q
43 Q
44 ;
45MAIL ; send bulletin when job is complete
46 D NOW^%DTC S IBEND=$$DAT2^IBOUTL(%)
47 S XMSUB=$S($G(IBR60):"CHARGES PENDING REIVEW",1:"HELD CHARGES")_" PASSED TO AR "_$P(IBSTJB,"@",1)
48 S XMDUZ="INTEGRATED BILLING PACKAGE",IBDUZ=DUZ
49 K IBT,XMY
50 S IBGRP=$P($G(^XMB(3.8,+$P($G(^IBE(350.9,1,0)),"^",11),0)),"^")
51 I IBGRP]"" S XMY("G."_IBGRP_"@"_^XMB("NETNAME"))=""
52 S XMTEXT="IBT("
53 S XMY(IBDUZ)=""
54 S IBT(1)="The job that passes "_$S($G(IBR60):"charges pending review",1:"held charges")_" to accounts receivable is complete."
55 S IBT(2)="[ "_IBRCOUNT_" ] charge"_$S(IBRCOUNT=1:" has",1:"s have")_" been passed to accounts receivable."
56 S IBT(3)=" "
57 S IBT(4)="Job started on "_$P(IBSTJB,"@",1)_" at "_$P(IBSTJB,"@",2)
58 S IBT(5)="Job finished on "_$P(IBEND,"@",1)_" at "_$P(IBEND,"@",2)
59 S IBT(6)=" "
60 S IBT(7)=" "
61 I IBRCOUNT>0 D
62 .S IBT(8)="* Use option 'On Hold/Hold-Review Charges Released to AR' to print a detailed"
63 .S IBT(9)=" list of charges auto-released by this tasked job."
64 ;
65 I $G(DIFROM) S IBDIFROM=DIFROM K DIFROM
66 D ^XMD
67 I $G(IBDIFROM) S DIFROM=IBDIFROM
68 Q
Note: See TracBrowser for help on using the repository browser.