IBTRCD0 ;ALB/AAS - CLAIMS TRACKING - EXPAND CONTACTS SCREEN - CONT ; 02-JUL-1993
;;2.0;INTEGRATED BILLING;**458,516**;21-MAR-94;Build 123
;;Per VA Directive 6402, this routine should not be modified.
;
% ;
EN D CONT,APPEAL,INS,COMM,USER
Q
;
CONT ; -- Contact infomation display
N OFFSET,START
S START=1,OFFSET=2
CON1 D SET^IBCNSP(START,OFFSET," Contact Information ",IORVON,IORVOFF)
D SET^IBCNSP(START+1,OFFSET," Contact Date: "_$$DAT1^IBOUTL(+IBTRCD,"2P"))
D SET^IBCNSP(START+2,OFFSET,"Person Contacted: "_$E($P(IBTRCD,"^",6),1,20))
D SET^IBCNSP(START+3,OFFSET," Contact Method: "_$$EXPAND^IBTRE(356.2,.17,$P(IBTRCD,"^",17)))
D SET^IBCNSP(START+4,OFFSET,"Call Ref. Number: "_$$CREFN^IBTRC(+$G(IBTRC),18))
D SET^IBCNSP(START+5,OFFSET," Review Date: "_$$DAT1^IBOUTL($P(IBTRCD,"^",24)))
I '$P(IBTRCD,"^",2) D SET^IBCNSP(START+2,OFFSET,"Patient Contacted: "_$P($G(^DPT(+$P(IBTRCD,"^",5),0)),"^"))
Q
;
APPEAL ; -- Appeals address infomation display
N OFFSET,START
S START=15,OFFSET=2
AP1 D SET^IBCNSP(START,OFFSET," Appeal Address Information ",IORVON,IORVOFF)
D SET^IBCNSP(START+1,OFFSET," Ins. Co. Name: "_$E($P($G(^DIC(36,+$P(IBTRCD,"^",8),0)),"^"),1,24))
N APLAD S APLAD=$G(^DIC(36,+$P(IBTRCD,"^",8),.14))
D SET^IBCNSP(START+2,OFFSET," Alternate Name: "_$P(APLAD,"^",7))
D SET^IBCNSP(START+3,OFFSET," Street line 1: "_$P(APLAD,"^",1))
D SET^IBCNSP(START+4,OFFSET," Street line 2: "_$P(APLAD,"^",2))
D SET^IBCNSP(START+5,OFFSET," Street line 3: "_$P(APLAD,"^",3))
D SET^IBCNSP(START+6,OFFSET," City/State/Zip: "_$P(APLAD,"^",4)_$S($P(APLAD,"^",4)]"":", ",1:"")_$P($G(^DIC(5,+$P(APLAD,"^",5),0)),"^",2)_" "_$P(APLAD,"^",6))
Q
;
INS ; -- Ins. Co. infomation display
N OFFSET,START,IBCDFND,IBPHONE
S START=9,OFFSET=2
ENINS ; -- entry point, must set start and offset
D SET^IBCNSP(START,OFFSET+25," Insurance Policy Information ",IORVON,IORVOFF)
D SET^IBCNSP(START+1,OFFSET," Ins. Co. Name: "_$E($P($G(^DIC(36,+$P(IBTRCD,"^",8),0)),"^"),1,24))
S IBCDFND=$G(^DPT(DFN,.312,+$P(IBTRCD1,"^",5),0))
D SET^IBCNSP(START+2,OFFSET," Group Number: "_$$GRP^IBCNS($P(IBCDFND,"^",18)))
D SET^IBCNSP(START+3,OFFSET," Whose Insurance: "_$$EXPAND^IBTRE(2.312,6,$P(IBCDFND,"^",6)))
S IBPHONE=$G(^DIC(36,+$P(IBTRCD,"^",8),.13))
S IBPHONE=$S($P(IBPHONE,"^",3)'="":$P(IBPHONE,"^",3),1:$P(IBPHONE,"^"))
D SET^IBCNSP(START+4,OFFSET," Pre-Cert Phone: "_IBPHONE)
D INS1
Q
INS1 ; -- second site of Ins. info
S OFFSET=45
;IB*2.0*516/TAZ - Use HIPAA Compliant fields
;D SET^IBCNSP(START+1,OFFSET,"Subscriber Name: "_$P(IBCDFND,"^",17))
;D SET^IBCNSP(START+2,OFFSET," Subscriber ID: "_$P(IBCDFND,"^",2))
D SET^IBCNSP(START+1,OFFSET,"Subscriber Name: "_$$GET1^DIQ(2.312,+$P(IBTRCD1,"^",5)_","_DFN_",",7.01))
D SET^IBCNSP(START+2,OFFSET," Subscriber ID: "_$$GET1^DIQ(2.312,+$P(IBTRCD1,"^",5)_","_DFN_",",7.02))
D SET^IBCNSP(START+3,OFFSET," Effective Date: "_$$DAT1^IBOUTL($P(IBCDFND,"^",8),"2P"))
D SET^IBCNSP(START+4,OFFSET,"Expiration Date: "_$$DAT1^IBOUTL($P(IBCDFND,"^",4),"2P"))
Q
;
USER ; -- display user information
N OFFSET,START
S START=15,OFFSET=45
USER1 D SET^IBCNSP(START,OFFSET," User Information ",IORVON,IORVOFF)
D SET^IBCNSP(START+1,OFFSET," Entered By: "_$P($G(^VA(200,+$P(IBTRCD1,"^",2),0)),"^"))
D SET^IBCNSP(START+2,OFFSET," Entered On: "_$$DAT1^IBOUTL(+$P(IBTRCD1,"^"),"2P"))
D SET^IBCNSP(START+3,OFFSET,"Last Edited By: "_$P($G(^VA(200,+$P(IBTRCD1,"^",4),0)),"^"))
D SET^IBCNSP(START+4,OFFSET,"Last Edited On: "_$$DAT1^IBOUTL(+$P(IBTRCD1,"^",3),"2P"))
Q
;
COMM ; -- Comment display
N OFFSET,START,I,IBLCNT
S START=23,OFFSET=2
COM1 D SET^IBCNSP(START,OFFSET," Comments ",IORVON,IORVOFF)
S (IBLCNT,IBI)=0 F S IBI=$O(^IBT(356.2,IBTRC,11,IBI)) Q:IBI<1 D
.S IBLCNT=IBLCNT+1
.D SET^IBCNSP(START+IBLCNT,OFFSET," "_$E($G(^IBT(356.2,IBTRC,11,IBI,0)),1,80))
D SC
Q
;
SC ; -- Service connected conditions
S START=START+2+IBLCNT,OFFSET=2,IBCNT=0,IBLCNT=0
D SC1^IBTRED01
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTRCD0 4027 printed Sep 23, 2025@20:03:59 Page 2
IBTRCD0 ;ALB/AAS - CLAIMS TRACKING - EXPAND CONTACTS SCREEN - CONT ; 02-JUL-1993
+1 ;;2.0;INTEGRATED BILLING;**458,516**;21-MAR-94;Build 123
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
% ;
EN DO CONT
DO APPEAL
DO INS
DO COMM
DO USER
+1 QUIT
+2 ;
CONT ; -- Contact infomation display
+1 NEW OFFSET,START
+2 SET START=1
SET OFFSET=2
CON1 DO SET^IBCNSP(START,OFFSET," Contact Information ",IORVON,IORVOFF)
+1 DO SET^IBCNSP(START+1,OFFSET," Contact Date: "_$$DAT1^IBOUTL(+IBTRCD,"2P"))
+2 DO SET^IBCNSP(START+2,OFFSET,"Person Contacted: "_$EXTRACT($PIECE(IBTRCD,"^",6),1,20))
+3 DO SET^IBCNSP(START+3,OFFSET," Contact Method: "_$$EXPAND^IBTRE(356.2,.17,$PIECE(IBTRCD,"^",17)))
+4 DO SET^IBCNSP(START+4,OFFSET,"Call Ref. Number: "_$$CREFN^IBTRC(+$GET(IBTRC),18))
+5 DO SET^IBCNSP(START+5,OFFSET," Review Date: "_$$DAT1^IBOUTL($PIECE(IBTRCD,"^",24)))
+6 IF '$PIECE(IBTRCD,"^",2)
DO SET^IBCNSP(START+2,OFFSET,"Patient Contacted: "_$PIECE($GET(^DPT(+$PIECE(IBTRCD,"^",5),0)),"^"))
+7 QUIT
+8 ;
APPEAL ; -- Appeals address infomation display
+1 NEW OFFSET,START
+2 SET START=15
SET OFFSET=2
AP1 DO SET^IBCNSP(START,OFFSET," Appeal Address Information ",IORVON,IORVOFF)
+1 DO SET^IBCNSP(START+1,OFFSET," Ins. Co. Name: "_$EXTRACT($PIECE($GET(^DIC(36,+$PIECE(IBTRCD,"^",8),0)),"^"),1,24))
+2 NEW APLAD
SET APLAD=$GET(^DIC(36,+$PIECE(IBTRCD,"^",8),.14))
+3 DO SET^IBCNSP(START+2,OFFSET," Alternate Name: "_$PIECE(APLAD,"^",7))
+4 DO SET^IBCNSP(START+3,OFFSET," Street line 1: "_$PIECE(APLAD,"^",1))
+5 DO SET^IBCNSP(START+4,OFFSET," Street line 2: "_$PIECE(APLAD,"^",2))
+6 DO SET^IBCNSP(START+5,OFFSET," Street line 3: "_$PIECE(APLAD,"^",3))
+7 DO SET^IBCNSP(START+6,OFFSET," City/State/Zip: "_$PIECE(APLAD,"^",4)_$SELECT($PIECE(APLAD,"^",4)]"":", ",1:"")_$PIECE($GET(^DIC(5,+$PIECE(APLAD,"^",5),0)),"^",2)_" "_$PIECE(APLAD,"^",6))
+8 QUIT
+9 ;
INS ; -- Ins. Co. infomation display
+1 NEW OFFSET,START,IBCDFND,IBPHONE
+2 SET START=9
SET OFFSET=2
ENINS ; -- entry point, must set start and offset
+1 DO SET^IBCNSP(START,OFFSET+25," Insurance Policy Information ",IORVON,IORVOFF)
+2 DO SET^IBCNSP(START+1,OFFSET," Ins. Co. Name: "_$EXTRACT($PIECE($GET(^DIC(36,+$PIECE(IBTRCD,"^",8),0)),"^"),1,24))
+3 SET IBCDFND=$GET(^DPT(DFN,.312,+$PIECE(IBTRCD1,"^",5),0))
+4 DO SET^IBCNSP(START+2,OFFSET," Group Number: "_$$GRP^IBCNS($PIECE(IBCDFND,"^",18)))
+5 DO SET^IBCNSP(START+3,OFFSET," Whose Insurance: "_$$EXPAND^IBTRE(2.312,6,$PIECE(IBCDFND,"^",6)))
+6 SET IBPHONE=$GET(^DIC(36,+$PIECE(IBTRCD,"^",8),.13))
+7 SET IBPHONE=$SELECT($PIECE(IBPHONE,"^",3)'="":$PIECE(IBPHONE,"^",3),1:$PIECE(IBPHONE,"^"))
+8 DO SET^IBCNSP(START+4,OFFSET," Pre-Cert Phone: "_IBPHONE)
+9 DO INS1
+10 QUIT
INS1 ; -- second site of Ins. info
+1 SET OFFSET=45
+2 ;IB*2.0*516/TAZ - Use HIPAA Compliant fields
+3 ;D SET^IBCNSP(START+1,OFFSET,"Subscriber Name: "_$P(IBCDFND,"^",17))
+4 ;D SET^IBCNSP(START+2,OFFSET," Subscriber ID: "_$P(IBCDFND,"^",2))
+5 DO SET^IBCNSP(START+1,OFFSET,"Subscriber Name: "_$$GET1^DIQ(2.312,+$PIECE(IBTRCD1,"^",5)_","_DFN_",",7.01))
+6 DO SET^IBCNSP(START+2,OFFSET," Subscriber ID: "_$$GET1^DIQ(2.312,+$PIECE(IBTRCD1,"^",5)_","_DFN_",",7.02))
+7 DO SET^IBCNSP(START+3,OFFSET," Effective Date: "_$$DAT1^IBOUTL($PIECE(IBCDFND,"^",8),"2P"))
+8 DO SET^IBCNSP(START+4,OFFSET,"Expiration Date: "_$$DAT1^IBOUTL($PIECE(IBCDFND,"^",4),"2P"))
+9 QUIT
+10 ;
USER ; -- display user information
+1 NEW OFFSET,START
+2 SET START=15
SET OFFSET=45
USER1 DO SET^IBCNSP(START,OFFSET," User Information ",IORVON,IORVOFF)
+1 DO SET^IBCNSP(START+1,OFFSET," Entered By: "_$PIECE($GET(^VA(200,+$PIECE(IBTRCD1,"^",2),0)),"^"))
+2 DO SET^IBCNSP(START+2,OFFSET," Entered On: "_$$DAT1^IBOUTL(+$PIECE(IBTRCD1,"^"),"2P"))
+3 DO SET^IBCNSP(START+3,OFFSET,"Last Edited By: "_$PIECE($GET(^VA(200,+$PIECE(IBTRCD1,"^",4),0)),"^"))
+4 DO SET^IBCNSP(START+4,OFFSET,"Last Edited On: "_$$DAT1^IBOUTL(+$PIECE(IBTRCD1,"^",3),"2P"))
+5 QUIT
+6 ;
COMM ; -- Comment display
+1 NEW OFFSET,START,I,IBLCNT
+2 SET START=23
SET OFFSET=2
COM1 DO SET^IBCNSP(START,OFFSET," Comments ",IORVON,IORVOFF)
+1 SET (IBLCNT,IBI)=0
FOR
SET IBI=$ORDER(^IBT(356.2,IBTRC,11,IBI))
if IBI<1
QUIT
Begin DoDot:1
+2 SET IBLCNT=IBLCNT+1
+3 DO SET^IBCNSP(START+IBLCNT,OFFSET," "_$EXTRACT($GET(^IBT(356.2,IBTRC,11,IBI,0)),1,80))
End DoDot:1
+4 DO SC
+5 QUIT
+6 ;
SC ; -- Service connected conditions
+1 SET START=START+2+IBLCNT
SET OFFSET=2
SET IBCNT=0
SET IBLCNT=0
+2 DO SC1^IBTRED01
+3 QUIT
