- IBRCON2 ;ALB/RJS - PASSING CHARGES TO A/R BY DATE - 4/28/92
- ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- INIT ;
- S (IBRCOUNT,IBRDONE)=0
- S IBFEE="DG FEE SERVICE (OPT) NEW",IBFEE=$O(^IBE(350.1,"B",IBFEE,0))
- S IBOPT="DG OPT COPAY NEW",IBOPT=$O(^IBE(350.1,"B",IBOPT,0))
- I IBFEE=""!(IBOPT="") W !,"Error finding entries in file 350.1" G END
- START ;
- S %DT("A")="Enter beginning date: "
- D PROMPT G:Y=-1 END
- S IBBEG=Y
- W !
- S %DT("A")="Enter ending date: "
- D PROMPT G:Y=-1 END
- I (Y<IBBEG) W !,"Ending date must be > or = start date!",!
- I G START
- S IBENDING=Y
- W !!
- S SUBROUT="LOAD1" D LOOP,PROMPT2
- G:IBRDONE=1 END
- D QUEUED,HOME^%ZIS
- END ;
- I $D(ZTQUEUED) S ZTREQ="@" Q
- K %DT,DFN,IBCUTOFF,IBDUZ,IBNOS,IBRRCNR,IBRXXX,IBSEQNO,Y,XMY
- K IBEND,IBRCOUNT,IBRDONE,IBSTART,SUBROUT,XMDUZ,XMSUB,XMTEXT
- K IBFEE,IBOPT,DIR,%,%ZIS,IBBEG,IBENDING
- Q
- NEXT ;
- D NOW^%DTC S IBSTART=$$DAT2^IBOUTL(%)
- S SUBROUT="LOAD2" D LOOP
- D NOW^%DTC S IBEND=$$DAT2^IBOUTL(%)
- D MAIL
- Q
- LOOP ;
- S IBSEQNO=1,IBDUZ=DUZ
- F IBRXXX=IBFEE,IBOPT D
- .S IBRRCNR=0
- .F S IBRRCNR=$O(^IB("AE",IBRXXX,IBRRCNR)) Q:IBRRCNR="" D @SUBROUT
- Q
- LOAD1 ;
- 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)
- S IBRCOUNT=IBRCOUNT+1
- W "."
- Q
- LOAD2 ;
- 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)
- S IBNOS=IBRRCNR,DFN=$P(^IB(IBRRCNR,0),U,2)
- D ^IBR,ERR:Y<1
- Q
- PROMPT ;
- S %DT="AEX" D ^%DT
- Q
- ERR ;
- W !,"Error encountered - a separate bulletin has been posted"
- Q
- PROMPT2 ;
- I IBRCOUNT=0 W !," There are no outpatient or fee basis converted",!," charges in this date range" S IBRDONE=1 Q
- W !!,"There are [ ",IBRCOUNT," ] charges to be passed to accounts receivable",!
- S DIR(0)="YA"
- S DIR("A")="Do you wish to pass these charges to accounts receivable (Y/N): "
- D ^DIR
- I Y'=1 S IBRDONE=1 Q
- Q
- QUEUED ;
- 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")
- Q
- OPEN ;
- S %ZIS="QM" D ^%ZIS
- Q
- MAIL ;
- S XMSUB="PASSED CONVERTED CHARGES"
- S XMDUZ="INTEGRATED BILLING PACKAGE"
- S XMTEXT="IBT("
- K IBT,XMY
- S XMY(IBDUZ)=""
- S IBT(1)="The job that passes converted charges to accounts receivable"
- S IBT(2)="is complete."
- S IBT(3)="[ "_IBRCOUNT_" ] charges have been passed to accounts receivable."
- S IBT(4)=""
- S IBT(5)="Job started on "_$P(IBSTART,"@",1)_" at "_$P(IBSTART,"@",2)
- S IBT(6)="Job finished on "_$P(IBEND,"@",1)_" at "_$P(IBEND,"@",2)
- D ^XMD
- Q
- IBRCON2 ;ALB/RJS - PASSING CHARGES TO A/R BY DATE - 4/28/92
- +1 ;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- INIT ;
- +1 SET (IBRCOUNT,IBRDONE)=0
- +2 SET IBFEE="DG FEE SERVICE (OPT) NEW"
- SET IBFEE=$ORDER(^IBE(350.1,"B",IBFEE,0))
- +3 SET IBOPT="DG OPT COPAY NEW"
- SET IBOPT=$ORDER(^IBE(350.1,"B",IBOPT,0))
- +4 IF IBFEE=""!(IBOPT="")
- WRITE !,"Error finding entries in file 350.1"
- GOTO END
- START ;
- +1 SET %DT("A")="Enter beginning date: "
- +2 DO PROMPT
- IF Y=-1
- GOTO END
- +3 SET IBBEG=Y
- +4 WRITE !
- +5 SET %DT("A")="Enter ending date: "
- +6 DO PROMPT
- IF Y=-1
- GOTO END
- +7 IF (Y<IBBEG)
- WRITE !,"Ending date must be > or = start date!",!
- +8 IF $TEST
- GOTO START
- +9 SET IBENDING=Y
- +10 WRITE !!
- +11 SET SUBROUT="LOAD1"
- DO LOOP
- DO PROMPT2
- +12 IF IBRDONE=1
- GOTO END
- +13 DO QUEUED
- DO HOME^%ZIS
- END ;
- +1 IF $DATA(ZTQUEUED)
- SET ZTREQ="@"
- QUIT
- +2 KILL %DT,DFN,IBCUTOFF,IBDUZ,IBNOS,IBRRCNR,IBRXXX,IBSEQNO,Y,XMY
- +3 KILL IBEND,IBRCOUNT,IBRDONE,IBSTART,SUBROUT,XMDUZ,XMSUB,XMTEXT
- +4 KILL IBFEE,IBOPT,DIR,%,%ZIS,IBBEG,IBENDING
- +5 QUIT
- NEXT ;
- +1 DO NOW^%DTC
- SET IBSTART=$$DAT2^IBOUTL(%)
- +2 SET SUBROUT="LOAD2"
- DO LOOP
- +3 DO NOW^%DTC
- SET IBEND=$$DAT2^IBOUTL(%)
- +4 DO MAIL
- +5 QUIT
- LOOP ;
- +1 SET IBSEQNO=1
- SET IBDUZ=DUZ
- +2 FOR IBRXXX=IBFEE,IBOPT
- Begin DoDot:1
- +3 SET IBRRCNR=0
- +4 FOR
- SET IBRRCNR=$ORDER(^IB("AE",IBRXXX,IBRRCNR))
- IF IBRRCNR=""
- QUIT
- DO @SUBROUT
- End DoDot:1
- +5 QUIT
- LOAD1 ;
- +1 IF $PIECE($GET(^IB(IBRRCNR,0)),U,17)=""!($PIECE($GET(^(0)),U,17)>IBENDING)!($PIECE($GET(^(0)),U,17)<IBBEG)!($PIECE($GET(^(0)),U,5)'=99)
- QUIT
- +2 SET IBRCOUNT=IBRCOUNT+1
- +3 WRITE "."
- +4 QUIT
- LOAD2 ;
- +1 IF $PIECE($GET(^IB(IBRRCNR,0)),U,17)=""!($PIECE($GET(^(0)),U,17)>IBENDING)!($PIECE($GET(^(0)),U,17)<IBBEG)!($PIECE($GET(^(0)),U,5)'=99)
- QUIT
- +2 SET IBNOS=IBRRCNR
- SET DFN=$PIECE(^IB(IBRRCNR,0),U,2)
- +3 DO ^IBR
- IF Y<1
- DO ERR
- +4 QUIT
- PROMPT ;
- +1 SET %DT="AEX"
- DO ^%DT
- +2 QUIT
- ERR ;
- +1 WRITE !,"Error encountered - a separate bulletin has been posted"
- +2 QUIT
- PROMPT2 ;
- +1 IF IBRCOUNT=0
- WRITE !," There are no outpatient or fee basis converted",!," charges in this date range"
- SET IBRDONE=1
- QUIT
- +2 WRITE !!,"There are [ ",IBRCOUNT," ] charges to be passed to accounts receivable",!
- +3 SET DIR(0)="YA"
- +4 SET DIR("A")="Do you wish to pass these charges to accounts receivable (Y/N): "
- +5 DO ^DIR
- +6 IF Y'=1
- SET IBRDONE=1
- QUIT
- +7 QUIT
- QUEUED ;
- +1 SET ZTIO=""
- SET ZTRTN="NEXT^IBRCON2"
- SET ZTDESC="IBRCON2 JOB TO PASS TO AR CONVERTED CHARGES"
- SET ZTSAVE("IB*")=""
- DO ^%ZTLOAD
- WRITE !!,$SELECT($DATA(ZTSK):"Request Queued",1:"Request Cancelled")
- +2 QUIT
- OPEN ;
- +1 SET %ZIS="QM"
- DO ^%ZIS
- +2 QUIT
- MAIL ;
- +1 SET XMSUB="PASSED CONVERTED CHARGES"
- +2 SET XMDUZ="INTEGRATED BILLING PACKAGE"
- +3 SET XMTEXT="IBT("
- +4 KILL IBT,XMY
- +5 SET XMY(IBDUZ)=""
- +6 SET IBT(1)="The job that passes converted charges to accounts receivable"
- +7 SET IBT(2)="is complete."
- +8 SET IBT(3)="[ "_IBRCOUNT_" ] charges have been passed to accounts receivable."
- +9 SET IBT(4)=""
- +10 SET IBT(5)="Job started on "_$PIECE(IBSTART,"@",1)_" at "_$PIECE(IBSTART,"@",2)
- +11 SET IBT(6)="Job finished on "_$PIECE(IBEND,"@",1)_" at "_$PIECE(IBEND,"@",2)
- +12 DO ^XMD
- +13 QUIT
