- IBCDC ;ALB/ARH - AUTOMATED BILLER (CLEAN-UP) ; 9/5/93
- ;;Version 2.0 ; INTEGRATED BILLING ;**55**; 21-MAR-94
- ;;Per VHA Directive 10-93-142, this routine should not be modified.
- ;
- I $D(^TMP("IBEABD",$J)) D SEABD
- I $D(^TMP("IBCE",$J)) D SETCOMM^IBCDE
- I $D(^TMP("IBILL",$J)) D SCTB
- Q
- ;
- SEABD ;reset EABD on events
- ;^TMP("IBEABD",$J,IBTRN,IBDT(=new date))
- I $D(^TMP("IBEABD",$J)) S IBTRN=0 F S IBTRN=$O(^TMP("IBEABD",$J,IBTRN)) Q:'IBTRN D
- . S IBEABD=$O(^TMP("IBEABD",$J,IBTRN,"")) D EABD(IBTRN,IBEABD)
- K IBTRN,IBEABD
- Q
- ;
- EABD(DA,EABD) ; set EABD (356,.17) of claims tracking entry DA to the value in EABD
- N X,Y,DIE,DR,DTOUT Q:'$D(^IBT(356,+$G(DA),0)) I '$G(EABD) S EABD="@"
- S DIE="^IBT(356,",DR=".17////"_EABD D ^DIE
- Q
- ;
- SCTB ;set Claims Tracking/Bill file (356,.17) entries (causes .17 set)
- ;^TMP("IBILL",$J,IBTRN,IBIFN)
- I $D(^TMP("IBILL",$J)) S IBTRN=0 F S IBTRN=$O(^TMP("IBILL",$J,IBTRN)) Q:'IBTRN D
- . S IBIFN=0 F S IBIFN=$O(^TMP("IBILL",$J,IBTRN,IBIFN)) Q:'IBIFN D CTB(IBTRN,IBIFN)
- K IBTRN,IBIFN
- Q
- ;
- CTB(TRN,IFN) ; set Claims Tracking/Bill file (356.399) entries which also sets (356,.17)
- N X,Y,DIE,DR,DTOUT I '$G(TRN)!'$G(IFN) Q
- I '$D(^IBT(356.399,"ACB",TRN,IFN)) S DIC="^IBT(356.399,",DIC(0)="L",DIC("DR")=".02////"_IFN,X=TRN K DD,DO D FILE^DICN
- K X,Y,DIC
- Q
- ;
- BSTAT(IFN) ; updates certain files/fields based on the status of the bill passed in
- ;SHOULD BE CALLED BY ANY ROUTINE THAT CAUSES A BILLS STATUS TO CHANGE TO CANCELED OR PRINTED
- ;if bill status is canceled: deletes bill comments (362.1) and deletes the initial bill number from (356,.11)
- ;if bill is printed: deletes bills comments (362.1)
- ;NOTE THAT ENTRIES IN 356.399 ARE NOT DELETED IF BILL IS CANCELLED, just the initial bill number in 356
- N X,Y,IBI,IBX,IBY,TRN,STAT S IFN=+$G(IFN),STAT=$G(^DGCR(399,IFN,0)),STAT=+$P(STAT,U,13) I STAT<4 G BSTATQ
- I STAT=7 S IBX=$$FBILL(IFN) I +IBX F IBI=1:1 S TRN=$P(IBX,U,IBI) Q:'TRN D ;modifiy claims tracking entry
- . I $P($G(^IBT(356,TRN,0)),U,11)=IFN S DIE="^IBT(356,",DA=TRN,DR=".11///@" D ^DIE K DIE,DA,DR ;delete initial bill #
- I STAT>3 S IBX=$$FINDB^IBCDE(IFN) I +IBX F IBI=1:1 S IBY=$P(IBX,U,IBI) Q:'IBY D
- . S DIK="^IBA(362.1,",DA=+IBY D ^DIK K DIK,DA ; delete comment entries for bill
- BSTATQ Q
- ;
- COPYB(IFN,IFN1) ;function for copy a bill, adds comment to comment file (362.1) for bill and event
- ;and adds an entry to the event/bill file (356.399) (IFN is old bill, IFN1 new bill) nothing returned
- N X,Y,IBX1,IBX,IBY,COMM,IBI S IFN=+$G(IFN),IBX=$G(^DGCR(399,IFN,0)) I IBX="" G COPYBE
- S COMM="Copied from bill "_$P(IBX,U,1) S IBX=$$FBILL(IFN) I 'IBX G COPYBE
- F IBI=1:1 S IBY=$P(IBX,U,IBI) Q:'IBY D CTB(IBY,IFN1) S IBX1=$$COMM1^IBCDE(IBY,IFN1) I +IBX1 D COMM2^IBCDE(IBX1,COMM)
- COPYBE Q
- ;
- FBILL(IFN) ;returns all events associated with a bill (356.399), string of event IFN's separated by "^"
- N X,Y S X="",IFN=+$G(IFN) I '$D(^DGCR(399,IFN,0)) G FBILLE
- S Y=0 F S Y=$O(^IBT(356.399,"C",IFN,Y)) Q:'Y S X=X_+$G(^IBT(356.399,Y,0))_U
- FBILLE Q X
- ;
- CLEAN ;remove all episodes from auto biller list when frequency is turned on, deletes all EABD'S
- N IBX,IBY,IBZ,IBI,IBCNT,X,Y,DIE,DR,DTOUT,DIC,DA
- I $O(^IBT(356,"ATOBIL",0)) W !!,"Removing events already on the auto biller list. Only events added to Claims",!,"Tracking after the auto biller Frequency is set to a positive number",!,"will be auto billed." I +$G(IBZWRT) S IBZWRT=0
- S (IBCNT,IBX)=0 F S IBX=$O(^IBT(356,"ATOBIL",IBX)) Q:'IBX D
- . S IBY=0 F S IBY=$O(^IBT(356,"ATOBIL",IBX,IBY)) Q:'IBY D
- .. S IBZ=0 F S IBZ=$O(^IBT(356,"ATOBIL",IBX,IBY,IBZ)) Q:'IBZ D
- ... S IBI=0 F S IBI=$O(^IBT(356,"ATOBIL",IBX,IBY,IBZ,IBI)) Q:'IBI D
- .... S DA=IBI,DIE="^IBT(356,",DR=".17////@" D ^DIE
- .... S IBCNT=IBCNT+1 I '(IBCNT#20) W "."
- Q
- ;
- ABOFF ; set Automate Billing off for all event types when frequency is turned off
- N IBX,X,Y,DIE,DR,DTOUT,DIC,DA
- W !!,"Since the auto biller has been turned off, the AUTOMATE BILLING parameter",!,"will be turned OFF for all Claims Tracking Event Types...",! I +$G(IBZWRT) S IBZWRT=0
- S IBX=0 F S IBX=$O(^IBE(356.6,IBX)) Q:'IBX D
- . I +$P($G(^IBE(356.6,IBX,0)),U,4) S DA=IBX,DIE="^IBE(356.6,",DR=".04////@" D ^DIE
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCDC 4244 printed Feb 18, 2025@23:35:42 Page 2
- IBCDC ;ALB/ARH - AUTOMATED BILLER (CLEAN-UP) ; 9/5/93
- +1 ;;Version 2.0 ; INTEGRATED BILLING ;**55**; 21-MAR-94
- +2 ;;Per VHA Directive 10-93-142, this routine should not be modified.
- +3 ;
- +4 IF $DATA(^TMP("IBEABD",$JOB))
- DO SEABD
- +5 IF $DATA(^TMP("IBCE",$JOB))
- DO SETCOMM^IBCDE
- +6 IF $DATA(^TMP("IBILL",$JOB))
- DO SCTB
- +7 QUIT
- +8 ;
- SEABD ;reset EABD on events
- +1 ;^TMP("IBEABD",$J,IBTRN,IBDT(=new date))
- +2 IF $DATA(^TMP("IBEABD",$JOB))
- SET IBTRN=0
- FOR
- SET IBTRN=$ORDER(^TMP("IBEABD",$JOB,IBTRN))
- if 'IBTRN
- QUIT
- Begin DoDot:1
- +3 SET IBEABD=$ORDER(^TMP("IBEABD",$JOB,IBTRN,""))
- DO EABD(IBTRN,IBEABD)
- End DoDot:1
- +4 KILL IBTRN,IBEABD
- +5 QUIT
- +6 ;
- EABD(DA,EABD) ; set EABD (356,.17) of claims tracking entry DA to the value in EABD
- +1 NEW X,Y,DIE,DR,DTOUT
- if '$DATA(^IBT(356,+$GET(DA),0))
- QUIT
- IF '$GET(EABD)
- SET EABD="@"
- +2 SET DIE="^IBT(356,"
- SET DR=".17////"_EABD
- DO ^DIE
- +3 QUIT
- +4 ;
- SCTB ;set Claims Tracking/Bill file (356,.17) entries (causes .17 set)
- +1 ;^TMP("IBILL",$J,IBTRN,IBIFN)
- +2 IF $DATA(^TMP("IBILL",$JOB))
- SET IBTRN=0
- FOR
- SET IBTRN=$ORDER(^TMP("IBILL",$JOB,IBTRN))
- if 'IBTRN
- QUIT
- Begin DoDot:1
- +3 SET IBIFN=0
- FOR
- SET IBIFN=$ORDER(^TMP("IBILL",$JOB,IBTRN,IBIFN))
- if 'IBIFN
- QUIT
- DO CTB(IBTRN,IBIFN)
- End DoDot:1
- +4 KILL IBTRN,IBIFN
- +5 QUIT
- +6 ;
- CTB(TRN,IFN) ; set Claims Tracking/Bill file (356.399) entries which also sets (356,.17)
- +1 NEW X,Y,DIE,DR,DTOUT
- IF '$GET(TRN)!'$GET(IFN)
- QUIT
- +2 IF '$DATA(^IBT(356.399,"ACB",TRN,IFN))
- SET DIC="^IBT(356.399,"
- SET DIC(0)="L"
- SET DIC("DR")=".02////"_IFN
- SET X=TRN
- KILL DD,DO
- DO FILE^DICN
- +3 KILL X,Y,DIC
- +4 QUIT
- +5 ;
- BSTAT(IFN) ; updates certain files/fields based on the status of the bill passed in
- +1 ;SHOULD BE CALLED BY ANY ROUTINE THAT CAUSES A BILLS STATUS TO CHANGE TO CANCELED OR PRINTED
- +2 ;if bill status is canceled: deletes bill comments (362.1) and deletes the initial bill number from (356,.11)
- +3 ;if bill is printed: deletes bills comments (362.1)
- +4 ;NOTE THAT ENTRIES IN 356.399 ARE NOT DELETED IF BILL IS CANCELLED, just the initial bill number in 356
- +5 NEW X,Y,IBI,IBX,IBY,TRN,STAT
- SET IFN=+$GET(IFN)
- SET STAT=$GET(^DGCR(399,IFN,0))
- SET STAT=+$PIECE(STAT,U,13)
- IF STAT<4
- GOTO BSTATQ
- +6 ;modifiy claims tracking entry
- IF STAT=7
- SET IBX=$$FBILL(IFN)
- IF +IBX
- FOR IBI=1:1
- SET TRN=$PIECE(IBX,U,IBI)
- if 'TRN
- QUIT
- Begin DoDot:1
- +7 ;delete initial bill #
- IF $PIECE($GET(^IBT(356,TRN,0)),U,11)=IFN
- SET DIE="^IBT(356,"
- SET DA=TRN
- SET DR=".11///@"
- DO ^DIE
- KILL DIE,DA,DR
- End DoDot:1
- +8 IF STAT>3
- SET IBX=$$FINDB^IBCDE(IFN)
- IF +IBX
- FOR IBI=1:1
- SET IBY=$PIECE(IBX,U,IBI)
- if 'IBY
- QUIT
- Begin DoDot:1
- +9 ; delete comment entries for bill
- SET DIK="^IBA(362.1,"
- SET DA=+IBY
- DO ^DIK
- KILL DIK,DA
- End DoDot:1
- BSTATQ QUIT
- +1 ;
- COPYB(IFN,IFN1) ;function for copy a bill, adds comment to comment file (362.1) for bill and event
- +1 ;and adds an entry to the event/bill file (356.399) (IFN is old bill, IFN1 new bill) nothing returned
- +2 NEW X,Y,IBX1,IBX,IBY,COMM,IBI
- SET IFN=+$GET(IFN)
- SET IBX=$GET(^DGCR(399,IFN,0))
- IF IBX=""
- GOTO COPYBE
- +3 SET COMM="Copied from bill "_$PIECE(IBX,U,1)
- SET IBX=$$FBILL(IFN)
- IF 'IBX
- GOTO COPYBE
- +4 FOR IBI=1:1
- SET IBY=$PIECE(IBX,U,IBI)
- if 'IBY
- QUIT
- DO CTB(IBY,IFN1)
- SET IBX1=$$COMM1^IBCDE(IBY,IFN1)
- IF +IBX1
- DO COMM2^IBCDE(IBX1,COMM)
- COPYBE QUIT
- +1 ;
- FBILL(IFN) ;returns all events associated with a bill (356.399), string of event IFN's separated by "^"
- +1 NEW X,Y
- SET X=""
- SET IFN=+$GET(IFN)
- IF '$DATA(^DGCR(399,IFN,0))
- GOTO FBILLE
- +2 SET Y=0
- FOR
- SET Y=$ORDER(^IBT(356.399,"C",IFN,Y))
- if 'Y
- QUIT
- SET X=X_+$GET(^IBT(356.399,Y,0))_U
- FBILLE QUIT X
- +1 ;
- CLEAN ;remove all episodes from auto biller list when frequency is turned on, deletes all EABD'S
- +1 NEW IBX,IBY,IBZ,IBI,IBCNT,X,Y,DIE,DR,DTOUT,DIC,DA
- +2 IF $ORDER(^IBT(356,"ATOBIL",0))
- WRITE !!,"Removing events already on the auto biller list. Only events added to Claims",!,"Tracking after the auto biller Frequency is set to a positive number",!,"will be auto billed."
- IF +$GET(IBZWRT)
- SET IBZWRT=0
- +3 SET (IBCNT,IBX)=0
- FOR
- SET IBX=$ORDER(^IBT(356,"ATOBIL",IBX))
- if 'IBX
- QUIT
- Begin DoDot:1
- +4 SET IBY=0
- FOR
- SET IBY=$ORDER(^IBT(356,"ATOBIL",IBX,IBY))
- if 'IBY
- QUIT
- Begin DoDot:2
- +5 SET IBZ=0
- FOR
- SET IBZ=$ORDER(^IBT(356,"ATOBIL",IBX,IBY,IBZ))
- if 'IBZ
- QUIT
- Begin DoDot:3
- +6 SET IBI=0
- FOR
- SET IBI=$ORDER(^IBT(356,"ATOBIL",IBX,IBY,IBZ,IBI))
- if 'IBI
- QUIT
- Begin DoDot:4
- +7 SET DA=IBI
- SET DIE="^IBT(356,"
- SET DR=".17////@"
- DO ^DIE
- +8 SET IBCNT=IBCNT+1
- IF '(IBCNT#20)
- WRITE "."
- End DoDot:4
- End DoDot:3
- End DoDot:2
- End DoDot:1
- +9 QUIT
- +10 ;
- ABOFF ; set Automate Billing off for all event types when frequency is turned off
- +1 NEW IBX,X,Y,DIE,DR,DTOUT,DIC,DA
- +2 WRITE !!,"Since the auto biller has been turned off, the AUTOMATE BILLING parameter",!,"will be turned OFF for all Claims Tracking Event Types...",!
- IF +$GET(IBZWRT)
- SET IBZWRT=0
- +3 SET IBX=0
- FOR
- SET IBX=$ORDER(^IBE(356.6,IBX))
- if 'IBX
- QUIT
- Begin DoDot:1
- +4 IF +$PIECE($GET(^IBE(356.6,IBX,0)),U,4)
- SET DA=IBX
- SET DIE="^IBE(356.6,"
- SET DR=".04////@"
- DO ^DIE
- End DoDot:1
- +5 QUIT