IBTRED01 ;ALB/AAS - EXPAND/EDIT CLAIMS TRACKING ENTRY - CONT; 01-JUL-1993
;;2.0;INTEGRATED BILLING;**389**;21-MAR-94;Build 6
;;Per VHA Directive 2004-038, this routine should not be modified.
;
% I '$G(IBTRN)!($G(IORVON)="") G ^IBTRED
D UR,REVIEW,SC
Q
REVIEW ; -- List Reviews done
N OFFSET,START,IBTRV,IDT,IBTRVD,IBTRTP
S START=24,OFFSET=2,IBLCNT=0
D SET^IBCNSP(START,OFFSET," Hospital Reviews Entered ",IORVON,IORVOFF)
S IDT="" F S IDT=$O(^IBT(356.1,"ATIDT",IBTRN,IDT)) Q:'IDT S IBTRV="" F S IBTRV=$O(^IBT(356.1,"ATIDT",IBTRN,IDT,IBTRV)) Q:'IBTRV D
.S IBLCNT=$G(IBLCNT)+1
.S IBTRVD=$G(^IBT(356.1,IBTRV,0))
.S IBTRTP=$P($G(^IBE(356.11,+$P(IBTRVD,"^",22),0)),"^")
.;D SET^IBCNSP(START+IBLCNT,OFFSET,$J(IBLCNT,2)_". "_$E(IBTRTP_" ",1,28)_" on "_$E($$DAT1^IBOUTL($P(IBTRVD,"^"),"2P")_" ",1,8)_" Status: "_$$EXPAND^IBTRE(356.1,.21,$P(IBTRVD,"^",21)))
.S IBTEXT=$E(IBTRTP_" Status: "_$$EXPAND^IBTRE(356.1,.21,$P(IBTRVD,"^",21))_" ",1,50)
.D SET^IBCNSP(START+IBLCNT,OFFSET,$J(IBLCNT,2)_". "_IBTEXT_" on "_$$DAT1^IBOUTL($P(IBTRVD,"^"),"2P"))
.Q
D COMM
Q
COMM ; -- List Communication Entries
N OFFSET,START,IDT,IBTRCD,IBCNT
S START=26+$G(IBLCNT),OFFSET=2
D SET^IBCNSP(START,OFFSET," Insurance Reviews Entered ",IORVON,IORVOFF)
S IDT="" F S IDT=$O(^IBT(356.2,"ATIDT",IBTRN,IDT)) Q:'IDT S IBTRC="" F S IBTRC=$O(^IBT(356.2,"ATIDT",IBTRN,IDT,IBTRC)) Q:'IBTRC D
.S IBLCNT=$G(IBLCNT)+1,IBCNT=$G(IBCNT)+1
.S IBTRCD=$G(^IBT(356.2,IBTRC,0))
.S IBTEXT=$E($$EXPAND^IBTRE(356.2,.04,$P(IBTRCD,"^",4))_" Contact "_$$EXPAND^IBTRE(356.2,.11,$P(IBTRCD,"^",11))_" ",1,50)
.D SET^IBCNSP(START+IBCNT,OFFSET,$J(IBCNT,2)_". "_IBTEXT_" on "_$$DAT1^IBOUTL(+IBTRCD,"2P"))
.Q
Q
;
SC ; -- Show eligibility/sc conditions
N OFFSET,START,IDT,IBTRCD,IBCNT,I1,I2,I3
S START=28+$G(IBLCNT),OFFSET=2
SC1 D SET^IBCNSP(START,OFFSET," Service Connected Conditions: ",IORVON,IORVOFF)
D ELIG^VADPT
S IBLCNT=$G(IBLCNT)+1,IBCNT=$G(IBCNT)+1,I3=0
;
D SET^IBCNSP(START+IBCNT,OFFSET,"Service Connected: "_$S('$G(VAEL(3)):"NO",1:$P(VAEL(3),"^",2)_"%"))
;
F I=0:0 S I=$O(^DPT(DFN,.372,I)) Q:'I D
.S I1=^DPT(DFN,.372,I,0)
.Q:'$P(I1,"^",3)
.S I2=$G(^DIC(31,+I1,0))
.S:$P(I2,"^",4)'="" I2=$P(I2,"^",4)
.S I2=$P(I2,"^")
.S IBLCNT=$G(IBLCNT)+1,IBCNT=$G(IBCNT)+1
.D SET^IBCNSP(START+IBCNT,OFFSET,$J(IBCNT-1,2)_". "_$E(I2_" ",1,45)_$J($P(I1,"^",2),3)_"%")
.S I3=I3+1
.Q
I 'I3 S IBLCNT=$G(IBLCNT)+1,IBCNT=$G(IBCNT)+1 D SET^IBCNSP(START+IBCNT,OFFSET,$S('$O(^DPT(DFN,.372,0)):"NONE STATED",1:"NO SC DISABILITIES LISTED")) S I3=1
SCQ Q
;
UR ; -- ur information region
N OFFSET,START
S START=7,OFFSET=51
D SET^IBCNSP(START,OFFSET," Review Information ",IORVON,IORVOFF)
D SET^IBCNSP(START+1,OFFSET," Insurance Claim: "_$$EXPAND^IBTRE(356,.24,$P(IBTRND,"^",24)))
D SET^IBCNSP(START+2,OFFSET," Follow-up Type: "_$$EXPAND^IBTRE(356,1.07,$P(IBTRND1,"^",7)))
D SET^IBCNSP(START+3,OFFSET," Random Sample: "_$$EXPAND^IBTRE(356,.25,$P(IBTRND,"^",25)))
D SET^IBCNSP(START+4,OFFSET,"Special Condition: "_$$EXPAND^IBTRE(356,.26,$P(IBTRND,"^",26)))
D SET^IBCNSP(START+5,OFFSET," Local Addition: "_$$EXPAND^IBTRE(356,.27,$P(IBTRND,"^",27)))
D SET^IBCNSP(START+6,OFFSET," Ins. Reviewer: "_$$EXPAND^IBTRE(356,1.06,$P(IBTRND1,"^",6)))
D SET^IBCNSP(START+7,OFFSET,"Hospital Reviewer: "_$$EXPAND^IBTRE(356,1.05,$P(IBTRND1,"^",5)))
Q
;
4 ; -- Visit region for prosthetics
N IBDA,IBRMPR S IBDA=$P(IBTRND,"^",9) D PRODATA^IBTUTL1(IBDA)
D SET^IBCNSP(START+2,OFFSET," Item: "_$P($$PIN^IBCSC5B(+IBDA),U,2))
D SET^IBCNSP(START+3,OFFSET," Description: "_$G(IBRMPR(660,+IBDA,24,"E")))
D SET^IBCNSP(START+4,OFFSET," Quantity: "_$J($G(IBRMPR(660,+IBDA,5,"E")),$L($G(IBRMPR(660,+IBDA,14,"E")))))
D SET^IBCNSP(START+5,OFFSET," Total Cost: $"_$G(IBRMPR(660,+IBDA,14,"E")))
D SET^IBCNSP(START+6,OFFSET," Transaction: "_$G(IBRMPR(660,+IBDA,2,"E")))
D SET^IBCNSP(START+7,OFFSET," Vendor: "_$G(IBRMPR(660,+IBDA,7,"E")))
D SET^IBCNSP(START+8,OFFSET," Source: "_$G(IBRMPR(660,+IBDA,12,"E")))
D SET^IBCNSP(START+9,OFFSET," Delivery Date: "_$G(IBRMPR(660,+IBDA,10,"E")))
D SET^IBCNSP(START+10,OFFSET," Remarks: "_$G(IBRMPR(660,+IBDA,16,"E")))
D SET^IBCNSP(START+11,OFFSET," Return Status: "_$G(IBRMPR(660,+IBDA,17,"E")))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTRED01 4483 printed Oct 16, 2024@18:28:32 Page 2
IBTRED01 ;ALB/AAS - EXPAND/EDIT CLAIMS TRACKING ENTRY - CONT; 01-JUL-1993
+1 ;;2.0;INTEGRATED BILLING;**389**;21-MAR-94;Build 6
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
% IF '$GET(IBTRN)!($GET(IORVON)="")
GOTO ^IBTRED
+1 DO UR
DO REVIEW
DO SC
+2 QUIT
REVIEW ; -- List Reviews done
+1 NEW OFFSET,START,IBTRV,IDT,IBTRVD,IBTRTP
+2 SET START=24
SET OFFSET=2
SET IBLCNT=0
+3 DO SET^IBCNSP(START,OFFSET," Hospital Reviews Entered ",IORVON,IORVOFF)
+4 SET IDT=""
FOR
SET IDT=$ORDER(^IBT(356.1,"ATIDT",IBTRN,IDT))
if 'IDT
QUIT
SET IBTRV=""
FOR
SET IBTRV=$ORDER(^IBT(356.1,"ATIDT",IBTRN,IDT,IBTRV))
if 'IBTRV
QUIT
Begin DoDot:1
+5 SET IBLCNT=$GET(IBLCNT)+1
+6 SET IBTRVD=$GET(^IBT(356.1,IBTRV,0))
+7 SET IBTRTP=$PIECE($GET(^IBE(356.11,+$PIECE(IBTRVD,"^",22),0)),"^")
+8 ;D SET^IBCNSP(START+IBLCNT,OFFSET,$J(IBLCNT,2)_". "_$E(IBTRTP_" ",1,28)_" on "_$E($$DAT1^IBOUTL($P(IBTRVD,"^"),"2P")_" ",1,8)_" Status: "_$$EXPAND^IBTRE(356.1,.21,$P(IBTRVD,"^",21)))
+9 SET IBTEXT=$EXTRACT(IBTRTP_" Status: "_$$EXPAND^IBTRE(356.1,.21,$PIECE(IBTRVD,"^",21))_" ",1,50)
+10 DO SET^IBCNSP(START+IBLCNT,OFFSET,$JUSTIFY(IBLCNT,2)_". "_IBTEXT_" on "_$$DAT1^IBOUTL($PIECE(IBTRVD,"^"),"2P"))
+11 QUIT
End DoDot:1
+12 DO COMM
+13 QUIT
COMM ; -- List Communication Entries
+1 NEW OFFSET,START,IDT,IBTRCD,IBCNT
+2 SET START=26+$GET(IBLCNT)
SET OFFSET=2
+3 DO SET^IBCNSP(START,OFFSET," Insurance Reviews Entered ",IORVON,IORVOFF)
+4 SET IDT=""
FOR
SET IDT=$ORDER(^IBT(356.2,"ATIDT",IBTRN,IDT))
if 'IDT
QUIT
SET IBTRC=""
FOR
SET IBTRC=$ORDER(^IBT(356.2,"ATIDT",IBTRN,IDT,IBTRC))
if 'IBTRC
QUIT
Begin DoDot:1
+5 SET IBLCNT=$GET(IBLCNT)+1
SET IBCNT=$GET(IBCNT)+1
+6 SET IBTRCD=$GET(^IBT(356.2,IBTRC,0))
+7 SET IBTEXT=$EXTRACT($$EXPAND^IBTRE(356.2,.04,$PIECE(IBTRCD,"^",4))_" Contact "_$$EXPAND^IBTRE(356.2,.11,$PIECE(IBTRCD,"^",11))_" ",1,50)
+8 DO SET^IBCNSP(START+IBCNT,OFFSET,$JUSTIFY(IBCNT,2)_". "_IBTEXT_" on "_$$DAT1^IBOUTL(+IBTRCD,"2P"))
+9 QUIT
End DoDot:1
+10 QUIT
+11 ;
SC ; -- Show eligibility/sc conditions
+1 NEW OFFSET,START,IDT,IBTRCD,IBCNT,I1,I2,I3
+2 SET START=28+$GET(IBLCNT)
SET OFFSET=2
SC1 DO SET^IBCNSP(START,OFFSET," Service Connected Conditions: ",IORVON,IORVOFF)
+1 DO ELIG^VADPT
+2 SET IBLCNT=$GET(IBLCNT)+1
SET IBCNT=$GET(IBCNT)+1
SET I3=0
+3 ;
+4 DO SET^IBCNSP(START+IBCNT,OFFSET,"Service Connected: "_$SELECT('$GET(VAEL(3)):"NO",1:$PIECE(VAEL(3),"^",2)_"%"))
+5 ;
+6 FOR I=0:0
SET I=$ORDER(^DPT(DFN,.372,I))
if 'I
QUIT
Begin DoDot:1
+7 SET I1=^DPT(DFN,.372,I,0)
+8 if '$PIECE(I1,"^",3)
QUIT
+9 SET I2=$GET(^DIC(31,+I1,0))
+10 if $PIECE(I2,"^",4)'=""
SET I2=$PIECE(I2,"^",4)
+11 SET I2=$PIECE(I2,"^")
+12 SET IBLCNT=$GET(IBLCNT)+1
SET IBCNT=$GET(IBCNT)+1
+13 DO SET^IBCNSP(START+IBCNT,OFFSET,$JUSTIFY(IBCNT-1,2)_". "_$EXTRACT(I2_" ",1,45)_$JUSTIFY($PIECE(I1,"^",2),3)_"%")
+14 SET I3=I3+1
+15 QUIT
End DoDot:1
+16 IF 'I3
SET IBLCNT=$GET(IBLCNT)+1
SET IBCNT=$GET(IBCNT)+1
DO SET^IBCNSP(START+IBCNT,OFFSET,$SELECT('$ORDER(^DPT(DFN,.372,0)):"NONE STATED",1:"NO SC DISABILITIES LISTED"))
SET I3=1
SCQ QUIT
+1 ;
UR ; -- ur information region
+1 NEW OFFSET,START
+2 SET START=7
SET OFFSET=51
+3 DO SET^IBCNSP(START,OFFSET," Review Information ",IORVON,IORVOFF)
+4 DO SET^IBCNSP(START+1,OFFSET," Insurance Claim: "_$$EXPAND^IBTRE(356,.24,$PIECE(IBTRND,"^",24)))
+5 DO SET^IBCNSP(START+2,OFFSET," Follow-up Type: "_$$EXPAND^IBTRE(356,1.07,$PIECE(IBTRND1,"^",7)))
+6 DO SET^IBCNSP(START+3,OFFSET," Random Sample: "_$$EXPAND^IBTRE(356,.25,$PIECE(IBTRND,"^",25)))
+7 DO SET^IBCNSP(START+4,OFFSET,"Special Condition: "_$$EXPAND^IBTRE(356,.26,$PIECE(IBTRND,"^",26)))
+8 DO SET^IBCNSP(START+5,OFFSET," Local Addition: "_$$EXPAND^IBTRE(356,.27,$PIECE(IBTRND,"^",27)))
+9 DO SET^IBCNSP(START+6,OFFSET," Ins. Reviewer: "_$$EXPAND^IBTRE(356,1.06,$PIECE(IBTRND1,"^",6)))
+10 DO SET^IBCNSP(START+7,OFFSET,"Hospital Reviewer: "_$$EXPAND^IBTRE(356,1.05,$PIECE(IBTRND1,"^",5)))
+11 QUIT
+12 ;
4 ; -- Visit region for prosthetics
+1 NEW IBDA,IBRMPR
SET IBDA=$PIECE(IBTRND,"^",9)
DO PRODATA^IBTUTL1(IBDA)
+2 DO SET^IBCNSP(START+2,OFFSET," Item: "_$PIECE($$PIN^IBCSC5B(+IBDA),U,2))
+3 DO SET^IBCNSP(START+3,OFFSET," Description: "_$GET(IBRMPR(660,+IBDA,24,"E")))
+4 DO SET^IBCNSP(START+4,OFFSET," Quantity: "_$JUSTIFY($GET(IBRMPR(660,+IBDA,5,"E")),$LENGTH($GET(IBRMPR(660,+IBDA,14,"E")))))
+5 DO SET^IBCNSP(START+5,OFFSET," Total Cost: $"_$GET(IBRMPR(660,+IBDA,14,"E")))
+6 DO SET^IBCNSP(START+6,OFFSET," Transaction: "_$GET(IBRMPR(660,+IBDA,2,"E")))
+7 DO SET^IBCNSP(START+7,OFFSET," Vendor: "_$GET(IBRMPR(660,+IBDA,7,"E")))
+8 DO SET^IBCNSP(START+8,OFFSET," Source: "_$GET(IBRMPR(660,+IBDA,12,"E")))
+9 DO SET^IBCNSP(START+9,OFFSET," Delivery Date: "_$GET(IBRMPR(660,+IBDA,10,"E")))
+10 DO SET^IBCNSP(START+10,OFFSET," Remarks: "_$GET(IBRMPR(660,+IBDA,16,"E")))
+11 DO SET^IBCNSP(START+11,OFFSET," Return Status: "_$GET(IBRMPR(660,+IBDA,17,"E")))
+12 QUIT
