IBTRED1 ;ALB/AAS - CLAIMS TRACKING EDIT ; 06-JUL-93
;;2.0;INTEGRATED BILLING;**458**;21-MAR-94;Build 4
;;Per VHA Directive 2004-038, this routine should not be modified.
;
% G ^IBTRE
;
NX(IBTMPNM) ; -- edit next template
N IBXX,VALMY,IBTRV,IBTRC
D EN^VALM(IBTMPNM)
I '$D(IBFASTXT) D BLD^IBTRED
S VALMBCK="R"
Q
;
EDIT(IBTEMP,BLD) ; -- edit entry point for claims tracking
; -- Input IBTEMP = template name or dr string
; BLD = any non-zero value if calling routine is doing own
; rebuild
;
D FULL^VALM1 W !
L +^IBT(356,+IBTRN):5 I '$T D LOCKED^IBTRCD1 G EDITQ
D SAVE
S DIE="^IBT(356,",DA=IBTRN
S DR=IBTEMP
D ^DIE K DA,DR,DIC,DIE
D COMP
I IBDIF=1 D UPDATE I '$G(BLD) D HDR^IBTRED,BLD^IBTRED
L -^IBT(356,+IBTRN)
EDITQ K ^TMP($J,"IBT")
S VALMBCK="R"
Q
;
SAVE ; -- Save the global before editing
K ^TMP($J,"IBT")
S ^TMP($J,"IBT",356,IBTRN,0)=$G(^IBT(356,IBTRN,0))
S ^TMP($J,"IBT",356,IBTRN,1)=$G(^IBT(356,IBTRN,1))
Q
;
COMP ; -- Compare before editing with globals
S IBDIF=0
I $G(^IBT(356,IBTRN,0))'=$G(^TMP($J,"IBT",356,IBTRN,0)) S IBDIF=1
I $G(^IBT(356,IBTRN,1))'=$G(^TMP($J,"IBT",356,IBTRN,1)) S IBDIF=1
Q
;
UPDATE ; -- enter date and user if editing has taken place
; entry locked by edit, locks not needed here
S DIE="^IBT(356,",DA=IBTRN
S DR="1.03///NOW;1.04////"_DUZ
D ^DIE K DA,DR,DIC,DIE
Q
;
DICS(Y) ; -- called by input transform and screen logic for type of diagnois
N IBY
S IBY=0
I Y=2 S IBY=1 G DICSQ
I Y=1 I '$D(^IBT(356.9,"ATP",+$P($G(^IBT(356.9,DA,0)),U,2),1))!($O(^IBT(356.9,"ATP",+$P($G(^IBT(356.9,DA,0)),U,2),1,0))=DA) S IBY=1
I Y=3 I '$D(^IBT(356.9,"ATP",+$P($G(^IBT(356.9,DA,0)),U,2),3))!($O(^IBT(356.9,"ATP",+$P($G(^IBT(356.9,DA,0)),U,2),3,0))=DA) S IBY=1
;I Y=3 I '$D(^IBT(356.9,"ADG",+$P($G(^IBT(356.9,DA,0)),U,2),+^(0)))!($O(^IBT(356.9,"ADG",+$P($G(^IBT(356.9,DA,0)),U,2),+^(0),0))=DA) S IBY=1
DICSQ Q IBY
;
BILLD(IBTRN) ; -- compute total amount billed and received for this visit
; -- output total amount billed (minus offset) ^ total amount recieved
N X,Y,Z,IBY,IBZ
S (IBY,IBZ)=0
I '$G(IBTRN) G BILLDQ
;
S (X,Y,Z)=0 F S X=$O(^IBT(356.399,"ACB",IBTRN,X)) Q:X="" D COMPUT
;
I 'IBY,'IBZ D ;look to 399 if no ct pointer
.N DGPM,IBEVDT
.S IBEVDT=$P(^IBT(356,+IBTRN,0),"^",6)
.;inpatient
.S DGPM=$P(^IBT(356,+IBTRN,0),"^",5) I DGPM D
..S (X,Y,Z)=0 F S X=$O(^DGCR(399,"D",IBEVDT,X)) Q:'X D COMPUT
.;
.;outpatient
.I $P($G(^IBE(356.6,+$P(^IBT(356,+IBTRN,0),"^",18),0)),"^",8)=2 D
..S IBEVDT=+$P(IBEVDT,"."),DFN=$P(^IBT(356,+IBTRN,0),"^",2)
..S (X,Y,Z)=0 F S X=$O(^DGCR(399,"AOPV",DFN,IBEVDT,X)) Q:'X D COMPUT
..;I IBY S IBY=IBY_" (May include multiple visit dates)"
;
BILLDQ I 'IBY,$P(^IBT(356,+IBTRN,0),"^",29) S IBY=$P(^IBT(356,+IBTRN,0),"^",29)_" (Estimated)"
Q $G(IBY)_"^"_+$G(IBZ)
;
COMPUT ; -- add up the numbers
Q:$P($G(^DGCR(399,X,"S")),"^",17)
S Y=$P($G(^DGCR(399,X,"U1")),"^",1)-$P($G(^("U1")),"^",2)
I Y>0 S IBY=IBY+Y
S Z=$$TPR^PRCAFN(X)
I Z>0 S IBZ=IBZ+Y
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTRED1 3098 printed Apr 09, 2024@21:34:29 Page 2
IBTRED1 ;ALB/AAS - CLAIMS TRACKING EDIT ; 06-JUL-93
+1 ;;2.0;INTEGRATED BILLING;**458**;21-MAR-94;Build 4
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
% GOTO ^IBTRE
+1 ;
NX(IBTMPNM) ; -- edit next template
+1 NEW IBXX,VALMY,IBTRV,IBTRC
+2 DO EN^VALM(IBTMPNM)
+3 IF '$DATA(IBFASTXT)
DO BLD^IBTRED
+4 SET VALMBCK="R"
+5 QUIT
+6 ;
EDIT(IBTEMP,BLD) ; -- edit entry point for claims tracking
+1 ; -- Input IBTEMP = template name or dr string
+2 ; BLD = any non-zero value if calling routine is doing own
+3 ; rebuild
+4 ;
+5 DO FULL^VALM1
WRITE !
+6 LOCK +^IBT(356,+IBTRN):5
IF '$TEST
DO LOCKED^IBTRCD1
GOTO EDITQ
+7 DO SAVE
+8 SET DIE="^IBT(356,"
SET DA=IBTRN
+9 SET DR=IBTEMP
+10 DO ^DIE
KILL DA,DR,DIC,DIE
+11 DO COMP
+12 IF IBDIF=1
DO UPDATE
IF '$GET(BLD)
DO HDR^IBTRED
DO BLD^IBTRED
+13 LOCK -^IBT(356,+IBTRN)
EDITQ KILL ^TMP($JOB,"IBT")
+1 SET VALMBCK="R"
+2 QUIT
+3 ;
SAVE ; -- Save the global before editing
+1 KILL ^TMP($JOB,"IBT")
+2 SET ^TMP($JOB,"IBT",356,IBTRN,0)=$GET(^IBT(356,IBTRN,0))
+3 SET ^TMP($JOB,"IBT",356,IBTRN,1)=$GET(^IBT(356,IBTRN,1))
+4 QUIT
+5 ;
COMP ; -- Compare before editing with globals
+1 SET IBDIF=0
+2 IF $GET(^IBT(356,IBTRN,0))'=$GET(^TMP($JOB,"IBT",356,IBTRN,0))
SET IBDIF=1
+3 IF $GET(^IBT(356,IBTRN,1))'=$GET(^TMP($JOB,"IBT",356,IBTRN,1))
SET IBDIF=1
+4 QUIT
+5 ;
UPDATE ; -- enter date and user if editing has taken place
+1 ; entry locked by edit, locks not needed here
+2 SET DIE="^IBT(356,"
SET DA=IBTRN
+3 SET DR="1.03///NOW;1.04////"_DUZ
+4 DO ^DIE
KILL DA,DR,DIC,DIE
+5 QUIT
+6 ;
DICS(Y) ; -- called by input transform and screen logic for type of diagnois
+1 NEW IBY
+2 SET IBY=0
+3 IF Y=2
SET IBY=1
GOTO DICSQ
+4 IF Y=1
IF '$DATA(^IBT(356.9,"ATP",+$PIECE($GET(^IBT(356.9,DA,0)),U,2),1))!($ORDER(^IBT(356.9,"ATP",+$PIECE($GET(^IBT(356.9,DA,0)),U,2),1,0))=DA)
SET IBY=1
+5 IF Y=3
IF '$DATA(^IBT(356.9,"ATP",+$PIECE($GET(^IBT(356.9,DA,0)),U,2),3))!($ORDER(^IBT(356.9,"ATP",+$PIECE($GET(^IBT(356.9,DA,0)),U,2),3,0))=DA)
SET IBY=1
+6 ;I Y=3 I '$D(^IBT(356.9,"ADG",+$P($G(^IBT(356.9,DA,0)),U,2),+^(0)))!($O(^IBT(356.9,"ADG",+$P($G(^IBT(356.9,DA,0)),U,2),+^(0),0))=DA) S IBY=1
DICSQ QUIT IBY
+1 ;
BILLD(IBTRN) ; -- compute total amount billed and received for this visit
+1 ; -- output total amount billed (minus offset) ^ total amount recieved
+2 NEW X,Y,Z,IBY,IBZ
+3 SET (IBY,IBZ)=0
+4 IF '$GET(IBTRN)
GOTO BILLDQ
+5 ;
+6 SET (X,Y,Z)=0
FOR
SET X=$ORDER(^IBT(356.399,"ACB",IBTRN,X))
if X=""
QUIT
DO COMPUT
+7 ;
+8 ;look to 399 if no ct pointer
IF 'IBY
IF 'IBZ
Begin DoDot:1
+9 NEW DGPM,IBEVDT
+10 SET IBEVDT=$PIECE(^IBT(356,+IBTRN,0),"^",6)
+11 ;inpatient
+12 SET DGPM=$PIECE(^IBT(356,+IBTRN,0),"^",5)
IF DGPM
Begin DoDot:2
+13 SET (X,Y,Z)=0
FOR
SET X=$ORDER(^DGCR(399,"D",IBEVDT,X))
if 'X
QUIT
DO COMPUT
End DoDot:2
+14 ;
+15 ;outpatient
+16 IF $PIECE($GET(^IBE(356.6,+$PIECE(^IBT(356,+IBTRN,0),"^",18),0)),"^",8)=2
Begin DoDot:2
+17 SET IBEVDT=+$PIECE(IBEVDT,".")
SET DFN=$PIECE(^IBT(356,+IBTRN,0),"^",2)
+18 SET (X,Y,Z)=0
FOR
SET X=$ORDER(^DGCR(399,"AOPV",DFN,IBEVDT,X))
if 'X
QUIT
DO COMPUT
+19 ;I IBY S IBY=IBY_" (May include multiple visit dates)"
End DoDot:2
End DoDot:1
+20 ;
BILLDQ IF 'IBY
IF $PIECE(^IBT(356,+IBTRN,0),"^",29)
SET IBY=$PIECE(^IBT(356,+IBTRN,0),"^",29)_" (Estimated)"
+1 QUIT $GET(IBY)_"^"_+$GET(IBZ)
+2 ;
COMPUT ; -- add up the numbers
+1 if $PIECE($GET(^DGCR(399,X,"S")),"^",17)
QUIT
+2 SET Y=$PIECE($GET(^DGCR(399,X,"U1")),"^",1)-$PIECE($GET(^("U1")),"^",2)
+3 IF Y>0
SET IBY=IBY+Y
+4 SET Z=$$TPR^PRCAFN(X)
+5 IF Z>0
SET IBZ=IBZ+Y
+6 QUIT
