Routine: IBTRCD0

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

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)),"^"))

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))

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

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"))

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"))

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

SC ; -- Service connected conditions

 S START=START+2+IBLCNT,OFFSET=2,IBCNT=0,IBLCNT=0

 D SC1^IBTRED01

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTRCD0   4027     printed  Feb 18, 2025@23:54:09                                                                                                                                                                                                     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

IBTRCD0.m