source: WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBRCON2.m@ 1259

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

initial load of WorldVistAEHR

File size: 2.6 KB
Line 
1IBRCON2 ;ALB/RJS - PASSING CHARGES TO A/R BY DATE - 4/28/92
2 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
4INIT ;
5 S (IBRCOUNT,IBRDONE)=0
6 S IBFEE="DG FEE SERVICE (OPT) NEW",IBFEE=$O(^IBE(350.1,"B",IBFEE,0))
7 S IBOPT="DG OPT COPAY NEW",IBOPT=$O(^IBE(350.1,"B",IBOPT,0))
8 I IBFEE=""!(IBOPT="") W !,"Error finding entries in file 350.1" G END
9START ;
10 S %DT("A")="Enter beginning date: "
11 D PROMPT G:Y=-1 END
12 S IBBEG=Y
13 W !
14 S %DT("A")="Enter ending date: "
15 D PROMPT G:Y=-1 END
16 I (Y<IBBEG) W !,"Ending date must be > or = start date!",!
17 I G START
18 S IBENDING=Y
19 W !!
20 S SUBROUT="LOAD1" D LOOP,PROMPT2
21 G:IBRDONE=1 END
22 D QUEUED,HOME^%ZIS
23END ;
24 I $D(ZTQUEUED) S ZTREQ="@" Q
25 K %DT,DFN,IBCUTOFF,IBDUZ,IBNOS,IBRRCNR,IBRXXX,IBSEQNO,Y,XMY
26 K IBEND,IBRCOUNT,IBRDONE,IBSTART,SUBROUT,XMDUZ,XMSUB,XMTEXT
27 K IBFEE,IBOPT,DIR,%,%ZIS,IBBEG,IBENDING
28 Q
29NEXT ;
30 D NOW^%DTC S IBSTART=$$DAT2^IBOUTL(%)
31 S SUBROUT="LOAD2" D LOOP
32 D NOW^%DTC S IBEND=$$DAT2^IBOUTL(%)
33 D MAIL
34 Q
35LOOP ;
36 S IBSEQNO=1,IBDUZ=DUZ
37 F IBRXXX=IBFEE,IBOPT D
38 .S IBRRCNR=0
39 .F S IBRRCNR=$O(^IB("AE",IBRXXX,IBRRCNR)) Q:IBRRCNR="" D @SUBROUT
40 Q
41LOAD1 ;
42 Q:$P($G(^IB(IBRRCNR,0)),U,17)=""!($P($G(^(0)),U,17)>IBENDING)!($P($G(^(0)),U,17)<IBBEG)!($P($G(^(0)),U,5)'=99)
43 S IBRCOUNT=IBRCOUNT+1
44 W "."
45 Q
46LOAD2 ;
47 Q:$P($G(^IB(IBRRCNR,0)),U,17)=""!($P($G(^(0)),U,17)>IBENDING)!($P($G(^(0)),U,17)<IBBEG)!($P($G(^(0)),U,5)'=99)
48 S IBNOS=IBRRCNR,DFN=$P(^IB(IBRRCNR,0),U,2)
49 D ^IBR,ERR:Y<1
50 Q
51PROMPT ;
52 S %DT="AEX" D ^%DT
53 Q
54ERR ;
55 W !,"Error encountered - a separate bulletin has been posted"
56 Q
57PROMPT2 ;
58 I IBRCOUNT=0 W !," There are no outpatient or fee basis converted",!," charges in this date range" S IBRDONE=1 Q
59 W !!,"There are [ ",IBRCOUNT," ] charges to be passed to accounts receivable",!
60 S DIR(0)="YA"
61 S DIR("A")="Do you wish to pass these charges to accounts receivable (Y/N): "
62 D ^DIR
63 I Y'=1 S IBRDONE=1 Q
64 Q
65QUEUED ;
66 S ZTIO="",ZTRTN="NEXT^IBRCON2",ZTDESC="IBRCON2 JOB TO PASS TO AR CONVERTED CHARGES",ZTSAVE("IB*")="" D ^%ZTLOAD W !!,$S($D(ZTSK):"Request Queued",1:"Request Cancelled")
67 Q
68OPEN ;
69 S %ZIS="QM" D ^%ZIS
70 Q
71MAIL ;
72 S XMSUB="PASSED CONVERTED CHARGES"
73 S XMDUZ="INTEGRATED BILLING PACKAGE"
74 S XMTEXT="IBT("
75 K IBT,XMY
76 S XMY(IBDUZ)=""
77 S IBT(1)="The job that passes converted charges to accounts receivable"
78 S IBT(2)="is complete."
79 S IBT(3)="[ "_IBRCOUNT_" ] charges have been passed to accounts receivable."
80 S IBT(4)=""
81 S IBT(5)="Job started on "_$P(IBSTART,"@",1)_" at "_$P(IBSTART,"@",2)
82 S IBT(6)="Job finished on "_$P(IBEND,"@",1)_" at "_$P(IBEND,"@",2)
83 D ^XMD
84 Q
Note: See TracBrowser for help on using the repository browser.