- 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 Feb 18, 2025@23:54:26 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
