| 1 | IBRCON2 ;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.
|
|---|
| 4 | INIT ;
|
|---|
| 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
|
|---|
| 9 | START ;
|
|---|
| 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
|
|---|
| 23 | END ;
|
|---|
| 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
|
|---|
| 29 | NEXT ;
|
|---|
| 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
|
|---|
| 35 | LOOP ;
|
|---|
| 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
|
|---|
| 41 | LOAD1 ;
|
|---|
| 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
|
|---|
| 46 | LOAD2 ;
|
|---|
| 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
|
|---|
| 51 | PROMPT ;
|
|---|
| 52 | S %DT="AEX" D ^%DT
|
|---|
| 53 | Q
|
|---|
| 54 | ERR ;
|
|---|
| 55 | W !,"Error encountered - a separate bulletin has been posted"
|
|---|
| 56 | Q
|
|---|
| 57 | PROMPT2 ;
|
|---|
| 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
|
|---|
| 65 | QUEUED ;
|
|---|
| 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
|
|---|
| 68 | OPEN ;
|
|---|
| 69 | S %ZIS="QM" D ^%ZIS
|
|---|
| 70 | Q
|
|---|
| 71 | MAIL ;
|
|---|
| 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
|
|---|
