$KID IB*2.0*621
**INSTALL NAME**
IB*2.0*621
"BLD",10972,0)
IB*2.0*621^INTEGRATED BILLING^0^3180718^y
"BLD",10972,1,0)
^^1^1^3180612^
"BLD",10972,1,1,0)
This is IB Build-7
"BLD",10972,4,0)
^9.64PA^2^4
"BLD",10972,4,2,0)
2
"BLD",10972,4,2,2,0)
^9.641^2^1
"BLD",10972,4,2,2,2,0)
PATIENT  (File-top level)
"BLD",10972,4,2,2,2,1,0)
^9.6411^2001^1
"BLD",10972,4,2,2,2,1,2001,0)
DATE LAST EICD RUN
"BLD",10972,4,2,222)
y^n^p^^^^n^^n
"BLD",10972,4,2,224)

"BLD",10972,4,350.9,0)
350.9
"BLD",10972,4,350.9,2,0)
^9.641^350.9002^2
"BLD",10972,4,350.9,2,350.9,0)
IB SITE PARAMETERS  (File-top level)
"BLD",10972,4,350.9,2,350.9,1,0)
^9.6411^51.31^1
"BLD",10972,4,350.9,2,350.9,1,51.31,0)
EICD PAYER
"BLD",10972,4,350.9,2,350.9002,0)
BATCH EXTRACTS  (sub-file)
"BLD",10972,4,350.9,2,350.9002,1,0)
^9.6411^.05^5
"BLD",10972,4,350.9,2,350.9002,1,.01,0)
BATCH EXTRACTS
"BLD",10972,4,350.9,2,350.9002,1,.05,0)
MAXIMUM EXTRACT NUMBER
"BLD",10972,4,350.9,2,350.9002,1,.07,0)
START DAYS
"BLD",10972,4,350.9,2,350.9002,1,.08,0)
DAYS AFTER START
"BLD",10972,4,350.9,2,350.9002,1,.09,0)
FREQUENCY
"BLD",10972,4,350.9,222)
y^n^p^^^^n^^n
"BLD",10972,4,350.9,224)

"BLD",10972,4,365.1,0)
365.1
"BLD",10972,4,365.1,2,0)
^9.641^365.1^1
"BLD",10972,4,365.1,2,365.1,0)
IIV TRANSMISSION QUEUE  (File-top level)
"BLD",10972,4,365.1,2,365.1,1,0)
^9.6411^.21^2
"BLD",10972,4,365.1,2,365.1,1,.1,0)
WHICH EXTRACT
"BLD",10972,4,365.1,2,365.1,1,.21,0)
EICD INS-FND IEN
"BLD",10972,4,365.1,222)
y^n^p^^^^n^^n
"BLD",10972,4,365.1,224)

"BLD",10972,4,365.18,0)
365.18
"BLD",10972,4,365.18,222)
y^n^f^^^^n
"BLD",10972,4,"APDD",2,2)

"BLD",10972,4,"APDD",2,2,2001)

"BLD",10972,4,"APDD",350.9,350.9)

"BLD",10972,4,"APDD",350.9,350.9,51.31)

"BLD",10972,4,"APDD",350.9,350.9002)

"BLD",10972,4,"APDD",350.9,350.9002,.01)

"BLD",10972,4,"APDD",350.9,350.9002,.05)

"BLD",10972,4,"APDD",350.9,350.9002,.07)

"BLD",10972,4,"APDD",350.9,350.9002,.08)

"BLD",10972,4,"APDD",350.9,350.9002,.09)

"BLD",10972,4,"APDD",365.1,365.1)

"BLD",10972,4,"APDD",365.1,365.1,.1)

"BLD",10972,4,"APDD",365.1,365.1,.21)

"BLD",10972,4,"B",2,2)

"BLD",10972,4,"B",350.9,350.9)

"BLD",10972,4,"B",365.1,365.1)

"BLD",10972,4,"B",365.18,365.18)

"BLD",10972,6.3)
8
"BLD",10972,"ABPKG")
n
"BLD",10972,"INID")
n^n^n
"BLD",10972,"INIT")
IBY621PO
"BLD",10972,"KRN",0)
^9.67PA^779.2^20
"BLD",10972,"KRN",.4,0)
.4
"BLD",10972,"KRN",.4,"NM",0)
^9.68A^^
"BLD",10972,"KRN",.401,0)
.401
"BLD",10972,"KRN",.402,0)
.402
"BLD",10972,"KRN",.402,"NM",0)
^9.68A^1^1
"BLD",10972,"KRN",.402,"NM",1,0)
IBEDIT INS CO1    FILE #36^36^0
"BLD",10972,"KRN",.402,"NM","B","IBEDIT INS CO1    FILE #36",1)

"BLD",10972,"KRN",.403,0)
.403
"BLD",10972,"KRN",.5,0)
.5
"BLD",10972,"KRN",.84,0)
.84
"BLD",10972,"KRN",3.6,0)
3.6
"BLD",10972,"KRN",3.8,0)
3.8
"BLD",10972,"KRN",9.2,0)
9.2
"BLD",10972,"KRN",9.8,0)
9.8
"BLD",10972,"KRN",9.8,"NM",0)
^9.68A^27^27
"BLD",10972,"KRN",9.8,"NM",1,0)
IBCNEDE^^0^B50050843
"BLD",10972,"KRN",9.8,"NM",2,0)
IBCNEDE4^^0^B60089694
"BLD",10972,"KRN",9.8,"NM",3,0)
IBCNEDE5^^0^B14392775
"BLD",10972,"KRN",9.8,"NM",4,0)
IBCNEDE6^^0^B7201517
"BLD",10972,"KRN",9.8,"NM",5,0)
IBCNEDE7^^0^B32586873
"BLD",10972,"KRN",9.8,"NM",6,0)
IBCNEDEP^^0^B106470156
"BLD",10972,"KRN",9.8,"NM",7,0)
IBCNEHLM^^0^B24096430
"BLD",10972,"KRN",9.8,"NM",8,0)
IBCNEHLQ^^0^B100140677
"BLD",10972,"KRN",9.8,"NM",9,0)
IBCNEHLT^^0^B95865249
"BLD",10972,"KRN",9.8,"NM",10,0)
IBCNEKIT^^0^B147072833
"BLD",10972,"KRN",9.8,"NM",11,0)
IBCNEMS1^^0^B7021261
"BLD",10972,"KRN",9.8,"NM",12,0)
IBCNEPM^^0^B15435667
"BLD",10972,"KRN",9.8,"NM",13,0)
IBJPI^^0^B54110191
"BLD",10972,"KRN",9.8,"NM",14,0)
IBY621PO^^0^B16847703
"BLD",10972,"KRN",9.8,"NM",15,0)
IBCNEHL1^^0^B191724717
"BLD",10972,"KRN",9.8,"NM",16,0)
IBCNEHL2^^0^B75613048
"BLD",10972,"KRN",9.8,"NM",17,0)
IBCNEHL4^^0^B209669693
"BLD",10972,"KRN",9.8,"NM",18,0)
IBCNEHL7^^0^B33947813
"BLD",10972,"KRN",9.8,"NM",19,0)
IBCNEHLI^^0^B11183366
"BLD",10972,"KRN",9.8,"NM",20,0)
IBCNEHL3^^0^B172154152
"BLD",10972,"KRN",9.8,"NM",21,0)
IBCNEHL6^^0^B7440508
"BLD",10972,"KRN",9.8,"NM",22,0)
IBCNERP7^^0^B35463903
"BLD",10972,"KRN",9.8,"NM",23,0)
IBCNERP8^^0^B110475563
"BLD",10972,"KRN",9.8,"NM",24,0)
IBCNERP9^^0^B183172218
"BLD",10972,"KRN",9.8,"NM",25,0)
IBCNEUT5^^0^B63252821
"BLD",10972,"KRN",9.8,"NM",26,0)
IBCNEBF^^0^B48497431
"BLD",10972,"KRN",9.8,"NM",27,0)
IBCNERP0^^0^B5584263
"BLD",10972,"KRN",9.8,"NM","B","IBCNEBF",26)

"BLD",10972,"KRN",9.8,"NM","B","IBCNEDE",1)

"BLD",10972,"KRN",9.8,"NM","B","IBCNEDE4",2)

"BLD",10972,"KRN",9.8,"NM","B","IBCNEDE5",3)

"BLD",10972,"KRN",9.8,"NM","B","IBCNEDE6",4)

"BLD",10972,"KRN",9.8,"NM","B","IBCNEDE7",5)

"BLD",10972,"KRN",9.8,"NM","B","IBCNEDEP",6)

"BLD",10972,"KRN",9.8,"NM","B","IBCNEHL1",15)

"BLD",10972,"KRN",9.8,"NM","B","IBCNEHL2",16)

"BLD",10972,"KRN",9.8,"NM","B","IBCNEHL3",20)

"BLD",10972,"KRN",9.8,"NM","B","IBCNEHL4",17)

"BLD",10972,"KRN",9.8,"NM","B","IBCNEHL6",21)

"BLD",10972,"KRN",9.8,"NM","B","IBCNEHL7",18)

"BLD",10972,"KRN",9.8,"NM","B","IBCNEHLI",19)

"BLD",10972,"KRN",9.8,"NM","B","IBCNEHLM",7)

"BLD",10972,"KRN",9.8,"NM","B","IBCNEHLQ",8)

"BLD",10972,"KRN",9.8,"NM","B","IBCNEHLT",9)

"BLD",10972,"KRN",9.8,"NM","B","IBCNEKIT",10)

"BLD",10972,"KRN",9.8,"NM","B","IBCNEMS1",11)

"BLD",10972,"KRN",9.8,"NM","B","IBCNEPM",12)

"BLD",10972,"KRN",9.8,"NM","B","IBCNERP0",27)

"BLD",10972,"KRN",9.8,"NM","B","IBCNERP7",22)

"BLD",10972,"KRN",9.8,"NM","B","IBCNERP8",23)

"BLD",10972,"KRN",9.8,"NM","B","IBCNERP9",24)

"BLD",10972,"KRN",9.8,"NM","B","IBCNEUT5",25)

"BLD",10972,"KRN",9.8,"NM","B","IBJPI",13)

"BLD",10972,"KRN",9.8,"NM","B","IBY621PO",14)

"BLD",10972,"KRN",19,0)
19
"BLD",10972,"KRN",19,"NM",0)
^9.68A^^
"BLD",10972,"KRN",19.1,0)
19.1
"BLD",10972,"KRN",101,0)
101
"BLD",10972,"KRN",101,"NM",0)
^9.68A^4^4
"BLD",10972,"KRN",101,"NM",1,0)
IBCNE EIV RPI IN^^0
"BLD",10972,"KRN",101,"NM",2,0)
IBCNE EIV RQP OUT^^0
"BLD",10972,"KRN",101,"NM",3,0)
IBCNE EIV ID REQUEST^^0
"BLD",10972,"KRN",101,"NM",4,0)
IBCNE EIV ID RESPONSE^^0
"BLD",10972,"KRN",101,"NM","B","IBCNE EIV ID REQUEST",3)

"BLD",10972,"KRN",101,"NM","B","IBCNE EIV ID RESPONSE",4)

"BLD",10972,"KRN",101,"NM","B","IBCNE EIV RPI IN",1)

"BLD",10972,"KRN",101,"NM","B","IBCNE EIV RQP OUT",2)

"BLD",10972,"KRN",409.61,0)
409.61
"BLD",10972,"KRN",771,0)
771
"BLD",10972,"KRN",779.2,0)
779.2
"BLD",10972,"KRN",870,0)
870
"BLD",10972,"KRN",8989.51,0)
8989.51
"BLD",10972,"KRN",8989.52,0)
8989.52
"BLD",10972,"KRN",8994,0)
8994
"BLD",10972,"KRN","B",.4,.4)

"BLD",10972,"KRN","B",.401,.401)

"BLD",10972,"KRN","B",.402,.402)

"BLD",10972,"KRN","B",.403,.403)

"BLD",10972,"KRN","B",.5,.5)

"BLD",10972,"KRN","B",.84,.84)

"BLD",10972,"KRN","B",3.6,3.6)

"BLD",10972,"KRN","B",3.8,3.8)

"BLD",10972,"KRN","B",9.2,9.2)

"BLD",10972,"KRN","B",9.8,9.8)

"BLD",10972,"KRN","B",19,19)

"BLD",10972,"KRN","B",19.1,19.1)

"BLD",10972,"KRN","B",101,101)

"BLD",10972,"KRN","B",409.61,409.61)

"BLD",10972,"KRN","B",771,771)

"BLD",10972,"KRN","B",779.2,779.2)

"BLD",10972,"KRN","B",870,870)

"BLD",10972,"KRN","B",8989.51,8989.51)

"BLD",10972,"KRN","B",8989.52,8989.52)

"BLD",10972,"KRN","B",8994,8994)

"BLD",10972,"QDEF")
^^^^NO^^^^NO^^NO
"BLD",10972,"QUES",0)
^9.62^^
"BLD",10972,"REQB",0)
^9.611^2^2
"BLD",10972,"REQB",1,0)
IB*2.0*595^1
"BLD",10972,"REQB",2,0)
IB*2.0*519^1
"BLD",10972,"REQB","B","IB*2.0*519",2)

"BLD",10972,"REQB","B","IB*2.0*595",1)

"FIA",2)
PATIENT
"FIA",2,0)
^DPT(
"FIA",2,0,0)
2I
"FIA",2,0,1)
y^n^p^^^^n^^n
"FIA",2,0,10)

"FIA",2,0,11)

"FIA",2,0,"RLRO")

"FIA",2,0,"VR")
2.0^IB
"FIA",2,2)
1
"FIA",2,2,2001)

"FIA",350.9)
IB SITE PARAMETERS
"FIA",350.9,0)
^IBE(350.9,
"FIA",350.9,0,0)
350.9I
"FIA",350.9,0,1)
y^n^p^^^^n^^n
"FIA",350.9,0,10)

"FIA",350.9,0,11)

"FIA",350.9,0,"RLRO")

"FIA",350.9,0,"VR")
2.0^IB
"FIA",350.9,350.9)
1
"FIA",350.9,350.9,51.17)

"FIA",350.9,350.9,51.31)

"FIA",350.9,350.9002)
1
"FIA",350.9,350.9002,.01)

"FIA",350.9,350.9002,.05)

"FIA",350.9,350.9002,.07)

"FIA",350.9,350.9002,.08)

"FIA",350.9,350.9002,.09)

"FIA",365.1)
IIV TRANSMISSION QUEUE
"FIA",365.1,0)
^IBCN(365.1,
"FIA",365.1,0,0)
365.1
"FIA",365.1,0,1)
y^n^p^^^^n^^n
"FIA",365.1,0,10)

"FIA",365.1,0,11)

"FIA",365.1,0,"RLRO")

"FIA",365.1,0,"VR")
2.0^IB
"FIA",365.1,365.1)
1
"FIA",365.1,365.1,.1)

"FIA",365.1,365.1,.21)

"FIA",365.18)
EIV EICD TRACKING
"FIA",365.18,0)
^IBCN(365.18,
"FIA",365.18,0,0)
365.18P
"FIA",365.18,0,1)
y^n^f^^^^n
"FIA",365.18,0,10)

"FIA",365.18,0,11)

"FIA",365.18,0,"RLRO")

"FIA",365.18,0,"VR")
2.0^IB
"FIA",365.18,365.18)
0
"FIA",365.18,365.185)
0
"INIT")
IBY621PO
"KRN",.402,1838,-1)
0^1
"KRN",.402,1838,0)
IBEDIT INS CO1^3180524.1255^^36^^^3180716
"KRN",.402,1838,"DIAB",1,0,36,8)
EDI INST SECONDARY ID(2);"EDI - 2ND Inst Payer Sec. ID"
"KRN",.402,1838,"DIAB",1,0,36,9)
EDI ID NUMBER - PROF;"EDI - Prof Payer Primary ID"
"KRN",.402,1838,"DIAB",1,0,36,13)
EDI PROF SECONDARY ID QUAL(2);"EDI - 2ND Prof Payer Sec. ID Qualifier"
"KRN",.402,1838,"DIAB",1,0,36,19)
ATT/REND ID BILL SEC ID INST//NO;"Use Att/Rend ID as Billing Provider Sec. ID (UB)?"
"KRN",.402,1838,"DIAB",1,1,36.015,0)
.01;"EDI - Alt Inst Payer Primary ID Type"
"KRN",.402,1838,"DIAB",1,1,36.016,0)
.01;"EDI - Alt Prof Payer Primary ID Type"
"KRN",.402,1838,"DIAB",1,1,36.03,0)
ALL
"KRN",.402,1838,"DIAB",2,0,36,10)
EDI PROF SECONDARY ID QUAL(1);"EDI - 1ST Prof Payer Sec. ID Qualifier"
"KRN",.402,1838,"DIAB",2,0,36,17)
MAX NUMBER TEST BILLS PER DAY;"MAX # TEST BILLS TO TRANSMIT PER DAY"
"KRN",.402,1838,"DIAB",2,0,36,18)
REF PROV SEC ID DEF CMS-1500//UPIN;"Default ID (1500)"
"KRN",.402,1838,"DIAB",2,0,36,23)
ANOTHER CO. PROCESS INQUIRIES?;T
"KRN",.402,1838,"DIAB",2,1,36.015,0)
.02;"EDI - Alt Inst Payer Primary ID"
"KRN",.402,1838,"DIAB",2,1,36.016,0)
.02;"EDI - Alt Prof Payer Primary ID"
"KRN",.402,1838,"DIAB",3,0,36,1)
ANOTHER CO. PROCESS PRECERTS?;T
"KRN",.402,1838,"DIAB",3,0,36,18)
REF PROV SEC ID REQ ON CLAIMS;"Require ID on Claim"
"KRN",.402,1838,"DIAB",3,0,36,24)
INS COMPANY LINK TYPE;T
"KRN",.402,1838,"DIAB",4,0,36,3)
15;"EDI - Alt Inst Payer Primary ID Type"
"KRN",.402,1838,"DIAB",4,0,36,20)
ANOTHER CO. PROCESS IP CLAIMS?;T
"KRN",.402,1838,"DIAB",5,0,36,5)
EDI INST SECONDARY ID(1);"EDI - 1ST Inst Payer Sec. ID"
"KRN",.402,1838,"DIAB",5,0,36,16)
BIN NUMBER;"EDI - Bin Number"
"KRN",.402,1838,"DIAB",5,0,36,18)
ATT/REND ID BILL SEC ID PROF//NO;"Use Att/Rend ID as Billing Provider Sec. ID (1500)?"
"KRN",.402,1838,"DIAB",6,0,36,2)
EDI ID NUMBER - INST;"EDI - Inst Payer Primary ID"
"KRN",.402,1838,"DIAB",6,0,36,3)
EDI INST SECONDARY ID QUAL(1);"EDI - 1ST Inst Payer Sec. ID Qualifier"
"KRN",.402,1838,"DIAB",6,0,36,6)
EDI INST SECONDARY ID QUAL(2);"EDI - 2ND Inst Payer Sec. ID Qualifier"
"KRN",.402,1838,"DIAB",6,0,36,14)
EDI PROF SECONDARY ID(2);"EDI - 2ND Prof Payer Sec. ID"
"KRN",.402,1838,"DIAB",6,0,36,17)
PERF PROV SECOND ID TYPE 1500;"Default ID (1500)"
"KRN",.402,1838,"DIAB",6,0,36,25)
INS COMPANY LINK PARENT;T
"KRN",.402,1838,"DIAB",7,0,36,9)
16;"EDI - Alt Prof Payer Primary ID Type"
"KRN",.402,1838,"DIAB",7,0,36,11)
EDI PROF SECONDARY ID(1);"EDI - 1ST Prof Payer Sec. ID"
"KRN",.402,1838,"DIAB",7,0,36,15)
ELECTRONIC INSURANCE TYPE;"EDI - Insurance Type"
"KRN",.402,1838,"DIAB",7,0,36,17)
PERF PROV SECOND ID TYPE UB;"Default ID (UB)"
"KRN",.402,1838,"DIAB",8,0,36,17)
SECONDARY ID REQUIREMENTS;"Require ID on Claim"
"KRN",.402,1838,"DIAB",9,0,36,16)
PRINT SEC/TERT AUTO CLAIMS?;"EDI - Print Sec/Tert Auto Claims?"
"KRN",.402,1838,"DIAB",10,0,36,16)
PRINT SEC MED CLAIMS W/O MRA;"EDI - Print Medicare Sec Claims w/o MRA?"
"KRN",.402,1838,"DIAB",11,0,36,1)
TRANSMIT ELECTRONICALLY;"EDI - Transmit?"
"KRN",.402,1838,"DIAB",12,0,36,22)
ANOTHER CO. PROCESS APPEALS?;T
"KRN",.402,1838,"DIAB",13,0,36,0)
STANDARD FTF;"STANDARD FILING TIME FRAME"
"KRN",.402,1838,"DIAB",16,0,36,0)
STANDARD FTF VALUE;"STANDARD FILING TIME FRAME VALUE"
"KRN",.402,1838,"DIAB",20,0,36,21)
ANOTHER CO. PROCESS RX CLAIMS?;T
"KRN",.402,1838,"DIAB",24,0,36,20)
ANOTHER CO. PROCESS OP CLAIMS?;T
"KRN",.402,1838,"DR",1,36)
S:",6,"'[IBY Y="@0";.01;@0;S:",0,1,6,12,"'[IBY Y="@10";S:",12,"[IBY Y="@18";2;1;.06;.07;.08;.09;.15;.18STANDARD FILING TIME FRAME~;I 'X S Y="@016";I '$$FTFV^IBCNSU31(X) S Y="@016";.19STANDARD FILING TIME FRAME VALUE~;@016;.12;.13;
"KRN",.402,1838,"DR",1,36,1)
.132;.134;.178T~;S:'X Y="@11";.139;S Y="@16";@11;.133;@16;I '$$KCHK^XUSRB("IB EDI INSURANCE EDIT") S Y="@171";3.01EDI - Transmit?~;S DIPA("IBTX")=X;I X=$G(IBEDIKEY(1))!$$KCHK^XUSRB("IB EDI INSURANCE EDIT") S Y="@1721";
"KRN",.402,1838,"DR",1,36,2)
3.01////^S X=$G(IBEDIKEY(1));I $$EDIKEY^IBCNSC();S Y="@171";@1721;I '$G(DIPA("IBTX")) S Y="@17";3.04EDI - Inst Payer Primary ID~;I X=$G(IBEDIKEY(4))!$$KCHK^XUSRB("IB EDI INSURANCE EDIT") S Y="@17211";3.04////^S X=$G(IBEDIKEY(4));
"KRN",.402,1838,"DR",1,36,3)
I $$EDIKEY^IBCNSC();S Y="@171";@17211;15EDI - Alt Inst Payer Primary ID Type~;I '$G(DIPA("IBTX")) S Y="@17";6.01EDI - 1ST Inst Payer Sec. ID Qualifier~;
"KRN",.402,1838,"DR",1,36,4)
I X=""&($G(IBEDIKEY(3,6))="")&$$KCHK^XUSRB("IB EDI INSURANCE EDIT") S Y="@1722";I X=$G(IBEDIKEY(1,6))!$$KCHK^XUSRB("IB EDI INSURANCE EDIT") S Y="@17212";6.01////^S X=$G(IBEDIKEY(1,6));6.02////^S X=$G(IBEDIKEY(2,6));
"KRN",.402,1838,"DR",1,36,5)
I $$EDIKEY^IBCNSC();S Y="@171";@17212;I '$G(DIPA("IBTX")) S Y="@17";6.02EDI - 1ST Inst Payer Sec. ID~;I X=$G(IBEDIKEY(2,6))!$$KCHK^XUSRB("IB EDI INSURANCE EDIT") S Y="@17213";6.02////^S X=$G(IBEDIKEY(2,6));
"KRN",.402,1838,"DR",1,36,6)
6.01////^S X=$G(IBEDIKEY(1,6));I $$EDIKEY^IBCNSC();S Y="@171";@17213;I '$G(DIPA("IBTX")) S Y="@17";6.03EDI - 2ND Inst Payer Sec. ID Qualifier~;I X=""&$$KCHK^XUSRB("IB EDI INSURANCE EDIT") S Y="@1722";
"KRN",.402,1838,"DR",1,36,7)
I X=$G(IBEDIKEY(3,6))!$$KCHK^XUSRB("IB EDI INSURANCE EDIT") S Y="@17214";6.03////^S X=$G(IBEDIKEY(3,6));6.04////^S X=$G(IBEDIKEY(4,6));I $$EDIKEY^IBCNSC();S Y="@171";@17214;I '$G(DIPA("IBTX")) S Y="@17";
"KRN",.402,1838,"DR",1,36,8)
6.04EDI - 2ND Inst Payer Sec. ID~;I X=$G(IBEDIKEY(4,6))!$$KCHK^XUSRB("IB EDI INSURANCE EDIT") S Y="@1722";6.04////^S X=$G(IBEDIKEY(4,6));6.03////^S X=$G(IBEDIKEY(3,6));I $$EDIKEY^IBCNSC();S Y="@171";@1722;
"KRN",.402,1838,"DR",1,36,9)
3.02EDI - Prof Payer Primary ID~;I X=$G(IBEDIKEY(2))!$$KCHK^XUSRB("IB EDI INSURANCE EDIT") S Y="@17221";3.02////^S X=$G(IBEDIKEY(2));I $$EDIKEY^IBCNSC();S Y="@171";@17221;16EDI - Alt Prof Payer Primary ID Type~;
"KRN",.402,1838,"DR",1,36,10)
I '$G(DIPA("IBTX")) S Y="@17";6.05EDI - 1ST Prof Payer Sec. ID Qualifier~;I X=""&($G(IBEDIKEY(7,6))="")&$$KCHK^XUSRB("IB EDI INSURANCE EDIT") S Y="@1723";I X=$G(IBEDIKEY(5,6))!$$KCHK^XUSRB("IB EDI INSURANCE EDIT") S Y="@17222";
"KRN",.402,1838,"DR",1,36,11)
6.05////^S X=$G(IBEDIKEY(5,6));6.06////^S X=$G(IBEDIKEY(6,6));I $$EDIKEY^IBCNSC();S Y="@171";@17222;I '$G(DIPA("IBTX")) S Y="@17";6.06EDI - 1ST Prof Payer Sec. ID~;
"KRN",.402,1838,"DR",1,36,12)
I X=$G(IBEDIKEY(6,6))!$$KCHK^XUSRB("IB EDI INSURANCE EDIT") S Y="@17223";6.06////^S X=$G(IBEDIKEY(6,6));6.05////^S X=$G(IBEDIKEY(5,6));I $$EDIKEY^IBCNSC();S Y="@171";@17223;I '$G(DIPA("IBTX")) S Y="@17";
"KRN",.402,1838,"DR",1,36,13)
6.07EDI - 2ND Prof Payer Sec. ID Qualifier~;I X=""&$$KCHK^XUSRB("IB EDI INSURANCE EDIT") S Y="@1723";I X=$G(IBEDIKEY(7,6))!$$KCHK^XUSRB("IB EDI INSURANCE EDIT") S Y="@17224";6.07////^S X=$G(IBEDIKEY(7,6));
"KRN",.402,1838,"DR",1,36,14)
6.08////^S X=$G(IBEDIKEY(8,6));I $$EDIKEY^IBCNSC();S Y="@171";@17224;I '$G(DIPA("IBTX")) S Y="@17";6.08EDI - 2ND Prof Payer Sec. ID~;I X=$G(IBEDIKEY(8,6))!$$KCHK^XUSRB("IB EDI INSURANCE EDIT") S Y="@1723";
"KRN",.402,1838,"DR",1,36,15)
6.08////^S X=$G(IBEDIKEY(8,6));6.07////^S X=$G(IBEDIKEY(7,6));I $$EDIKEY^IBCNSC();S Y="@171";@1723;@17;3.09EDI - Insurance Type~;I X=$G(IBEDIKEY(9))!$$KCHK^XUSRB("IB EDI INSURANCE EDIT") S Y="@1724";3.09////^S X=$G(IBEDIKEY(9));
"KRN",.402,1838,"DR",1,36,16)
I $$EDIKEY^IBCNSC();S Y="@171";@1724;@171;3.03EDI - Bin Number~;I '$$KCHK^XUSRB("IB EDI INSURANCE EDIT") S Y="@1725";7.01;@1725;6.09EDI - Print Sec/Tert Auto Claims?~;6.1EDI - Print Medicare Sec Claims w/o MRA?~;
"KRN",.402,1838,"DR",1,36,17)
I $G(DIPA("IBTX"))'=2 S Y="@18";3.06MAX # TEST BILLS TO TRANSMIT PER DAY~;@18;S:",6,12,"'[IBY Y="@181";W !!,"Attending/Rendering Provider Secondary ID";4.01Default ID (1500)~;4.02Default ID (UB)~;4.03Require ID on Claim~;
"KRN",.402,1838,"DR",1,36,18)
W !!,"Referring Provider Secondary ID";4.04Default ID (1500)~//UPIN;4.05Require ID on Claim~;W !!,"Billing Provider Secondary IDs";4.06Use Att/Rend ID as Billing Provider Sec. ID (1500)?~//NO;
"KRN",.402,1838,"DR",1,36,19)
4.08Use Att/Rend ID as Billing Provider Sec. ID (UB)?~//NO;W !!,"Billing Provider/Service Facility";@181;S:IBY["1" Y="@99";@10;S:",0,2,6,"'[IBY Y="@20";.111;S:X="" Y="@1";.112;S:X="" Y="@1";.113;@1;.114;.115;.116;.131;.119;
"KRN",.402,1838,"DR",1,36,20)
S:(IBY["0")!(IBY["2") Y="@99";@20;S:",3,6,"'[IBY Y="@30";.128T~;S:'X Y="@21";.127;S Y="@26";@21;.121;S:X="" Y="@2";.122;S:X="" Y="@2";.123;@2;.124;.125;.126;.135;.129;@26;S:IBY["3" Y="@99";@30;S:",10,6,"'[IBY Y="@80";.168T~;
"KRN",.402,1838,"DR",1,36,21)
S:'X Y="@31";.167;S Y="@36";@31;.161;S:X="" Y="@5";.162;S:X="" Y="@5";.163;@5;.164;.165;.166;.136;.169;@36;S:IBY["10" Y="@99";@80;S:",11,6,"'[IBY Y="@90";.188T~;S:'X Y="@81";.187;S Y="@86";@81;.181;S:X="" Y="@6";.182;S:X="" Y="@6";
"KRN",.402,1838,"DR",1,36,22)
.183;@6;.184;.185;.186;.1311;.189;@86;S:IBY["11" Y="@99";@90;S:",4,6,"'[IBY Y="@40";.148T~;S:'X Y="@41";.147;S Y="@46";@41;.141;S:X="" Y="@3";.142;S:X="" Y="@3";.143;@3;.144;.145;.146;.137;.149;@46;S:IBY["4" Y="@99";@40;
"KRN",.402,1838,"DR",1,36,23)
S:",5,6,"'[IBY Y="@55";.158T~;S:'X Y="@51";.157;S Y="@56";@51;.151;S:X="" Y="@4";.152;S:X="" Y="@4";.153;@4;.154;.155;.156;.138;.159;@56;S:IBY["5" Y="@99";@55;S:",13,6,"'[IBY Y="@60";
"KRN",.402,1838,"DR",1,36,24)
I '$$KCHK^XUSRB("IB EDI INSURANCE EDIT") S Y="@551";I $D(^DIC(36,"APC",+$G(DA))),$P($G(^DIC(36,+$G(DA),3)),U,13)="P" S Y="@551";3.13T~;S DIPA("IBLNK")=X;I X=$G(IBEDIKEY(13))!$$KCHK^XUSRB("IB EDI INSURANCE EDIT") S Y="@552";
"KRN",.402,1838,"DR",1,36,25)
3.13////^S X=$G(IBEDIKEY(13));I $$EDIKEY^IBCNSC();S Y="@551";@552;I $G(DIPA("IBLNK"))'="C" S Y="@551";3.14T~;I X=$G(IBEDIKEY(14))!$$KCHK^XUSRB("IB EDI INSURANCE EDIT") S Y="@553";3.14////^S X=$G(IBEDIKEY(14));I $$EDIKEY^IBCNSC();
"KRN",.402,1838,"DR",1,36,26)
S Y="@551";@553;D COPY^IBCEPCID(+$G(DA));@551;S:IBY=",13," Y="@99";@60;S IBPI=$$GET1^DIQ(36,DA,3.1,"I");S:",7,6,"'[IBY Y="@50";3.1;I X="" S Y="@50";S IBPJ=X;I +$$GET1^DIQ(350.9,"1,",51.30,"I")'=IBPJ S Y="@605";3.1///@;
"KRN",.402,1838,"DR",1,36,27)
3.1///^S X=IBPI;W !,"LINKING TO THE MBI PAYER IS NOT ALLOWED";S Y="@60";@605;I +$$GET1^DIQ(350.9,"1,",51.31,"I")'=IBPJ S Y="@50";3.1///@;3.1///^S X=IBPI;
"KRN",.402,1838,"DR",1,36,28)
W !,"LINKING TO THE ELECTRONIC INSURANCE COVERAGE DISCOVERY PAYER IS NOT ALLOWED";S Y="@60";@50;K IBPI,IBPJ;S:",8,6,"'[IBY Y="@70";11;S:IBY["8" Y="@99";@70;S:",9,6,"'[IBY Y="@99";10;@99;
"KRN",.402,1838,"DR",2,36.015)
.01EDI - Alt Inst Payer Primary ID Type~;.02EDI - Alt Inst Payer Primary ID~;
"KRN",.402,1838,"DR",2,36.016)
.01EDI - Alt Prof Payer Primary ID Type~;.02EDI - Alt Prof Payer Primary ID~;
"KRN",.402,1838,"DR",2,36.03)
.01
"KRN",101,8342,-1)
0^2
"KRN",101,8342,0)
IBCNE EIV RQP OUT^EIV EICD IDENTIFICATION OUT^^E^^^^^^^^
"KRN",101,8342,1,0)
^101.06^1^1^3180628^^
"KRN",101,8342,1,1,0)
This protocol is for Identification messages
"KRN",101,8342,99)
64803,45296
"KRN",101,8342,770)
IIV VISTA^^RQP^I04^^^^AL^NE^2.4^
"KRN",101,8342,772)
D ^IBCNEHLI
"KRN",101,8342,775,0)
^101.0775PA^1^1
"KRN",101,8342,775,1,0)
8343
"KRN",101,8342,775,1,"^")
IBCNE EIV ID REQUEST
"KRN",101,8343,-1)
0^3
"KRN",101,8343,0)
IBCNE EIV ID REQUEST^EIV EICD IDENTIFICATION REQUEST^^S^^^^^^^^
"KRN",101,8343,1,0)
^101.06^2^2^3180628^^
"KRN",101,8343,1,1,0)
This protocol is for the outbound message associated with the EICD
"KRN",101,8343,1,2,0)
Identification Request for insurance.
"KRN",101,8343,99)
64803,45776
"KRN",101,8343,770)
^IIV EC^^I04^^^IIV EC^^^2.4^ACK
"KRN",101,8343,771)
Q
"KRN",101,8343,773)
1^1^0
"KRN",101,8382,-1)
0^1
"KRN",101,8382,0)
IBCNE EIV RPI IN^EIV EICD IDENTIFICATION IN^^E^^^^^^^^
"KRN",101,8382,1,0)
^^3^3^3180604^
"KRN",101,8382,1,1,0)
This protocol is for EICD Identification Responses.  Incoming responses 
"KRN",101,8382,1,2,0)
to EICD Identification Inquiries.  Refer to protocol "IBCNE EIV RQP OUT"
"KRN",101,8382,1,3,0)
for EICD Identification Inquiries.
"KRN",101,8382,99)
64803,44500
"KRN",101,8382,770)
IIV EC^^RPI^I04^^^^^^2.4^
"KRN",101,8382,771)

"KRN",101,8382,772)
D ^IBCNEHLI
"KRN",101,8382,775,0)
^101.0775PA^1^1
"KRN",101,8382,775,1,0)
8383
"KRN",101,8382,775,1,"^")
IBCNE EIV ID RESPONSE
"KRN",101,8383,-1)
0^4
"KRN",101,8383,0)
IBCNE EIV ID RESPONSE^EIV EICD IDENTIFICATION RESPONSE^^S^^^^^^^^
"KRN",101,8383,99)
64803,46023
"KRN",101,8383,770)
^IIV VISTA^^I04^^^^^^^ACK
"KRN",101,8383,771)
D ^IBCNEHLI
"MBREQ")
0
"ORD",7,.402)
.402;7;;;EDEOUT^DIFROMSO(.402,DA,"",XPDA);FPRE^DIFROMSI(.402,"",XPDA);EPRE^DIFROMSI(.402,DA,$E("N",$G(XPDNEW)),XPDA,"",OLDA);;EPOST^DIFROMSI(.402,DA,"",XPDA);DEL^DIFROMSK(.402,"",%)
"ORD",7,.402,0)
INPUT TEMPLATE
"ORD",15,101)
101;15;;;PRO^XPDTA;PROF1^XPDIA;PROE1^XPDIA;PROF2^XPDIA;;PRODEL^XPDIA
"ORD",15,101,0)
PROTOCOL
"PKG",230,-1)
1^1
"PKG",230,0)
INTEGRATED BILLING^IB^INTEGRATED BILLING
"PKG",230,20,0)
^9.402P^1^1
"PKG",230,20,1,0)
2^^IBAXDR
"PKG",230,20,1,1)

"PKG",230,20,"B",2,1)

"PKG",230,22,0)
^9.49I^1^1
"PKG",230,22,1,0)
2.0^2940321^2940525
"PKG",230,22,1,"PAH",1,0)
621^3180718
"PKG",230,22,1,"PAH",1,1,0)
^^1^1^3180718
"PKG",230,22,1,"PAH",1,1,1,0)
This is IB Build-7
"QUES","XPF1",0)
Y
"QUES","XPF1","??")
^D REP^XPDH
"QUES","XPF1","A")
Shall I write over your |FLAG| File
"QUES","XPF1","B")
YES
"QUES","XPF1","M")
D XPF1^XPDIQ
"QUES","XPF2",0)
Y
"QUES","XPF2","??")
^D DTA^XPDH
"QUES","XPF2","A")
Want my data |FLAG| yours
"QUES","XPF2","B")
YES
"QUES","XPF2","M")
D XPF2^XPDIQ
"QUES","XPI1",0)
YO
"QUES","XPI1","??")
^D INHIBIT^XPDH
"QUES","XPI1","A")
Want KIDS to INHIBIT LOGONs during the install
"QUES","XPI1","B")
NO
"QUES","XPI1","M")
D XPI1^XPDIQ
"QUES","XPM1",0)
PO^VA(200,:EM
"QUES","XPM1","??")
^D MG^XPDH
"QUES","XPM1","A")
Enter the Coordinator for Mail Group '|FLAG|'
"QUES","XPM1","B")

"QUES","XPM1","M")
D XPM1^XPDIQ
"QUES","XPO1",0)
Y
"QUES","XPO1","??")
^D MENU^XPDH
"QUES","XPO1","A")
Want KIDS to Rebuild Menu Trees Upon Completion of Install
"QUES","XPO1","B")
NO
"QUES","XPO1","M")
D XPO1^XPDIQ
"QUES","XPZ1",0)
Y
"QUES","XPZ1","??")
^D OPT^XPDH
"QUES","XPZ1","A")
Want to DISABLE Scheduled Options, Menu Options, and Protocols
"QUES","XPZ1","B")
NO
"QUES","XPZ1","M")
D XPZ1^XPDIQ
"QUES","XPZ2",0)
Y
"QUES","XPZ2","??")
^D RTN^XPDH
"QUES","XPZ2","A")
Want to MOVE routines to other CPUs
"QUES","XPZ2","B")
NO
"QUES","XPZ2","M")
D XPZ2^XPDIQ
"RTN")
27
"RTN","IBCNEBF")
0^26^B48497431^B46385823
"RTN","IBCNEBF",1,0)
IBCNEBF ;DAOU/ALA - Create an Entry in the Buffer File ;20-JUN-2002
"RTN","IBCNEBF",2,0)
 ;;2.0;INTEGRATED BILLING;**184,271,361,371,416,438,497,621**;21-MAR-94;Build 8
"RTN","IBCNEBF",3,0)
 ;;Per VHA Directive 6402, this routine should not be modified.
"RTN","IBCNEBF",4,0)
 ;
"RTN","IBCNEBF",5,0)
 ;**Program Description**
"RTN","IBCNEBF",6,0)
 ;  This program will create a Buffer entry based upon input values
"RTN","IBCNEBF",7,0)
 ;
"RTN","IBCNEBF",8,0)
 Q
"RTN","IBCNEBF",9,0)
 ;
"RTN","IBCNEBF",10,0)
PT(DFN,IRIEN,SYMBOL,OVRRIDE,ADD,IBERROR) ;  Get data
"RTN","IBCNEBF",11,0)
 ;   from a specific patient and insurance record entry
"RTN","IBCNEBF",12,0)
 ;
"RTN","IBCNEBF",13,0)
 ;  Input Parameters
"RTN","IBCNEBF",14,0)
 ;    DFN = Patient IEN
"RTN","IBCNEBF",15,0)
 ;    IRIEN = Patient Insurance Record IEN
"RTN","IBCNEBF",16,0)
 ;    SYMBOL = eIV Symbol IEN
"RTN","IBCNEBF",17,0)
 ;    OVRRIDE = Override flag for ins. buffer record  (0 or 1)
"RTN","IBCNEBF",18,0)
 ;    ADD = If defined, then it will add a new Buffer entry
"RTN","IBCNEBF",19,0)
 ;    IBERROR = If defined, then it will be updated with error info.
"RTN","IBCNEBF",20,0)
 ;              OPTIONALLY PASSED BY REFERENCE
"RTN","IBCNEBF",21,0)
 ;
"RTN","IBCNEBF",22,0)
 I DFN=""!(IRIEN="") Q   ; * do not require SYMBOL or OVRRIDE
"RTN","IBCNEBF",23,0)
 ;
"RTN","IBCNEBF",24,0)
 ;
"RTN","IBCNEBF",25,0)
 N VBUF,IDATA0,IDATA3,IDATA7,IEN,INAME,PNAME,IIEN,GNUMB,GNAME,SUBID,PPHONE,PATID
"RTN","IBCNEBF",26,0)
 N BPHONE,EFFDT,EXPDT,WHO,REL,IDOB,ISSN,COB,TQIEN,RDATA,ISEX,NAME
"RTN","IBCNEBF",27,0)
 N MSG,XMSUB,MSGP,INSDATA,PCE,BFD,BFN,INSPCE,ESGHPARR
"RTN","IBCNEBF",28,0)
 N SUBADDR1,SUBADDR2,SUBCITY,SUBSTATE,SUBZIP,SUBCNTRY,SUBCNDIV
"RTN","IBCNEBF",29,0)
 ;
"RTN","IBCNEBF",30,0)
 S IDATA0=$G(^DPT(DFN,.312,IRIEN,0)),IDATA3=$G(^DPT(DFN,.312,IRIEN,3))
"RTN","IBCNEBF",31,0)
 S IDATA7=$G(^DPT(DFN,.312,IRIEN,7))
"RTN","IBCNEBF",32,0)
 S IIEN=$P(IDATA0,U,1),INAME=$$GET1^DIQ(36,IIEN,.01,"E")
"RTN","IBCNEBF",33,0)
 S PPHONE=$P($G(^DIC(36,IIEN,.13)),U,3),BPHONE=$P($G(^DIC(36,IIEN,.13)),U,2)
"RTN","IBCNEBF",34,0)
 S NAME=$P(IDATA7,U,1),SUBID=$P(IDATA7,U,2)
"RTN","IBCNEBF",35,0)
 S PATID=$P($G(^DPT(DFN,.312,IRIEN,5)),U,1)
"RTN","IBCNEBF",36,0)
 S WHO=$P(IDATA0,U,6),COB=$P(IDATA0,U,20)
"RTN","IBCNEBF",37,0)
 S IDOB=$P(IDATA3,U,1),ISSN=$P(IDATA3,U,5),ISEX=$P(IDATA3,U,12)
"RTN","IBCNEBF",38,0)
 S EFFDT=$P(IDATA0,U,8),EXPDT=$P(IDATA0,U,4)
"RTN","IBCNEBF",39,0)
 S REL=$P($G(^DPT(DFN,.312,IRIEN,4)),U,3)
"RTN","IBCNEBF",40,0)
 S SUBADDR1=$P(IDATA3,U,6),SUBADDR2=$P(IDATA3,U,7)
"RTN","IBCNEBF",41,0)
 S SUBCITY=$P(IDATA3,U,8),SUBSTATE=$P(IDATA3,U,9),SUBZIP=$P(IDATA3,U,10)
"RTN","IBCNEBF",42,0)
 S SUBCNTRY=$P(IDATA3,U,13),SUBCNDIV=$P(IDATA3,U,14)
"RTN","IBCNEBF",43,0)
 ;
"RTN","IBCNEBF",44,0)
 S IENS=IRIEN_","_DFN_","
"RTN","IBCNEBF",45,0)
 S GNUMB=$$GET1^DIQ(2.312,IENS,21,"E")
"RTN","IBCNEBF",46,0)
 S GNAME=$$GET1^DIQ(2.312,IENS,20,"E")
"RTN","IBCNEBF",47,0)
 ;
"RTN","IBCNEBF",48,0)
 ; Capture the employer sponsored insurance fields into array
"RTN","IBCNEBF",49,0)
 ;   ESGHPARR(buffer field number) = data
"RTN","IBCNEBF",50,0)
 ;
"RTN","IBCNEBF",51,0)
 S INSDATA=$G(^DPT(DFN,.312,IRIEN,2)),PCE=0
"RTN","IBCNEBF",52,0)
 F BFD=5:1:12,2,1,3,4 S PCE=PCE+1,BFN=BFD/100+61,INSPCE=$P(INSDATA,U,PCE) I INSPCE'="" S ESGHPARR(BFN)=INSPCE
"RTN","IBCNEBF",53,0)
 ;
"RTN","IBCNEBF",54,0)
 D FIL
"RTN","IBCNEBF",55,0)
 K ADD
"RTN","IBCNEBF",56,0)
 Q
"RTN","IBCNEBF",57,0)
 ;
"RTN","IBCNEBF",58,0)
RP(IEN,ADD,BUFF) ;  Get data from a specific response record
"RTN","IBCNEBF",59,0)
 ;
"RTN","IBCNEBF",60,0)
 ;  Input Parameter
"RTN","IBCNEBF",61,0)
 ;    IEN  = Internal entry number of the Response
"RTN","IBCNEBF",62,0)
 ;    ADD  = If defined, then it will add a new Buffer entry
"RTN","IBCNEBF",63,0)
 ;    BUFF = IEN of the Buffer Entry to be updated (optional)
"RTN","IBCNEBF",64,0)
 ;
"RTN","IBCNEBF",65,0)
 S BUFF=$G(BUFF) ; Initialize optional parameter
"RTN","IBCNEBF",66,0)
 ;
"RTN","IBCNEBF",67,0)
 N BPHONE,COB,DFN,EFFDT,EXPDT,GNAME,GNUMB,IBSOURCE,IDOB,IIEN,INAME,IRIEN,ISEX,ISSN,NAME
"RTN","IBCNEBF",68,0)
 N PATID,PIEN,PNAME,PPHONE,RDATA,RDATA5,RDATA13,RDATA14,REL,RSTYPE,SUBID,TQIEN,WHO
"RTN","IBCNEBF",69,0)
 N SUBADDR1,SUBADDR2,SUBCITY,SUBSTATE,SUBZIP,SUBCNTRY,SUBCNDIV
"RTN","IBCNEBF",70,0)
 ;
"RTN","IBCNEBF",71,0)
 S DFN=$P(^IBCN(365,IEN,0),U,2),TQIEN=$P(^IBCN(365,IEN,0),U,5)
"RTN","IBCNEBF",72,0)
 S PIEN=$P(^IBCN(365,IEN,0),U,3),RSTYPE=$P(^(0),U,10)
"RTN","IBCNEBF",73,0)
 I PIEN'="" S PNAME=$P(^IBE(365.12,PIEN,0),U,1)
"RTN","IBCNEBF",74,0)
 I TQIEN'="" S IRIEN=$P($G(^IBCN(365.1,TQIEN,0)),U,13),IBSOURCE=$$GET1^DIQ(365.1,TQIEN_",",3.02,"I") ; IB*2.0*621 IBSOURCE
"RTN","IBCNEBF",75,0)
 I $G(IRIEN)'="" S INAME="" D
"RTN","IBCNEBF",76,0)
 . S IIEN=$P($G(^DPT(DFN,.312,IRIEN,0)),U,1)
"RTN","IBCNEBF",77,0)
 . I IIEN="" Q
"RTN","IBCNEBF",78,0)
 . S INAME=$P(^DIC(36,IIEN,0),U,1)
"RTN","IBCNEBF",79,0)
 S RDATA=$G(^IBCN(365,IEN,1)),RDATA5=$G(^IBCN(365,IEN,5))
"RTN","IBCNEBF",80,0)
 S RDATA13=$G(^IBCN(365,IEN,13)),RDATA14=$G(^IBCN(365,IEN,14))
"RTN","IBCNEBF",81,0)
 S NAME=$P(RDATA13,U,1)
"RTN","IBCNEBF",82,0)
 S INAME=$S($G(INAME)'=""&(RSTYPE="O"):INAME,1:$G(PNAME))
"RTN","IBCNEBF",83,0)
 S IDOB=$P(RDATA,U,2)
"RTN","IBCNEBF",84,0)
 S ISSN=$P(RDATA,U,3)
"RTN","IBCNEBF",85,0)
 S ISEX=$P(RDATA,U,4)
"RTN","IBCNEBF",86,0)
 S COB=$P(RDATA,U,13)
"RTN","IBCNEBF",87,0)
 S SUBID=$P(RDATA13,U,2)
"RTN","IBCNEBF",88,0)
 S PATID=$P(RDATA,U,18)
"RTN","IBCNEBF",89,0)
 S GNAME=$P(RDATA14,U,1)
"RTN","IBCNEBF",90,0)
 S GNUMB=$P(RDATA14,U,2)
"RTN","IBCNEBF",91,0)
 S WHO=$P(RDATA,U,8)
"RTN","IBCNEBF",92,0)
 S REL=$$PREL^IBCNEHLU(355.33,60.14,$$GET1^DIQ(365,IEN,8.01))  ; IB*2*497  VALUE FROM 365,8.01 needs evaluation and possible conversion 
"RTN","IBCNEBF",93,0)
 S EFFDT=$P(RDATA,U,11)
"RTN","IBCNEBF",94,0)
 S EXPDT=$P(RDATA,U,12)
"RTN","IBCNEBF",95,0)
 S SUBADDR1=$P(RDATA5,U),SUBADDR2=$P(RDATA5,U,2),SUBCITY=$P(RDATA5,U,3)
"RTN","IBCNEBF",96,0)
 S SUBSTATE=$P(RDATA5,U,4),SUBZIP=$P(RDATA5,U,5),SUBCNTRY=$P(RDATA5,U,6)
"RTN","IBCNEBF",97,0)
 S SUBCNDIV=$P(RDATA5,U,7)
"RTN","IBCNEBF",98,0)
 S PPHONE="",BPHONE=""
"RTN","IBCNEBF",99,0)
 ;
"RTN","IBCNEBF",100,0)
 D FIL
"RTN","IBCNEBF",101,0)
 K DFN,VBUF,IEN,IRIEN,INAME,PNAME,IIEN,GNUMB,GNAME,SUBID,PPHONE,PATID
"RTN","IBCNEBF",102,0)
 K BPHONE,EFFDT,EXPDT,WHO,REL,IDOB,ISSN,COB,TQIEN,RDATA,ISEX,NAME
"RTN","IBCNEBF",103,0)
 K ADD,%DT,D0,DG,DIC,DISYS,DIW,IENS,IBEISTC
"RTN","IBCNEBF",104,0)
 Q
"RTN","IBCNEBF",105,0)
 ;
"RTN","IBCNEBF",106,0)
FIL ;  File Buffer Data
"RTN","IBCNEBF",107,0)
 ;
"RTN","IBCNEBF",108,0)
 S MSGP=$$MGRP^IBCNEUT5()
"RTN","IBCNEBF",109,0)
 ;
"RTN","IBCNEBF",110,0)
 ; Variable IDUZ is optionally set by the calling routine.  If it is
"RTN","IBCNEBF",111,0)
 ; not defined, it will be set to the specific, non-human user.
"RTN","IBCNEBF",112,0)
 ;
"RTN","IBCNEBF",113,0)
 I $G(IDUZ)="" S IDUZ=$$FIND1^DIC(200,"","X","INTERFACE,IB EIV")
"RTN","IBCNEBF",114,0)
 ;
"RTN","IBCNEBF",115,0)
 I $G(ADD) S VBUF(.02)=IDUZ  ; Entered By
"RTN","IBCNEBF",116,0)
 S VBUF(.12)=$G(SYMBOL)   ; Buffer Symbol
"RTN","IBCNEBF",117,0)
 S VBUF(.13)=$G(OVRRIDE) ; Override freshness flag
"RTN","IBCNEBF",118,0)
 S VBUF(.18)=$G(IBELIGDT) ; eligibility date, only comes from ^IBCNEQU (real time eIV inquiry)
"RTN","IBCNEBF",119,0)
 I '$G(ERACT) D  ; Only file if not an error
"RTN","IBCNEBF",120,0)
 . S VBUF(20.01)=INAME  ; Insurance Company/Payer Name
"RTN","IBCNEBF",121,0)
 . S VBUF(60.01)=DFN  ; Patient IEN
"RTN","IBCNEBF",122,0)
 . S VBUF(90.02)=GNUMB  ; Group Number
"RTN","IBCNEBF",123,0)
 . S VBUF(90.01)=GNAME  ; Group Name
"RTN","IBCNEBF",124,0)
 . S VBUF(91.01)=NAME  ; Name of Insured
"RTN","IBCNEBF",125,0)
 . S VBUF(90.03)=SUBID  ; Subscriber ID
"RTN","IBCNEBF",126,0)
 . S VBUF(62.01)=PATID  ; Patient/Member ID
"RTN","IBCNEBF",127,0)
 . S VBUF(20.04)=PPHONE  ; Precertification Phone
"RTN","IBCNEBF",128,0)
 . S VBUF(20.03)=BPHONE  ; Billing Phone
"RTN","IBCNEBF",129,0)
 . S VBUF(60.02)=EFFDT  ; Effective Date
"RTN","IBCNEBF",130,0)
 . S VBUF(60.03)=EXPDT  ; Expiration Date
"RTN","IBCNEBF",131,0)
 . S VBUF(60.05)=WHO  ; Whose Insurance
"RTN","IBCNEBF",132,0)
 . S VBUF(60.14)=REL  ;  Patient Relationship
"RTN","IBCNEBF",133,0)
 . S VBUF(60.08)=IDOB  ;  Insured's DOB
"RTN","IBCNEBF",134,0)
 . S VBUF(60.09)=ISSN  ;  Insured's SSN
"RTN","IBCNEBF",135,0)
 . S VBUF(60.12)=COB  ;  Coordination of Benefits
"RTN","IBCNEBF",136,0)
 . S VBUF(60.13)=ISEX  ;  Insured's Sex
"RTN","IBCNEBF",137,0)
 . S VBUF(62.02)=SUBADDR1 ; Subscriber address line 1
"RTN","IBCNEBF",138,0)
 . S VBUF(62.03)=SUBADDR2 ; Subscriber address line 2
"RTN","IBCNEBF",139,0)
 . S VBUF(62.04)=SUBCITY ; Subscriber address city
"RTN","IBCNEBF",140,0)
 . S VBUF(62.05)=SUBSTATE ; Subscriber address state
"RTN","IBCNEBF",141,0)
 . S VBUF(62.06)=SUBZIP ; Subscriber address zip code
"RTN","IBCNEBF",142,0)
 . S VBUF(62.07)=SUBCNTRY ; Subscriber address country code
"RTN","IBCNEBF",143,0)
 . S VBUF(62.08)=SUBCNDIV ; Subscriber address country subdivision code
"RTN","IBCNEBF",144,0)
 . ;
"RTN","IBCNEBF",145,0)
 . ; Define Service Type Code (STC) to be sent with Insurance Inquiry
"RTN","IBCNEBF",146,0)
 . ; IBEISTC contains the STC defined by User using option EI, otherwise default is sent
"RTN","IBCNEBF",147,0)
 . I +$G(IBEISTC) S VBUF(80.01)=IBEISTC
"RTN","IBCNEBF",148,0)
 . K IBEISTC
"RTN","IBCNEBF",149,0)
 . ;
"RTN","IBCNEBF",150,0)
 . ; If the employer sponsored insurance array exists, then merge it in
"RTN","IBCNEBF",151,0)
 . I $D(ESGHPARR) M VBUF=ESGHPARR
"RTN","IBCNEBF",152,0)
 ;
"RTN","IBCNEBF",153,0)
 ; Do not overwrite the existing insurance co. name if it already exists
"RTN","IBCNEBF",154,0)
 I $G(ADD)="",$G(BUFF)'="" K VBUF(20.01)
"RTN","IBCNEBF",155,0)
 ;
"RTN","IBCNEBF",156,0)
 ; ** initialize IBERROR
"RTN","IBCNEBF",157,0)
 S IBERROR=""
"RTN","IBCNEBF",158,0)
 ;
"RTN","IBCNEBF",159,0)
 ;  If need to add a new Buffer entry ...
"RTN","IBCNEBF",160,0)
 ;
"RTN","IBCNEBF",161,0)
 ;  Variable IBFDA is returned to the calling routine as the IEN of
"RTN","IBCNEBF",162,0)
 ;  the buffer entry that was just added.
"RTN","IBCNEBF",163,0)
 ;
"RTN","IBCNEBF",164,0)
 I $G(ADD) D
"RTN","IBCNEBF",165,0)
 . S IBSOURCE=$G(IBSOURCE,5) ; IB*2.0*621 Added IBSOURCE to replace hard coded eIV
"RTN","IBCNEBF",166,0)
 . S IBFDA=$$ADDSTF^IBCNBES(IBSOURCE,DFN,.VBUF)
"RTN","IBCNEBF",167,0)
 . ; Error Message is 2nd piece of result
"RTN","IBCNEBF",168,0)
 . S IBERROR=$P(IBFDA,U,2)
"RTN","IBCNEBF",169,0)
 . S IBFDA=$P(IBFDA,U,1)
"RTN","IBCNEBF",170,0)
 ;
"RTN","IBCNEBF",171,0)
 ;  If an error, send an email message
"RTN","IBCNEBF",172,0)
 I IBERROR'="" D  Q
"RTN","IBCNEBF",173,0)
 . S MSG(1)="Error returned by $$ADDSTF^IBCNBES:"
"RTN","IBCNEBF",174,0)
 . S MSG(2)=IBERROR
"RTN","IBCNEBF",175,0)
 . S MSG(3)="Values:"
"RTN","IBCNEBF",176,0)
 . S MSG(4)=" Patient DFN = "_$G(DFN)
"RTN","IBCNEBF",177,0)
 . S MSG(5)=" Pt Ins Record IEN = "_$G(IRIEN)
"RTN","IBCNEBF",178,0)
 . S MSG(6)="Please log a Remedy Ticket for this problem."
"RTN","IBCNEBF",179,0)
 . S XMSUB="Error creating Buffer Entry."
"RTN","IBCNEBF",180,0)
 . D MSG^IBCNEUT5(MSGP,XMSUB,"MSG(")
"RTN","IBCNEBF",181,0)
 . K MSGP,MSG,XMSUB,IBERR
"RTN","IBCNEBF",182,0)
 ;
"RTN","IBCNEBF",183,0)
 ;  If need to update a new Buffer Entry ...
"RTN","IBCNEBF",184,0)
 ;
"RTN","IBCNEBF",185,0)
 ;  Variable BUFF is passed into this routine whenever the buffer
"RTN","IBCNEBF",186,0)
 ;  entry is known and the ADD flag is off.  The existing buffer entry
"RTN","IBCNEBF",187,0)
 ;  is edited in this case.
"RTN","IBCNEBF",188,0)
 ;
"RTN","IBCNEBF",189,0)
 I $G(ADD)="" D EDITSTF^IBCNBES(BUFF,.VBUF)
"RTN","IBCNEBF",190,0)
 ;
"RTN","IBCNEBF",191,0)
 ;  If an error occurred in EDITSTF, the error array is not returned
"RTN","IBCNEBF",192,0)
 ;
"RTN","IBCNEBF",193,0)
 Q
"RTN","IBCNEDE")
0^1^B50050843^B48578031
"RTN","IBCNEDE",1,0)
IBCNEDE ;DAOU/DAC - eIV DATA EXTRACTS ;07-MAY-2015
"RTN","IBCNEDE",2,0)
 ;;2.0;INTEGRATED BILLING;**184,271,300,416,438,497,549,593,595,621**;21-MAR-94;Build 8
"RTN","IBCNEDE",3,0)
 ;;Per VA Directive 6402, this routine should not be modified.
"RTN","IBCNEDE",4,0)
 ;
"RTN","IBCNEDE",5,0)
 ;**Program Description**
"RTN","IBCNEDE",6,0)
 ;  This program is the main driver for all data extracts associated
"RTN","IBCNEDE",7,0)
 ;  with the electronic Insurance Verification interface.
"RTN","IBCNEDE",8,0)
 ;  This program will run each extract in the specified order, which 
"RTN","IBCNEDE",9,0)
 ;  populates the eIV Transmission File (sometimes it creates/updates 
"RTN","IBCNEDE",10,0)
 ;  an entry in the insurance buffer as well).  It then begins to 
"RTN","IBCNEDE",11,0)
 ;  process the inquiries in the eIV Transmission File.
"RTN","IBCNEDE",12,0)
 ;  08-08-2002
"RTN","IBCNEDE",13,0)
 ;  As this program will run in the background the variable ZTSTOP
"RTN","IBCNEDE",14,0)
 ;  can be returned from any of the extracts should a TaskMan stop
"RTN","IBCNEDE",15,0)
 ;  request occur.  Also, clear out the task record before exiting.
"RTN","IBCNEDE",16,0)
 ; 08-09-2002
"RTN","IBCNEDE",17,0)
 ;  Added check for "~NO PAYER", if it does not exist, build it
"RTN","IBCNEDE",18,0)
 ;
"RTN","IBCNEDE",19,0)
 Q
"RTN","IBCNEDE",20,0)
 ;
"RTN","IBCNEDE",21,0)
EN ; Entry Point
"RTN","IBCNEDE",22,0)
 ; Prevent simultaneous runs
"RTN","IBCNEDE",23,0)
 ; Set error trap to ensure that lock is released
"RTN","IBCNEDE",24,0)
 ;
"RTN","IBCNEDE",25,0)
 ; IB*2.0*549 - Quit if Nightly Extract Master switch is off
"RTN","IBCNEDE",26,0)
 Q:$$GET1^DIQ(350.9,"1,",51.28,"I")="N"
"RTN","IBCNEDE",27,0)
 ;
"RTN","IBCNEDE",28,0)
 N $ES,$ET
"RTN","IBCNEDE",29,0)
 S $ET="D ER^IBCNEDE"
"RTN","IBCNEDE",30,0)
 ; Check lock
"RTN","IBCNEDE",31,0)
 L +^TMP("IBCNEDE"):1 I '$T D  G ENX
"RTN","IBCNEDE",32,0)
 . I '$D(ZTSK) W !!,"The eIV Nightly Task is already running, please retry later." D PAUSE^VALM1
"RTN","IBCNEDE",33,0)
 ; Reset reg ack flag
"RTN","IBCNEDE",34,0)
 S $P(^IBE(350.9,1,51),U,22)=""
"RTN","IBCNEDE",35,0)
 ; If "~NO PAYER" is not a valid Payer File entry, rebuild it from
"RTN","IBCNEDE",36,0)
 ;  the existing utility
"RTN","IBCNEDE",37,0)
 I '$$FIND1^DIC(365.12,,"X","~NO PAYER") D PAYR^IBCNEUT2
"RTN","IBCNEDE",38,0)
 ;
"RTN","IBCNEDE",39,0)
 D CHKPER ; IB*2.0*595/DM Check for New Person (#200) EIV entries 
"RTN","IBCNEDE",40,0)
 ; 
"RTN","IBCNEDE",41,0)
 ; Confirm that all necessary tables have been loaded
"RTN","IBCNEDE",42,0)
 ; before the extract is run
"RTN","IBCNEDE",43,0)
 I '$$TBLCHK() G EN1
"RTN","IBCNEDE",44,0)
 ;
"RTN","IBCNEDE",45,0)
 ;IB*2.0*593/TAZ/HAN - Add job to update Covered by Health Insurance flag
"RTN","IBCNEDE",46,0)
 D EN^IBCNERTC($P($$NOW^XLFDT,"."))
"RTN","IBCNEDE",47,0)
 ;
"RTN","IBCNEDE",48,0)
 D AMCHECK^IBCNEUT6     ; ensure Auto Match entries are valid
"RTN","IBCNEDE",49,0)
 ;
"RTN","IBCNEDE",50,0)
 ; Run All 3 extracts and launch IBCNEDEP(Inquiries)
"RTN","IBCNEDE",51,0)
 D EN^IBCNEDE1 ; Insurance Buffer Extract
"RTN","IBCNEDE",52,0)
 ; Check to see if background process has been stopped, if so quit.
"RTN","IBCNEDE",53,0)
 I $G(ZTSTOP) G ENX
"RTN","IBCNEDE",54,0)
 D EN^IBCNEDE2 ; Pre Reg Extract
"RTN","IBCNEDE",55,0)
 ; Check to see if background process has been stopped, if so quit.
"RTN","IBCNEDE",56,0)
 I $G(ZTSTOP) G ENX
"RTN","IBCNEDE",57,0)
 D EN^IBCNEDE4 ; IB*2.0*621/DM add the EICD extract (formerly No Insurance)
"RTN","IBCNEDE",58,0)
 ; Check to see if background process has been stopped, if so quit.
"RTN","IBCNEDE",59,0)
EN1 I $G(ZTSTOP) G ENX
"RTN","IBCNEDE",60,0)
 ; Send enrollment message
"RTN","IBCNEDE",61,0)
 D ^IBCNEHLM
"RTN","IBCNEDE",62,0)
 I $G(ZTSTOP) G ENX
"RTN","IBCNEDE",63,0)
 I '$G(QFL) D
"RTN","IBCNEDE",64,0)
 . ; Wait for 'AA' acknowledgement
"RTN","IBCNEDE",65,0)
 . D WAIT  Q:'+QFL
"RTN","IBCNEDE",66,0)
 . KILL QFL
"RTN","IBCNEDE",67,0)
 . ;
"RTN","IBCNEDE",68,0)
 . D ^IBCNEDEP  ; Inquiries Processing
"RTN","IBCNEDE",69,0)
 ;
"RTN","IBCNEDE",70,0)
 ; Check to see if background process has been stopped, if so quit.
"RTN","IBCNEDE",71,0)
 I $G(ZTSTOP) G ENX
"RTN","IBCNEDE",72,0)
 D MMQ         ; Queue the Daily MailMan message
"RTN","IBCNEDE",73,0)
 D DSTQ        ; queue daily statistical message to FSC
"RTN","IBCNEDE",74,0)
 ; Send MailMan message if first of month to report on records 
"RTN","IBCNEDE",75,0)
 ;  eligible to be purged
"RTN","IBCNEDE",76,0)
 I +$E($P($$NOW^XLFDT(),"."),6,7)=1 D MMPURGE^IBCNEKI2
"RTN","IBCNEDE",77,0)
 ;
"RTN","IBCNEDE",78,0)
ENX ; Purge task record - if queued
"RTN","IBCNEDE",79,0)
 I $D(ZTQUEUED) S ZTREQ="@"
"RTN","IBCNEDE",80,0)
 L -^TMP("IBCNEDE")
"RTN","IBCNEDE",81,0)
 Q
"RTN","IBCNEDE",82,0)
 ;
"RTN","IBCNEDE",83,0)
TBLCHK() ;
"RTN","IBCNEDE",84,0)
 ; Confirm that at least one eIV payer and that all X12 tables
"RTN","IBCNEDE",85,0)
 ; have been loaded
"RTN","IBCNEDE",86,0)
 N PAY,PAYIEN,PAYOK,TBLOK,II
"RTN","IBCNEDE",87,0)
 S (PAY,PAYIEN,PAYOK)="",TBLOK=1
"RTN","IBCNEDE",88,0)
 F  S PAY=$O(^IBE(365.12,"B",PAY)) Q:PAY=""!PAYOK  I PAY'="~NO PAYER" D
"RTN","IBCNEDE",89,0)
 .  F  S PAYIEN=$O(^IBE(365.12,"B",PAY,PAYIEN)) Q:PAYIEN=""!PAYOK  D
"RTN","IBCNEDE",90,0)
 ..    I $$PYRAPP^IBCNEUT5("IIV",PAYIEN) S PAYOK=1 Q
"RTN","IBCNEDE",91,0)
 I PAYOK D
"RTN","IBCNEDE",92,0)
 . F II=11:1:18,21 I $O(^IBE(II*.001+365,"B",""))="" S TBLOK="" Q
"RTN","IBCNEDE",93,0)
 Q PAYOK&TBLOK
"RTN","IBCNEDE",94,0)
 ;
"RTN","IBCNEDE",95,0)
WAIT ;  Wait for acknowledgement comes back from EC
"RTN","IBCNEDE",96,0)
 ;  Hang for 60 seconds and check status again
"RTN","IBCNEDE",97,0)
 ;  Try 360 times for a total of 21600 seconds (6 hours)
"RTN","IBCNEDE",98,0)
 S QFL=0,CT=0
"RTN","IBCNEDE",99,0)
 F  D  Q:QFL'=""!(CT>360)
"RTN","IBCNEDE",100,0)
 . S QFL=$$GET1^DIQ(350.9,"1,",51.22,"I")
"RTN","IBCNEDE",101,0)
 . Q:QFL'=""
"RTN","IBCNEDE",102,0)
 . HANG 60 S CT=CT+1
"RTN","IBCNEDE",103,0)
 KILL CT
"RTN","IBCNEDE",104,0)
 Q
"RTN","IBCNEDE",105,0)
 ;
"RTN","IBCNEDE",106,0)
FRESHDT(EXT,STALEDYS) ;  Calculate Freshness
"RTN","IBCNEDE",107,0)
 ;  Ext - ien of extract for future purposes
"RTN","IBCNEDE",108,0)
 ;  Staledys - # of days in the past in which an insurance verification
"RTN","IBCNEDE",109,0)
 ;  is considered still valid/current
"RTN","IBCNEDE",110,0)
 N STALEDT
"RTN","IBCNEDE",111,0)
 S STALEDT=$$FMADD^XLFDT(DT,-STALEDYS)
"RTN","IBCNEDE",112,0)
 Q STALEDT
"RTN","IBCNEDE",113,0)
 ;
"RTN","IBCNEDE",114,0)
 ; ---------------------------------------------------
"RTN","IBCNEDE",115,0)
MMQ ; This procedure is responsible for scheduling the creation and 
"RTN","IBCNEDE",116,0)
 ; sending of the daily MailMan statistical message if the site has
"RTN","IBCNEDE",117,0)
 ; defined this appropriately in the eIV site parameters.
"RTN","IBCNEDE",118,0)
 ;
"RTN","IBCNEDE",119,0)
 NEW IIV,CURRTIME,MTIME,MSG,Y,MGRP
"RTN","IBCNEDE",120,0)
 NEW ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTUCI,ZTCPU,ZTPRI,ZTSAVE,ZTKIL,ZTSYNC,ZTSK
"RTN","IBCNEDE",121,0)
 ;
"RTN","IBCNEDE",122,0)
 S IIV=$G(^IBE(350.9,1,51))
"RTN","IBCNEDE",123,0)
 I '$P(IIV,U,2) G MMQX          ; site does not want daily messages
"RTN","IBCNEDE",124,0)
 I '$P(IIV,U,3) G MMQX          ; MM message time is not defined
"RTN","IBCNEDE",125,0)
 I '$P(IIV,U,4) G MMQX          ; Mail Group is not defined
"RTN","IBCNEDE",126,0)
 ;
"RTN","IBCNEDE",127,0)
 S CURRTIME=$P($H,",",2)        ; current $H time
"RTN","IBCNEDE",128,0)
 S MTIME=DT_"."_$P(IIV,U,3)     ; build a FileMan date/time
"RTN","IBCNEDE",129,0)
 S MTIME=$$FMTH^XLFDT(MTIME)    ; convert to $H format
"RTN","IBCNEDE",130,0)
 S MTIME=$P(MTIME,",",2)        ; $H time of MM message
"RTN","IBCNEDE",131,0)
 ;
"RTN","IBCNEDE",132,0)
 ; If the current time is after the MailMan message time, then 
"RTN","IBCNEDE",133,0)
 ; schedule the MM message for tomorrow at that time.
"RTN","IBCNEDE",134,0)
 I CURRTIME>MTIME S ZTDTH=($H+1)_","_MTIME
"RTN","IBCNEDE",135,0)
 ;
"RTN","IBCNEDE",136,0)
 ; Otherwise, schedule it for later today
"RTN","IBCNEDE",137,0)
 E  S ZTDTH=+$H_","_MTIME
"RTN","IBCNEDE",138,0)
 ;
"RTN","IBCNEDE",139,0)
 ; Set up the other TaskManager variables
"RTN","IBCNEDE",140,0)
 S ZTRTN="MAILMSG^IBCNERP7"
"RTN","IBCNEDE",141,0)
 S ZTDESC="eIV Daily Statistics E-Mail"
"RTN","IBCNEDE",142,0)
 S ZTIO=""
"RTN","IBCNEDE",143,0)
 D ^%ZTLOAD            ; Call TaskManager
"RTN","IBCNEDE",144,0)
 I $G(ZTSK) G MMQX     ; Task# is OK so get out
"RTN","IBCNEDE",145,0)
 ;
"RTN","IBCNEDE",146,0)
 ; Send a MailMan message if this Task could not get scheduled
"RTN","IBCNEDE",147,0)
 S MSG(1)="TaskManager could not schedule the daily eIV MailMan message"
"RTN","IBCNEDE",148,0)
 S MSG(2)="at the specified time of "_$E($P(IIV,U,3),1,2)_":"_$E($P(IIV,U,3),3,4)_"."
"RTN","IBCNEDE",149,0)
 S MSG(3)="This is defined in the eIV Site Parameters option."
"RTN","IBCNEDE",150,0)
 ; Set to IB site parameter MAILGROUP
"RTN","IBCNEDE",151,0)
 S MGRP=$$MGRP^IBCNEUT5()
"RTN","IBCNEDE",152,0)
 D MSG^IBCNEUT5(MGRP,"eIV Statistical Message Not Sent","MSG(")
"RTN","IBCNEDE",153,0)
 ;
"RTN","IBCNEDE",154,0)
MMQX ;
"RTN","IBCNEDE",155,0)
 Q
"RTN","IBCNEDE",156,0)
 ;
"RTN","IBCNEDE",157,0)
ER ; Unlock the eIV Nightly Task and return to log error
"RTN","IBCNEDE",158,0)
 L -^TMP("IBCNEDE")
"RTN","IBCNEDE",159,0)
 D ^%ZTER
"RTN","IBCNEDE",160,0)
 D UNWIND^%ZTER
"RTN","IBCNEDE",161,0)
 Q
"RTN","IBCNEDE",162,0)
 ;
"RTN","IBCNEDE",163,0)
DSTQ ; This procedure is responsible for scheduling the creation and 
"RTN","IBCNEDE",164,0)
 ; sending of the daily statistical message to FSC.
"RTN","IBCNEDE",165,0)
 ;
"RTN","IBCNEDE",166,0)
 N IIV,CURRTIME,MTIME,MSG,MGRP
"RTN","IBCNEDE",167,0)
 N ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTUCI,ZTCPU,ZTPRI,ZTSAVE,ZTKIL,ZTSYNC,ZTSK
"RTN","IBCNEDE",168,0)
 ;
"RTN","IBCNEDE",169,0)
 S IIV=$G(^IBE(350.9,1,51))
"RTN","IBCNEDE",170,0)
 I '$P(IIV,U,3) G DSTQX          ; MM message time is not defined
"RTN","IBCNEDE",171,0)
 ;
"RTN","IBCNEDE",172,0)
 S CURRTIME=$P($H,",",2)        ; current $H time
"RTN","IBCNEDE",173,0)
 S MTIME=DT_"."_$P(IIV,U,3)     ; build a FileMan date/time
"RTN","IBCNEDE",174,0)
 S MTIME=$$FMTH^XLFDT(MTIME)    ; convert to $H format
"RTN","IBCNEDE",175,0)
 S MTIME=$P(MTIME,",",2)        ; $H time of MM message
"RTN","IBCNEDE",176,0)
 ;
"RTN","IBCNEDE",177,0)
 ; If the current time is after the MailMan message time, then schedule the message for tomorrow at that time.
"RTN","IBCNEDE",178,0)
 ; Otherwise, schedule it for later today.
"RTN","IBCNEDE",179,0)
 S ZTDTH=$S(CURRTIME>MTIME:$H+1,1:+$H)_","_MTIME
"RTN","IBCNEDE",180,0)
 ;
"RTN","IBCNEDE",181,0)
 ; Set up the other TaskManager variables
"RTN","IBCNEDE",182,0)
 S ZTRTN="EN1^IBCNEHLM"
"RTN","IBCNEDE",183,0)
 S ZTDESC="eIV Daily Statistics HL7 Message"
"RTN","IBCNEDE",184,0)
 S ZTIO=""
"RTN","IBCNEDE",185,0)
 D ^%ZTLOAD            ; Call TaskManager
"RTN","IBCNEDE",186,0)
 I $G(ZTSK) G DSTQX    ; Task# is OK so get out
"RTN","IBCNEDE",187,0)
 ;
"RTN","IBCNEDE",188,0)
 ; Send a MailMan message if this Task could not get scheduled
"RTN","IBCNEDE",189,0)
 S MSG(1)="TaskManager could not schedule the daily eIV Statistics HL7 message"
"RTN","IBCNEDE",190,0)
 S MSG(2)="at the specified time of "_$E($P(IIV,U,3),1,2)_":"_$E($P(IIV,U,3),3,4)_"."
"RTN","IBCNEDE",191,0)
 S MSG(3)="This is defined in the eIV Site Parameters option."
"RTN","IBCNEDE",192,0)
 ; Set to IB site parameter MAILGROUP
"RTN","IBCNEDE",193,0)
 S MGRP=$$MGRP^IBCNEUT5() I MGRP'="" D MSG^IBCNEUT5(MGRP,"eIV Statistical HL7 Message Not Sent","MSG(")
"RTN","IBCNEDE",194,0)
 ;
"RTN","IBCNEDE",195,0)
DSTQX ;
"RTN","IBCNEDE",196,0)
 Q
"RTN","IBCNEDE",197,0)
 ;
"RTN","IBCNEDE",198,0)
CHKPER ; IB*2.0*595/DM
"RTN","IBCNEDE",199,0)
 ; check for the existence of New Person: "INTERFACE,IB EIV" and/or "AUTOUPDATE,IBEIV"
"RTN","IBCNEDE",200,0)
 ; send a mailman message to "PII                   " if either/both are missing.
"RTN","IBCNEDE",201,0)
 ;
"RTN","IBCNEDE",202,0)
 N IBA,IBI,WKDT,IBMCT,MSG,MGRP,IBXMY
"RTN","IBCNEDE",203,0)
 ;
"RTN","IBCNEDE",204,0)
 S IBA=+$$FIND1^DIC(200,,"MX","AUTOUPDATE,IBEIV"),IBI=+$$FIND1^DIC(200,,"MX","INTERFACE,IB EIV")
"RTN","IBCNEDE",205,0)
 I IBA,IBI Q
"RTN","IBCNEDE",206,0)
 ;
"RTN","IBCNEDE",207,0)
 S WKDT=$$SITE^VASITE()
"RTN","IBCNEDE",208,0)
 S MSG(1)="Missing EIV New Person entries, for station "_$P(WKDT,U,3)_":"_$P(WKDT,U,2)
"RTN","IBCNEDE",209,0)
 S MSG(2)="-------------------------------------------------------------------------------"
"RTN","IBCNEDE",210,0)
 S IBMCT=2
"RTN","IBCNEDE",211,0)
 I 'IBA S MSG(IBMCT)="Entry for 'AUTOUPDATE,IBEIV' is missing",IBMCT=IBMCT+1
"RTN","IBCNEDE",212,0)
 I 'IBI S MSG(IBMCT)="Entry for 'INTERFACE,IB EIV' is missing",IBMCT=IBMCT+1
"RTN","IBCNEDE",213,0)
 S MSG(IBMCT)="-------------------------------------------------------------------------------"
"RTN","IBCNEDE",214,0)
 S MGRP=$$MGRP^IBCNEUT5()
"RTN","IBCNEDE",215,0)
 S IBXMY("PII                   ")=""
"RTN","IBCNEDE",216,0)
 D MSG^IBCNEUT5(MGRP,"Missing EIV New Person entries ("_$P(WKDT,U,3)_")","MSG(",,.IBXMY)
"RTN","IBCNEDE",217,0)
 Q
"RTN","IBCNEDE4")
0^2^B60089694^B81971988
"RTN","IBCNEDE4",1,0)
IBCNEDE4 ;AITC/DM - EICD (Electronic Insurance Coverage Discovery) extract;24-JUN-2002
"RTN","IBCNEDE4",2,0)
 ;;2.0;INTEGRATED BILLING;**184,271,416,621**;21-MAR-94;Build 8
"RTN","IBCNEDE4",3,0)
 ;;Per VA Directive 6402, this routine should not be modified.
"RTN","IBCNEDE4",4,0)
 ;
"RTN","IBCNEDE4",5,0)
 ; **Program Description**
"RTN","IBCNEDE4",6,0)
 ; The Electronic Insurance Coverage Discovery a.k.a EICD extract (#4)
"RTN","IBCNEDE4",7,0)
 ; is called from the nightly job - IBCNEDE.
"RTN","IBCNEDE4",8,0)
 ;
"RTN","IBCNEDE4",9,0)
 ; Formerly known as "No Insurance", we are reworking the entire logic for 
"RTN","IBCNEDE4",10,0)
 ; determining insurance for those who don't have active policies with patch IB*2.0*621.
"RTN","IBCNEDE4",11,0)
 ;
"RTN","IBCNEDE4",12,0)
 Q
"RTN","IBCNEDE4",13,0)
 ;
"RTN","IBCNEDE4",14,0)
EN ; EICD extract entry 
"RTN","IBCNEDE4",15,0)
 N CLNC,DATA1,DATA2,DATA5,DFN,EACTIVE,ELG,FRESHDT,IBACTV,IBAPPTDT
"RTN","IBCNEDE4",16,0)
 N IBBEGDT,IBCSIEN,IBDFNDONE,IBEFF,IBEICDPAY,IBENDDT,IBERR,IBEXP,IBFDA
"RTN","IBCNEDE4",17,0)
 N IBFREQ,IBIDX,IBINSNM,IBMSG,IBSDA,IBTASKTOT,IBTOPIEN,IBTQCNT,IBTQIEN
"RTN","IBCNEDE4",18,0)
 N IBTQSTAT,IBWK1,IBWK2,IBWKIEN,MAXCNT,OK
"RTN","IBCNEDE4",19,0)
 ;
"RTN","IBCNEDE4",20,0)
 ;  Get Extract parameters
"RTN","IBCNEDE4",21,0)
 S EACTIVE=$$SETTINGS^IBCNEDE7(4)
"RTN","IBCNEDE4",22,0)
 I 'EACTIVE G ENQQ ; not active, or required fields missing
"RTN","IBCNEDE4",23,0)
 S MAXCNT=$P(EACTIVE,U,4) ; throttle daily extract queries
"RTN","IBCNEDE4",24,0)
 S:MAXCNT="" MAXCNT=9999999999
"RTN","IBCNEDE4",25,0)
 S IBWK1=$P(EACTIVE,U,6) ; start days
"RTN","IBCNEDE4",26,0)
 S IBBEGDT=$$FMADD^XLFDT(DT,IBWK1) ; begin date = today + start days
"RTN","IBCNEDE4",27,0)
 S IBENDDT=$$FMADD^XLFDT(DT,IBWK1+$P(EACTIVE,U,7)) ; end date = today + start days + days after start
"RTN","IBCNEDE4",28,0)
 S IBFREQ=$P(EACTIVE,U,8) ; frequency
"RTN","IBCNEDE4",29,0)
 S FRESHDT=$$FMADD^XLFDT(DT,-IBFREQ)
"RTN","IBCNEDE4",30,0)
 S IBCSIEN=$$FIND1^DIC(355.12,,"X","CONTRACT SERVICES","C")
"RTN","IBCNEDE4",31,0)
 S IBTQSTAT=$$FIND1^DIC(365.14,,"X","Ready to Transmit","B")
"RTN","IBCNEDE4",32,0)
 ;
"RTN","IBCNEDE4",33,0)
 ; see if the EICD PAYER site parameter has been populated
"RTN","IBCNEDE4",34,0)
 ; and is nationally and locally active, if not, quietly quit 
"RTN","IBCNEDE4",35,0)
 S IBEICDPAY=+$$GET1^DIQ(350.9,"1,",51.31,"I") ; "EICD PAYER"
"RTN","IBCNEDE4",36,0)
 I 'IBEICDPAY G ENQQ
"RTN","IBCNEDE4",37,0)
 I '($$GET1^DIQ(365.121,"1,"_IBEICDPAY_",",.02,"I")) G ENQQ ; "NATIONAL ACTIVE"
"RTN","IBCNEDE4",38,0)
 I '($$GET1^DIQ(365.121,"1,"_IBEICDPAY_",",.03,"I")) G ENQQ ; "LOCAL ACTIVE"
"RTN","IBCNEDE4",39,0)
 ;
"RTN","IBCNEDE4",40,0)
 ; gather the non-active insurance company names
"RTN","IBCNEDE4",41,0)
 ; we will strip all blanks from the names, so dashes ('-') are treated properly for a compare 
"RTN","IBCNEDE4",42,0)
 F IBIDX=2:1 S IBWK1=$P($T(NAINSCO+IBIDX),";;",2) Q:IBWK1=""  S IBINSNM($TR(IBWK1," ",""))=""
"RTN","IBCNEDE4",43,0)
 ;
"RTN","IBCNEDE4",44,0)
 ; gather the non-active type of plan iens
"RTN","IBCNEDE4",45,0)
 F IBIDX=2:1 S IBWK1=$P($T(NATPLANS+IBIDX),";;",2) Q:IBWK1=""  D
"RTN","IBCNEDE4",46,0)
 . S IBWK2=+$$FIND1^DIC(355.1,,"BQX",IBWK1)
"RTN","IBCNEDE4",47,0)
 . Q:'IBWK2
"RTN","IBCNEDE4",48,0)
 . S IBTOPIEN(IBWK2)=""
"RTN","IBCNEDE4",49,0)
 ;
"RTN","IBCNEDE4",50,0)
 S IBTASKTOT=0 ; Taskman check
"RTN","IBCNEDE4",51,0)
 S IBTQCNT=0 ; TQ entry count 
"RTN","IBCNEDE4",52,0)
 K ^TMP($J,"SDAMA301"),^TMP($J,"IBCNEDE4"),IBDFNDONE
"RTN","IBCNEDE4",53,0)
 ;
"RTN","IBCNEDE4",54,0)
 ; Loop through clinics 
"RTN","IBCNEDE4",55,0)
 S CLNC=0 F  S CLNC=$O(^SC(CLNC)) Q:'CLNC  D
"RTN","IBCNEDE4",56,0)
 . D CLINICEX^IBCNEDE2 Q:'OK  ; clinic excluded
"RTN","IBCNEDE4",57,0)
 . S ^TMP($J,"IBCNEDE4",CLNC)=""
"RTN","IBCNEDE4",58,0)
 ;
"RTN","IBCNEDE4",59,0)
 ; Set up variables for scheduling api and call
"RTN","IBCNEDE4",60,0)
 S IBSDA("FLDS")=8
"RTN","IBCNEDE4",61,0)
 S IBSDA(1)=IBBEGDT_";"_IBENDDT
"RTN","IBCNEDE4",62,0)
 S IBSDA(2)="^TMP($J,""IBCNEDE4"","
"RTN","IBCNEDE4",63,0)
 S IBSDA(3)="R"
"RTN","IBCNEDE4",64,0)
 S OK=$$SDAPI^SDAMA301(.IBSDA) I OK<1 D:OK<0 ERRMSG G ENQQ
"RTN","IBCNEDE4",65,0)
 ;
"RTN","IBCNEDE4",66,0)
 ; loop through returned clinics
"RTN","IBCNEDE4",67,0)
 S CLNC=0
"RTN","IBCNEDE4",68,0)
 F  S CLNC=$O(^TMP($J,"SDAMA301",CLNC)) Q:'CLNC  D  G ENQQ:$G(ZTSTOP)!(IBTQCNT'<MAXCNT)
"RTN","IBCNEDE4",69,0)
 . ;
"RTN","IBCNEDE4",70,0)
 . ; Loop through patients returned
"RTN","IBCNEDE4",71,0)
 . S DFN=0
"RTN","IBCNEDE4",72,0)
 . F  S DFN=$O(^TMP($J,"SDAMA301",CLNC,DFN)) Q:'DFN  D  Q:$G(ZTSTOP)!(IBTQCNT'<MAXCNT)
"RTN","IBCNEDE4",73,0)
 .. ;
"RTN","IBCNEDE4",74,0)
 .. ; CHECK DFN STUFF
"RTN","IBCNEDE4",75,0)
 .. Q:$D(IBDFNDONE(DFN))  ; DFN has been handled
"RTN","IBCNEDE4",76,0)
 .. ;
"RTN","IBCNEDE4",77,0)
 .. S OK=1
"RTN","IBCNEDE4",78,0)
 .. S IBWK1=+$$GET1^DIQ(2,DFN_",",.6,"I") ; "TEST PATIENT INDICATOR"
"RTN","IBCNEDE4",79,0)
 .. S:IBWK1 OK=0
"RTN","IBCNEDE4",80,0)
 .. ;
"RTN","IBCNEDE4",81,0)
 .. S IBWK1=+$$GET1^DIQ(2,DFN_",",2001,"I") ; "DATE LAST EICD RUN" from PATIENT INS node
"RTN","IBCNEDE4",82,0)
 .. I IBWK1,(IBWK1>FRESHDT) S OK=0
"RTN","IBCNEDE4",83,0)
 .. ; 
"RTN","IBCNEDE4",84,0)
 .. S IBWK1=+$$GET1^DIQ(2,DFN_",",.351,"I") ; "DATE OF DEATH" 
"RTN","IBCNEDE4",85,0)
 .. S:IBWK1 OK=0
"RTN","IBCNEDE4",86,0)
 .. ;
"RTN","IBCNEDE4",87,0)
 .. ; any value for CITY is valid, HL7 will replace a "" with "UNKNOWN" 
"RTN","IBCNEDE4",88,0)
 .. S IBWK1=$$GET1^DIQ(2,DFN_",",.115) ; "STATE"
"RTN","IBCNEDE4",89,0)
 .. S:IBWK1="" OK=0
"RTN","IBCNEDE4",90,0)
 .. S IBWK1=$$GET1^DIQ(2,DFN_",",.116) ; "ZIP CODE"
"RTN","IBCNEDE4",91,0)
 .. S:IBWK1="" OK=0
"RTN","IBCNEDE4",92,0)
 .. ;
"RTN","IBCNEDE4",93,0)
 .. I 'OK S IBDFNDONE(DFN)="" Q  ; patient requirements not met 
"RTN","IBCNEDE4",94,0)
 .. ;   
"RTN","IBCNEDE4",95,0)
 .. ; Loop through dates in range at clinic
"RTN","IBCNEDE4",96,0)
 .. S IBAPPTDT=IBBEGDT
"RTN","IBCNEDE4",97,0)
 .. F  S IBAPPTDT=$O(^TMP($J,"SDAMA301",CLNC,DFN,IBAPPTDT)) Q:('IBAPPTDT)!((IBAPPTDT\1)>IBENDDT)  D  Q:$G(ZTSTOP)!(IBTQCNT'<MAXCNT)
"RTN","IBCNEDE4",98,0)
 ... ;
"RTN","IBCNEDE4",99,0)
 ... ; Update count for periodic check
"RTN","IBCNEDE4",100,0)
 ... S IBTASKTOT=IBTASKTOT+1
"RTN","IBCNEDE4",101,0)
 ... ; Check for request to stop background job, periodically
"RTN","IBCNEDE4",102,0)
 ... I $D(ZTQUEUED),IBTASKTOT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 Q
"RTN","IBCNEDE4",103,0)
 ... ;
"RTN","IBCNEDE4",104,0)
 ... Q:$D(IBDFNDONE(DFN))  ; we've already seen this DFN
"RTN","IBCNEDE4",105,0)
 ... ;
"RTN","IBCNEDE4",106,0)
 ... S IBWK1=$G(^TMP($J,"SDAMA301",CLNC,DFN,IBAPPTDT))
"RTN","IBCNEDE4",107,0)
 ... S ELG=$P(IBWK1,U,8)
"RTN","IBCNEDE4",108,0)
 ... S:ELG="" ELG=$$GET1^DIQ(2,DFN_",",.361) ; "PRIMARY ELIGIBILITY CODE" 
"RTN","IBCNEDE4",109,0)
 ... D ELG^IBCNEDE2 Q:'OK  ; eligibility exclusion
"RTN","IBCNEDE4",110,0)
 ... ;
"RTN","IBCNEDE4",111,0)
 ... ; skip any patient with "active" insurance 
"RTN","IBCNEDE4",112,0)
 ... S IBACTV=0
"RTN","IBCNEDE4",113,0)
 ... S IBIDX=0 ; check policies for "active" insurance 
"RTN","IBCNEDE4",114,0)
 ... F  S IBIDX=$O(^DPT(DFN,.312,IBIDX)) Q:('IBIDX)!IBACTV  D
"RTN","IBCNEDE4",115,0)
 .... S IBWKIEN=IBIDX_","_DFN_","
"RTN","IBCNEDE4",116,0)
 .... S IBEFF=+$$GET1^DIQ(2.312,IBWKIEN,8,"I") ; effective date 
"RTN","IBCNEDE4",117,0)
 .... S IBEXP=+$$GET1^DIQ(2.312,IBWKIEN,3,"I") ; expiration date
"RTN","IBCNEDE4",118,0)
 .... I 'IBEFF Q  ; non-active
"RTN","IBCNEDE4",119,0)
 .... I IBEXP,(IBEXP<(IBAPPTDT\1)) Q  ; non-active
"RTN","IBCNEDE4",120,0)
 .... ; 
"RTN","IBCNEDE4",121,0)
 .... S IBWK1=$$GET1^DIQ(2.312,IBWKIEN,.01,"E") ; insurance company name 
"RTN","IBCNEDE4",122,0)
 .... Q:$D(IBINSNM($TR(IBWK1," ","")))  ; matches non-active insurance
"RTN","IBCNEDE4",123,0)
 .... S IBWK1=$$GET1^DIQ(2.312,IBWKIEN,.18,"I")   ; group plan ien 
"RTN","IBCNEDE4",124,0)
 .... S IBWK2=$$GET1^DIQ(355.3,IBWK1_",",.09,"I") ; type of plan ien
"RTN","IBCNEDE4",125,0)
 .... ; no type of plan is considered active 
"RTN","IBCNEDE4",126,0)
 .... I IBWK2'="",$D(IBTOPIEN(IBWK2)) Q  ; matches non-active type of plan
"RTN","IBCNEDE4",127,0)
 .... ; 
"RTN","IBCNEDE4",128,0)
 .... ; 'IBEXP is considered active at this point 
"RTN","IBCNEDE4",129,0)
 .... S IBACTV=1 Q  ; active 
"RTN","IBCNEDE4",130,0)
 ... ;
"RTN","IBCNEDE4",131,0)
 ... I IBACTV Q  ; next clinic appt 
"RTN","IBCNEDE4",132,0)
 ... ; 
"RTN","IBCNEDE4",133,0)
 ... ; This DFN is considered non-active, we'll attempt a TQ entry
"RTN","IBCNEDE4",134,0)
 ... S IBDFNDONE(DFN)=""  ; ok to flag DFN as handled now 
"RTN","IBCNEDE4",135,0)
 ... ; there should be no TQ entry for this DFN, consider it a safety check 
"RTN","IBCNEDE4",136,0)
 ... I '$$ADDTQ^IBCNEUT5(DFN,IBEICDPAY,DT,IBFREQ,1) Q
"RTN","IBCNEDE4",137,0)
 ... ; SET prepare and file the TQ
"RTN","IBCNEDE4",138,0)
 ... ; DFN:Patient IEN
"RTN","IBCNEDE4",139,0)
 ... ; IBEICDPAY:EICD payer IEN
"RTN","IBCNEDE4",140,0)
 ... ; IBTQSTAT:TQ STATUS IEN - Ready to Transmit 
"RTN","IBCNEDE4",141,0)
 ... ; FRESHDT:Freshness date 
"RTN","IBCNEDE4",142,0)
 ... ; 4:EICD data extract (#4)
"RTN","IBCNEDE4",143,0)
 ... ; I:Identification 
"RTN","IBCNEDE4",144,0)
 ... ; DT:Todays date 
"RTN","IBCNEDE4",145,0)
 ... ; IBCSIEN:Source of Information IEN - Contract Services    
"RTN","IBCNEDE4",146,0)
 ... S DATA1=DFN_U_IBEICDPAY_U_IBTQSTAT_U_""_U_""_U_FRESHDT
"RTN","IBCNEDE4",147,0)
 ... S DATA2=4_U_"I"_U_DT
"RTN","IBCNEDE4",148,0)
 ... S DATA5=IBCSIEN
"RTN","IBCNEDE4",149,0)
 ... S IBTQIEN=$$SETTQ^IBCNEDE7(DATA1,DATA2,,,DATA5) ; Sets in TQ
"RTN","IBCNEDE4",150,0)
 ... I IBTQIEN="" K IBDFNDONE(DFN) Q   ; didn't file, unmark DFN 
"RTN","IBCNEDE4",151,0)
 ... S IBTQCNT=IBTQCNT+1               ; increment the TQ count
"RTN","IBCNEDE4",152,0)
 ... ; place a stub into EIV EICD TRACKING (#365.18)
"RTN","IBCNEDE4",153,0)
 ... K IBFDA,IBERR
"RTN","IBCNEDE4",154,0)
 ... ; EIV EICD TRACKING, .01:TRANSMISSION .02:DATE CREATED .03:PAYER .05:PATIENT
"RTN","IBCNEDE4",155,0)
 ... S IBFDA(365.18,"+1,",.01)=IBTQIEN,IBFDA(365.18,"+1,",.02)=DT
"RTN","IBCNEDE4",156,0)
 ... S IBFDA(365.18,"+1,",.03)=IBEICDPAY,IBFDA(365.18,"+1,",.05)=DFN
"RTN","IBCNEDE4",157,0)
 ... D UPDATE^DIE(,"IBFDA",,"IBERR")
"RTN","IBCNEDE4",158,0)
 ... I $G(IBERR("DIERR",1,"TEXT",1))'="" D  Q
"RTN","IBCNEDE4",159,0)
 .... S IBMSG=""
"RTN","IBCNEDE4",160,0)
 .... D MSG002^IBCNEMS1(.IBMSG,.IBERR,IBTQIEN)
"RTN","IBCNEDE4",161,0)
 .... D MSG^IBCNEUT5($$MGRP^IBCNEUT5(),"eIV Problem: Error writing EIV EICD TRACKING (#365.18)","IBMSG(")
"RTN","IBCNEDE4",162,0)
 ... Q  ; next clinic appt
"RTN","IBCNEDE4",163,0)
 ... ; 
"RTN","IBCNEDE4",164,0)
ENQQ ; clean and quit 
"RTN","IBCNEDE4",165,0)
 K ^TMP($J,"SDAMA301"),^TMP($J,"IBCNEDE2")
"RTN","IBCNEDE4",166,0)
 Q
"RTN","IBCNEDE4",167,0)
 ;
"RTN","IBCNEDE4",168,0)
ERRMSG ; Send a message indicating an extract error has occurred
"RTN","IBCNEDE4",169,0)
 S IBMSG=""
"RTN","IBCNEDE4",170,0)
 D MSG001^IBCNEMS1(.IBMSG,"EICD")
"RTN","IBCNEDE4",171,0)
 D MSG^IBCNEUT5($$MGRP^IBCNEUT5(),"eIV Problem: EICD Extract","IBMSG(")
"RTN","IBCNEDE4",172,0)
 ;
"RTN","IBCNEDE4",173,0)
 Q
"RTN","IBCNEDE4",174,0)
 ;
"RTN","IBCNEDE4",175,0)
NAINSCO ; Non-active Insurance companies
"RTN","IBCNEDE4",176,0)
 ;
"RTN","IBCNEDE4",177,0)
 ;;MEDICARE (WNR)
"RTN","IBCNEDE4",178,0)
 ;;VACAA-WNR  
"RTN","IBCNEDE4",179,0)
 ;;CAMP LEJEUNE - WNR
"RTN","IBCNEDE4",180,0)
 ;;IVF - WNR
"RTN","IBCNEDE4",181,0)
 ;;VHA DIRECTIVE 1029 WNR
"RTN","IBCNEDE4",182,0)
 ;
"RTN","IBCNEDE4",183,0)
NATPLANS ; Non-active Type of Plans
"RTN","IBCNEDE4",184,0)
 ;
"RTN","IBCNEDE4",185,0)
 ;;ACCIDENT AND HEALTH INSURANCE
"RTN","IBCNEDE4",186,0)
 ;;AUTOMOBILE
"RTN","IBCNEDE4",187,0)
 ;;AVIATION TRIP INSURANCE
"RTN","IBCNEDE4",188,0)
 ;;CATASTROPHIC INSURANCE
"RTN","IBCNEDE4",189,0)
 ;;CHAMPVA
"RTN","IBCNEDE4",190,0)
 ;;COINSURANCE
"RTN","IBCNEDE4",191,0)
 ;;DENTAL INSURANCE
"RTN","IBCNEDE4",192,0)
 ;;DUAL COVERAGE
"RTN","IBCNEDE4",193,0)
 ;;INCOME PROTECTION (INDEMNITY)
"RTN","IBCNEDE4",194,0)
 ;;KEY-MAN HEALTH INSURANCE
"RTN","IBCNEDE4",195,0)
 ;;LABS, PROCEDURES, X-RAY, ETC. (ONLY)
"RTN","IBCNEDE4",196,0)
 ;;MEDI-CAL
"RTN","IBCNEDE4",197,0)
 ;;MEDICAID
"RTN","IBCNEDE4",198,0)
 ;;MEDICARE (M)
"RTN","IBCNEDE4",199,0)
 ;;MEDICARE/MEDICAID (MEDI-CAL)
"RTN","IBCNEDE4",200,0)
 ;;MENTAL HEALTH
"RTN","IBCNEDE4",201,0)
 ;;NO-FAULT INSURANCE
"RTN","IBCNEDE4",202,0)
 ;;PRESCRIPTION
"RTN","IBCNEDE4",203,0)
 ;;QUALIFIED IMPAIRMENT INSURANCE
"RTN","IBCNEDE4",204,0)
 ;;SPECIAL CLASS INSURANCE
"RTN","IBCNEDE4",205,0)
 ;;SPECIAL RISK INSURANCE
"RTN","IBCNEDE4",206,0)
 ;;SPECIFIED DISEASE INSURANCE
"RTN","IBCNEDE4",207,0)
 ;;Substance abuse only
"RTN","IBCNEDE4",208,0)
 ;;TORT FEASOR
"RTN","IBCNEDE4",209,0)
 ;;TRICARE
"RTN","IBCNEDE4",210,0)
 ;;TRICARE SUPPLEMENTAL
"RTN","IBCNEDE4",211,0)
 ;;VA SPECIAL CLASS
"RTN","IBCNEDE4",212,0)
 ;;VISION
"RTN","IBCNEDE4",213,0)
 ;;WORKERS' COMPENSATION INSURANCE
"RTN","IBCNEDE4",214,0)
 ;
"RTN","IBCNEDE4",215,0)
 Q
"RTN","IBCNEDE4",216,0)
 ;
"RTN","IBCNEDE5")
0^3^B14392775^B29541392
"RTN","IBCNEDE5",1,0)
IBCNEDE5 ;DAOU/DAC - eIV DATA EXTRACTS ;15-OCT-2002
"RTN","IBCNEDE5",2,0)
 ;;2.0;INTEGRATED BILLING;**184,271,416,497,549,621**;21-MAR-94;Build 8
"RTN","IBCNEDE5",3,0)
 ;;Per VA Directive 6402, this routine should not be modified.
"RTN","IBCNEDE5",4,0)
 ;
"RTN","IBCNEDE5",5,0)
 Q    ; no direct calls allowed
"RTN","IBCNEDE5",6,0)
 ; IB*2.0*621 - Removed tag "SIDCHK2"
"RTN","IBCNEDE5",7,0)
 ;
"RTN","IBCNEDE5",8,0)
SIDCHK(PIEN,DFN,BSID,SIDARRAY,FRESHDT) ; Checks the flag setting of
"RTN","IBCNEDE5",9,0)
 ; 'Identification Requires Subscriber ID'. The function returns a "^"
"RTN","IBCNEDE5",10,0)
 ; delimited string.  The first value is between 1 and 5 telling the
"RTN","IBCNEDE5",11,0)
 ; calling program what action(s) it should perform. The 2nd piece
"RTN","IBCNEDE5",12,0)
 ; indicates the Subcriber ID that the calling program should use for
"RTN","IBCNEDE5",13,0)
 ; setting the Subscriber IDs in the eIV Transmission Queue file (365.1).
"RTN","IBCNEDE5",14,0)
 ; The calling program is to address the blank Sub IDs.
"RTN","IBCNEDE5",15,0)
 ;
"RTN","IBCNEDE5",16,0)
 ; PIEN - Payer's IEN (file 365.12)
"RTN","IBCNEDE5",17,0)
 ; DFN - Patient's IEN (file 2)
"RTN","IBCNEDE5",18,0)
 ; INREC - Insurance IEN of Patients record (subfile 2.312)
"RTN","IBCNEDE5",19,0)
 ; BSID - Subscriber ID from buffer file (file 355.33 field 60.04)
"RTN","IBCNEDE5",20,0)
 ; SIDARRAY - Array of active subscribers
"RTN","IBCNEDE5",21,0)
 ; FRESHDT - Freshness Date - used for checking verified date
"RTN","IBCNEDE5",22,0)
 ;
"RTN","IBCNEDE5",23,0)
 ; Logic to follow:
"RTN","IBCNEDE5",24,0)
 ;
"RTN","IBCNEDE5",25,0)
 ; Id. Req.| Sub ID|Action|
"RTN","IBCNEDE5",26,0)
 ;  Sub ID | found |  #   | Create
"RTN","IBCNEDE5",27,0)
 ; ________|_______|______|________
"RTN","IBCNEDE5",28,0)
 ; YES        YES     1     1 Verification TQ entry w/ Sub ID
"RTN","IBCNEDE5",29,0)
 ; YES        NO      3     new buffer entry or modify existing saying manual verification required
"RTN","IBCNEDE5",30,0)
 ; NO         NO      4     1 Ver. TQ entry w/ blank Sub ID
"RTN","IBCNEDE5",31,0)
 ;
"RTN","IBCNEDE5",32,0)
 ; * Note: The insurance record found with the proper PIEN will only be
"RTN","IBCNEDE5",33,0)
 ;         picked up if the insurance policy is active, and if the insurance
"RTN","IBCNEDE5",34,0)
 ;         policy hasn't been verified within the Freshness period.
"RTN","IBCNEDE5",35,0)
 ;
"RTN","IBCNEDE5",36,0)
 N SIDACT,SID,APPIEN,SIDSTR,SIDREQ
"RTN","IBCNEDE5",37,0)
 N INSSTR,INSSTR1,INSSTR7,SYMBOL,EXP,SUBID,SUBIDS,SIDCNT,INREC,MVER,VFLG,MCRTQ
"RTN","IBCNEDE5",38,0)
 ;
"RTN","IBCNEDE5",39,0)
 S FRESHDT=$G(FRESHDT),VFLG=0
"RTN","IBCNEDE5",40,0)
 ;
"RTN","IBCNEDE5",41,0)
 ; if the subscriber ID from the buffer extract exists, this is the only entry
"RTN","IBCNEDE5",42,0)
 I $G(BSID)'="" D  G SIDCHKX
"RTN","IBCNEDE5",43,0)
 . S SID=BSID,(SIDACT,SIDCNT)=1
"RTN","IBCNEDE5",44,0)
 . S SIDARRAY($$STRIP(SID,,DFN)_"_")=""
"RTN","IBCNEDE5",45,0)
 . Q
"RTN","IBCNEDE5",46,0)
 ;
"RTN","IBCNEDE5",47,0)
 S APPIEN=$$PYRAPP^IBCNEUT5("IIV",PIEN)
"RTN","IBCNEDE5",48,0)
 S SIDSTR=$G(^IBE(365.12,PIEN,1,APPIEN,0))
"RTN","IBCNEDE5",49,0)
 S SIDREQ=$P(SIDSTR,U,8)
"RTN","IBCNEDE5",50,0)
 ;
"RTN","IBCNEDE5",51,0)
 S INSSTR="",SIDCNT=0,INREC=$O(^DPT(DFN,.312,0)),MCRTQ=0 S:'INREC INREC=1
"RTN","IBCNEDE5",52,0)
 ;
"RTN","IBCNEDE5",53,0)
 I $D(BSID),BSID="" G SIDC1
"RTN","IBCNEDE5",54,0)
 ;
"RTN","IBCNEDE5",55,0)
 I $G(^DPT(DFN,.312,INREC,0)) F  D  Q:'INREC
"RTN","IBCNEDE5",56,0)
 . S INSSTR=$G(^DPT(DFN,.312,INREC,0))
"RTN","IBCNEDE5",57,0)
 . S INSSTR1=$G(^DPT(DFN,.312,INREC,1))
"RTN","IBCNEDE5",58,0)
 . S INSSTR7=$G(^DPT(DFN,.312,INREC,7))    ; IB*2.0*497 (vd)
"RTN","IBCNEDE5",59,0)
 . S SYMBOL=$$INSERROR^IBCNEUT3("I",+INSSTR)
"RTN","IBCNEDE5",60,0)
 . I $P(SYMBOL,U)="" D            ; no eIV related error w/ ins. company
"RTN","IBCNEDE5",61,0)
 .. N MCRPYR
"RTN","IBCNEDE5",62,0)
 .. I PIEN'=$P(SYMBOL,U,2) Q      ; wrong payer ien
"RTN","IBCNEDE5",63,0)
 .. ;
"RTN","IBCNEDE5",64,0)
 .. S MCRPYR=0                                           ; Medicare payer flag
"RTN","IBCNEDE5",65,0)
 .. I PIEN=+$P($G(^IBE(350.9,1,51)),U,25) S MCRPYR=1     ; this is the Medicare payer
"RTN","IBCNEDE5",66,0)
 .. I MCRPYR,MCRTQ Q      ; the Medicare payer is already in the array
"RTN","IBCNEDE5",67,0)
 .. ;
"RTN","IBCNEDE5",68,0)
 .. S SUBID=$P(INSSTR7,U,2)                ; IB*2.0*497 (vd)
"RTN","IBCNEDE5",69,0)
 .. I SUBID="" Q                           ; missing Subscriber ID
"RTN","IBCNEDE5",70,0)
 .. I $P(INSSTR,U,8)>DT Q                  ; future effective date
"RTN","IBCNEDE5",71,0)
 .. S EXP=$P(INSSTR,U,4) I EXP,EXP<DT Q    ; expired
"RTN","IBCNEDE5",72,0)
 .. S MVER=$P(INSSTR1,U,3)                 ; last verified date
"RTN","IBCNEDE5",73,0)
 .. I MVER'="",FRESHDT'="",MVER>FRESHDT S VFLG=1 Q     ; verified recently
"RTN","IBCNEDE5",74,0)
 .. S SUBIDS=$$STRIP(SUBID,,DFN)
"RTN","IBCNEDE5",75,0)
 .. I $D(SIDARRAY(SUBIDS_"_"_INREC)) Q            ; already in the array
"RTN","IBCNEDE5",76,0)
 .. S SIDARRAY(SUBIDS_"_"_INREC)="",SIDCNT=SIDCNT+1
"RTN","IBCNEDE5",77,0)
 .. I MCRPYR S MCRTQ=1     ; flag indicating Medicare payer is in the array
"RTN","IBCNEDE5",78,0)
 .. Q
"RTN","IBCNEDE5",79,0)
 . ;
"RTN","IBCNEDE5",80,0)
 . S INREC=$O(^DPT(DFN,.312,INREC))
"RTN","IBCNEDE5",81,0)
 . Q
"RTN","IBCNEDE5",82,0)
 ;
"RTN","IBCNEDE5",83,0)
 I SIDCNT S SIDACT=1 G SIDCHKX
"RTN","IBCNEDE5",84,0)
 I 'SIDCNT,VFLG S SIDACT=1 G SIDCHKX
"RTN","IBCNEDE5",85,0)
SIDC1 ;
"RTN","IBCNEDE5",86,0)
 S SIDACT=$S(SIDREQ:3,1:4)
"RTN","IBCNEDE5",87,0)
 ;
"RTN","IBCNEDE5",88,0)
SIDCHKX ; EXIT POINT
"RTN","IBCNEDE5",89,0)
 ;
"RTN","IBCNEDE5",90,0)
 Q SIDACT_U_SIDCNT
"RTN","IBCNEDE5",91,0)
 ;
"RTN","IBCNEDE5",92,0)
SSN(DFN) ; Get Patient SSN and update SIDARRAY, if needed
"RTN","IBCNEDE5",93,0)
 S SSN=$$GETSSN(DFN)
"RTN","IBCNEDE5",94,0)
 N SSNS
"RTN","IBCNEDE5",95,0)
 S SSNS=$$STRIP(SSN,1,DFN)
"RTN","IBCNEDE5",96,0)
 I $P($O(SIDARRAY(SSNS_"_")),"_")=SSNS Q
"RTN","IBCNEDE5",97,0)
 I SSNS'="",'$D(SIDARRAY(SSNS_"_")) S SIDARRAY(SSNS_"_")="",SIDCNT=SIDCNT+1
"RTN","IBCNEDE5",98,0)
 Q
"RTN","IBCNEDE5",99,0)
 ;
"RTN","IBCNEDE5",100,0)
GETSSN(DFN) ; Get Patient SSN
"RTN","IBCNEDE5",101,0)
 Q:'$G(DFN) ""
"RTN","IBCNEDE5",102,0)
 Q $P($G(^DPT(DFN,0)),U,9)
"RTN","IBCNEDE5",103,0)
 ;
"RTN","IBCNEDE5",104,0)
STRIP(ID,SS,DFN) ; Strip dashes and spaces if ssn
"RTN","IBCNEDE5",105,0)
 ;         ID can be ssn or subid
"RTN","IBCNEDE5",106,0)
 ;         if SS, ssn is being passed
"RTN","IBCNEDE5",107,0)
 N SSN,IDS,IDB
"RTN","IBCNEDE5",108,0)
 S SS=$G(SS)
"RTN","IBCNEDE5",109,0)
 ; If a ssn is passed, strip dashes and spaces
"RTN","IBCNEDE5",110,0)
 I SS Q $TR(ID,"- ")
"RTN","IBCNEDE5",111,0)
 ; If not ssn format, do not strip
"RTN","IBCNEDE5",112,0)
 S IDB=$TR(ID," ")
"RTN","IBCNEDE5",113,0)
 I IDB'?3N1"-"2N1"-"4N,IDB'?9N Q ID
"RTN","IBCNEDE5",114,0)
 ; Compare w/SSN - if it matches, strip dashes and spaces
"RTN","IBCNEDE5",115,0)
 S IDS=$TR(ID,"- ")
"RTN","IBCNEDE5",116,0)
 S SSN=$TR($$GETSSN(DFN),"- ")
"RTN","IBCNEDE5",117,0)
 I SSN=IDS Q IDS
"RTN","IBCNEDE5",118,0)
 Q ID
"RTN","IBCNEDE5",119,0)
 ;
"RTN","IBCNEDE6")
0^4^B7201517^B33816621
"RTN","IBCNEDE6",1,0)
IBCNEDE6 ;DAOU/DAC - eIV DATA EXTRACTS ;15-OCT-2002
"RTN","IBCNEDE6",2,0)
 ;;2.0;INTEGRATED BILLING;**184,271,345,416,497,506,621**;21-MAR-94;Build 8
"RTN","IBCNEDE6",3,0)
 ;;Per VA Directive 6402, this routine should not be modified.
"RTN","IBCNEDE6",4,0)
 ;
"RTN","IBCNEDE6",5,0)
 Q    ; no direct calls allowed
"RTN","IBCNEDE6",6,0)
 ;
"RTN","IBCNEDE6",7,0)
 ; IB*2*416 removed the ability to perform Identification inquiries.
"RTN","IBCNEDE6",8,0)
 ; However, this code is being left as is for future changes.
"RTN","IBCNEDE6",9,0)
 ;
"RTN","IBCNEDE6",10,0)
 ; IB*2*621 removed old code associated with a previous extract that 
"RTN","IBCNEDE6",11,0)
 ; is now replaced with EICD extract logic
"RTN","IBCNEDE6",12,0)
 ;
"RTN","IBCNEDE6",13,0)
UPDDTS(PIEN,SVDT,FRDT) ;  Update service date and freshness date per payer
"RTN","IBCNEDE6",14,0)
 ; date parameters FUTURE SERVICE DAYS (365.121,.14) and PAST SERVICE
"RTN","IBCNEDE6",15,0)
 ; DAYS (365.121,.15)
"RTN","IBCNEDE6",16,0)
 ; Output:
"RTN","IBCNEDE6",17,0)
 ;  SVDT - passed by reference - updates service date
"RTN","IBCNEDE6",18,0)
 ;  FRDT - passed by reference - updates freshness date - except for 
"RTN","IBCNEDE6",19,0)
 ;         INAC where it is optional
"RTN","IBCNEDE6",20,0)
 N FDAYS,PDAYS,DIFF,AIEN,DATA,OSVDT,EDTFLG
"RTN","IBCNEDE6",21,0)
 ;
"RTN","IBCNEDE6",22,0)
 ; Init vars - save original service date to calc diff
"RTN","IBCNEDE6",23,0)
 S (FDAYS,PDAYS,EDTFLG)=0,OSVDT=SVDT
"RTN","IBCNEDE6",24,0)
 ; Determine Payer App IEN
"RTN","IBCNEDE6",25,0)
 S AIEN=$$PYRAPP^IBCNEUT5("IIV",PIEN)
"RTN","IBCNEDE6",26,0)
 I AIEN="" Q  ; Quit without changing if app is not defined
"RTN","IBCNEDE6",27,0)
 S DATA=$G(^IBE(365.12,PIEN,1,AIEN,0))
"RTN","IBCNEDE6",28,0)
 I DATA="" Q  ; Quit without changing if node is not defined
"RTN","IBCNEDE6",29,0)
 S FDAYS=$P(DATA,U,14),PDAYS=$P(DATA,U,15)
"RTN","IBCNEDE6",30,0)
 ; Process past service days if not null
"RTN","IBCNEDE6",31,0)
 I PDAYS'="" D
"RTN","IBCNEDE6",32,0)
 . ; If zero and Service Date is less than today, reset to today
"RTN","IBCNEDE6",33,0)
 . I PDAYS=0&(SVDT<DT) S SVDT=$$DT^XLFDT,EDTFLG=1
"RTN","IBCNEDE6",34,0)
 . ; If non-zero and service date is earlier than the allowed
"RTN","IBCNEDE6",35,0)
 . ;  payer service date range, reset service date to earliest allowed
"RTN","IBCNEDE6",36,0)
 . ;  date for the payer
"RTN","IBCNEDE6",37,0)
 . I PDAYS,(SVDT<$$FMADD^XLFDT($$DT^XLFDT,-PDAYS)) D
"RTN","IBCNEDE6",38,0)
 . . S SVDT=$$FMADD^XLFDT($$DT^XLFDT,-PDAYS),EDTFLG=1
"RTN","IBCNEDE6",39,0)
 ; Process future service days if not edited and if not null
"RTN","IBCNEDE6",40,0)
 I EDTFLG=0,FDAYS'="" D
"RTN","IBCNEDE6",41,0)
 . ; If zero and Service Date is greater than today, reset to today
"RTN","IBCNEDE6",42,0)
 . I FDAYS=0&(SVDT>DT) S SVDT=$$DT^XLFDT,EDTFLG=1
"RTN","IBCNEDE6",43,0)
 . ; If non-zero and service date is later than the allowed
"RTN","IBCNEDE6",44,0)
 . ;  payer service date range, reset service date to latest allowed
"RTN","IBCNEDE6",45,0)
 . ;  date for the payer
"RTN","IBCNEDE6",46,0)
 . I FDAYS,(SVDT>$$FMADD^XLFDT($$DT^XLFDT,FDAYS)) D
"RTN","IBCNEDE6",47,0)
 . . S SVDT=$$FMADD^XLFDT($$DT^XLFDT,FDAYS),EDTFLG=1
"RTN","IBCNEDE6",48,0)
 ;
"RTN","IBCNEDE6",49,0)
 ; Determine if difference exists
"RTN","IBCNEDE6",50,0)
 I EDTFLG,$G(FRDT)'="" S FRDT=$$FMADD^XLFDT(FRDT,$$FMDIFF^XLFDT(SVDT,OSVDT))
"RTN","IBCNEDE6",51,0)
 ;
"RTN","IBCNEDE6",52,0)
 Q
"RTN","IBCNEDE6",53,0)
 ;
"RTN","IBCNEDE6",54,0)
TFL(DFN) ; Examines treating facility list,
"RTN","IBCNEDE6",55,0)
 ; value returned is 1 if patient has visited at least one other site
"RTN","IBCNEDE6",56,0)
 N IBC,IBZ,IBS
"RTN","IBCNEDE6",57,0)
 D TFL^VAFCTFU1(.IBZ,DFN) Q:-$G(IBZ(1))=1 0
"RTN","IBCNEDE6",58,0)
 S IBS=+$P($$SITE^VASITE,"^",3),(IBZ,IBC)=0
"RTN","IBCNEDE6",59,0)
 ; Look for remote facilities of type VAMC:
"RTN","IBCNEDE6",60,0)
 F  S IBZ=$O(IBZ(IBZ)) Q:IBZ<1  I +IBZ(IBZ)>0,+IBZ(IBZ)'=IBS,$P(IBZ(IBZ),U,5)="VAMC" S IBC=1 Q
"RTN","IBCNEDE6",61,0)
 Q IBC
"RTN","IBCNEDE7")
0^5^B32586873^B28965288
"RTN","IBCNEDE7",1,0)
IBCNEDE7 ;DAOU/DAC - eIV DATA EXTRACTS ;04-JUN-2002
"RTN","IBCNEDE7",2,0)
 ;;2.0;INTEGRATED BILLING;**271,416,438,497,601,621**;21-MAR-94;Build 8
"RTN","IBCNEDE7",3,0)
 ;;Per VA Directive 6402, this routine should not be modified.
"RTN","IBCNEDE7",4,0)
 ;
"RTN","IBCNEDE7",5,0)
 Q    ; no direct calls allowed
"RTN","IBCNEDE7",6,0)
 ; 
"RTN","IBCNEDE7",7,0)
SETTINGS(EXTNUM) ; Check site parameter settings for the extracts
"RTN","IBCNEDE7",8,0)
 ; Input Parameter:
"RTN","IBCNEDE7",9,0)
 ;
"RTN","IBCNEDE7",10,0)
 ; IB*2.0*621/DM reimplement extract (#4), now EICD, formerly No Insurance   
"RTN","IBCNEDE7",11,0)
 ; EXTNUM is either 1, 2, 3, 4 to represent the different extracts
"RTN","IBCNEDE7",12,0)
 ; 1 - Insurance Buffer extract
"RTN","IBCNEDE7",13,0)
 ; 2 - Pre-Reg (appointments)
"RTN","IBCNEDE7",14,0)
 ; 3 - Non Verified
"RTN","IBCNEDE7",15,0)
 ; 4 - EICD
"RTN","IBCNEDE7",16,0)
 ;
"RTN","IBCNEDE7",17,0)
 ; Output parameters:
"RTN","IBCNEDE7",18,0)
 ; Returns a "^" delimited string passing back:
"RTN","IBCNEDE7",19,0)
 ;    EACTIVE - A flag of whether to consider the extract active
"RTN","IBCNEDE7",20,0)
 ;    XDAYS - Number of days to look back in the past when extracting data
"RTN","IBCNEDE7",21,0)
 ;    STALEDYS - "stale days": number of days from today to determine the
"RTN","IBCNEDE7",22,0)
 ;          freshness. This is only used for the non-verified extract.
"RTN","IBCNEDE7",23,0)
 ;          The "Buffer" and "Appt" extract get their days from the IB SITE PARAMETER
"RTN","IBCNEDE7",24,0)
 ;          file within their specific extract routine.
"RTN","IBCNEDE7",25,0)
 ;    MAXCNT - Max Number of entries you are allowed to set into the eIV 
"RTN","IBCNEDE7",26,0)
 ;          Transmission Queue file.  If null, # of entries allowed is unlimited.
"RTN","IBCNEDE7",27,0)
 ;    SUPPBUFF - Suppress Buffer Flag - Either '0' (No) or '1' (Yes)
"RTN","IBCNEDE7",28,0)
 ;          1 will suppress the creation of buffer entries
"RTN","IBCNEDE7",29,0)
 ;          0 will not
"RTN","IBCNEDE7",30,0)
 ;          Applies to #2 (Pre Reg), #3 (Non verified) and #4 (EICD) 
"RTN","IBCNEDE7",31,0)
 ; 
"RTN","IBCNEDE7",32,0)
 ;    For now, the next three parameters are only used by the EICD (#4) extract  
"RTN","IBCNEDE7",33,0)
 ;    STARTDYS - number of days from today to form the extract's start date  
"RTN","IBCNEDE7",34,0)
 ;    DYSAFTER - number of days added to the start date to form the extract's end date
"RTN","IBCNEDE7",35,0)
 ;    FREQ - how long the extract must wait before an attempt to re-verify for the patient
"RTN","IBCNEDE7",36,0)
 ;
"RTN","IBCNEDE7",37,0)
 N DIC,DISYS,DA,X,Y,EACTIVE,XDAYS,STALEDYS,MAXCNT,OK,SUPPBUFF
"RTN","IBCNEDE7",38,0)
 N STARTDYS,DYSAFTER,FREQ
"RTN","IBCNEDE7",39,0)
 S EACTIVE=0,(XDAYS,STALEDYS,MAXCNT,SUPPBUFF,STARTDYS,DYSAFTER,FREQ)=""
"RTN","IBCNEDE7",40,0)
 S OK=$S(EXTNUM=1:1,EXTNUM=2:1,EXTNUM=3:1,EXTNUM=4:1,1:0)
"RTN","IBCNEDE7",41,0)
 I 'OK G EXIT
"RTN","IBCNEDE7",42,0)
 S DA=1,DIC="^IBE(350.9,"_DA_",51.17,",DIC(0)="X",X=EXTNUM D ^DIC
"RTN","IBCNEDE7",43,0)
 ;
"RTN","IBCNEDE7",44,0)
 I Y<1 G EXIT  ; extract not defined in the IB Site Parameter
"RTN","IBCNEDE7",45,0)
 ;
"RTN","IBCNEDE7",46,0)
 S EACTIVE=$G(^IBE(350.9,1,51.17,+Y,0))
"RTN","IBCNEDE7",47,0)
 S XDAYS=$P(EACTIVE,U,3)
"RTN","IBCNEDE7",48,0)
 S STALEDYS=$P(EACTIVE,U,4)
"RTN","IBCNEDE7",49,0)
 S MAXCNT=$P(EACTIVE,U,5)
"RTN","IBCNEDE7",50,0)
 S SUPPBUFF=$P(EACTIVE,U,6)
"RTN","IBCNEDE7",51,0)
 S STARTDYS=$P(EACTIVE,U,7)
"RTN","IBCNEDE7",52,0)
 S DYSAFTER=$P(EACTIVE,U,8)
"RTN","IBCNEDE7",53,0)
 S FREQ=$P(EACTIVE,U,9)
"RTN","IBCNEDE7",54,0)
 I SUPPBUFF="" S SUPPBUFF=0
"RTN","IBCNEDE7",55,0)
 S EACTIVE=$P(EACTIVE,U,2)
"RTN","IBCNEDE7",56,0)
EXIT ;
"RTN","IBCNEDE7",57,0)
 I EXTNUM=2,(XDAYS="") S EACTIVE=0  ; missing required data
"RTN","IBCNEDE7",58,0)
 I EXTNUM=3 D
"RTN","IBCNEDE7",59,0)
 . I XDAYS=""!(STALEDYS="") S EACTIVE=0   ; missing required data
"RTN","IBCNEDE7",60,0)
 I EXTNUM=4,((STARTDYS="")!(DYSAFTER="")!(FREQ="")) S EACTIVE=0  ; missing required data
"RTN","IBCNEDE7",61,0)
 Q EACTIVE_U_XDAYS_U_STALEDYS_U_MAXCNT_U_SUPPBUFF_U_STARTDYS_U_DYSAFTER_U_FREQ
"RTN","IBCNEDE7",62,0)
 ;
"RTN","IBCNEDE7",63,0)
SETTQ(DATA1,DATA2,ORIG,OVERRIDE,DATA5) ;Set extract data in TQ file 365.1
"RTN","IBCNEDE7",64,0)
 ;
"RTN","IBCNEDE7",65,0)
 ; DATA1, DATA2, ORIG & DATA5 are "^" delimited variables containing the data
"RTN","IBCNEDE7",66,0)
 ; listed below
"RTN","IBCNEDE7",67,0)
 ;
"RTN","IBCNEDE7",68,0)
 ; OVERRIDE - flag indicates that this entry is a result of the 
"RTN","IBCNEDE7",69,0)
 ;         'Request Re-Verification' menu option.
"RTN","IBCNEDE7",70,0)
 ;
"RTN","IBCNEDE7",71,0)
 N BUFFIEN,FDA,IENARRAY,ERROR,TRANSNO,DFN,SRVCODE
"RTN","IBCNEDE7",72,0)
 ; do not allow "NO PAYER" entries
"RTN","IBCNEDE7",73,0)
 I $P(DATA1,U,2)=$$FIND1^DIC(365.12,"","X","~NO PAYER") Q
"RTN","IBCNEDE7",74,0)
 S BUFFIEN=$P(DATA1,U,4),SRVCODE=0
"RTN","IBCNEDE7",75,0)
 ;IB*2.0*621/DM make sure SRVCODE is populated
"RTN","IBCNEDE7",76,0)
 S:BUFFIEN SRVCODE=+$$GET1^DIQ(355.33,BUFFIEN_",",80.01,"I") ; "INQ SERVICE TYPE CODE 1"
"RTN","IBCNEDE7",77,0)
 S:'SRVCODE SRVCODE=+$$GET1^DIQ(350.9,"1,",60.01,"I")        ; "DEFAULT SERVICE TYPE CODE 1"
"RTN","IBCNEDE7",78,0)
 S TRANSNO=$P($G(^IBCN(365.1,0)),U,3)+1
"RTN","IBCNEDE7",79,0)
 S FDA(365.1,"+1,",.01)=TRANSNO             ; Transaction #
"RTN","IBCNEDE7",80,0)
 ;
"RTN","IBCNEDE7",81,0)
 S DFN=$P(DATA1,U)
"RTN","IBCNEDE7",82,0)
 S FDA(365.1,"+1,",.02)=DFN                 ; patient DFN
"RTN","IBCNEDE7",83,0)
 S FDA(365.1,"+1,",.03)=$P(DATA1,U,2)       ; ien of payer
"RTN","IBCNEDE7",84,0)
 S FDA(365.1,"+1,",.04)=$P(DATA1,U,3)       ; ien of transmission status
"RTN","IBCNEDE7",85,0)
 S FDA(365.1,"+1,",.15)=DT                  ; trans status date
"RTN","IBCNEDE7",86,0)
 S FDA(365.1,"+1,",.05)=BUFFIEN             ; ien of buffer
"RTN","IBCNEDE7",87,0)
 ;
"RTN","IBCNEDE7",88,0)
 S FDA(365.1,"+1,",.06)=$$NOW^XLFDT         ; creation date/time
"RTN","IBCNEDE7",89,0)
 S FDA(365.1,"+1,",.07)=0                   ; transmission retries
"RTN","IBCNEDE7",90,0)
 S FDA(365.1,"+1,",.08)=0                   ; number of retries
"RTN","IBCNEDE7",91,0)
 I $D(OVERRIDE) S FDA(365.1,"+1,",.14)=OVERRIDE  ; override flag
"RTN","IBCNEDE7",92,0)
 S FDA(365.1,"+1,",.16)=$P(DATA1,U,5)        ; Sub. ID
"RTN","IBCNEDE7",93,0)
 S FDA(365.1,"+1,",.17)=$P(DATA1,U,6)        ; Freshness Date
"RTN","IBCNEDE7",94,0)
 S FDA(365.1,"+1,",.18)=$P(DATA1,U,7)        ; Pass Buffer ien?
"RTN","IBCNEDE7",95,0)
 S FDA(365.1,"+1,",.19)=$P(DATA1,U,8)        ; Patient ID
"RTN","IBCNEDE7",96,0)
 S FDA(365.1,"+1,",.2)=SRVCODE               ; Service code
"RTN","IBCNEDE7",97,0)
 ;
"RTN","IBCNEDE7",98,0)
 I $D(DATA2) D
"RTN","IBCNEDE7",99,0)
 . S FDA(365.1,"+1,",.1)=$P(DATA2,U)          ; which extract (ien)
"RTN","IBCNEDE7",100,0)
 . S FDA(365.1,"+1,",.11)=$P(DATA2,U,2)       ; query flag
"RTN","IBCNEDE7",101,0)
 . S FDA(365.1,"+1,",.12)=$P(DATA2,U,3)       ; service date
"RTN","IBCNEDE7",102,0)
 . S FDA(365.1,"+1,",.13)=$P(DATA2,U,4)       ; patient insur. ien
"RTN","IBCNEDE7",103,0)
 ;
"RTN","IBCNEDE7",104,0)
 I $D(ORIG) D
"RTN","IBCNEDE7",105,0)
 . S FDA(365.1,"+1,",1.02)=$P(ORIG,U)   ; original ins co (in buffer)
"RTN","IBCNEDE7",106,0)
 . S FDA(365.1,"+1,",1.03)=$P(ORIG,U,2)   ; original grp # (in buffer)
"RTN","IBCNEDE7",107,0)
 . S FDA(365.1,"+1,",1.04)=$P(ORIG,U,3)   ; original grp name (in buffer)
"RTN","IBCNEDE7",108,0)
 . S FDA(365.1,"+1,",1.05)=$P(ORIG,U,4)   ; original subscriber ID
"RTN","IBCNEDE7",109,0)
 ;
"RTN","IBCNEDE7",110,0)
 I $D(DATA5) D
"RTN","IBCNEDE7",111,0)
 . S FDA(365.1,"+1,",3.02)=$P(DATA5,U)   ; source of information ien, IB*2*601/DM
"RTN","IBCNEDE7",112,0)
 . S FDA(365.1,"+1,",.21)=$P(DATA5,U,2)  ; EICD INS-FND IEN, IB*2*621/DM 
"RTN","IBCNEDE7",113,0)
 ;
"RTN","IBCNEDE7",114,0)
 D UPDATE^DIE("","FDA","IENARRAY","ERROR")
"RTN","IBCNEDE7",115,0)
 ;
"RTN","IBCNEDE7",116,0)
 I $G(ERROR("DIERR",1,"TEXT",1))'="" D  ; MailMan msg
"RTN","IBCNEDE7",117,0)
 . N MGRP,XMSUB,MSG
"RTN","IBCNEDE7",118,0)
 . ;
"RTN","IBCNEDE7",119,0)
 . ; Set to IB site parameter MAILGROUP
"RTN","IBCNEDE7",120,0)
 . S MGRP=$$MGRP^IBCNEUT5()
"RTN","IBCNEDE7",121,0)
 . ;
"RTN","IBCNEDE7",122,0)
 . S XMSUB="eIV Problem: Trouble setting entry in File 365.1"
"RTN","IBCNEDE7",123,0)
 . S MSG(1)="Tried to create an entry in the eIV Transmission Queue File #365.1 without"
"RTN","IBCNEDE7",124,0)
 . S MSG(2)="success."
"RTN","IBCNEDE7",125,0)
 . S MSG(3)=""
"RTN","IBCNEDE7",126,0)
 . S MSG(4)="Error encountered: "_$G(ERROR("DIERR",1,"TEXT",1))
"RTN","IBCNEDE7",127,0)
 . S MSG(5)=""
"RTN","IBCNEDE7",128,0)
 . S MSG(6)="The data that was to be stored is as follows:"
"RTN","IBCNEDE7",129,0)
 . S MSG(7)=""
"RTN","IBCNEDE7",130,0)
 . S MSG(8)="Transaction #: "_TRANSNO
"RTN","IBCNEDE7",131,0)
 . S MSG(9)="Patient: "_$P($G(^DPT(DFN,0)),U)_$$SSN^IBCNEDEQ(DFN)
"RTN","IBCNEDE7",132,0)
 . S MSG(10)="Extract: "_$P($G(DATA2),U,1)
"RTN","IBCNEDE7",133,0)
 . S MSG(11)="Payer: "
"RTN","IBCNEDE7",134,0)
 . S:$P(DATA1,U,2)'="" MSG(11)=MSG(11)_$P($G(^IBE(365.12,$P(DATA1,U,2),0)),U,1)
"RTN","IBCNEDE7",135,0)
 . S MSG(12)="Please call the Help Desk about this problem."
"RTN","IBCNEDE7",136,0)
 . D MSG^IBCNEUT5(MGRP,XMSUB,"MSG(")
"RTN","IBCNEDE7",137,0)
 ;
"RTN","IBCNEDE7",138,0)
 Q $G(IENARRAY(1))
"RTN","IBCNEDE7",139,0)
 ;
"RTN","IBCNEDE7",140,0)
PYRACTV(PIEN) ; check if given payer is nationally active for eIV
"RTN","IBCNEDE7",141,0)
 ; returns 1 if payer is nationally active, 0 otherwise
"RTN","IBCNEDE7",142,0)
 N APPIEN,RES
"RTN","IBCNEDE7",143,0)
 S RES=0
"RTN","IBCNEDE7",144,0)
 I +$G(PIEN)'>0 G PYRACTVX
"RTN","IBCNEDE7",145,0)
 S APPIEN=$$PYRAPP^IBCNEUT5("IIV",PIEN)
"RTN","IBCNEDE7",146,0)
 I +$G(APPIEN)'>0 G PYRACTVX
"RTN","IBCNEDE7",147,0)
 I $P($G(^IBE(365.12,PIEN,1,APPIEN,0)),U,2)=1 S RES=1
"RTN","IBCNEDE7",148,0)
PYRACTVX ;
"RTN","IBCNEDE7",149,0)
 Q RES
"RTN","IBCNEDEP")
0^6^B106470156^B94374860
"RTN","IBCNEDEP",1,0)
IBCNEDEP ;DAOU/ALA - Process Transaction Records ;14-OCT-2015
"RTN","IBCNEDEP",2,0)
 ;;2.0;INTEGRATED BILLING;**184,271,300,416,438,506,533,549,601,621**;21-MAR-94;Build 8
"RTN","IBCNEDEP",3,0)
 ;;Per VA Directive 6402, this routine should not be modified.
"RTN","IBCNEDEP",4,0)
 ;
"RTN","IBCNEDEP",5,0)
 ;  This program finds records needing HL7 msg creation
"RTN","IBCNEDEP",6,0)
 ;  Periodically check for stop request for background task
"RTN","IBCNEDEP",7,0)
 ;
"RTN","IBCNEDEP",8,0)
 ;  Variables
"RTN","IBCNEDEP",9,0)
 ;    RETR = # retries allowed
"RTN","IBCNEDEP",10,0)
 ;    RETRYFLG = determines if a Transmitted message can be resent
"RTN","IBCNEDEP",11,0)
 ;    MGRP = Msg Mailgroup
"RTN","IBCNEDEP",12,0)
 ;    FAIL = # of days before failure
"RTN","IBCNEDEP",13,0)
 ;    FMSG = Failure Mailman flag
"RTN","IBCNEDEP",14,0)
 ;    TMSG = Timeout Mailman flag
"RTN","IBCNEDEP",15,0)
 ;    FLDT = Failure date
"RTN","IBCNEDEP",16,0)
 ;    FUTDT = Future transmission date
"RTN","IBCNEDEP",17,0)
 ;    DFN = Patient IEN
"RTN","IBCNEDEP",18,0)
 ;    PAYR = Payer IEN
"RTN","IBCNEDEP",19,0)
 ;    DTCRT = Date Created
"RTN","IBCNEDEP",20,0)
 ;    BUFF = Buffer File IEN
"RTN","IBCNEDEP",21,0)
 ;    NRETR = # of retries accomplished
"RTN","IBCNEDEP",22,0)
 ;    IHCNT = Count of successful HL7 msgs
"RTN","IBCNEDEP",23,0)
 ;    QUERY = Type of msg
"RTN","IBCNEDEP",24,0)
 ;    EXT =  Which extract produced record
"RTN","IBCNEDEP",25,0)
 ;    SRVDT = Service Date
"RTN","IBCNEDEP",26,0)
 ;    IRIEN = Insurance Record IEN
"RTN","IBCNEDEP",27,0)
 ;    NTRAN = # of transmissions accomplished
"RTN","IBCNEDEP",28,0)
 ;    OVRIDE = Override Flag
"RTN","IBCNEDEP",29,0)
 ;    BNDL = Bundle Verification Flag
"RTN","IBCNEDEP",30,0)
 ;
"RTN","IBCNEDEP",31,0)
EN ;  Entry point
"RTN","IBCNEDEP",32,0)
 ;
"RTN","IBCNEDEP",33,0)
 ;  Start processing of data
"RTN","IBCNEDEP",34,0)
 K ^TMP("HLS",$J),^TMP("IBQUERY",$J)
"RTN","IBCNEDEP",35,0)
 ; Initialize count for periodic TaskMan check
"RTN","IBCNEDEP",36,0)
 ;IB*533 RRA CREATE VARIABLES TO ACCOUNT FOR MAX SENT LIMITATIONS
"RTN","IBCNEDEP",37,0)
 N IBMAXCNT,IBSENT
"RTN","IBCNEDEP",38,0)
 S IBCNETOT=0,IBSENT=0
"RTN","IBCNEDEP",39,0)
 ;
"RTN","IBCNEDEP",40,0)
 S C1CODE=$O(^IBE(365.15,"B","C1",""))
"RTN","IBCNEDEP",41,0)
 ;  Get IB Site Parameters
"RTN","IBCNEDEP",42,0)
 S IBCNEP=$G(^IBE(350.9,1,51))
"RTN","IBCNEDEP",43,0)
 S RETR=+$P(IBCNEP,U,6),BNDL=$P(IBCNEP,U,23)
"RTN","IBCNEDEP",44,0)
 S MGRP=$$MGRP^IBCNEUT5()
"RTN","IBCNEDEP",45,0)
 S FAIL=$P(IBCNEP,U,5),TMSG=$P(IBCNEP,U,7),FMSG=$P(IBCNEP,U,20)
"RTN","IBCNEDEP",46,0)
 S RETRYFLG=$P(IBCNEP,U,26)        ;set value to (#350.9, 51.26) - IB*2.0*506
"RTN","IBCNEDEP",47,0)
 S IBMAXCNT=$P(IBCNEP,U,15)   ;get HL7 MAXIMUM NUMBER - IB*533
"RTN","IBCNEDEP",48,0)
 S FLDT=$$FMADD^XLFDT(DT,-FAIL)
"RTN","IBCNEDEP",49,0)
 ; Statuses
"RTN","IBCNEDEP",50,0)
 ;   1 = Ready To Transmit
"RTN","IBCNEDEP",51,0)
 ;   2 = Transmitted
"RTN","IBCNEDEP",52,0)
 ;   4 = Hold
"RTN","IBCNEDEP",53,0)
 ;   6 = Retry
"RTN","IBCNEDEP",54,0)
 ;
"RTN","IBCNEDEP",55,0)
 ; If the status is 'HOLD' is this a 'Retry'?   -  IB*2.0*506
"RTN","IBCNEDEP",56,0)
 ;  DO HLD   ; this is not to be called unless the status of HOLD is reinstated...see HLD tag
"RTN","IBCNEDEP",57,0)
 ;  below and the code within ERROR^IBCNEHL3
"RTN","IBCNEDEP",58,0)
 ;
"RTN","IBCNEDEP",59,0)
 ; Exit based on stop request
"RTN","IBCNEDEP",60,0)
 I $G(ZTSTOP) G EXIT
"RTN","IBCNEDEP",61,0)
 ;
"RTN","IBCNEDEP",62,0)
TMT ;  If the status is 'Transmitted' - is this a 'Retry' or
"RTN","IBCNEDEP",63,0)
 ;  'Comm Failure'
"RTN","IBCNEDEP",64,0)
 S IEN=""
"RTN","IBCNEDEP",65,0)
 F  S IEN=$O(^IBCN(365.1,"AC",2,IEN)) Q:IEN=""  D  Q:$G(ZTSTOP)
"RTN","IBCNEDEP",66,0)
 . ; Update count for periodic check
"RTN","IBCNEDEP",67,0)
 . S IBCNETOT=IBCNETOT+1
"RTN","IBCNEDEP",68,0)
 . ; Check for request to stop background job, periodically
"RTN","IBCNEDEP",69,0)
 . I $D(ZTQUEUED),IBCNETOT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 Q
"RTN","IBCNEDEP",70,0)
 . ;
"RTN","IBCNEDEP",71,0)
 . NEW TDATA,DTCRT,BUFF,DFN,PAYR,XMSUB,VERID,EXT
"RTN","IBCNEDEP",72,0)
 . S TDATA=$G(^IBCN(365.1,IEN,0))
"RTN","IBCNEDEP",73,0)
 . S DFN=$P(TDATA,U,2),PAYR=$P(TDATA,U,3)
"RTN","IBCNEDEP",74,0)
 . S DTCRT=$P(TDATA,U,6)\1,BUFF=$P(TDATA,U,5)
"RTN","IBCNEDEP",75,0)
 . S VERID=$P(TDATA,U,11)
"RTN","IBCNEDEP",76,0)
 . S EXT=$P(TDATA,U,10)
"RTN","IBCNEDEP",77,0)
 . ;
"RTN","IBCNEDEP",78,0)
 . ;  Check against the Failure Date
"RTN","IBCNEDEP",79,0)
 . I (VERID="I")&(EXT=4) Q:DT<$$FMADD^XLFDT(DTCRT+30)  ; IB*2.0*621 ; HAN
"RTN","IBCNEDEP",80,0)
 . I (VERID'="I")&(EXT'=4)&(DTCRT>FLDT) Q
"RTN","IBCNEDEP",81,0)
 . ;
"RTN","IBCNEDEP",82,0)
 . ;  If retries are defined
"RTN","IBCNEDEP",83,0)
 . I (VERID'="I"&(EXT'=4))&(RETRYFLG="Y") D  Q     ; IB*2.0*506 ; IB*2.0*621 
"RTN","IBCNEDEP",84,0)
 .. ;
"RTN","IBCNEDEP",85,0)
 .. I '$$PYRACTV^IBCNEDE7(PAYR) Q    ; If Payer is not Nationally Active skip record  -  IB*2.0*506
"RTN","IBCNEDEP",86,0)
 .. ;
"RTN","IBCNEDEP",87,0)
 .. D SST^IBCNEUT2(IEN,6)    ; mark TQ entry status as 'retry'
"RTN","IBCNEDEP",88,0)
 .. Q
"RTN","IBCNEDEP",89,0)
 . ;
"RTN","IBCNEDEP",90,0)
 . D SST^IBCNEUT2(IEN,5)     ; if RETRYFLG=NO set TQ record to 'communication failure'
"RTN","IBCNEDEP",91,0)
 . ;
"RTN","IBCNEDEP",92,0)
 . ;  For msg in the Response file set the status to
"RTN","IBCNEDEP",93,0)
 . ; 'Comm Failure'
"RTN","IBCNEDEP",94,0)
 . D RSTA^IBCNEUT7(IEN)
"RTN","IBCNEDEP",95,0)
 . I (VERID="I")&(EXT=4) D
"RTN","IBCNEDEP",96,0)
 .. N IENS,RSUPDT,TRKIEN
"RTN","IBCNEDEP",97,0)
 .. S TRKIEN=$O(^IBCN(365.18,"B",IEN,"")),IENS=TRKIEN_","
"RTN","IBCNEDEP",98,0)
 .. S RSUPDT(365.18,IENS,.06)=$$GET1^DIQ(365.16,"1,"_IEN_",",.03) ;There is only one occurance for EICD Identification
"RTN","IBCNEDEP",99,0)
 .. S RSUPDT(365.18,IENS,.07)=0  ;Set status to "Error"
"RTN","IBCNEDEP",100,0)
 .. D FILE^DIE("","RSUPDT","ERROR")
"RTN","IBCNEDEP",101,0)
 . ;
"RTN","IBCNEDEP",102,0)
 . ;  Set Buffer symbol to 'C1' (Comm Failure)    ; used to be 'B12' - ien of 15
"RTN","IBCNEDEP",103,0)
 . I BUFF'="" D BUFF^IBCNEUT2(BUFF,C1CODE)        ; set to "#" communication failure - IB*2.0*506
"RTN","IBCNEDEP",104,0)
 . ;
"RTN","IBCNEDEP",105,0)
 . I PAYR=$$FIND1^DIC(365.12,"","X","~NO PAYER") Q
"RTN","IBCNEDEP",106,0)
 . ;
"RTN","IBCNEDEP",107,0)
 . ; Issue comm fail MailMan msg only for ver'ns
"RTN","IBCNEDEP",108,0)
 . I VERID="V" D CERR^IBCNEDEQ
"RTN","IBCNEDEP",109,0)
 ;
"RTN","IBCNEDEP",110,0)
 ; Exit for stop request
"RTN","IBCNEDEP",111,0)
 I $G(ZTSTOP) G EXIT
"RTN","IBCNEDEP",112,0)
 ;
"RTN","IBCNEDEP",113,0)
RET ;  If status is 'Retry'     ; retries only exist if the RETRYFLG=YES - IB*2.0*506
"RTN","IBCNEDEP",114,0)
 S IEN=""
"RTN","IBCNEDEP",115,0)
 F  S IEN=$O(^IBCN(365.1,"AC",6,IEN)) Q:IEN=""  D  Q:$G(ZTSTOP)
"RTN","IBCNEDEP",116,0)
 . ; Update count for periodic check
"RTN","IBCNEDEP",117,0)
 . S IBCNETOT=IBCNETOT+1
"RTN","IBCNEDEP",118,0)
 . ; Check for request to stop background job, periodically
"RTN","IBCNEDEP",119,0)
 . I $D(ZTQUEUED),IBCNETOT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 Q
"RTN","IBCNEDEP",120,0)
 . ;
"RTN","IBCNEDEP",121,0)
 . NEW TDATA,NRETR,PAYR,BUFF,DFN,MSG,RIEN,HIEN,XMSUB,VERID
"RTN","IBCNEDEP",122,0)
 . S TDATA=$G(^IBCN(365.1,IEN,0))
"RTN","IBCNEDEP",123,0)
 . S NRETR=$P(TDATA,U,8),PAYR=$P(TDATA,U,3)
"RTN","IBCNEDEP",124,0)
 . S BUFF=$P(TDATA,U,5),DFN=$P(TDATA,U,2)
"RTN","IBCNEDEP",125,0)
 . S VERID=$P(TDATA,U,11)
"RTN","IBCNEDEP",126,0)
 . S NRETR=NRETR+1
"RTN","IBCNEDEP",127,0)
 . ;
"RTN","IBCNEDEP",128,0)
 . ;  If retries are finished, set to communication failure  - IB*2.0*506
"RTN","IBCNEDEP",129,0)
 . I NRETR>RETR D  Q
"RTN","IBCNEDEP",130,0)
 .. D SST^IBCNEUT2(IEN,5)
"RTN","IBCNEDEP",131,0)
 .. ;
"RTN","IBCNEDEP",132,0)
 .. ;  Set Buffer symbol to 'C1' (Comm Failure)    ; used to be 'B12' - ien of 15
"RTN","IBCNEDEP",133,0)
 .. I BUFF'="" D BUFF^IBCNEUT2(BUFF,C1CODE)        ; set to "#" communication failure - IB*2.0*506
"RTN","IBCNEDEP",134,0)
 .. ;
"RTN","IBCNEDEP",135,0)
 .. ;  For msg in the Response file set the status to
"RTN","IBCNEDEP",136,0)
 .. ; 'Comm Failure'
"RTN","IBCNEDEP",137,0)
 .. D RSTA^IBCNEUT7(IEN)
"RTN","IBCNEDEP",138,0)
 .. I PAYR=$$FIND1^DIC(365.12,"","X","~NO PAYER") Q
"RTN","IBCNEDEP",139,0)
 .. ;
"RTN","IBCNEDEP",140,0)
 .. ;I VERID="V" D CERE^IBCNEDEQ      ; removed IB*2.0*506
"RTN","IBCNEDEP",141,0)
 . ; If generating retry, set eIV status to comm failure (5) for
"RTN","IBCNEDEP",142,0)
 . ; remaining related responses
"RTN","IBCNEDEP",143,0)
 . D RSTA^IBCNEUT7(IEN)
"RTN","IBCNEDEP",144,0)
 ;
"RTN","IBCNEDEP",145,0)
 ; Exit for stop request
"RTN","IBCNEDEP",146,0)
 I $G(ZTSTOP) G EXIT
"RTN","IBCNEDEP",147,0)
 ;
"RTN","IBCNEDEP",148,0)
FIN ; Prioritize requests for statuses 'Retry' and 'Ready to Transmit'
"RTN","IBCNEDEP",149,0)
 ;
"RTN","IBCNEDEP",150,0)
 ;  Separate inquiries into verifications, identifications,
"RTN","IBCNEDEP",151,0)
 ;  and "fishes" - VNUM = Priority of output
"RTN","IBCNEDEP",152,0)
 F STA=1,6 S IEN="" D
"RTN","IBCNEDEP",153,0)
 . F  S IEN=$O(^IBCN(365.1,"AC",STA,IEN)) Q:IEN=""  D
"RTN","IBCNEDEP",154,0)
 .. S IBDATA=$G(^IBCN(365.1,IEN,0)) Q:IBDATA=""
"RTN","IBCNEDEP",155,0)
 .. S QUERY=$P(IBDATA,U,11),DFN=$P(IBDATA,U,2),OVRIDE=$P(IBDATA,U,14)
"RTN","IBCNEDEP",156,0)
 .. S PAYR=$P(IBDATA,U,3)
"RTN","IBCNEDEP",157,0)
 .. I QUERY="V" S VNUM=3
"RTN","IBCNEDEP",158,0)
 .. I QUERY'="V" D
"RTN","IBCNEDEP",159,0)
 ... ;I PAYR=$$FIND1^DIC(365.12,,"X","~NO PAYER") S VNUM=5 Q  ; IB*601 - HAN
"RTN","IBCNEDEP",160,0)
 ... S VNUM=4
"RTN","IBCNEDEP",161,0)
 .. I OVRIDE'="" D
"RTN","IBCNEDEP",162,0)
 ... I PAYR=$$FIND1^DIC(365.12,,"X","~NO PAYER") S VNUM=2 Q
"RTN","IBCNEDEP",163,0)
 ... S VNUM=1
"RTN","IBCNEDEP",164,0)
 .. S ^TMP("IBQUERY",$J,VNUM,DFN,IEN)=""
"RTN","IBCNEDEP",165,0)
 ;
"RTN","IBCNEDEP",166,0)
LP ;  Loop through priorities, process as either verifications
"RTN","IBCNEDEP",167,0)
 ;  or identifications
"RTN","IBCNEDEP",168,0)
 N IHCNT,IBSTOP
"RTN","IBCNEDEP",169,0)
 S VNUM="",IHCNT=0
"RTN","IBCNEDEP",170,0)
 F  S VNUM=$O(^TMP("IBQUERY",$J,VNUM)) Q:VNUM=""  D  Q:$G(ZTSTOP)!$G(QFL)=1!($G(IBSTOP)=1)
"RTN","IBCNEDEP",171,0)
 . I VNUM=1!(VNUM=3) D VER Q
"RTN","IBCNEDEP",172,0)
 . D ID
"RTN","IBCNEDEP",173,0)
 ;
"RTN","IBCNEDEP",174,0)
EXIT ;  Finish
"RTN","IBCNEDEP",175,0)
 K BUFF,CNT,D,D0,DA,DFN,DI,DIC,DIE,DISYS,DQ,DR,DTCRT,EICDVIEN,EXT,FAIL,FLDT,FUTDT
"RTN","IBCNEDEP",176,0)
 K FRDT,FMSG,GT1,HCT,HIEN,HL,HLCDOM,HLCINS,HLCS,HLCSTCP,HLDOM,HLECH,%I,%H
"RTN","IBCNEDEP",177,0)
 K HLEID,HLFS,HLHDR,HLINST,HLIP,HLN,HLPARAM,HLPROD,HLQ,HLRESLT,XMSUB
"RTN","IBCNEDEP",178,0)
 K HLSAN,HLTYPE,HLX,IBCNEP,IBCNHLP,IEN,IHCNT,IN1,IRIEN,MDTM,MGRP,MSGID,TOT
"RTN","IBCNEDEP",179,0)
 K NRETR,NTRAN,OVRIDE,PAYR,PID,QFL,QUERY,RETR,RETRYFLG,RSIEN,SRVDT,STA,TRANSR,X
"RTN","IBCNEDEP",180,0)
 K ZMID,^TMP("IBQUERY",$J),Y,DOD,DGREL,TMSG,RSTYPE,OMSGID,QFL
"RTN","IBCNEDEP",181,0)
 K IBCNETOT,HLP,SUBID,VNUM,BNDL,IBDATA,PATID,C1CODE
"RTN","IBCNEDEP",182,0)
 Q
"RTN","IBCNEDEP",183,0)
 ;
"RTN","IBCNEDEP",184,0)
VER ;  Initialize HL7 variables protocol for Verifications
"RTN","IBCNEDEP",185,0)
 S IBCNHLP="IBCNE IIV RQV OUT"
"RTN","IBCNEDEP",186,0)
 D INIT^IBCNEHLO
"RTN","IBCNEDEP",187,0)
 ;
"RTN","IBCNEDEP",188,0)
 S DFN=""
"RTN","IBCNEDEP",189,0)
 F  S DFN=$O(^TMP("IBQUERY",$J,VNUM,DFN)) Q:DFN=""  D  Q:$G(ZTSTOP)!($G(IBSTOP)=1)
"RTN","IBCNEDEP",190,0)
 . ;
"RTN","IBCNEDEP",191,0)
 . ;  If the INQUIRE SECONDARY INSURANCES flag is 'yes',
"RTN","IBCNEDEP",192,0)
 . ;  bundle verifications together, send a continuation pointer
"RTN","IBCNEDEP",193,0)
 . I VNUM=3,BNDL D  Q:QFL
"RTN","IBCNEDEP",194,0)
 .. S TOT=0,IEN="",QFL=0
"RTN","IBCNEDEP",195,0)
 .. F  S IEN=$O(^TMP("IBQUERY",$J,VNUM,DFN,IEN)) Q:IEN=""  S TOT=TOT+1
"RTN","IBCNEDEP",196,0)
 . ;
"RTN","IBCNEDEP",197,0)
 . S IEN="",OMSGID="",QFL=0,CNT=0
"RTN","IBCNEDEP",198,0)
 . F  S IEN=$O(^TMP("IBQUERY",$J,VNUM,DFN,IEN)) Q:IEN=""  D  Q:$G(ZTSTOP)!($G(IBSTOP)=1)
"RTN","IBCNEDEP",199,0)
 .. ;
"RTN","IBCNEDEP",200,0)
 .. ; IB*2.0*549 - quit if test site and not a valid test case
"RTN","IBCNEDEP",201,0)
 .. Q:'$$XMITOK^IBCNETST(IEN)
"RTN","IBCNEDEP",202,0)
 .. ; Update count for periodic check
"RTN","IBCNEDEP",203,0)
 .. S IBCNETOT=IBCNETOT+1
"RTN","IBCNEDEP",204,0)
 .. ; Check for request to stop background job, periodically
"RTN","IBCNEDEP",205,0)
 .. I $D(ZTQUEUED),IBCNETOT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 Q
"RTN","IBCNEDEP",206,0)
 .. ;
"RTN","IBCNEDEP",207,0)
 .. D PROC I PID="" Q
"RTN","IBCNEDEP",208,0)
 .. ;
"RTN","IBCNEDEP",209,0)
 .. I BNDL S HLP("CONTPTR")=$G(OMSGID)
"RTN","IBCNEDEP",210,0)
 .. D GENERATE^HLMA(IBCNHLP,"GM",1,.HLRESLT,"",.HLP)
"RTN","IBCNEDEP",211,0)
 .. K ^TMP("HLS",$J),HLP
"RTN","IBCNEDEP",212,0)
 .. ;
"RTN","IBCNEDEP",213,0)
 .. ;  If not successful
"RTN","IBCNEDEP",214,0)
 .. I $P(HLRESLT,U,2)]"" D HLER^IBCNEDEQ Q
"RTN","IBCNEDEP",215,0)
 .. ;  If successful
"RTN","IBCNEDEP",216,0)
 .. ; increment counter and quit if reached IBMAXCNT IB*533
"RTN","IBCNEDEP",217,0)
 .. S IBSENT=IBSENT+1
"RTN","IBCNEDEP",218,0)
 .. I IBMAXCNT'="",IBSENT+1>IBMAXCNT S IBSTOP=1
"RTN","IBCNEDEP",219,0)
 .. D SCC^IBCNEDEQ
"RTN","IBCNEDEP",220,0)
 .. I BNDL D
"RTN","IBCNEDEP",221,0)
 ... I CNT=1 S OMSGID=MSGID
"RTN","IBCNEDEP",222,0)
 ;
"RTN","IBCNEDEP",223,0)
 K HL,IN1,GT1,PID,DFN,^TMP($J,"HLS")
"RTN","IBCNEDEP",224,0)
 Q
"RTN","IBCNEDEP",225,0)
 ;
"RTN","IBCNEDEP",226,0)
ID ;  Send Identification Msgs
"RTN","IBCNEDEP",227,0)
 ;
"RTN","IBCNEDEP",228,0)
 ;  Initialize the HL7 variables based on the HL7 protocol
"RTN","IBCNEDEP",229,0)
 S IBCNHLP="IBCNE EIV RQP OUT"
"RTN","IBCNEDEP",230,0)
 D INIT^IBCNEHLO
"RTN","IBCNEDEP",231,0)
 ;
"RTN","IBCNEDEP",232,0)
 S DFN=""
"RTN","IBCNEDEP",233,0)
 F  S DFN=$O(^TMP("IBQUERY",$J,VNUM,DFN)) Q:DFN=""  D  Q:$G(ZTSTOP)!QFL
"RTN","IBCNEDEP",234,0)
 . ; Update count for periodic check
"RTN","IBCNEDEP",235,0)
 . S IBCNETOT=IBCNETOT+1
"RTN","IBCNEDEP",236,0)
 . ; Check for request to stop background job, periodically
"RTN","IBCNEDEP",237,0)
 . I $D(ZTQUEUED),IBCNETOT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 Q
"RTN","IBCNEDEP",238,0)
 . ;
"RTN","IBCNEDEP",239,0)
 . S TOT=0,IEN="",CNT=0,OMSGID="",QFL=0
"RTN","IBCNEDEP",240,0)
 . ;
"RTN","IBCNEDEP",241,0)
 . ;  Get the total # of identification msgs for a patient
"RTN","IBCNEDEP",242,0)
 . F  S IEN=$O(^TMP("IBQUERY",$J,VNUM,DFN,IEN)) Q:IEN=""  S TOT=TOT+1
"RTN","IBCNEDEP",243,0)
 . ;
"RTN","IBCNEDEP",244,0)
 . ;  For each identification transaction generate an HL7 msg
"RTN","IBCNEDEP",245,0)
 . F  S IEN=$O(^TMP("IBQUERY",$J,VNUM,DFN,IEN)) Q:IEN=""  D
"RTN","IBCNEDEP",246,0)
 .. ;IB*2.0*621 - quit if test site and not a valid test case
"RTN","IBCNEDEP",247,0)
 .. Q:'$$XMITOK^IBCNETST(IEN)
"RTN","IBCNEDEP",248,0)
 .. ;
"RTN","IBCNEDEP",249,0)
 .. D PROC
"RTN","IBCNEDEP",250,0)
 .. ;
"RTN","IBCNEDEP",251,0)
 .. ;I VNUM=4 S HLP("CONTPTR")=$G(OMSGID) ; IB*621 - HAN
"RTN","IBCNEDEP",252,0)
 .. D GENERATE^HLMA(IBCNHLP,"GM",1,.HLRESLT,"",.HLP)
"RTN","IBCNEDEP",253,0)
 .. K ^TMP("HLS",$J),HLP
"RTN","IBCNEDEP",254,0)
 .. ;
"RTN","IBCNEDEP",255,0)
 .. ;  If not successful
"RTN","IBCNEDEP",256,0)
 .. I $P(HLRESLT,U,2)]"" D HLER^IBCNEDEQ Q
"RTN","IBCNEDEP",257,0)
 .. ;
"RTN","IBCNEDEP",258,0)
 .. ;  If successful
"RTN","IBCNEDEP",259,0)
 .. D SCC^IBCNEDEQ
"RTN","IBCNEDEP",260,0)
 .. ; IB*621 - HAN Set DATE LAST EICD RUN
"RTN","IBCNEDEP",261,0)
 .. S DA=DFN,DIE="^DPT(",DR="2001///"_DT
"RTN","IBCNEDEP",262,0)
 .. D ^DIE
"RTN","IBCNEDEP",263,0)
 ;
"RTN","IBCNEDEP",264,0)
 Q
"RTN","IBCNEDEP",265,0)
 ;
"RTN","IBCNEDEP",266,0)
PROC ;  Process TQ record
"RTN","IBCNEDEP",267,0)
 S TRANSR=$G(^IBCN(365.1,IEN,0))
"RTN","IBCNEDEP",268,0)
 S DFN=$P(TRANSR,U,2),PAYR=$P(TRANSR,U,3),BUFF=$P(TRANSR,U,5)
"RTN","IBCNEDEP",269,0)
 S QUERY=$P(TRANSR,U,11),EXT=$P(TRANSR,U,10),SRVDT=$P(TRANSR,U,12)
"RTN","IBCNEDEP",270,0)
 S IRIEN=$P(TRANSR,U,13),HCT=0,NTRAN=$P(TRANSR,U,7),NRETR=$P(TRANSR,U,8)
"RTN","IBCNEDEP",271,0)
 S SUBID=$P(TRANSR,U,16),OVRIDE=$P(TRANSR,U,14),STA=$P(TRANSR,U,4)
"RTN","IBCNEDEP",272,0)
 S FRDT=$P(TRANSR,U,17),PATID=$P(TRANSR,U,19),EICDVIEN=$P(TRANSR,U,21)
"RTN","IBCNEDEP",273,0)
 ;
"RTN","IBCNEDEP",274,0)
 ;  Build the HL7 msg
"RTN","IBCNEDEP",275,0)
 S HCT=HCT+1,^TMP("HLS",$J,HCT)="PRD|NA"
"RTN","IBCNEDEP",276,0)
 D PID^IBCNEHLQ I PID=""!(PID?."*") Q
"RTN","IBCNEDEP",277,0)
 S HCT=HCT+1,^TMP("HLS",$J,HCT)=$TR(PID,"*","")
"RTN","IBCNEDEP",278,0)
 D GT1^IBCNEHLQ I GT1'="",GT1'?."*" S HCT=HCT+1,^TMP("HLS",$J,HCT)=$TR(GT1,"*","")
"RTN","IBCNEDEP",279,0)
 D IN1^IBCNEHLQ I IN1'="",IN1'?."*" D
"RTN","IBCNEDEP",280,0)
 . S HCT=HCT+1
"RTN","IBCNEDEP",281,0)
 . I VNUM=1 S ^TMP("HLS",$J,HCT)=$TR(IN1,"*","") Q
"RTN","IBCNEDEP",282,0)
 . I VNUM=2,'BNDL S ^TMP("HLS",$J,HCT)=$TR(IN1,"*","") Q
"RTN","IBCNEDEP",283,0)
 . S CNT=CNT+1 I TOT=0 S TOT=1
"RTN","IBCNEDEP",284,0)
 . S $P(IN1,HLFS,22)=TOT,$P(IN1,HLFS,21)=CNT
"RTN","IBCNEDEP",285,0)
 . S ^TMP("HLS",$J,HCT)=$TR(IN1,"*","")
"RTN","IBCNEDEP",286,0)
 ;
"RTN","IBCNEDEP",287,0)
 ;  Build multi-field NTE segment
"RTN","IBCNEDEP",288,0)
 D NTE^IBCNEHLQ(1)
"RTN","IBCNEDEP",289,0)
 ;  If build successful
"RTN","IBCNEDEP",290,0)
 I NTE'="",$E(NTE,1)'="*" S HCT=HCT+1,^TMP("HLS",$J,HCT)=$TR(NTE,"*","")
"RTN","IBCNEDEP",291,0)
 ; IB*2.0*601 - Added NTE 2 & 3
"RTN","IBCNEDEP",292,0)
 D NTE^IBCNEHLQ(2)
"RTN","IBCNEDEP",293,0)
 ; If build successful Second NTE segment
"RTN","IBCNEDEP",294,0)
 I NTE'="",$E(NTE,1)'="*" S HCT=HCT+1,^TMP("HLS",$J,HCT)=$TR(NTE,"*","")
"RTN","IBCNEDEP",295,0)
 D NTE^IBCNEHLQ(3)
"RTN","IBCNEDEP",296,0)
 ; set the third NTE segment
"RTN","IBCNEDEP",297,0)
 I NTE'="",$E(NTE,1)'="*" S HCT=HCT+1,^TMP("HLS",$J,HCT)=$TR(NTE,"*","")
"RTN","IBCNEDEP",298,0)
 ; IB*601 - End HAN
"RTN","IBCNEDEP",299,0)
 ; IB*2.0*621
"RTN","IBCNEDEP",300,0)
 D NTE^IBCNEHLQ(4)
"RTN","IBCNEDEP",301,0)
 ; set the fourth NTE segment
"RTN","IBCNEDEP",302,0)
 S HCT=HCT+1,^TMP("HLS",$J,HCT)=$TR(NTE,"*","")
"RTN","IBCNEDEP",303,0)
 D NTE^IBCNEHLQ(5)
"RTN","IBCNEDEP",304,0)
 ; set the fifth NTE segment
"RTN","IBCNEDEP",305,0)
 S HCT=HCT+1,^TMP("HLS",$J,HCT)=$TR(NTE,"*","")
"RTN","IBCNEDEP",306,0)
 ; IB*621 - End HAN
"RTN","IBCNEDEP",307,0)
 K NTE
"RTN","IBCNEDEP",308,0)
 Q
"RTN","IBCNEDEP",309,0)
 ;
"RTN","IBCNEDEP",310,0)
 ; The tag HLD was found at the top of this routine.  It was moved
"RTN","IBCNEDEP",311,0)
 ; to its own procedure because it isn't needed anymore at this time.
"RTN","IBCNEDEP",312,0)
 ; Responses will not have the status of HOLD starting with patch IB*2.0*506.
"RTN","IBCNEDEP",313,0)
 ; If HOLD is reinstated, then the logic below must be rewritten for the
"RTN","IBCNEDEP",314,0)
 ; appropriate retry logic at that time.
"RTN","IBCNEDEP",315,0)
HLD ;  Go through the 'Hold' statuses, see if ready to be 'retried'
"RTN","IBCNEDEP",316,0)
 Q  ; Quit added as safety valve
"RTN","IBCNEDEP",317,0)
 ;S IEN=""
"RTN","IBCNEDEP",318,0)
 ;F  S IEN=$O(^IBCN(365.1,"AC",4,IEN)) Q:IEN=""  D  Q:$G(ZTSTOP)
"RTN","IBCNEDEP",319,0)
 ;. ; Update count for periodic check
"RTN","IBCNEDEP",320,0)
 ;. S IBCNETOT=IBCNETOT+1
"RTN","IBCNEDEP",321,0)
 ;. ; Check for request to stop background job, periodically
"RTN","IBCNEDEP",322,0)
 ;. I $D(ZTQUEUED),IBCNETOT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 Q
"RTN","IBCNEDEP",323,0)
 ;. ;
"RTN","IBCNEDEP",324,0)
 ;. S FUTDT=$P($G(^IBCN(365.1,IEN,0)),U,9)
"RTN","IBCNEDEP",325,0)
 ;. ;
"RTN","IBCNEDEP",326,0)
 ;. ;  If the future date is today, set status to 'Retry',
"RTN","IBCNEDEP",327,0)
 ;. ;  DON'T clear future transmission date. (Need date to see if this is the first
"RTN","IBCNEDEP",328,0)
 ;. ;  time that the payer asked us to resubmit this inquiry.)
"RTN","IBCNEDEP",329,0)
 ;. I FUTDT'>DT D SST^IBCNEUT2(IEN,6) ;D
"RTN","IBCNEDEP",330,0)
 ;. ;. NEW DA,DIE,DR
"RTN","IBCNEDEP",331,0)
 ;. ;. S DA=IEN,DIE="^IBCN(365.1,",DR=".09///@" D ^DIE
"RTN","IBCNEDEP",332,0)
 ;.. ;
"RTN","IBCNEDEP",333,0)
 ;.. D SST^IBCNEUT2(IEN,6)     ; set TQ status to 'retry'
"RTN","IBCNEDEP",334,0)
 Q
"RTN","IBCNEHL1")
0^15^B191724717^B169495376
"RTN","IBCNEHL1",1,0)
IBCNEHL1 ;DAOU/ALA - HL7 Process Incoming RPI Messages ;26-JUN-2002
"RTN","IBCNEHL1",2,0)
 ;;2.0;INTEGRATED BILLING;**300,345,416,444,438,497,506,549,593,601,595,621**;21-MAR-94;Build 8
"RTN","IBCNEHL1",3,0)
 ;;Per VA Directive 6402, this routine should not be modified.
"RTN","IBCNEHL1",4,0)
 ;
"RTN","IBCNEHL1",5,0)
 ;**Program Description**
"RTN","IBCNEHL1",6,0)
 ;  This program will process incoming IIV response messages.
"RTN","IBCNEHL1",7,0)
 ;  This includes updating the record in the IIV Response File,
"RTN","IBCNEHL1",8,0)
 ;  updating the Buffer record (if there is one and creating a new
"RTN","IBCNEHL1",9,0)
 ;  one if there isn't) with the appropriate Buffer Symbol and data
"RTN","IBCNEHL1",10,0)
 ;
"RTN","IBCNEHL1",11,0)
 ;  Variables
"RTN","IBCNEHL1",12,0)
 ;    ACK       - Acknowledgment (AA=Accepted, AE=Error)
"RTN","IBCNEHL1",13,0)
 ;    ERACT     - Error Action
"RTN","IBCNEHL1",14,0)
 ;    ERCON     - Error Condition
"RTN","IBCNEHL1",15,0)
 ;    ERFLG     - Error quit flag
"RTN","IBCNEHL1",16,0)
 ;    ERTXT     - Error Message Text
"RTN","IBCNEHL1",17,0)
 ;    HL        - Array of HL7 variables
"RTN","IBCNEHL1",18,0)
 ;    IBSEG     - Optional, array of fields in segment
"RTN","IBCNEHL1",19,0)
 ;    IIVSTAT   - EC generated flag interpreting status of response
"RTN","IBCNEHL1",20,0)
 ;                 1 = + (auto-update requirement)
"RTN","IBCNEHL1",21,0)
 ;                 6 = -
"RTN","IBCNEHL1",22,0)
 ;                 V = #
"RTN","IBCNEHL1",23,0)
 ;                 MBI% = %   ; will not receive from FSC, derived in FIL^IBCNEHL6
"RTN","IBCNEHL1",24,0)
 ;                 MBI# = #   ; will not receive from FSC, derived in FIL^IBCNEHL6
"RTN","IBCNEHL1",25,0)
 ;    MAP       - Array that maps EC's IIV status flag to IIV STATUS TABLE (#365.15)   IEN
"RTN","IBCNEHL1",26,0)
 ;    MSGID     - Original Message Control ID
"RTN","IBCNEHL1",27,0)
 ;    RIEN      - Response Record IEN
"RTN","IBCNEHL1",28,0)
 ;    SEG       - HL7 Segment Name
"RTN","IBCNEHL1",29,0)
 ;
"RTN","IBCNEHL1",30,0)
 ;IB*2.0*621/TAZ - Added to insure that routine is called via entry point EN with the event type.
"RTN","IBCNEHL1",31,0)
 Q  ;No direct entry to routine.  Call label EN with parameter
"RTN","IBCNEHL1",32,0)
 ;
"RTN","IBCNEHL1",33,0)
 ;IB*2.0*621/TAZ - Added EVENTYP to control type of event processing.
"RTN","IBCNEHL1",34,0)
EN(EVENTYP) ; Entry Point
"RTN","IBCNEHL1",35,0)
 ;EVENTYP=1 >  EICD Identification Response (RPI^IO4)
"RTN","IBCNEHL1",36,0)
 ;EVENTYP=2 >  Normal 271 Response (RPI^IO1) 
"RTN","IBCNEHL1",37,0)
 N ACK,AUTO,EBDA,ERACT,ERCON,ERFLG,ERROR,ERTXT,G2OFLG,HCT,HLCMP,HLREP,HLSCMP,IBTRACK
"RTN","IBCNEHL1",38,0)
 N IIVSTAT,IRIEN,MAP,MGRP,RIEN,RSUPDT,SEG,SUBID,TRACE,TRKIEN,UP
"RTN","IBCNEHL1",39,0)
 S (ERFLG,G2OFLG)=0,MGRP=$$MGRP^IBCNEUT5(),HCT=1,SUBID="",IIVSTAT=""
"RTN","IBCNEHL1",40,0)
 ;
"RTN","IBCNEHL1",41,0)
 S HLCMP=$E(HL("ECH")) ; HL7 component separator
"RTN","IBCNEHL1",42,0)
 S HLSCMP=$E(HL("ECH"),4) ; HL7 subcomponent separator
"RTN","IBCNEHL1",43,0)
 S HLREP=$E(HL("ECH"),2) ; HL7 repetition separator
"RTN","IBCNEHL1",44,0)
 ; Create map from EC to VistA
"RTN","IBCNEHL1",45,0)
 S MAP(1)=8,MAP(6)=9,MAP("V")=21   ; These are X12 codes mapped from EC to VistA
"RTN","IBCNEHL1",46,0)
 S MAP("MBI%")=26,MAP("MBI#")=27   ; These are NOT X12 codes from FSC - we derive them only for MBI responses
"RTN","IBCNEHL1",47,0)
 ;
"RTN","IBCNEHL1",48,0)
 ;  Loop through the message and find each segment for processing
"RTN","IBCNEHL1",49,0)
 F  S HCT=$O(^TMP($J,"IBCNEHLI",HCT)) Q:HCT=""  D  Q:ERFLG
"RTN","IBCNEHL1",50,0)
 .D SPAR^IBCNEHLU
"RTN","IBCNEHL1",51,0)
 .S SEG=$G(IBSEG(1))
"RTN","IBCNEHL1",52,0)
 .; check if we are inside G2O group of segments
"RTN","IBCNEHL1",53,0)
 .I SEG="ZTY" S G2OFLG=1
"RTN","IBCNEHL1",54,0)
 .I G2OFLG,SEG'="ZTY",SEG'="CTD" S G2OFLG=0
"RTN","IBCNEHL1",55,0)
 .; If we are outside of Z_Benefit_group, kill EB multiple ien
"RTN","IBCNEHL1",56,0)
 .; I +$G(EBDA),".MSH.MSA.PRD.PID.GT1.IN1.IN3."[("."_SEG_".")!('G2OFLG&(SEG="CTD")) K EBDA
"RTN","IBCNEHL1",57,0)
 .;
"RTN","IBCNEHL1",58,0)
 .Q:SEG="PRD"  ; IB*2*497  PRD segment is not processed
"RTN","IBCNEHL1",59,0)
 .;
"RTN","IBCNEHL1",60,0)
 .I SEG="MSA" D MSA^IBCNEHL2(.ERACT,.ERCON,.ERROR,.ERTXT,.IBSEG,MGRP,.RIEN,.TRACE,EVENTYP) Q
"RTN","IBCNEHL1",61,0)
 .;
"RTN","IBCNEHL1",62,0)
 .;  Contact Segment
"RTN","IBCNEHL1",63,0)
 .I SEG="CTD",'G2OFLG D CTD^IBCNEHL2(.ERROR,.IBSEG,RIEN) Q
"RTN","IBCNEHL1",64,0)
 .;
"RTN","IBCNEHL1",65,0)
 .;  Patient Segment
"RTN","IBCNEHL1",66,0)
 .I SEG="PID" D PID^IBCNEHL2(.ERFLG,.ERROR,.IBSEG,RIEN) Q
"RTN","IBCNEHL1",67,0)
 .;
"RTN","IBCNEHL1",68,0)
 .;  Guarantor Segment
"RTN","IBCNEHL1",69,0)
 .;IB*2.0*621/TAZ Pass EVENTYP along
"RTN","IBCNEHL1",70,0)
 .I SEG="GT1" D GT1^IBCNEHL2(.ERROR,.IBSEG,RIEN,.SUBID,EVENTYP) Q
"RTN","IBCNEHL1",71,0)
 .;
"RTN","IBCNEHL1",72,0)
 .;  Insurance Segment
"RTN","IBCNEHL1",73,0)
 .;IB*2.0*621/TAZ Pass EVENTYP along
"RTN","IBCNEHL1",74,0)
 .I SEG="IN1" D IN1^IBCNEHL2(.ERROR,.IBSEG,RIEN,SUBID,EVENTYP) Q
"RTN","IBCNEHL1",75,0)
 .;
"RTN","IBCNEHL1",76,0)
 .;  Addt'l Insurance Segment
"RTN","IBCNEHL1",77,0)
 .;I SEG="IN2" ; for future expansion, add IN2 tag to IBCNEHL2
"RTN","IBCNEHL1",78,0)
 .;
"RTN","IBCNEHL1",79,0)
 .;  Addt'l Insurance - Cert Segment
"RTN","IBCNEHL1",80,0)
 .I SEG="IN3" D IN3^IBCNEHL2(.ERROR,.IBSEG,RIEN) Q 
"RTN","IBCNEHL1",81,0)
 .;
"RTN","IBCNEHL1",82,0)
 .; IB*2*497 GROUP LEVEL REFERENCE ID segment (x12 loops 2100C and 2100D)
"RTN","IBCNEHL1",83,0)
 . I SEG="ZRF",'$D(EBDA) D GZRF^IBCNEHL5(.ERROR,.IBSEG,RIEN) Q
"RTN","IBCNEHL1",84,0)
 .;
"RTN","IBCNEHL1",85,0)
 .;  Eligibility/Benefit Segment
"RTN","IBCNEHL1",86,0)
 .I SEG="ZEB" D ZEB^IBCNEHL2(.EBDA,.ERROR,.IBSEG,RIEN) Q
"RTN","IBCNEHL1",87,0)
 .;
"RTN","IBCNEHL1",88,0)
 .; Healthcare Delivery Segment
"RTN","IBCNEHL1",89,0)
 .I SEG="ZHS" D ZHS^IBCNEHL4(EBDA,.ERROR,.IBSEG,RIEN) Q
"RTN","IBCNEHL1",90,0)
 .;
"RTN","IBCNEHL1",91,0)
 .; Benefit level Reference ID Segment  (X12 loops 2110C and 2110D)
"RTN","IBCNEHL1",92,0)
 .I SEG="ZRF",+$G(EBDA) D ZRF^IBCNEHL4(EBDA,.ERROR,.IBSEG,RIEN) Q  ;IB*2*497 add check to make sure z benefit group
"RTN","IBCNEHL1",93,0)
 .;
"RTN","IBCNEHL1",94,0)
 .; Subscriber Date Segment
"RTN","IBCNEHL1",95,0)
 .I SEG="ZSD" D ZSD^IBCNEHL4(EBDA,.ERROR,.IBSEG,RIEN) Q
"RTN","IBCNEHL1",96,0)
 .;
"RTN","IBCNEHL1",97,0)
 .; Subscriber Additional Info Segment
"RTN","IBCNEHL1",98,0)
 .I SEG="ZII" D ZII^IBCNEHL4(EBDA,.ERROR,.IBSEG,RIEN) Q
"RTN","IBCNEHL1",99,0)
 .;
"RTN","IBCNEHL1",100,0)
 .; Benefit Related Entity Segment
"RTN","IBCNEHL1",101,0)
 .I SEG="ZTY" D ZTY^IBCNEHL4(EBDA,.ERROR,.IBSEG,RIEN) Q
"RTN","IBCNEHL1",102,0)
 .;
"RTN","IBCNEHL1",103,0)
 .; Benefit Related Entity Contact Segment
"RTN","IBCNEHL1",104,0)
 .I SEG="CTD",G2OFLG D G2OCTD^IBCNEHL4(EBDA,.ERROR,.IBSEG,RIEN) Q
"RTN","IBCNEHL1",105,0)
 .;
"RTN","IBCNEHL1",106,0)
 .; Benefit Related Entity Notes Segment
"RTN","IBCNEHL1",107,0)
 .I SEG="NTE",+$G(EBDA) D EBNTE^IBCNEHL2(EBDA,.IBSEG,RIEN) Q
"RTN","IBCNEHL1",108,0)
 .;
"RTN","IBCNEHL1",109,0)
 .; Reject Reasons Segment
"RTN","IBCNEHL1",110,0)
 .I SEG="ERR" K ERDA D ERR^IBCNEHL4(.ERDA,.ERROR,.IBSEG,RIEN) Q
"RTN","IBCNEHL1",111,0)
 .;
"RTN","IBCNEHL1",112,0)
 .; Notes Segment
"RTN","IBCNEHL1",113,0)
 .I SEG="NTE",'$D(EBDA),+$G(ERDA) D NTE^IBCNEHL4(ERDA,.ERROR,.IBSEG,RIEN) Q
"RTN","IBCNEHL1",114,0)
 .;
"RTN","IBCNEHL1",115,0)
 .; Subscriber date segment (subscriber level)
"RTN","IBCNEHL1",116,0)
 .I SEG="ZTP" D ZTP^IBCNEHL4(.ERROR,.IBSEG,RIEN) Q
"RTN","IBCNEHL1",117,0)
 . ; ib*2*497  -  add processing for ROL, DG1, and ZMP segments
"RTN","IBCNEHL1",118,0)
 . ; Provider Code segment 
"RTN","IBCNEHL1",119,0)
 . I SEG="ROL" D ROL^IBCNEHL5(.ERROR,.IBSEG,RIEN) Q
"RTN","IBCNEHL1",120,0)
 . ;
"RTN","IBCNEHL1",121,0)
 . ; Health Care Diagnosis Code segment
"RTN","IBCNEHL1",122,0)
 . I SEG="DG1" D DG1^IBCNEHL5(.ERROR,.IBSEG,RIEN) Q
"RTN","IBCNEHL1",123,0)
 .;
"RTN","IBCNEHL1",124,0)
 .; Military Personnel Information segment
"RTN","IBCNEHL1",125,0)
 . I SEG="ZMP" D ZMP^IBCNEHL5(.ERROR,.IBSEG,RIEN)
"RTN","IBCNEHL1",126,0)
 ;
"RTN","IBCNEHL1",127,0)
 ;IB*2.0*621/TAZ - File EICD Identification Response
"RTN","IBCNEHL1",128,0)
 I EVENTYP=1 S TRKIEN=$$SVEICD^IBCNEHL7()
"RTN","IBCNEHL1",129,0)
 ;IB*2.0*621/TAZ - Update EIV EICD TRACKING FILE for EICD verification Response 
"RTN","IBCNEHL1",130,0)
 I EVENTYP=2 D
"RTN","IBCNEHL1",131,0)
 . N D0,D1,FDA,IENS,TQN,EXT
"RTN","IBCNEHL1",132,0)
 . S TQN=$$GET1^DIQ(365,RIEN_",",.05,"I")
"RTN","IBCNEHL1",133,0)
 . S EXT=$$GET1^DIQ(365.1,TQN_",",.1,"I")
"RTN","IBCNEHL1",134,0)
 . I EXT'=4 Q
"RTN","IBCNEHL1",135,0)
 . S D0=$O(^IBCN(365.18,"C",TQN,"")) Q:'D0  S D1=$O(^IBCN(365.18,"C",TQN,D0,"")) Q:'D1
"RTN","IBCNEHL1",136,0)
 . S IENS=D1_","_D0_","
"RTN","IBCNEHL1",137,0)
 . S FDA(365.185,IENS,1.03)=RIEN
"RTN","IBCNEHL1",138,0)
 . I ERACT'=""!(ERTXT'="") S FDA(365.185,IENS,1.04)=0  ;Error response
"RTN","IBCNEHL1",139,0)
 . I IIVSTAT=1 S FDA(365.185,IENS,1.04)=1  ;Active
"RTN","IBCNEHL1",140,0)
 . I IIVSTAT=6 S FDA(365.185,IENS,1.04)=2  ;Inactive
"RTN","IBCNEHL1",141,0)
 . I IIVSTAT="V" S FDA(365.185,IENS,1.04)=3  ;Ambiguous
"RTN","IBCNEHL1",142,0)
 . D FILE^DIE("","FDA"),CLEAN^DILF
"RTN","IBCNEHL1",143,0)
 ;
"RTN","IBCNEHL1",144,0)
 S AUTO=$$AUTOUPD(RIEN)
"RTN","IBCNEHL1",145,0)
 I $G(ACK)'="AE",$G(ERACT)="",$G(ERTXT)="",'$D(ERROR),+AUTO D  Q
"RTN","IBCNEHL1",146,0)
 .D:$P(AUTO,U,3)'="" AUTOFIL($P(AUTO,U,2),$P(AUTO,U,3),$P(AUTO,U,6))
"RTN","IBCNEHL1",147,0)
 .D:$P(AUTO,U,4)'="" AUTOFIL($P(AUTO,U,2),$P(AUTO,U,4),$P(AUTO,U,6))
"RTN","IBCNEHL1",148,0)
 .Q
"RTN","IBCNEHL1",149,0)
 D FIL
"RTN","IBCNEHL1",150,0)
 ;
"RTN","IBCNEHL1",151,0)
ENX ;
"RTN","IBCNEHL1",152,0)
 Q
"RTN","IBCNEHL1",153,0)
 ;
"RTN","IBCNEHL1",154,0)
 ; =================================================================
"RTN","IBCNEHL1",155,0)
AUTOFIL(DFN,IEN312,ISSUB) ; Finish processing the response message - file directly into patient insurance
"RTN","IBCNEHL1",156,0)
 ;
"RTN","IBCNEHL1",157,0)
 N BUFF,DATA,ERROR,IENS,MIL,OKAY,PREL,RDATA0,RDATA1,RDATA5,RDATA13,RSTYPE,TQN,TSTAMP,XX   ; IB*2.0*497 (vd)
"RTN","IBCNEHL1",158,0)
 ;
"RTN","IBCNEHL1",159,0)
 Q:$G(RIEN)=""
"RTN","IBCNEHL1",160,0)
 S TSTAMP=$$NOW^XLFDT(),IENS=IEN312_","_DFN_","
"RTN","IBCNEHL1",161,0)
 S RDATA0=$G(^IBCN(365,RIEN,0)),RDATA1=$G(^IBCN(365,RIEN,1)),RDATA5=$G(^IBCN(365,RIEN,5))
"RTN","IBCNEHL1",162,0)
 S RDATA13=$G(^IBCN(365,RIEN,13))         ; IB*2.0*497 (vd)
"RTN","IBCNEHL1",163,0)
 S TQN=$P(RDATA0,U,5),RSTYPE=$P(RDATA0,U,10)
"RTN","IBCNEHL1",164,0)
 ;\Beginning IB*2.0*549 - Modified the following lines
"RTN","IBCNEHL1",165,0)
 S XX=$$GET1^DIQ(2.312,IENS,7.01,"I")
"RTN","IBCNEHL1",166,0)
 I ISSUB,XX="" S DATA(2.312,IENS,7.01)=$P(RDATA13,U)    ; Name
"RTN","IBCNEHL1",167,0)
 S XX=$$GET1^DIQ(2.312,IENS,3.01,"I")
"RTN","IBCNEHL1",168,0)
 I XX="" S DATA(2.312,IENS,3.01)=$P(RDATA1,U,2)         ; DOB
"RTN","IBCNEHL1",169,0)
 S XX=$$GET1^DIQ(2.312,IENS,3.05,"I")
"RTN","IBCNEHL1",170,0)
 I XX="" S DATA(2.312,IENS,3.05)=$P(RDATA1,U,3)         ; SSN
"RTN","IBCNEHL1",171,0)
 S XX=$$GET1^DIQ(2.312,IENS,6,"I")
"RTN","IBCNEHL1",172,0)
 I ISSUB,XX="" S DATA(2.312,IENS,6)=$P(RDATA1,U,8)      ; Whose insurance
"RTN","IBCNEHL1",173,0)
 ; pt. relationship (365,8.01) IB*2*497 code from 365,8.01 needs evaluation and possible conversion
"RTN","IBCNEHL1",174,0)
 S PREL=$$GET1^DIQ(365,RIEN,8.01)
"RTN","IBCNEHL1",175,0)
 S XX=$$GET1^DIQ(2.312,IENS,4.03,"I")
"RTN","IBCNEHL1",176,0)
 I ISSUB,XX="",PREL'="" D
"RTN","IBCNEHL1",177,0)
 . S DATA(2.312,IENS,4.03)=$$PREL^IBCNEHLU(2.312,4.03,PREL)
"RTN","IBCNEHL1",178,0)
 ;\End of IB*2.0*549 changes.
"RTN","IBCNEHL1",179,0)
 ; IB*2*595/DM moved the following 4 lines below 
"RTN","IBCNEHL1",180,0)
 ;S DATA(2.312,IENS,1.03)=TSTAMP                         ; Date last verified
"RTN","IBCNEHL1",181,0)
 ;S DATA(2.312,IENS,1.04)=""                            ; Last verified by
"RTN","IBCNEHL1",182,0)
 ;S DATA(2.312,IENS,1.05)=TSTAMP                         ; Date last edited
"RTN","IBCNEHL1",183,0)
 ;S DATA(2.312,IENS,1.06)=""                            ; Last edited by
"RTN","IBCNEHL1",184,0)
 ;S DATA(2.312,IENS,1.09)=5 ; Source of info = eIV
"RTN","IBCNEHL1",185,0)
 ;IB*2.0*595/DM persist the original Source of Information
"RTN","IBCNEHL1",186,0)
 ;note: external values are used to populate DATA
"RTN","IBCNEHL1",187,0)
 I $$GET1^DIQ(2.312,IENS,1.09,"I")="" D
"RTN","IBCNEHL1",188,0)
 . S XX=$$GET1^DIQ(365.1,TQN_",1,",3.02)
"RTN","IBCNEHL1",189,0)
 . I XX="" S XX="eIV"
"RTN","IBCNEHL1",190,0)
 . S DATA(2.312,IENS,1.09)=XX
"RTN","IBCNEHL1",191,0)
 ;
"RTN","IBCNEHL1",192,0)
 ; Set Subscriber address Fields if none of the fields are currently defined
"RTN","IBCNEHL1",193,0)
 ;\Beginning IB*2.0*549 - Modified the following lines
"RTN","IBCNEHL1",194,0)
 S XX=$$GET1^DIQ(2.312,IENS,3.06,"I")       ; Current Ins Street Line 1
"RTN","IBCNEHL1",195,0)
 I XX="" D
"RTN","IBCNEHL1",196,0)
 . S XX=$$GET1^DIQ(2.312,IENS,3.07,"I")     ; Current Ins Street Line 2
"RTN","IBCNEHL1",197,0)
 . Q:XX'=""
"RTN","IBCNEHL1",198,0)
 . S XX=$$GET1^DIQ(2.312,IENS,3.08,"I")     ; Current Ins City
"RTN","IBCNEHL1",199,0)
 . Q:XX'=""
"RTN","IBCNEHL1",200,0)
 . S XX=$$GET1^DIQ(2.312,IENS,3.09,"I")     ; Current Ins State
"RTN","IBCNEHL1",201,0)
 . Q:XX'=""
"RTN","IBCNEHL1",202,0)
 . S XX=$$GET1^DIQ(2.312,IENS,3.1,"I")      ; Current Ins Zip
"RTN","IBCNEHL1",203,0)
 . Q:XX'=""
"RTN","IBCNEHL1",204,0)
 . S XX=$$GET1^DIQ(2.312,IENS,3.13,"I")     ; Current Ins Country
"RTN","IBCNEHL1",205,0)
 . Q:XX'=""
"RTN","IBCNEHL1",206,0)
 . S XX=$$GET1^DIQ(2.312,IENS,3.14,"I")     ; Current Ins Country Subdivision
"RTN","IBCNEHL1",207,0)
 . Q:XX'=""
"RTN","IBCNEHL1",208,0)
 . S DATA(2.312,IENS,3.06)=$P(RDATA5,U)     ; Street line 1
"RTN","IBCNEHL1",209,0)
 . S DATA(2.312,IENS,3.07)=$P(RDATA5,U,2)   ; Street line 2
"RTN","IBCNEHL1",210,0)
 . S DATA(2.312,IENS,3.08)=$P(RDATA5,U,3)   ; City
"RTN","IBCNEHL1",211,0)
 . S DATA(2.312,IENS,3.09)=$P(RDATA5,U,4)   ; State
"RTN","IBCNEHL1",212,0)
 . S DATA(2.312,IENS,3.1)=$P(RDATA5,U,5)    ; Zip
"RTN","IBCNEHL1",213,0)
 . S DATA(2.312,IENS,3.13)=$P(RDATA5,U,6)   ; Country
"RTN","IBCNEHL1",214,0)
 . S DATA(2.312,IENS,3.14)=$P(RDATA5,U,7)   ; Country subdivision
"RTN","IBCNEHL1",215,0)
 ;\End of IB*2.0*549 changes.
"RTN","IBCNEHL1",216,0)
 ;
"RTN","IBCNEHL1",217,0)
 L +^DPT(DFN,.312,IEN312):15 I '$T D LCKERR^IBCNEHL3 D FIL Q
"RTN","IBCNEHL1",218,0)
 I $D(DATA) D FILE^DIE("ET","DATA","ERROR") ;IB*2*595/DM make sure DATA has data  
"RTN","IBCNEHL1",219,0)
 I $D(ERROR) D WARN^IBCNEHL3 K ERROR D FIL G AUTOFILX
"RTN","IBCNEHL1",220,0)
 ; IB*2*595/DM set auto-update fields
"RTN","IBCNEHL1",221,0)
 ; the EIV AUTO-UPDATE flag is now located in the IIV Response file
"RTN","IBCNEHL1",222,0)
 ;set eIV auto-update field separately because of the trigger on field 1.05
"RTN","IBCNEHL1",223,0)
 ;S DATA(2.312,IENS,4.04)="YES"
"RTN","IBCNEHL1",224,0)
 K DATA
"RTN","IBCNEHL1",225,0)
 S DATA(2.312,IENS,1.03)=TSTAMP                        ; Date last verified
"RTN","IBCNEHL1",226,0)
 S DATA(2.312,IENS,1.04)="AUTOUPDATE,IBEIV"            ; Last verified by ; Edit with 595 was null
"RTN","IBCNEHL1",227,0)
 S DATA(2.312,IENS,1.05)=TSTAMP                        ; Date last edited
"RTN","IBCNEHL1",228,0)
 S DATA(2.312,IENS,1.06)="AUTOUPDATE,IBEIV"            ; Last edited by ; Edit with 595 was null
"RTN","IBCNEHL1",229,0)
 D FILE^DIE("ET","DATA","ERROR")
"RTN","IBCNEHL1",230,0)
 I $D(ERROR) D WARN^IBCNEHL3 G AUTOFILX
"RTN","IBCNEHL1",231,0)
 ; IB*2*595/DM set the insurance record IEN in the IIV Response file
"RTN","IBCNEHL1",232,0)
 ; to track which policy was updated based on the response
"RTN","IBCNEHL1",233,0)
 D UPDIREC^IBCNEHL3(RIEN,IEN312)
"RTN","IBCNEHL1",234,0)
 ; IB*2*595/DM set the EIV AUTO-UPDATE in the response file to signal auto-update
"RTN","IBCNEHL1",235,0)
 K DATA
"RTN","IBCNEHL1",236,0)
 S DATA(365,RIEN_",",.13)="YES"
"RTN","IBCNEHL1",237,0)
 D FILE^DIE("ET","DATA")
"RTN","IBCNEHL1",238,0)
 ;
"RTN","IBCNEHL1",239,0)
 S ERFLG=$$GRPFILE(DFN,IEN312,RIEN,1)
"RTN","IBCNEHL1",240,0)
 I $G(ERFLG) G AUTOFILX  ;IB*2*497  file data at 2.312, 9, 10 and 11 subfiles; if error is produced update buffer entry and then quit processing
"RTN","IBCNEHL1",241,0)
 ; file new EB data
"RTN","IBCNEHL1",242,0)
 S ERFLG=$$EBFILE(DFN,IEN312,RIEN,1)
"RTN","IBCNEHL1",243,0)
 ; bail out if something went wrong during filing of EB data
"RTN","IBCNEHL1",244,0)
 I $G(ERFLG) G AUTOFILX
"RTN","IBCNEHL1",245,0)
 ; update insurance record ien in transmission queue
"RTN","IBCNEHL1",246,0)
 D UPDIREC^IBCNEHL3(RIEN,IEN312)
"RTN","IBCNEHL1",247,0)
 ;  For an original response, set the Transmission Queue Status to 'Response Received' &
"RTN","IBCNEHL1",248,0)
 ;  update remaining retries to comm failure (5)
"RTN","IBCNEHL1",249,0)
 I $G(RSTYPE)="O" D SST^IBCNEUT2(TQN,3),RSTA^IBCNEUT7(TQN)
"RTN","IBCNEHL1",250,0)
 ; update buffer file entry so only stub remains and status is changed
"RTN","IBCNEHL1",251,0)
 S BUFF=+$P($G(^IBCN(365,RIEN,0)),U,4)
"RTN","IBCNEHL1",252,0)
 I BUFF D
"RTN","IBCNEHL1",253,0)
 .D STATUS^IBCNBEE(BUFF,"A",0,0,0) ; update buffer entry's status to accepted
"RTN","IBCNEHL1",254,0)
 .D DELDATA^IBCNBED(BUFF) ; delete buffer's insurance/patient data
"RTN","IBCNEHL1",255,0)
 .Q
"RTN","IBCNEHL1",256,0)
AUTOFILX ;
"RTN","IBCNEHL1",257,0)
 L -^DPT(DFN,.312,IEN312)
"RTN","IBCNEHL1",258,0)
 Q
"RTN","IBCNEHL1",259,0)
 ;
"RTN","IBCNEHL1",260,0)
GRPFILE(DFN,IEN312,RIEN,AFLG) ;  ib*2*497  file data at node 12 and at subfiles 2.312,9, 10 and 11
"RTN","IBCNEHL1",261,0)
 ; DFN - file 2 ien
"RTN","IBCNEHL1",262,0)
 ; IEN312 - file 2.312 ien
"RTN","IBCNEHL1",263,0)
 ; RIEN = file 365 ien
"RTN","IBCNEHL1",264,0)
 ; AFLG - 1 if called from autoupdate, 0 if called from ins. buffer process entry
"RTN","IBCNEHL1",265,0)
 ; output - returns 0 or 1
"RTN","IBCNEHL1",266,0)
 ;          0 - entry update received an error when attempting to file
"RTN","IBCNEHL1",267,0)
 ;          1 - successful update
"RTN","IBCNEHL1",268,0)
 N DA,DATA12,DIAG,DIAG3121,ERFLG,ERROR,IENS,IENS365,IENS312,NODE,PROV,PROV332,REF,REF3129,Z,Z2
"RTN","IBCNEHL1",269,0)
 ; retrieve external values of data located at node 12 of 365
"RTN","IBCNEHL1",270,0)
 S IENS=IEN312_","_DFN_","
"RTN","IBCNEHL1",271,0)
 D GETS^DIQ(365,RIEN,"12.01:12.07",,"MIL")
"RTN","IBCNEHL1",272,0)
 M DATA12(2.312,IENS)=MIL(365,RIEN_",")
"RTN","IBCNEHL1",273,0)
 D FILE^DIE("ET","DATA12","ERROR")
"RTN","IBCNEHL1",274,0)
 I $D(ERROR) D:AFLG WARN^IBCNEHL3 K ERROR
"RTN","IBCNEHL1",275,0)
 ; remove existing sub-file entries at nodes 9, 10, and 11 before update of new data
"RTN","IBCNEHL1",276,0)
 F NODE="9","10","11" D
"RTN","IBCNEHL1",277,0)
 . S DIK="^DPT("_DFN_",.312,"_IEN312_","_NODE_",",DA(2)=DFN,DA(1)=IEN312
"RTN","IBCNEHL1",278,0)
 . S DA=0 F  S DA=$O(^DPT(DFN,.312,IEN312,NODE,DA)) Q:DA=""!(DA?1.A)  D ^DIK
"RTN","IBCNEHL1",279,0)
 S IENS312="+1,"_IEN312_","_DFN_","
"RTN","IBCNEHL1",280,0)
 ; update node 9 data
"RTN","IBCNEHL1",281,0)
 S Z="" F  S Z=$O(^IBCN(365,RIEN,9,"B",Z)) Q:'Z  D
"RTN","IBCNEHL1",282,0)
 . S IENS365=$O(^IBCN(365,RIEN,9,"B",Z,""))_","_RIEN_","
"RTN","IBCNEHL1",283,0)
 . D GETS^DIQ(365.09,IENS365,"*",,"REF")
"RTN","IBCNEHL1",284,0)
 S Z2="" F  S Z2=$O(REF(365.09,Z2)) Q:Z2=""  M REF3129(2.3129,IENS312)=REF(365.09,Z2) D UPDATE^DIE("E","REF3129",,"ERROR") K REF3129 I $D(ERROR) D:AFLG WARN^IBCNEHL3 K ERROR
"RTN","IBCNEHL1",285,0)
 ; update node 10 data
"RTN","IBCNEHL1",286,0)
 S Z="" F  S Z=$O(^IBCN(365,RIEN,10,"B",Z)) Q:'Z  D
"RTN","IBCNEHL1",287,0)
 . S IENS365=$O(^IBCN(365,RIEN,10,"B",Z,""))_","_RIEN_","
"RTN","IBCNEHL1",288,0)
 . D GETS^DIQ(365.04,IENS365,"*",,"PROV")
"RTN","IBCNEHL1",289,0)
 S Z2="" F  S Z2=$O(PROV(365.04,Z2)) Q:Z2=""  M PROV332(2.332,IENS312)=PROV(365.04,Z2) D UPDATE^DIE("E","PROV332",,"ERROR") K PROV332 I $D(ERROR) D:AFLG WARN^IBCNEHL3 K ERROR
"RTN","IBCNEHL1",290,0)
 ; update node 11 data
"RTN","IBCNEHL1",291,0)
 S Z="" F  S Z=$O(^IBCN(365,RIEN,11,"B",Z)) Q:'Z  D
"RTN","IBCNEHL1",292,0)
 . S IENS365=$O(^IBCN(365,RIEN,11,"B",Z,""))_","_RIEN_","
"RTN","IBCNEHL1",293,0)
 . D GETS^DIQ(365.01,IENS365,"*",,"DIAG")
"RTN","IBCNEHL1",294,0)
 S Z2="" F  S Z2=$O(DIAG(365.01,Z2)) Q:Z2=""  M DIAG3121(2.31211,IENS312)=DIAG(365.01,Z2) D UPDATE^DIE("E","DIAG3121",,"ERROR") K DIAG3121 I $D(ERROR) D:AFLG WARN^IBCNEHL3 K ERROR
"RTN","IBCNEHL1",295,0)
GRPFILEX ;
"RTN","IBCNEHL1",296,0)
 Q $G(ERFLG)
"RTN","IBCNEHL1",297,0)
 ;
"RTN","IBCNEHL1",298,0)
FIL ; Finish processing the response message - file into insurance buffer
"RTN","IBCNEHL1",299,0)
 ; IB*2*601/DM FIL()routine moved to IBCNEHL6 to meet SAC guidelines due to size
"RTN","IBCNEHL1",300,0)
 D FIL^IBCNEHL6
"RTN","IBCNEHL1",301,0)
 Q
"RTN","IBCNEHL1",302,0)
 ;
"RTN","IBCNEHL1",303,0)
AUTOUPD(RIEN) ;
"RTN","IBCNEHL1",304,0)
 ; Returns "1^file 2 ien^file 2.312 ien^2nd file 2.312 ien^Medicare flag^subscriber flag", if entry
"RTN","IBCNEHL1",305,0)
 ; in file 365 is eligible for auto-update, returns 0 otherwise.
"RTN","IBCNEHL1",306,0)
 ;
"RTN","IBCNEHL1",307,0)
 ; Medicare flag: 1 for Medicare, 0 otherwise
"RTN","IBCNEHL1",308,0)
 ; Subscriber flag: 1 if patient is the subscriber, 0 otherwise
"RTN","IBCNEHL1",309,0)
 ;
"RTN","IBCNEHL1",310,0)
 ; For non-Medicare response: 1st file 2.312 ien is set, 2nd file 2.312 ien is empty, pieces 5-7 are empty
"RTN","IBCNEHL1",311,0)
 ; For Medicare response: 1st file 2.312 ien contains ien for Medicare Part A, 2nd file 2.312 ien contains ien for Medicare Part B,
"RTN","IBCNEHL1",312,0)
 ;                        either one may be empty, but at least one of them is set if entry is eligible.
"RTN","IBCNEHL1",313,0)
 ;
"RTN","IBCNEHL1",314,0)
 ; RIEN - ien in file 365
"RTN","IBCNEHL1",315,0)
 ;
"RTN","IBCNEHL1",316,0)
 N APPIEN,GDATA,GIEN,GNAME,GNUM,GNUM1,GOK,IEN2,IEN312,IEN36,IDATA0,IDATA3,ISSUB,MWNRA,MWNRB,MWNRIEN,MWNRTYP
"RTN","IBCNEHL1",317,0)
 N ONEPOL,PIEN,RDATA0,RDATA1,RES,TQIEN,IDATA7,RDATA13,RDATA14   ; IB*2.0*497
"RTN","IBCNEHL1",318,0)
 S RES=0
"RTN","IBCNEHL1",319,0)
 I +$G(RIEN)'>0 Q RES                       ; Invalid ien for file 365
"RTN","IBCNEHL1",320,0)
 ; IB*2.0*595/DM if entry is missing from #200, file in buffer
"RTN","IBCNEHL1",321,0)
 I '$$FIND1^DIC(200,,"M","AUTOUPDATE,IBEIV") Q RES
"RTN","IBCNEHL1",322,0)
 ;
"RTN","IBCNEHL1",323,0)
 ; IB*2.0*549 - Moved up the next 5 lines.  Originally, these lines were
"RTN","IBCNEHL1",324,0)
 ;              directly after line 'I $G(IIVSTAT)'=1 Q RES'
"RTN","IBCNEHL1",325,0)
 S RDATA0=$G(^IBCN(365,RIEN,0)),RDATA1=$G(^IBCN(365,RIEN,1))
"RTN","IBCNEHL1",326,0)
 ;
"RTN","IBCNEHL1",327,0)
 ; IB*2.0*497  longer fields for GROUP NAME, GROUP NUMBER, NAME OF INSURED, and SUBSCRIBER ID
"RTN","IBCNEHL1",328,0)
 S RDATA13=$G(^IBCN(365,RIEN,13)),RDATA14=$G(^IBCN(365,RIEN,14))
"RTN","IBCNEHL1",329,0)
 S PIEN=$P(RDATA0,U,3)
"RTN","IBCNEHL1",330,0)
 ;
"RTN","IBCNEHL1",331,0)
 ; IB*2.0*549 - Moved up the next 2 lines.  Originally, these lines were
"RTN","IBCNEHL1",332,0)
 ;              directly after 'S IEN2=$P(RDATA0,U,2) I +IEN2'>0 Q RES'
"RTN","IBCNEHL1",333,0)
 S MWNRIEN=$P($G(^IBE(350.9,1,51)),U,25),MWNRTYP=0,(MWNRA,MWNRB)=""
"RTN","IBCNEHL1",334,0)
 I PIEN=MWNRIEN S MWNRTYP=$$ISMCR^IBCNEHLU(RIEN)
"RTN","IBCNEHL1",335,0)
 ;
"RTN","IBCNEHL1",336,0)
 ; IB*2.0*549 - Added ',MWNRTYP' below to only quit for non-medicare policies
"RTN","IBCNEHL1",337,0)
 I $G(IIVSTAT)'=1,'MWNRTYP Q RES            ; Only auto-update 'active policy' responses
"RTN","IBCNEHL1",338,0)
 I +PIEN>0 S APPIEN=$$PYRAPP^IBCNEUT5("IIV",PIEN)
"RTN","IBCNEHL1",339,0)
 I +$G(APPIEN)'>0 Q RES  ; couldn't find eIV application entry
"RTN","IBCNEHL1",340,0)
 ;
"RTN","IBCNEHL1",341,0)
 ;IB*2.0*601/HN Don't allow any entry with HMS SOI to auto-update
"RTN","IBCNEHL1",342,0)
 ;IB*2.0*595/HN Don't allow any entry with Contract Services SOI to auto-update
"RTN","IBCNEHL1",343,0)
 I "^HMS^CONTRACT SERVICES^"[("^"_$$GET1^DIQ(355.33,+$$GET1^DIQ(365,RIEN_",","BUFFER ENTRY","I")_",","SOURCE OF INFORMATION")_"^") Q RES
"RTN","IBCNEHL1",344,0)
 ;
"RTN","IBCNEHL1",345,0)
 ; Check dictionary 365.1 MANUAL REQUEST DATE/TIME Flag, Quit if Set.
"RTN","IBCNEHL1",346,0)
 I $P(RDATA0,U,5)'="",$P($G(^IBCN(365.1,$P(RDATA0,U,5),3)),U,1)'="" Q RES
"RTN","IBCNEHL1",347,0)
 I $P(^IBE(365.12,PIEN,1,APPIEN,0),U,7)=0 Q RES  ; auto-accept is OFF
"RTN","IBCNEHL1",348,0)
 S IEN2=$P(RDATA0,U,2) I +IEN2'>0 Q RES  ; couldn't find patient
"RTN","IBCNEHL1",349,0)
 S ONEPOL=$$ONEPOL^IBCNEHLU(PIEN,IEN2)
"RTN","IBCNEHL1",350,0)
 ; try to find a matching pat. insurance
"RTN","IBCNEHL1",351,0)
 S IEN36="" F  S IEN36=$O(^DIC(36,"AC",PIEN,IEN36)) Q:IEN36=""!(RES>0)  D
"RTN","IBCNEHL1",352,0)
 .S IEN312="" F  S IEN312=$O(^DPT(IEN2,.312,"B",IEN36,IEN312)) Q:IEN312=""!(RES>0&('+MWNRTYP))  D
"RTN","IBCNEHL1",353,0)
 ..S IDATA0=$G(^DPT(IEN2,.312,IEN312,0)),IDATA3=$G(^DPT(IEN2,.312,IEN312,3))
"RTN","IBCNEHL1",354,0)
 ..S IDATA7=$G(^DPT(IEN2,.312,IEN312,7))   ; IB*2.0*497 (vd)
"RTN","IBCNEHL1",355,0)
 ..I $$EXPIRED^IBCNEDE2($P(IDATA0,U,4)) Q  ; Insurance policy has expired
"RTN","IBCNEHL1",356,0)
 ..S ISSUB=$$PATISSUB^IBCNEHLU(IDATA0)
"RTN","IBCNEHL1",357,0)
 ..; Patient is the subscriber
"RTN","IBCNEHL1",358,0)
 ..I ISSUB,'$$CHK1^IBCNEHL3 Q
"RTN","IBCNEHL1",359,0)
 ..; Patient is the dependent
"RTN","IBCNEHL1",360,0)
 ..I 'ISSUB,'$$CHK2^IBCNEHL3(MWNRTYP) Q
"RTN","IBCNEHL1",361,0)
 ..; check group number
"RTN","IBCNEHL1",362,0)
 ..S GNUM=$P(RDATA14,U,2),GIEN=+$P(IDATA0,U,18),GOK=1  ;IB*2*497  group number needs to be retrieved from new field
"RTN","IBCNEHL1",363,0)
 ..; check non-Medicare group number
"RTN","IBCNEHL1",364,0)
 ..I '+MWNRTYP D  Q:'GOK  ; Group number doesn't match
"RTN","IBCNEHL1",365,0)
 ...I 'ONEPOL D
"RTN","IBCNEHL1",366,0)
 ....I GIEN'>0 S GOK=0 Q
"RTN","IBCNEHL1",367,0)
 ....S GNUM1=$P($G(^IBA(355.3,GIEN,2)),U,2)    ; IB*2.0*497 (vd)
"RTN","IBCNEHL1",368,0)
 ....I GNUM=""!(GNUM1="")!(GNUM'=GNUM1) S GOK=0
"RTN","IBCNEHL1",369,0)
 ....Q
"RTN","IBCNEHL1",370,0)
 ...I ONEPOL D
"RTN","IBCNEHL1",371,0)
 ....I GNUM'="",GIEN'="" S GNUM1=$P($G(^IBA(355.3,GIEN,2)),U,2) I GNUM1'="",GNUM'=GNUM1 S GOK=0  ; IB*2.0*497 (vd)
"RTN","IBCNEHL1",372,0)
 ....Q
"RTN","IBCNEHL1",373,0)
 ...Q
"RTN","IBCNEHL1",374,0)
 ..; check for Medicare part A/B
"RTN","IBCNEHL1",375,0)
 ..I +MWNRTYP D  Q:'GOK  ; Group number doesn't match
"RTN","IBCNEHL1",376,0)
 ...I GIEN'>0 S GOK=0 Q
"RTN","IBCNEHL1",377,0)
 ...S GDATA=$G(^IBA(355.3,GIEN,0))
"RTN","IBCNEHL1",378,0)
 ...I $P(GDATA,U,14)="A" D
"RTN","IBCNEHL1",379,0)
 ....;IB*2.0*549 Change $P(MWNRTYP,U,2)="MA"!($P(MWNRTYP,U,2)="B")
"RTN","IBCNEHL1",380,0)
 ....;           To     $P(MWNRTYP,U,5)="MA"!($P(MWNRTYP,U,5)="B")
"RTN","IBCNEHL1",381,0)
 ....I $P(MWNRTYP,U,5)="MA"!($P(MWNRTYP,U,5)="B") S MWNRA=IEN312 Q
"RTN","IBCNEHL1",382,0)
 ....S GOK=0
"RTN","IBCNEHL1",383,0)
 ....Q
"RTN","IBCNEHL1",384,0)
 ...I $P(GDATA,U,14)="B" D
"RTN","IBCNEHL1",385,0)
 ....;IB*2.0*549 Change $P(MWNRTYP,U,2)="MB"!($P(MWNRTYP,U,2)="B")
"RTN","IBCNEHL1",386,0)
 ....;           To     $P(MWNRTYP,U,5)="MB"!($P(MWNRTYP,U,5)="B")
"RTN","IBCNEHL1",387,0)
 ....I $P(MWNRTYP,U,5)="MB"!($P(MWNRTYP,U,5)="B") S MWNRB=IEN312 Q
"RTN","IBCNEHL1",388,0)
 ....S GOK=0
"RTN","IBCNEHL1",389,0)
 ....Q
"RTN","IBCNEHL1",390,0)
 ...Q
"RTN","IBCNEHL1",391,0)
 ..S RES=1_U_IEN2_U_$S(+MWNRTYP:MWNRA_U_MWNRB_U_1,1:IEN312_U_U_0)
"RTN","IBCNEHL1",392,0)
 ..S $P(RES,U,6)=ISSUB
"RTN","IBCNEHL1",393,0)
 ..Q
"RTN","IBCNEHL1",394,0)
 .Q
"RTN","IBCNEHL1",395,0)
 Q RES
"RTN","IBCNEHL1",396,0)
 ;
"RTN","IBCNEHL1",397,0)
EBFILE(DFN,IEN312,RIEN,AFLG) ; File eligibility/benefit data from file 365 into file 2.312
"RTN","IBCNEHL1",398,0)
 ; Input:   DFN     - Internal Patient IEN
"RTN","IBCNEHL1",399,0)
 ;          IEN312  - Insurance multiple #
"RTN","IBCNEHL1",400,0)
 ;          RIEN    - file 365 ien
"RTN","IBCNEHL1",401,0)
 ;          AFLG    - 1 if called from autoupdate
"RTN","IBCNEHL1",402,0)
 ;                    0 if called from ins. buffer process entry
"RTN","IBCNEHL1",403,0)
 ; Returns: "" on success, ERFLG on failure. Also called from ACCEPT^IBCNBAR
"RTN","IBCNEHL1",404,0)
 ;          for manual processing of ins. buffer entry.
"RTN","IBCNEHL1",405,0)
 ;
"RTN","IBCNEHL1",406,0)
 ;
"RTN","IBCNEHL1",407,0)
 Q $$EBFILE^IBCNEHL5(DFN,IEN312,RIEN,AFLG)  ;IB*2.0*549 moved because of routine size
"RTN","IBCNEHL1",408,0)
 ;
"RTN","IBCNEHL2")
0^16^B75613048^B70236887
"RTN","IBCNEHL2",1,0)
IBCNEHL2 ;DAOU/ALA - HL7 Process Incoming RPI Msgs (cont.) ;26-JUN-2002  ; Compiled December 16, 2004 15:29:37
"RTN","IBCNEHL2",2,0)
 ;;2.0;INTEGRATED BILLING;**300,345,416,438,497,621**;21-MAR-94;Build 8
"RTN","IBCNEHL2",3,0)
 ;;Per VHA Directive 6402, this routine should not be modified.
"RTN","IBCNEHL2",4,0)
 ;
"RTN","IBCNEHL2",5,0)
 ;**Program Description**
"RTN","IBCNEHL2",6,0)
 ;  This pgm will process the indiv segments of the
"RTN","IBCNEHL2",7,0)
 ;  incoming eIV response msgs.
"RTN","IBCNEHL2",8,0)
 ;
"RTN","IBCNEHL2",9,0)
 ; * Each of these tags are called by IBCNEHL1.
"RTN","IBCNEHL2",10,0)
 ; 
"RTN","IBCNEHL2",11,0)
 ;  This routine is based on IBCNEHLP which was introduced with patch 184, and subsequently
"RTN","IBCNEHL2",12,0)
 ;  patched with patches 252 and 271.  IBCNEHLP is obsolete and deleted with patch 300.
"RTN","IBCNEHL2",13,0)
 ;
"RTN","IBCNEHL2",14,0)
 ;  Variables
"RTN","IBCNEHL2",15,0)
 ;    SEG = HL7 Seg Name
"RTN","IBCNEHL2",16,0)
 ;    MSGID = Original Msg Control ID
"RTN","IBCNEHL2",17,0)
 ;    ACK =  Acknowledgment (AA=Accepted, AE=Error)
"RTN","IBCNEHL2",18,0)
 ;    ERTXT = Error Msg Text
"RTN","IBCNEHL2",19,0)
 ;    ERFLG = Error quit flag
"RTN","IBCNEHL2",20,0)
 ;    ERACT = Error Action
"RTN","IBCNEHL2",21,0)
 ;    ERCON = Error Condition
"RTN","IBCNEHL2",22,0)
 ;    RIEN = Response Record IEN
"RTN","IBCNEHL2",23,0)
 ;    IBSEG = Array of the segment
"RTN","IBCNEHL2",24,0)
 ;
"RTN","IBCNEHL2",25,0)
 Q  ; No direct calls
"RTN","IBCNEHL2",26,0)
 ;
"RTN","IBCNEHL2",27,0)
MSA(ERACT,ERCON,ERROR,ERTXT,IBSEG,MGRP,RIEN,TRACE,EVENTYP) ;  Process the MSA seg
"RTN","IBCNEHL2",28,0)
 ;
"RTN","IBCNEHL2",29,0)
 ;  Input:
"RTN","IBCNEHL2",30,0)
 ;  IBSEG,MGRP
"RTN","IBCNEHL2",31,0)
 ;
"RTN","IBCNEHL2",32,0)
 ;  Output:
"RTN","IBCNEHL2",33,0)
 ;  ERACT,ERCON,ERROR,ERTXT,RIEN,TRACE,ACK
"RTN","IBCNEHL2",34,0)
 ;
"RTN","IBCNEHL2",35,0)
 D MSA^IBCNEHL4
"RTN","IBCNEHL2",36,0)
 Q
"RTN","IBCNEHL2",37,0)
 ;
"RTN","IBCNEHL2",38,0)
CTD(ERROR,IBSEG,RIEN) ; Process the CTD seg
"RTN","IBCNEHL2",39,0)
 ;
"RTN","IBCNEHL2",40,0)
 ; Input:
"RTN","IBCNEHL2",41,0)
 ; IBSEG,RIEN
"RTN","IBCNEHL2",42,0)
 ;
"RTN","IBCNEHL2",43,0)
 ; Output:
"RTN","IBCNEHL2",44,0)
 ; ERROR
"RTN","IBCNEHL2",45,0)
 ;
"RTN","IBCNEHL2",46,0)
 N CTNAME,CTQUAL,CTNUM,CTQIEN,D1,DA,DATA,DIC,DILN,DISYS,DLAYGO,FFL,FLD,IENS,II,RSUPDT,X,Y
"RTN","IBCNEHL2",47,0)
 ;
"RTN","IBCNEHL2",48,0)
 ;  Parse out data from seg
"RTN","IBCNEHL2",49,0)
 S CTNAME=$G(IBSEG(3)),CTQUAL=$P($G(IBSEG(6)),$E(HLECH),9),CTNUM=$P($G(IBSEG(6)),$E(HLECH))
"RTN","IBCNEHL2",50,0)
 I $TR(CTNAME," ")="" S CTNAME="NOT SPECIFIED"
"RTN","IBCNEHL2",51,0)
 S CTQIEN=$$FIND1^DIC(365.021,"","X",CTQUAL)
"RTN","IBCNEHL2",52,0)
 I CTNAME[$E(HLECH) S CTNAME=$$DECHL7($$FMNAME^HLFNC(CTNAME,HLECH))
"RTN","IBCNEHL2",53,0)
 S CTNAME=$E(CTNAME,1,32)
"RTN","IBCNEHL2",54,0)
 ;
"RTN","IBCNEHL2",55,0)
 ;  Look up contact person
"RTN","IBCNEHL2",56,0)
 S DA(1)=RIEN,DIC="^IBCN(365,"_DA(1)_",3,",DIC(0)="LZ",DLAYGO=365.03
"RTN","IBCNEHL2",57,0)
 I '$D(^IBCN(365,DA(1),3,0)) S ^IBCN(365,DA(1),3,0)="^365.03^^"
"RTN","IBCNEHL2",58,0)
 S X=CTNAME D ^DIC
"RTN","IBCNEHL2",59,0)
 S DA=+Y,DATA=^IBCN(365,DA(1),3,DA,0),FLD=2,FFL=0
"RTN","IBCNEHL2",60,0)
 ;
"RTN","IBCNEHL2",61,0)
 ;  Check if contact already has this communication qualifier on file
"RTN","IBCNEHL2",62,0)
 F II=2,4,6 I $P(DATA,U,II)=CTQIEN S FLD=II,FFL=1 Q
"RTN","IBCNEHL2",63,0)
 I 'FFL F II=2,4,6 I $P(DATA,U,II)="" S FLD=II Q
"RTN","IBCNEHL2",64,0)
 ;
"RTN","IBCNEHL2",65,0)
 S IENS=$$IENS^DILF(.DA)
"RTN","IBCNEHL2",66,0)
 S RSUPDT(365.03,IENS,(FLD/2))=CTNUM   ;stuffs the communication # in the correct field ;IB*2.0*497
"RTN","IBCNEHL2",67,0)
 S RSUPDT(365.03,IENS,".0"_FLD)=CTQIEN
"RTN","IBCNEHL2",68,0)
 D FILE^DIE("I","RSUPDT","ERROR")
"RTN","IBCNEHL2",69,0)
CTDX ;
"RTN","IBCNEHL2",70,0)
 Q
"RTN","IBCNEHL2",71,0)
 ;
"RTN","IBCNEHL2",72,0)
PID(ERFLG,ERROR,IBSEG,RIEN) ;  Process the PID seg
"RTN","IBCNEHL2",73,0)
 ;
"RTN","IBCNEHL2",74,0)
 ; Input:
"RTN","IBCNEHL2",75,0)
 ; IBSEG,RIEN
"RTN","IBCNEHL2",76,0)
 ;
"RTN","IBCNEHL2",77,0)
 ; Output:
"RTN","IBCNEHL2",78,0)
 ; ERFLG,ERROR
"RTN","IBCNEHL2",79,0)
 ;
"RTN","IBCNEHL2",80,0)
 D PID^IBCNEHL4
"RTN","IBCNEHL2",81,0)
 Q
"RTN","IBCNEHL2",82,0)
 ;
"RTN","IBCNEHL2",83,0)
GT1(ERROR,IBSEG,RIEN,SUBID,EVENTYP) ;  Process the GT1 Guarantor seg
"RTN","IBCNEHL2",84,0)
 ;
"RTN","IBCNEHL2",85,0)
 ; Input:
"RTN","IBCNEHL2",86,0)
 ; IBSEG,RIEN
"RTN","IBCNEHL2",87,0)
 ;
"RTN","IBCNEHL2",88,0)
 ; Output:
"RTN","IBCNEHL2",89,0)
 ; ERROR,SUBID
"RTN","IBCNEHL2",90,0)
 ;
"RTN","IBCNEHL2",91,0)
 D GT1^IBCNEHL4
"RTN","IBCNEHL2",92,0)
 Q
"RTN","IBCNEHL2",93,0)
 ;
"RTN","IBCNEHL2",94,0)
IN1(ERROR,IBSEG,RIEN,SUBID,EVENTYP) ;  Process the IN1 Insurance seg
"RTN","IBCNEHL2",95,0)
 ;
"RTN","IBCNEHL2",96,0)
 ; Input:
"RTN","IBCNEHL2",97,0)
 ; IBSEG,RIEN,SUBID,ACK
"RTN","IBCNEHL2",98,0)
 ;
"RTN","IBCNEHL2",99,0)
 ; Output:
"RTN","IBCNEHL2",100,0)
 ; ERROR
"RTN","IBCNEHL2",101,0)
 ;
"RTN","IBCNEHL2",102,0)
 N COB,EFFDT,EXPDT,GNAME,GNUMB,MBRID,PAYRID,PYRNM,RSUPDT,SRVDT
"RTN","IBCNEHL2",103,0)
 N PYLEDT,CERDT,RELTN
"RTN","IBCNEHL2",104,0)
 ;
"RTN","IBCNEHL2",105,0)
 ; Austin sending responses with an error indicator will populate IBSEG(3) w/ 
"RTN","IBCNEHL2",106,0)
 ;9 zeros in order to send the HL7 required field when the payer does not 
"RTN","IBCNEHL2",107,0)
 ;send a value for this field
"RTN","IBCNEHL2",108,0)
 S MBRID=$$DECHL7($G(IBSEG(3))) I ACK="AE",($TR(MBRID,0)="") S MBRID=""
"RTN","IBCNEHL2",109,0)
 S PAYRID=$G(IBSEG(4)),PYRNM=$G(IBSEG(5))
"RTN","IBCNEHL2",110,0)
 S GNAME=$$DECHL7($G(IBSEG(10))),GNUMB=$$DECHL7($G(IBSEG(9)))
"RTN","IBCNEHL2",111,0)
 ; make sure group number is not longer than 17 chars, send mailman notification
"RTN","IBCNEHL2",112,0)
 ; if truncation is necessary
"RTN","IBCNEHL2",113,0)
 I $L(GNUMB)>17 D TRNCWARN^IBCNEHLU(GNUMB,$G(TRACE)) S GNUMB=$E(GNUMB,1,17)
"RTN","IBCNEHL2",114,0)
 ;IB*2.0*621/TAZ - Process EICD Discovery Response and Quit
"RTN","IBCNEHL2",115,0)
 I EVENTYP=1 D  G IN1X
"RTN","IBCNEHL2",116,0)
 . N SETID
"RTN","IBCNEHL2",117,0)
 . S SETID=$G(IBSEG(2))
"RTN","IBCNEHL2",118,0)
 . S IBTRACK(SETID,.01)=PAYRID   ;PAYER VA ID
"RTN","IBCNEHL2",119,0)
 . S IBTRACK(SETID,.02)=PYRNM    ;PAYER NAME
"RTN","IBCNEHL2",120,0)
 . S IBTRACK(SETID,.03)=GNUMB    ;GROUP NUMBER
"RTN","IBCNEHL2",121,0)
 . I $G(IBTRACK(SETID,.04))="" S IBTRACK(SETID,.04)=MBRID  ;SUBSCRIBER ID
"RTN","IBCNEHL2",122,0)
 . S IBTRACK(SETID,.05)=MBRID    ;MEMBER ID
"RTN","IBCNEHL2",123,0)
 S EFFDT=$G(IBSEG(13)),EXPDT=$G(IBSEG(14))
"RTN","IBCNEHL2",124,0)
 S COB=$G(IBSEG(23)),SRVDT=$G(IBSEG(27))
"RTN","IBCNEHL2",125,0)
 S PYLEDT=$G(IBSEG(30)),RELTN=$G(IBSEG(18))
"RTN","IBCNEHL2",126,0)
 ;
"RTN","IBCNEHL2",127,0)
 ; Relationship codes sent through the HL7 msg are X12 codes
"RTN","IBCNEHL2",128,0)
 ; X12 codes from the interface that are special cases: "21"=unknown, "40"=cadaver donor
"RTN","IBCNEHL2",129,0)
 S RELTN=$S(RELTN="21":"",RELTN="40":"G8",1:RELTN)
"RTN","IBCNEHL2",130,0)
 S EFFDT=$$FMDATE^HLFNC(EFFDT),EXPDT=$$FMDATE^HLFNC(EXPDT)
"RTN","IBCNEHL2",131,0)
 S SRVDT=$$FMDATE^HLFNC(SRVDT),PYLEDT=$$FMDATE^HLFNC(PYLEDT)
"RTN","IBCNEHL2",132,0)
 ;
"RTN","IBCNEHL2",133,0)
 S RSUPDT(365,RIEN_",",1.11)=EFFDT
"RTN","IBCNEHL2",134,0)
 S RSUPDT(365,RIEN_",",1.12)=EXPDT,RSUPDT(365,RIEN_",",1.1)=SRVDT
"RTN","IBCNEHL2",135,0)
 S RSUPDT(365,RIEN_",",1.19)=PYLEDT
"RTN","IBCNEHL2",136,0)
 S RSUPDT(365,RIEN_",",1.13)=COB,RSUPDT(365,RIEN_",",1.18)=MBRID
"RTN","IBCNEHL2",137,0)
 D FILE^DIE("","RSUPDT","ERROR") Q:$D(ERROR)  ; data needs to filed as internal values
"RTN","IBCNEHL2",138,0)
 ; IB*2*497 - add the following lines
"RTN","IBCNEHL2",139,0)
 ; data at 365, 8.01,13.02,14.01, 14.02 needs to be validated before it can be filed; pass the 'E' flag to DBS filer
"RTN","IBCNEHL2",140,0)
 K RSUPDT
"RTN","IBCNEHL2",141,0)
 S RSUPDT(365,RIEN_",",8.01)=RELTN D CODECHK^IBCNEHLU(.RSUPDT)  ; IB*2*497  check for new coded values
"RTN","IBCNEHL2",142,0)
 S RSUPDT(365,RIEN_",",13.02)=$S($G(SUBID)'="":SUBID,1:MBRID)
"RTN","IBCNEHL2",143,0)
 S RSUPDT(365,RIEN_",",14.01)=GNAME
"RTN","IBCNEHL2",144,0)
 S RSUPDT(365,RIEN_",",14.02)=GNUMB
"RTN","IBCNEHL2",145,0)
 D FILE^DIE("E","RSUPDT","ERROR")
"RTN","IBCNEHL2",146,0)
IN1X ;
"RTN","IBCNEHL2",147,0)
 Q
"RTN","IBCNEHL2",148,0)
 ;
"RTN","IBCNEHL2",149,0)
IN3(ERROR,IBSEG,RIEN) ;  Process IN3 Addt'l Insurance - Cert Seg
"RTN","IBCNEHL2",150,0)
 ;
"RTN","IBCNEHL2",151,0)
 ; Input:
"RTN","IBCNEHL2",152,0)
 ; IBSEG,RIEN
"RTN","IBCNEHL2",153,0)
 ;
"RTN","IBCNEHL2",154,0)
 ; Output:
"RTN","IBCNEHL2",155,0)
 ; ERROR
"RTN","IBCNEHL2",156,0)
 ;
"RTN","IBCNEHL2",157,0)
 N CRDT,RSUPDT
"RTN","IBCNEHL2",158,0)
 ;
"RTN","IBCNEHL2",159,0)
 S CRDT=$G(IBSEG(7))
"RTN","IBCNEHL2",160,0)
 S CRDT=$$FMDATE^HLFNC(CRDT)
"RTN","IBCNEHL2",161,0)
 S RSUPDT(365,RIEN_",",1.17)=CRDT
"RTN","IBCNEHL2",162,0)
 D FILE^DIE("I","RSUPDT","ERROR")
"RTN","IBCNEHL2",163,0)
IN3X ;
"RTN","IBCNEHL2",164,0)
 Q
"RTN","IBCNEHL2",165,0)
 ;
"RTN","IBCNEHL2",166,0)
ZEB(EBDA,ERROR,IBSEG,RIEN) ;  Process the ZEB Elig/Benefit seg
"RTN","IBCNEHL2",167,0)
 ;
"RTN","IBCNEHL2",168,0)
 ; Input:
"RTN","IBCNEHL2",169,0)
 ; IBSEG,IIVSTAT,RIEN
"RTN","IBCNEHL2",170,0)
 ;
"RTN","IBCNEHL2",171,0)
 ; Output:
"RTN","IBCNEHL2",172,0)
 ; EBDA,ERROR
"RTN","IBCNEHL2",173,0)
 ;
"RTN","IBCNEHL2",174,0)
 N D1,DA,DIC,DILN,DISYS,DLAYGO,EBN,IENS,II,MSG,PRMODS,RSUPDT,STC,STCSTR,SUBJECT,X,XMY,Y,MA,CODES
"RTN","IBCNEHL2",175,0)
 ;
"RTN","IBCNEHL2",176,0)
 ; Set a default eIV Status value of # ("V")
"RTN","IBCNEHL2",177,0)
 I IIVSTAT="" D
"RTN","IBCNEHL2",178,0)
 .   I IBSEG(7)'="eIV Eligibility Determination" S IIVSTAT="V" Q
"RTN","IBCNEHL2",179,0)
 .   I $F("_1_6_V_","_"_IBSEG(3)_"_") S IIVSTAT=IBSEG(3) Q
"RTN","IBCNEHL2",180,0)
 .   ; Unknown code received from the EC
"RTN","IBCNEHL2",181,0)
 .   S SUBJECT="eIV: Invalid Eligibility Status flag"
"RTN","IBCNEHL2",182,0)
 .   S MSG(1)="An invalid Eligibility Status flag '"_$G(IBSEG(3))_"' was received for site "_$P($$SITE^VASITE,"^",3)_","
"RTN","IBCNEHL2",183,0)
 .   S MSG(2)="trace number "_$G(TRACE,"unknown")_" and message control id "_$G(MSGID,"unknown")_"."
"RTN","IBCNEHL2",184,0)
 .   S MSG(3)="It has been interpreted as an ambiguous response in VistA."
"RTN","IBCNEHL2",185,0)
 .   S XMY("PII                   ")=""
"RTN","IBCNEHL2",186,0)
 .   D MSG^IBCNEUT5("",SUBJECT,"MSG(",,.XMY)
"RTN","IBCNEHL2",187,0)
 .   S IIVSTAT="V"
"RTN","IBCNEHL2",188,0)
 ;
"RTN","IBCNEHL2",189,0)
 ; Process the ZEB
"RTN","IBCNEHL2",190,0)
 S EBN=$G(IBSEG(2))
"RTN","IBCNEHL2",191,0)
 S DA(1)=RIEN,DIC="^IBCN(365,"_DA(1)_",2,",DIC(0)="L",DLAYGO=365.02
"RTN","IBCNEHL2",192,0)
 I '$D(^IBCN(365,DA(1),2,0)) S ^IBCN(365,DA(1),2,0)="^365.02^^"
"RTN","IBCNEHL2",193,0)
 S X=EBN D ^DIC
"RTN","IBCNEHL2",194,0)
 S DA=+Y,EBDA=DA
"RTN","IBCNEHL2",195,0)
 ;
"RTN","IBCNEHL2",196,0)
 S IENS=$$IENS^DILF(.DA)
"RTN","IBCNEHL2",197,0)
 ;
"RTN","IBCNEHL2",198,0)
 ; decode plan description ZEB segment
"RTN","IBCNEHL2",199,0)
 S IBSEG(7)=$$DECHL7($G(IBSEG(7)))
"RTN","IBCNEHL2",200,0)
 S RSUPDT(365.02,IENS,".02")=$P($G(IBSEG(3)),HLCMP) ; elig/benefit info
"RTN","IBCNEHL2",201,0)
 S RSUPDT(365.02,IENS,".03")=$P($G(IBSEG(4)),HLCMP) ; coverage level
"RTN","IBCNEHL2",202,0)
 S RSUPDT(365.02,IENS,".05")=$P($G(IBSEG(6)),HLCMP) ; insurance type
"RTN","IBCNEHL2",203,0)
 S RSUPDT(365.02,IENS,".06")=$G(IBSEG(7))           ; plan coverage
"RTN","IBCNEHL2",204,0)
 S RSUPDT(365.02,IENS,".07")=$P($G(IBSEG(8)),HLCMP) ; time period qualifier
"RTN","IBCNEHL2",205,0)
 S MA=$G(IBSEG(9)) I $TR(MA," ","")'="" S MA=$J(MA,0,2)
"RTN","IBCNEHL2",206,0)
 S RSUPDT(365.02,IENS,".08")=$$NUMCHK(MA)            ; Monetary amt
"RTN","IBCNEHL2",207,0)
 S RSUPDT(365.02,IENS,".09")=$$NUMCHK($G(IBSEG(10))) ; Percent
"RTN","IBCNEHL2",208,0)
 S RSUPDT(365.02,IENS,".1")=$G(IBSEG(11))            ; Quantity Qual.
"RTN","IBCNEHL2",209,0)
 F II=11:1:13 S RSUPDT(365.02,IENS,"."_II)=$G(IBSEG(II+1))
"RTN","IBCNEHL2",210,0)
 S RSUPDT(365.02,IENS,"1.01")=$P($G(IBSEG(15)),HLCMP) ; Procedure coding method
"RTN","IBCNEHL2",211,0)
 S RSUPDT(365.02,IENS,"1.02")=$G(IBSEG(16)) ; Procedure code
"RTN","IBCNEHL2",212,0)
 ; Procedure modifiers
"RTN","IBCNEHL2",213,0)
 S PRMODS=$G(IBSEG(17)) F II=1:1:4 S RSUPDT(365.02,IENS,"1.0"_(II+2))=$TR($P(PRMODS,HLREP,II),HL("ECH"))
"RTN","IBCNEHL2",214,0)
 D CODECHK^IBCNEHLU(.RSUPDT)  ; IB*2*497  check for new coded values
"RTN","IBCNEHL2",215,0)
 D FILE^DIE("ET","RSUPDT","ERROR") I $D(ERROR) Q
"RTN","IBCNEHL2",216,0)
 ; service type codes
"RTN","IBCNEHL2",217,0)
 K RSUPDT S STCSTR=$P($G(IBSEG(5)),HLCMP)
"RTN","IBCNEHL2",218,0)
 F II=1:1 S STC=$P(STCSTR,HLREP,II) Q:STC=""  S RSUPDT(365.292,"+"_II_","_IENS,".01")=STC,CODES(365.292,II,.01)=STC  ; IB*2*497 set up CODES array
"RTN","IBCNEHL2",219,0)
 D CODECHK^IBCNEHLU(.CODES)  ;IB*2*497
"RTN","IBCNEHL2",220,0)
 I $D(RSUPDT) D UPDATE^DIE("E","RSUPDT",,"ERROR")
"RTN","IBCNEHL2",221,0)
ZEBX ;
"RTN","IBCNEHL2",222,0)
 Q
"RTN","IBCNEHL2",223,0)
 ;
"RTN","IBCNEHL2",224,0)
EBNTE(EBDA,IBSEG,RIEN) ; Process NTE Benefit related entity Notes segment (in Eligibility/Benefit group)
"RTN","IBCNEHL2",225,0)
 ;
"RTN","IBCNEHL2",226,0)
 ; Input:
"RTN","IBCNEHL2",227,0)
 ; EBDA,IBSEG,RIEN
"RTN","IBCNEHL2",228,0)
 ;
"RTN","IBCNEHL2",229,0)
 ; Output:
"RTN","IBCNEHL2",230,0)
 ; ERROR
"RTN","IBCNEHL2",231,0)
 ;
"RTN","IBCNEHL2",232,0)
 N DA,IENS,NOTES
"RTN","IBCNEHL2",233,0)
 I $G(EBDA)="" G EBNTEX
"RTN","IBCNEHL2",234,0)
 S NOTES(1)=$$DECHL7($G(IBSEG(4)))
"RTN","IBCNEHL2",235,0)
 S DA(1)=RIEN,DA=EBDA
"RTN","IBCNEHL2",236,0)
 S IENS=$$IENS^DILF(.DA)
"RTN","IBCNEHL2",237,0)
 D WP^DIE(365.02,IENS,2,"A","NOTES","ERROR")
"RTN","IBCNEHL2",238,0)
EBNTEX ;
"RTN","IBCNEHL2",239,0)
 Q
"RTN","IBCNEHL2",240,0)
 ;
"RTN","IBCNEHL2",241,0)
DECHL7(STR,HLSEP,ECHARS) ; Decode HL7 escape seqs in data fields
"RTN","IBCNEHL2",242,0)
 ;
"RTN","IBCNEHL2",243,0)
 ; Input:
"RTN","IBCNEHL2",244,0)
 ; STR = Field data possible containing HL7 escape seqs for encoding chars
"RTN","IBCNEHL2",245,0)
 ; HLSEP (opt) = HL7 Field sep. char - assumes HLFS if not passed
"RTN","IBCNEHL2",246,0)
 ; ECHARS (opt) = HL7 encoding chars being used, assumes HL("ECH") if not passed
"RTN","IBCNEHL2",247,0)
 ;
"RTN","IBCNEHL2",248,0)
 ; Output Values
"RTN","IBCNEHL2",249,0)
 ; Fn returns string w/converted escape seqs
"RTN","IBCNEHL2",250,0)
 ;
"RTN","IBCNEHL2",251,0)
 N ESC,PAT,REPL,ECODE,PCE
"RTN","IBCNEHL2",252,0)
 ; Initialize opt. params.
"RTN","IBCNEHL2",253,0)
 I $G(HLSEP)="" S HLSEP=HLFS
"RTN","IBCNEHL2",254,0)
 I $G(ECHARS)="" S ECHARS=HL("ECH")
"RTN","IBCNEHL2",255,0)
 ;
"RTN","IBCNEHL2",256,0)
 S ESC=$E(ECHARS,3) ; Escape char.
"RTN","IBCNEHL2",257,0)
 ; Check for escape seqs, quit if not
"RTN","IBCNEHL2",258,0)
 I STR'[ESC G DECHL7X
"RTN","IBCNEHL2",259,0)
 ; Replace ^ w/{sp} (if any) to prevent filing problems
"RTN","IBCNEHL2",260,0)
 S ECHARS=$TR(ECHARS,"^"," ")
"RTN","IBCNEHL2",261,0)
 ;
"RTN","IBCNEHL2",262,0)
 ; Array of rep. chars
"RTN","IBCNEHL2",263,0)
 S REPL("F")=$TR(HLSEP,"^"," ") ;Field Sep
"RTN","IBCNEHL2",264,0)
 S REPL("S")=$E(ECHARS)     ;Comp Sep
"RTN","IBCNEHL2",265,0)
 S REPL("R")=$E(ECHARS,2)   ;Rep. sep
"RTN","IBCNEHL2",266,0)
 ; Temp. replace w/ASC 26, until after other ESC are stripped
"RTN","IBCNEHL2",267,0)
 S REPL("E")=$C(26)  ;Esc. sep
"RTN","IBCNEHL2",268,0)
 S REPL("T")=$E(ECHARS,4)   ;Subcomp. sep
"RTN","IBCNEHL2",269,0)
 ;
"RTN","IBCNEHL2",270,0)
 ; Translate out escape seqs left->right
"RTN","IBCNEHL2",271,0)
 F PCE=1:1:($L(STR,ESC)-1)\2 D
"RTN","IBCNEHL2",272,0)
 . ; Ignore empty esc. or unrec. esc. seq.
"RTN","IBCNEHL2",273,0)
 . S ECODE=$P(STR,ESC,2) I ECODE="" S ECODE="XXXX"
"RTN","IBCNEHL2",274,0)
 . I $D(REPL(ECODE))'>0 S STR=$P(STR,ESC)_$C(26)_$P(STR,ESC,2)_$C(26)_$P(STR,ESC,3,99999) Q
"RTN","IBCNEHL2",275,0)
 . ; Else, replace esc. seq. w/ char.
"RTN","IBCNEHL2",276,0)
 . S STR=$P(STR,ESC)_$G(REPL(ECODE))_$P(STR,ESC,3,99999)
"RTN","IBCNEHL2",277,0)
 ;
"RTN","IBCNEHL2",278,0)
 ;Replace the decoded ESC chars that were actually sent
"RTN","IBCNEHL2",279,0)
 S STR=$TR(STR,$C(26),ESC)
"RTN","IBCNEHL2",280,0)
 ;
"RTN","IBCNEHL2",281,0)
DECHL7X ; Exit w/return values
"RTN","IBCNEHL2",282,0)
 Q STR
"RTN","IBCNEHL2",283,0)
 ;
"RTN","IBCNEHL2",284,0)
NUMCHK(N) ; make sure that numeric value N is not greater than 99999
"RTN","IBCNEHL2",285,0)
 Q $S(+N>99999:99999,1:N)
"RTN","IBCNEHL3")
0^20^B172154152^B171754905
"RTN","IBCNEHL3",1,0)
IBCNEHL3 ;DAOU/ALA - HL7 Process Incoming RPI Continued ;03-JUL-2002  ; Compiled June 2, 2005 14:20:19
"RTN","IBCNEHL3",2,0)
 ;;2.0;INTEGRATED BILLING;**300,416,497,506,595,621**;21-MAR-94;Build 8
"RTN","IBCNEHL3",3,0)
 ;;Per VA Directive 6402, this routine should not be modified.
"RTN","IBCNEHL3",4,0)
 ;
"RTN","IBCNEHL3",5,0)
 ;**Program Description**
"RTN","IBCNEHL3",6,0)
 ;  This is a continuation of IBCNEHL1 which processes an incoming
"RTN","IBCNEHL3",7,0)
 ;  RPI IIV message.
"RTN","IBCNEHL3",8,0)
 ;  
"RTN","IBCNEHL3",9,0)
 ;  This routine is based on IBCNEHLS which was introduced with patch 184, and subsequently
"RTN","IBCNEHL3",10,0)
 ;  patched with patch 271.  IBCNEHLS is obsolete and deleted with patch 300.
"RTN","IBCNEHL3",11,0)
 ;
"RTN","IBCNEHL3",12,0)
 Q   ; no direct calls allow
"RTN","IBCNEHL3",13,0)
 ;
"RTN","IBCNEHL3",14,0)
ERROR(TQN,ERACT,ERCON,TRCN) ; Entry point
"RTN","IBCNEHL3",15,0)
 ; Input:  TQN - IEN for eIV Transmission Queue (#365.1), required
"RTN","IBCNEHL3",16,0)
 ;         ERACT - Error Action Code (#365.14), required
"RTN","IBCNEHL3",17,0)
 ;         ERCON - Error Condition Code (#365.17), required
"RTN","IBCNEHL3",18,0)
 ;         TRCN - Trace # from eIV Response (#365)
"RTN","IBCNEHL3",19,0)
 ;
"RTN","IBCNEHL3",20,0)
 ;         IIVSTAT - IIV status transmitted by EC
"RTN","IBCNEHL3",21,0)
 ;                   Note: MAP(IIVSTAT) = IIV STATUS IEN
"RTN","IBCNEHL3",22,0)
 N MSG,ERDESC,ERIEN,XMY,DA,DIE,DR
"RTN","IBCNEHL3",23,0)
 ;
"RTN","IBCNEHL3",24,0)
 I $G(TQN)="" G ERRORX
"RTN","IBCNEHL3",25,0)
 ;
"RTN","IBCNEHL3",26,0)
 ;/Removed the following lines of code as part of IB*2.0*506 but wanted to
"RTN","IBCNEHL3",27,0)
 ;/leave this code available if it should be needed in the future.
"RTN","IBCNEHL3",28,0)
 ; Scenarios:
"RTN","IBCNEHL3",29,0)
 ; #1 - If error message = "Resubmission Allowed" OR "Please Resubmit
"RTN","IBCNEHL3",30,0)
 ; Original Transaction" - set TQ
"RTN","IBCNEHL3",31,0)
 ; Fut Trans Dt to T + Comm Failure Days and Status to "Hold"
"RTN","IBCNEHL3",32,0)
 ;I ERACT="R"!(ERACT="P") D G ERRORX
"RTN","IBCNEHL3",33,0)
 ;. I $P($G(^IBCN(365.1,TQN,0)),U,9)="" D Q ; first time payer asked us to resubmit
"RTN","IBCNEHL3",34,0)
 ;. . ; Update IIV TQ fields: "Hold" (4), IIV Site Param Comm Failure Days
"RTN","IBCNEHL3",35,0)
 ;. . D UPDATE(TQN,4,+$P($G(^IBE(350.9,1,51)),U,5),ERACT)
"RTN","IBCNEHL3",36,0)
 ;. . ;
"RTN","IBCNEHL3",37,0)
 ;. ; payer asked us to resubmit for the 2nd time for this inquiry
"RTN","IBCNEHL3",38,0)
 ;. ; Update IIV TQ fields: "Response Received" (3), n/a ("")
"RTN","IBCNEHL3",39,0)
 ;. D UPDATE(TQN,3,"",ERACT,ERCON)
"RTN","IBCNEHL3",40,0)
 ;. ; clear future transmission date so it won't display in the buffer
"RTN","IBCNEHL3",41,0)
 ;. S DA=TQN,DIE="^IBCN(365.1,",DR=".09///@" D ^DIE
"RTN","IBCNEHL3",42,0)
 ;
"RTN","IBCNEHL3",43,0)
 ; #2 - If error message = "Please Wait 30 Days and Resubmit" - set TQ
"RTN","IBCNEHL3",44,0)
 ; Fut Trans Dt to T + 30 and Status to "Hold"
"RTN","IBCNEHL3",45,0)
 ;I ERACT="W" D G ERRORX
"RTN","IBCNEHL3",46,0)
 ;. ; Update IIV TQ fields: "Hold" (4), 30
"RTN","IBCNEHL3",47,0)
 ;. D UPDATE(TQN,4,30,ERACT)
"RTN","IBCNEHL3",48,0)
 ;
"RTN","IBCNEHL3",49,0)
 ; #3 - If error message = "Please Wait 10 Days and Resubmit" - set TQ
"RTN","IBCNEHL3",50,0)
 ; Fut Trans Dt to T + 10 and Status to "Hold"
"RTN","IBCNEHL3",51,0)
 ;I ERACT="X" D G ERRORX
"RTN","IBCNEHL3",52,0)
 ;. ; Update IIV TQ fields: "Hold" (4), 10
"RTN","IBCNEHL3",53,0)
 ;. D UPDATE(TQN,4,10,ERACT)
"RTN","IBCNEHL3",54,0)
 ;
"RTN","IBCNEHL3",55,0)
 ; #4 - If error message = "Resubmission Not Allowed" or
"RTN","IBCNEHL3",56,0)
 ; "Do not resubmit ...." OR "Please correct and resubmit"
"RTN","IBCNEHL3",57,0)
 ; - set TQ Status to "Response Received"
"RTN","IBCNEHL3",58,0)
 ; If we receive error txt, treat as an "N"
"RTN","IBCNEHL3",59,0)
 ;I ERACT="" S ERACT="N"
"RTN","IBCNEHL3",60,0)
 ;I ERACT="N"!(ERACT="Y")!(ERACT="S")!(ERACT="C") D G ERRORX
"RTN","IBCNEHL3",61,0)
 ;. ; Update IIV TQ fields: "Response Received" (3), n/a ("")
"RTN","IBCNEHL3",62,0)
 ;. D UPDATE(TQN,3,"",ERACT,ERCON)
"RTN","IBCNEHL3",63,0)
 ;
"RTN","IBCNEHL3",64,0)
 ; #5 - Error message is unfamiliar - new Error Action Code
"RTN","IBCNEHL3",65,0)
 ; *** Currently processed in IBCNEHL1 ***
"RTN","IBCNEHL3",66,0)
 ;/End of removed code for IB*2.0*506
"RTN","IBCNEHL3",67,0)
 ;
"RTN","IBCNEHL3",68,0)
 ; /IB*2.0*506 Beginning
"RTN","IBCNEHL3",69,0)
 ; For all Scenarios 1 thru 5, set TQ Status to "Response Received"
"RTN","IBCNEHL3",70,0)
 I ERACT="" S ERACT="N"
"RTN","IBCNEHL3",71,0)
 I ",R,P,W,X,N,Y,S,C,"[(","_ERACT_",") D  G ERRORX
"RTN","IBCNEHL3",72,0)
 . ; Update IIV TQ fields: "Response Received" (3), n/a ("")
"RTN","IBCNEHL3",73,0)
 . D UPDATE(TQN,3,"",ERACT,ERCON)
"RTN","IBCNEHL3",74,0)
 ; /IB*2.0*506 End
"RTN","IBCNEHL3",75,0)
 ;
"RTN","IBCNEHL3",76,0)
ERRORX ; ERROR exit pt
"RTN","IBCNEHL3",77,0)
 Q
"RTN","IBCNEHL3",78,0)
 ;
"RTN","IBCNEHL3",79,0)
UPDATE(TQN,TSTS,TDAYS,ERACT,ERCON) ;  Update Transmission Queue (#365.1)
"RTN","IBCNEHL3",80,0)
 ; Update/Create Buffer information as necessary
"RTN","IBCNEHL3",81,0)
 ; * If unsolicited error or negative Verification response do not
"RTN","IBCNEHL3",82,0)
 ; update TQ entry.  However, create a new Buffer entry.
"RTN","IBCNEHL3",83,0)
 ; Input Variables
"RTN","IBCNEHL3",84,0)
 ; ERACT,ERCON,IIVSTAT,TDAYS,TQN,TSTS
"RTN","IBCNEHL3",85,0)
 ;
"RTN","IBCNEHL3",86,0)
 ; Output Variables
"RTN","IBCNEHL3",87,0)
 ; IIVSTAT (updated)
"RTN","IBCNEHL3",88,0)
 ;
"RTN","IBCNEHL3",89,0)
 ; Init optional param
"RTN","IBCNEHL3",90,0)
 S ERCON=$G(ERCON)
"RTN","IBCNEHL3",91,0)
 ;
"RTN","IBCNEHL3",92,0)
 ; Init vars
"RTN","IBCNEHL3",93,0)
 N D,D0,DA,DFN,DI,DIC,DIE,DQ,DR,FTDT,IBDATA,IBIEN,IBQFL,IBSTS,IBSYM
"RTN","IBCNEHL3",94,0)
 N INSIEN,RSTYPE,SYMBOL,TQDATA,X
"RTN","IBCNEHL3",95,0)
 ;
"RTN","IBCNEHL3",96,0)
 ; If no ZEB segment received, set IIVSTAT to "V"
"RTN","IBCNEHL3",97,0)
 I $TR(IIVSTAT," ")="" S IIVSTAT="V"
"RTN","IBCNEHL3",98,0)
 ;
"RTN","IBCNEHL3",99,0)
 S TQDATA=$G(^IBCN(365.1,TQN,0))
"RTN","IBCNEHL3",100,0)
 I TQDATA="" G UPDATX
"RTN","IBCNEHL3",101,0)
 ;
"RTN","IBCNEHL3",102,0)
 ; Ins Buffer IEN
"RTN","IBCNEHL3",103,0)
 S IBIEN=$P(TQDATA,U,5)
"RTN","IBCNEHL3",104,0)
 S IBQFL=$P(TQDATA,U,11)
"RTN","IBCNEHL3",105,0)
 S RSTYPE=$P($G(^IBCN(365,RIEN,0)),U,10)
"RTN","IBCNEHL3",106,0)
 ;
"RTN","IBCNEHL3",107,0)
 ; If unsolicited error or negative Identification response DON'T
"RTN","IBCNEHL3",108,0)
 ; update TQ entry or Buffer (includes not creating a new buffer)
"RTN","IBCNEHL3",109,0)
 I RSTYPE="U",(IBQFL="I") G UPDATX
"RTN","IBCNEHL3",110,0)
 ;
"RTN","IBCNEHL3",111,0)
 I RSTYPE="U" S IBIEN=""  ; makes sure a new buffer is created
"RTN","IBCNEHL3",112,0)
 ;
"RTN","IBCNEHL3",113,0)
 ; Ins Buffer processing
"RTN","IBCNEHL3",114,0)
 I IBIEN'="" D
"RTN","IBCNEHL3",115,0)
 . ; Ins Buf data
"RTN","IBCNEHL3",116,0)
 . S IBDATA=$G(^IBA(355.33,+IBIEN,0))
"RTN","IBCNEHL3",117,0)
 . S IBSTS=$P(IBDATA,U,4)   ; Status
"RTN","IBCNEHL3",118,0)
 . S IBSYM=$P(IBDATA,U,12)  ; Symbol
"RTN","IBCNEHL3",119,0)
 . ; If IB status is (A)ccepted or (R)ejected or IB symbol is "*"
"RTN","IBCNEHL3",120,0)
 . ;  (verified) or IB symbol is "-" (denied), update TQ status to
"RTN","IBCNEHL3",121,0)
 . ;  Resp Rec'd (3) and DON'T update the Ins Buffer symbol
"RTN","IBCNEHL3",122,0)
 . I IBSTS="A"!(IBSTS="R")!(IBSYM=8)!(IBSYM=9) S TSTS=3 Q
"RTN","IBCNEHL3",123,0)
 . ; If TQ status is "Hold", update buffer symbol to "?" (10)
"RTN","IBCNEHL3",124,0)
 . I TSTS=4 D BUFF^IBCNEUT2(IBIEN,10) Q  ; Set buffer symbol to "?"
"RTN","IBCNEHL3",125,0)
 . ; If TQ status is "Response Received", update buffer symbol to "-" (9) for Error
"RTN","IBCNEHL3",126,0)
 . ; Action Codes ('N','Y','S') & Action Codes ('P','R', if 2nd time payer sent that code)
"RTN","IBCNEHL3",127,0)
 . I TSTS=3,(ERACT="N"!(ERACT="Y")!(ERACT="S")!(ERACT="C")!(ERACT="P")!(ERACT="R")) D  Q
"RTN","IBCNEHL3",128,0)
 .. S SYMBOL=MAP(IIVSTAT)
"RTN","IBCNEHL3",129,0)
 .. D BUFF^IBCNEUT2(IBIEN,SYMBOL) ; Set buffer symbol to EC value
"RTN","IBCNEHL3",130,0)
 .. D IIVPROC(IBIEN)   ; Set IIV process date & IIV status
"RTN","IBCNEHL3",131,0)
 . ; If TQ status is "Response Received", update buffer symbol to "!" (12 = B9) for new Error Action Code
"RTN","IBCNEHL3",132,0)
 . I TSTS=3,",W,X,R,P,C,N,Y,S,"'[(","_ERACT_",") D BUFF^IBCNEUT2(IBIEN,22) Q
"RTN","IBCNEHL3",133,0)
 ;
"RTN","IBCNEHL3",134,0)
 ; Non-Ins Buffer processing, create entry only for Verification queries
"RTN","IBCNEHL3",135,0)
 I IBIEN="",IBQFL="V" D
"RTN","IBCNEHL3",136,0)
 . ; Determine Patient DFN
"RTN","IBCNEHL3",137,0)
 . S DFN=$P(TQDATA,U,2)
"RTN","IBCNEHL3",138,0)
 . ; Determine Patient Ins record IEN
"RTN","IBCNEHL3",139,0)
 . S INSIEN=$P(TQDATA,U,13)  ; If INSIEN="" avoids TQ update
"RTN","IBCNEHL3",140,0)
 . ; If ERACT="C" symbol is passed by EC
"RTN","IBCNEHL3",141,0)
 . I ERACT="C" S SYMBOL=MAP(IIVSTAT) D BUF Q
"RTN","IBCNEHL3",142,0)
 . ;  Resubmission Not Allowed or Do Not Resubmit ...
"RTN","IBCNEHL3",143,0)
 . I ERACT="N"!(ERACT="Y")!(ERACT="S") S SYMBOL=MAP(IIVSTAT) D BUF Q
"RTN","IBCNEHL3",144,0)
 . ; An unknown error action - generate a '#'
"RTN","IBCNEHL3",145,0)
 . I ",W,X,R,P,C,N,Y,S,"'[(","_ERACT_",") S SYMBOL=22 D BUF Q
"RTN","IBCNEHL3",146,0)
 ;
"RTN","IBCNEHL3",147,0)
 I RSTYPE="U" G UPDATX  ; finished creating new buffer
"RTN","IBCNEHL3",148,0)
 ;
"RTN","IBCNEHL3",149,0)
 ; Update TQ record - Status
"RTN","IBCNEHL3",150,0)
 D SST^IBCNEUT2(TQN,TSTS)
"RTN","IBCNEHL3",151,0)
 ;
"RTN","IBCNEHL3",152,0)
 ; If TQ Status = "Hold", update TQ record - Future Transmission Date
"RTN","IBCNEHL3",153,0)
 I TSTS=4,+$G(TDAYS) D
"RTN","IBCNEHL3",154,0)
 . S FTDT=$$FMADD^XLFDT($$DT^XLFDT,TDAYS)
"RTN","IBCNEHL3",155,0)
 . S DIE="^IBCN(365.1,",DA=TQN,DR=".09///^S X=FTDT"
"RTN","IBCNEHL3",156,0)
 . D ^DIE
"RTN","IBCNEHL3",157,0)
 I TSTS=4,$P(TQDATA,U,8) D
"RTN","IBCNEHL3",158,0)
 . S DIE="^IBCN(365.1,",DA=TQN,DR=".08///0"
"RTN","IBCNEHL3",159,0)
 . D ^DIE
"RTN","IBCNEHL3",160,0)
 ;
"RTN","IBCNEHL3",161,0)
UPDATX ; UPDATE exit point
"RTN","IBCNEHL3",162,0)
 Q
"RTN","IBCNEHL3",163,0)
 ;
"RTN","IBCNEHL3",164,0)
PCK ; Payer Check
"RTN","IBCNEHL3",165,0)
 ;  Find the associated Response IEN
"RTN","IBCNEHL3",166,0)
 ;
"RTN","IBCNEHL3",167,0)
 ; Input Variables
"RTN","IBCNEHL3",168,0)
 ; MSGID
"RTN","IBCNEHL3",169,0)
 ;
"RTN","IBCNEHL3",170,0)
 ; Output Variables
"RTN","IBCNEHL3",171,0)
 ; RIEN,ERFLG
"RTN","IBCNEHL3",172,0)
 ;
"RTN","IBCNEHL3",173,0)
 N BUFF,DA,DFN,DIE,DR,IEN,IERN,IN1DATA,MDTM,QFL,PAYR,PIEN,PP
"RTN","IBCNEHL3",174,0)
 N PRDATA,PRIEN,RSIEN,X
"RTN","IBCNEHL3",175,0)
 N NOPAYER,TQIEN
"RTN","IBCNEHL3",176,0)
 ;
"RTN","IBCNEHL3",177,0)
 K ^TMP("IBCNEMID",$J)
"RTN","IBCNEHL3",178,0)
 D FIND^DIC(365,"","","P",MSGID,"","B","","","^TMP(""IBCNEMID"",$J)")
"RTN","IBCNEHL3",179,0)
 ;
"RTN","IBCNEHL3",180,0)
 S PP=0,QFL=0,(RIEN,PIEN)=""
"RTN","IBCNEHL3",181,0)
 S NOPAYER=$$FIND1^DIC(365.12,,"X","~NO PAYER"),TQIEN=$O(^IBCN(365.1,"C",MSGID,""))
"RTN","IBCNEHL3",182,0)
 F  S PP=$O(^TMP("IBCNEMID",$J,"DILIST",PP)) Q:'PP  D  Q:QFL
"RTN","IBCNEHL3",183,0)
 . S PRIEN=$P(^TMP("IBCNEMID",$J,"DILIST",PP,0),U,1)
"RTN","IBCNEHL3",184,0)
 . ;
"RTN","IBCNEHL3",185,0)
 . ;  If this is a response w/o an IN1 segment
"RTN","IBCNEHL3",186,0)
 . ;  Get payer IEN from TQ as original response shell will change for
"RTN","IBCNEHL3",187,0)
 . ;  ~NO PAYER if a payer response is received
"RTN","IBCNEHL3",188,0)
 . S IN1DATA=$S(EVENTYP=1:"",1:$$GIN1()) ; IB*2.0*621
"RTN","IBCNEHL3",189,0)
 . I IN1DATA="",PRIEN'="",TQIEN'="" D
"RTN","IBCNEHL3",190,0)
 ..  S QFL=1,PIEN=$P(^IBCN(365.1,TQIEN,0),U,3)
"RTN","IBCNEHL3",191,0)
 . ;
"RTN","IBCNEHL3",192,0)
 . I 'PIEN D PFN(IN1DATA) I 'PIEN S QFL=1 Q
"RTN","IBCNEHL3",193,0)
 . ;
"RTN","IBCNEHL3",194,0)
 . ; If message id/payer found & Response (#365) status is NOT
"RTN","IBCNEHL3",195,0)
 . ; 'Response Received' update the existing response entry (set RIEN)
"RTN","IBCNEHL3",196,0)
 . I $P(^IBCN(365,PRIEN,0),U,3)=PIEN,($P(^IBCN(365,PRIEN,0),U,6)'=3) D  Q
"RTN","IBCNEHL3",197,0)
 .. S RIEN=PRIEN,QFL=1
"RTN","IBCNEHL3",198,0)
 ..;
"RTN","IBCNEHL3",199,0)
 ..; If message id/payer found & Response (#365) status equals
"RTN","IBCNEHL3",200,0)
 . ; 'Response Received', RIEN is still null so that this tag knows
"RTN","IBCNEHL3",201,0)
 . ; to create a new unsolicited response entry
"RTN","IBCNEHL3",202,0)
 . ; 
"RTN","IBCNEHL3",203,0)
 . ; If payer response received to ~NO PAYER, update eIV Response file
"RTN","IBCNEHL3",204,0)
 . ; w/ responding payer
"RTN","IBCNEHL3",205,0)
 . I RIEN="" S PRDATA=$G(^IBCN(365,PRIEN,0)) I $P(PRDATA,U,3)=NOPAYER,$P(PRDATA,U,6)'=3,$P(PRDATA,U,10)="O" D  Q
"RTN","IBCNEHL3",206,0)
 .. S RIEN=PRIEN,QFL=1
"RTN","IBCNEHL3",207,0)
 .. S DIE="^IBCN(365,",DA=RIEN,DR=".03///^S X=PIEN" D ^DIE
"RTN","IBCNEHL3",208,0)
 ;
"RTN","IBCNEHL3",209,0)
 ;  If message id/payer not found or unsolicited response, create new response entry
"RTN","IBCNEHL3",210,0)
 I RIEN="" D  Q:ERFLG
"RTN","IBCNEHL3",211,0)
 . I $G(PRIEN)'="" D
"RTN","IBCNEHL3",212,0)
 .. S PRDATA=$G(^IBCN(365,PRIEN,0))
"RTN","IBCNEHL3",213,0)
 .. S DFN=$P(PRDATA,U,2),IEN=$P(PRDATA,U,5),MDTM=$P(PRDATA,U,8)
"RTN","IBCNEHL3",214,0)
 . ;
"RTN","IBCNEHL3",215,0)
 . I PIEN="" D  Q:ERFLG
"RTN","IBCNEHL3",216,0)
 ..  S IN1DATA=$$GIN1()
"RTN","IBCNEHL3",217,0)
 ..  I IN1DATA]"" D PFN(IN1DATA) I 'PIEN S PIEN="",QFL=1
"RTN","IBCNEHL3",218,0)
 . S PAYR=PIEN,(RSTYPE,BUFF)=""
"RTN","IBCNEHL3",219,0)
 . D RESP^IBCNEDEQ
"RTN","IBCNEHL3",220,0)
 . S RIEN=RSIEN
"RTN","IBCNEHL3",221,0)
 ;
"RTN","IBCNEHL3",222,0)
 ; If no payer in response file, set it
"RTN","IBCNEHL3",223,0)
 ; IB*2*595/DM correctly identify a payer when the payer name begins with numbers 
"RTN","IBCNEHL3",224,0)
 I $G(PIEN)'="",$G(RIEN)'="",$P($G(^IBCN(365,RIEN,0)),U,3)="" D
"RTN","IBCNEHL3",225,0)
 . S DIE="^IBCN(365,",DA=RIEN,DR=".03////^S X=PIEN" D ^DIE ;stuff internal value for payer
"RTN","IBCNEHL3",226,0)
 Q
"RTN","IBCNEHL3",227,0)
 ;
"RTN","IBCNEHL3",228,0)
BUF ; Create Buffer Record if Doesn't Exist
"RTN","IBCNEHL3",229,0)
 ;
"RTN","IBCNEHL3",230,0)
 ; Input Variables
"RTN","IBCNEHL3",231,0)
 ; RIEN,RSTYPE,TQN
"RTN","IBCNEHL3",232,0)
 ;
"RTN","IBCNEHL3",233,0)
 ; Output Variables
"RTN","IBCNEHL3",234,0)
 ; ERROR,SYMBOL is killed,TQIEN and IRIEN may be reset
"RTN","IBCNEHL3",235,0)
 ;
"RTN","IBCNEHL3",236,0)
 N BUFF,IBFDA,UP
"RTN","IBCNEHL3",237,0)
 I $G(RSTYPE)="U" S (TQIEN,IRIEN)=""
"RTN","IBCNEHL3",238,0)
 D RP^IBCNEBF(RIEN,1)
"RTN","IBCNEHL3",239,0)
 S BUFF=+IBFDA
"RTN","IBCNEHL3",240,0)
 S UP(365,RIEN_",",.04)=+IBFDA
"RTN","IBCNEHL3",241,0)
 I RSTYPE="O" S UP(365.1,TQN_",",.05)=+IBFDA
"RTN","IBCNEHL3",242,0)
 D FILE^DIE("I","UP","ERROR")
"RTN","IBCNEHL3",243,0)
 K SYMBOL
"RTN","IBCNEHL3",244,0)
 Q
"RTN","IBCNEHL3",245,0)
 ;
"RTN","IBCNEHL3",246,0)
IIVPROC(BUFF) ; Set IIV Processed Date to current dt/tm & IIV stat (aka SYMBOL)
"RTN","IBCNEHL3",247,0)
 ; Input Variables
"RTN","IBCNEHL3",248,0)
 ; BUFF
"RTN","IBCNEHL3",249,0)
 ;
"RTN","IBCNEHL3",250,0)
 ; Output Variables
"RTN","IBCNEHL3",251,0)
 ; SYMBOL
"RTN","IBCNEHL3",252,0)
 ;
"RTN","IBCNEHL3",253,0)
 N IDUZ,UP
"RTN","IBCNEHL3",254,0)
 S UP(355.33,BUFF_",",.15)=$$NOW^XLFDT()
"RTN","IBCNEHL3",255,0)
 ;  Set IDUZ to the specific, non-human user.
"RTN","IBCNEHL3",256,0)
 S IDUZ=$$FIND1^DIC(200,"","X","INTERFACE,IB EIV")
"RTN","IBCNEHL3",257,0)
 D FILE^DIE("I","UP","ERROR")
"RTN","IBCNEHL3",258,0)
 ; set the symbol of the buffer entry
"RTN","IBCNEHL3",259,0)
 D BUFF^IBCNEUT2(BUFF,SYMBOL)  ; reset symbol to appropriate value
"RTN","IBCNEHL3",260,0)
 Q
"RTN","IBCNEHL3",261,0)
 ;
"RTN","IBCNEHL3",262,0)
PFN(IN1DATA) ;  Find Payer from HL7 msg
"RTN","IBCNEHL3",263,0)
 ;
"RTN","IBCNEHL3",264,0)
 ; Input Variables
"RTN","IBCNEHL3",265,0)
 ; IN1DATA, TRACE
"RTN","IBCNEHL3",266,0)
 ;
"RTN","IBCNEHL3",267,0)
 ; Output Variables
"RTN","IBCNEHL3",268,0)
 ; ERFLG,ERROR,PIEN
"RTN","IBCNEHL3",269,0)
 ;
"RTN","IBCNEHL3",270,0)
 N IERN,PAYRID
"RTN","IBCNEHL3",271,0)
 S PAYRID=$$CLNSTR^IBCNEHLU($P($P(IN1DATA,HLFS,4),$E(HL("ECH"))),HL("ECH"),$E(HL("ECH")))
"RTN","IBCNEHL3",272,0)
 S PIEN=+$$FIND1^DIC(365.12,"","MX",PAYRID)
"RTN","IBCNEHL3",273,0)
 I PIEN=0 D  Q
"RTN","IBCNEHL3",274,0)
 . S ERFLG=1,IERN=$$ERRN^IBCNEUT7("ERROR(""DIERR"")")
"RTN","IBCNEHL3",275,0)
 . S ERROR("DIERR",IERN,"TEXT",1)="National Id: "_PAYRID_" not found in Payer Table"
"RTN","IBCNEHL3",276,0)
 . S ERROR("DIERR",IERN,"TEXT",2)="for Trace Number: "_TRACE
"RTN","IBCNEHL3",277,0)
 Q
"RTN","IBCNEHL3",278,0)
 ;
"RTN","IBCNEHL3",279,0)
GIN1() ;Get IN1 segment
"RTN","IBCNEHL3",280,0)
 ;
"RTN","IBCNEHL3",281,0)
 ; Input Variables
"RTN","IBCNEHL3",282,0)
 ; HCT
"RTN","IBCNEHL3",283,0)
 ;
"RTN","IBCNEHL3",284,0)
 ; Returns value of SEGMT
"RTN","IBCNEHL3",285,0)
 ;
"RTN","IBCNEHL3",286,0)
 N IPCT,SEGMT
"RTN","IBCNEHL3",287,0)
 S IPCT=HCT,SEGMT=""
"RTN","IBCNEHL3",288,0)
 F  S IPCT=$O(^TMP($J,"IBCNEHLI",IPCT)) Q:IPCT=""  D
"RTN","IBCNEHL3",289,0)
 . I $E(^TMP($J,"IBCNEHLI",IPCT,0),1,3)="IN1" S SEGMT=^TMP($J,"IBCNEHLI",IPCT,0)
"RTN","IBCNEHL3",290,0)
 Q SEGMT
"RTN","IBCNEHL3",291,0)
 ;
"RTN","IBCNEHL3",292,0)
 ; =================================================================
"RTN","IBCNEHL3",293,0)
WARN ;  Create and send a response processing error warning message
"RTN","IBCNEHL3",294,0)
 ;
"RTN","IBCNEHL3",295,0)
 ; Input Variables
"RTN","IBCNEHL3",296,0)
 ; ERROR, TRACE
"RTN","IBCNEHL3",297,0)
 ;
"RTN","IBCNEHL3",298,0)
 ; Output Variables
"RTN","IBCNEHL3",299,0)
 ; ERFLG=1
"RTN","IBCNEHL3",300,0)
 ;
"RTN","IBCNEHL3",301,0)
 N MCT,MSG,SUBCNT,VEN,XMY
"RTN","IBCNEHL3",302,0)
 S VEN=0,MCT=9,ERFLG=1,SUBCNT=""
"RTN","IBCNEHL3",303,0)
 S MSG(1)="IMPORTANT: Error While Processing Response Message from the EC"
"RTN","IBCNEHL3",304,0)
 S MSG(2)="-------------------------------------------------------------"
"RTN","IBCNEHL3",305,0)
 S MSG(3)="*** IRM *** Please contact Help Desk because the"
"RTN","IBCNEHL3",306,0)
 S MSG(4)="response message received from the Eligibility Communicator"
"RTN","IBCNEHL3",307,0)
 S MSG(5)="could not be processed.  Programming changes may be necessary"
"RTN","IBCNEHL3",308,0)
 S MSG(6)="to properly handle the response."
"RTN","IBCNEHL3",309,0)
 S MSG(7)="The associated Trace # is "_$S($G(TRACE)="":"Unknown",1:TRACE)_". If applicable,"
"RTN","IBCNEHL3",310,0)
 S MSG(8)="please review the response with the eIV Response Report by Trace#."
"RTN","IBCNEHL3",311,0)
 S MSG(9)=" "
"RTN","IBCNEHL3",312,0)
 F  S VEN=$O(ERROR("DIERR",VEN)) Q:'VEN  D
"RTN","IBCNEHL3",313,0)
 .S MCT=MCT+1,MSG(MCT)="Error:"
"RTN","IBCNEHL3",314,0)
 .F  S SUBCNT=$O(ERROR("DIERR",VEN,"TEXT",SUBCNT)) Q:'SUBCNT  S MCT=MCT+1,MSG(MCT)=ERROR("DIERR",VEN,"TEXT",SUBCNT)
"RTN","IBCNEHL3",315,0)
 .S MCT=MCT+1,MSG(MCT)=" "
"RTN","IBCNEHL3",316,0)
 .I $G(ERROR("DIERR",VEN,"PARAM","FILE"))'="" S MCT=MCT+1,MSG(MCT)="File: "_ERROR("DIERR",VEN,"PARAM","FILE")
"RTN","IBCNEHL3",317,0)
 .I $G(ERROR("DIERR",VEN,"PARAM","IENS"))'="" S MCT=MCT+1,MSG(MCT)="IENS: "_ERROR("DIERR",VEN,"PARAM","IENS")
"RTN","IBCNEHL3",318,0)
 .I $G(ERROR("DIERR",VEN,"PARAM","FIELD"))'="" S MCT=MCT+1,MSG(MCT)="Field: "_ERROR("DIERR",VEN,"PARAM","FIELD")
"RTN","IBCNEHL3",319,0)
 .S MCT=MCT+1,MSG(MCT)=" "
"RTN","IBCNEHL3",320,0)
 .Q
"RTN","IBCNEHL3",321,0)
 D MSG^IBCNEUT5(MGRP,MSG(1),"MSG(",,.XMY)
"RTN","IBCNEHL3",322,0)
 Q
"RTN","IBCNEHL3",323,0)
 ;
"RTN","IBCNEHL3",324,0)
 ; =================================================================
"RTN","IBCNEHL3",325,0)
UEACT ; Send warning msg if Unknown Error Action Code was received or
"RTN","IBCNEHL3",326,0)
 ; encountered problem filing date
"RTN","IBCNEHL3",327,0)
 ;
"RTN","IBCNEHL3",328,0)
 ; Input Variables
"RTN","IBCNEHL3",329,0)
 ; ERROR, IBIEN, IBQFL, RIEN, RSTYPE, TQDATA, TRACE
"RTN","IBCNEHL3",330,0)
 ;
"RTN","IBCNEHL3",331,0)
 ; Output Variables
"RTN","IBCNEHL3",332,0)
 ; ERFLG=1 (SET IN WARN TAG)
"RTN","IBCNEHL3",333,0)
 ;
"RTN","IBCNEHL3",334,0)
 N DFN,SYMBOL
"RTN","IBCNEHL3",335,0)
 D WARN  ; send warning msg
"RTN","IBCNEHL3",336,0)
 ;
"RTN","IBCNEHL3",337,0)
 ; If the response could not be created or there is no associated TQ entry, stop processing
"RTN","IBCNEHL3",338,0)
 I '$G(RIEN)!(TQDATA="") Q
"RTN","IBCNEHL3",339,0)
 ;
"RTN","IBCNEHL3",340,0)
 ;  For an original response, set the Transmission Queue Status to 'Response Received' &
"RTN","IBCNEHL3",341,0)
 ;  update remaining retries to comm failure (5)
"RTN","IBCNEHL3",342,0)
 I $G(RSTYPE)="O" D SST^IBCNEUT2(TQN,3),RSTA^IBCNEUT7(TQN)
"RTN","IBCNEHL3",343,0)
 ;
"RTN","IBCNEHL3",344,0)
 ; If it is an identification and policy is not active don't
"RTN","IBCNEHL3",345,0)
 ; create buffer entry
"RTN","IBCNEHL3",346,0)
 I IBQFL="I",IIVSTAT'=1 Q
"RTN","IBCNEHL3",347,0)
 ;
"RTN","IBCNEHL3",348,0)
 ; If unsolicited message or no buffer in TQ, create new buffer entry
"RTN","IBCNEHL3",349,0)
 I RSTYPE="U" S IBIEN=""
"RTN","IBCNEHL3",350,0)
 I IBIEN="" D  Q
"RTN","IBCNEHL3",351,0)
 .  S DFN=$P(TQDATA,U,2)        ; Determine Patient DFN
"RTN","IBCNEHL3",352,0)
 .  S SYMBOL=22 D BUF^IBCNEHL3  ; Create a new buffer entry
"RTN","IBCNEHL3",353,0)
 ;
"RTN","IBCNEHL3",354,0)
 ;Update buffer symbol
"RTN","IBCNEHL3",355,0)
 D BUFF^IBCNEUT2(IBIEN,22)
"RTN","IBCNEHL3",356,0)
 ;
"RTN","IBCNEHL3",357,0)
 Q
"RTN","IBCNEHL3",358,0)
 ;
"RTN","IBCNEHL3",359,0)
CHK1() ; check auto-update criteria for patient who is the subscriber
"RTN","IBCNEHL3",360,0)
 ; called from tag AUTOUPD, uses variables defined there
"RTN","IBCNEHL3",361,0)
 ;
"RTN","IBCNEHL3",362,0)
 ; returns 1 if given policy satisfies auto-update criteria, returns 0 otherwise
"RTN","IBCNEHL3",363,0)
 N RES
"RTN","IBCNEHL3",364,0)
 S RES=0
"RTN","IBCNEHL3",365,0)
 I $P(RDATA13,U,2)'=$P(IDATA7,U,2) G CHK1X  ; Subscriber ID doesn't match   ; IB*2.0*497 compare subscriber ID data at their new locations
"RTN","IBCNEHL3",366,0)
 I $P(RDATA1,U,2)'=$P(IDATA3,U) G CHK1X  ; DOB doesn't match
"RTN","IBCNEHL3",367,0)
 I '$$NAMECMP^IBCNEHLU($P(RDATA13,U),$P(IDATA7,U)) G CHK1X  ; Insured's name doesn't match  ; IB*2.0*497 compare name of insured data at their new locations
"RTN","IBCNEHL3",368,0)
 S RES=1
"RTN","IBCNEHL3",369,0)
CHK1X ;
"RTN","IBCNEHL3",370,0)
 Q RES
"RTN","IBCNEHL3",371,0)
 ;
"RTN","IBCNEHL3",372,0)
CHK2(MWNRTYP) ; check auto-update criteria for patient who is not the subscriber
"RTN","IBCNEHL3",373,0)
 ; called from tag AUTOUPD, uses variables defined there
"RTN","IBCNEHL3",374,0)
 ;
"RTN","IBCNEHL3",375,0)
 ; returns 1 if policy satisfies auto-update criteria, returns 0 otherwise
"RTN","IBCNEHL3",376,0)
 N DOB,ID,IDATA5,IENS,NAME,PDOB,PNAME,RES
"RTN","IBCNEHL3",377,0)
 S RES=0
"RTN","IBCNEHL3",378,0)
 S IDATA5=$G(^DPT(IEN2,.312,IEN312,5))
"RTN","IBCNEHL3",379,0)
 S IENS=IEN2_","
"RTN","IBCNEHL3",380,0)
 S ID=$P(RDATA13,U,2)    ; IB*2.0*497 Subscriber ID needs to be retrieved from its new location
"RTN","IBCNEHL3",381,0)
 I ID'=$P(IDATA7,U,2),ID'=$P(IDATA5,U) G CHK2X  ; both Subscriber ID and Patient ID don't match ; IB*2.0*497 compare subscriber ID at new locations
"RTN","IBCNEHL3",382,0)
 S DOB=$P(RDATA1,U,2),PDOB=$$GET1^DIQ(2,IENS,.03,"I")
"RTN","IBCNEHL3",383,0)
 I DOB'=$P(IDATA3,U),DOB'=PDOB G CHK2X  ; both Subscriber and Patient DOB don't match
"RTN","IBCNEHL3",384,0)
 S NAME=$P(RDATA13,U),PNAME=$$GET1^DIQ(2,IENS,.01)   ; IB*2.0*497 get name of insured at its new location
"RTN","IBCNEHL3",385,0)
 I '+MWNRTYP,'$$NAMECMP^IBCNEHLU(NAME,$P(IDATA7,U)),'$$NAMECMP^IBCNEHLU(NAME,PNAME) G CHK2X  ; non-Medicare, both Subscriber and Patient name don't match ; IB*2*497
"RTN","IBCNEHL3",386,0)
 I +MWNRTYP,'$$NAMECMP^IBCNEHLU(NAME,PNAME) G CHK2X  ; Medicare, Patient name doesn't match
"RTN","IBCNEHL3",387,0)
 S RES=1
"RTN","IBCNEHL3",388,0)
CHK2X ;
"RTN","IBCNEHL3",389,0)
 Q RES
"RTN","IBCNEHL3",390,0)
 ;
"RTN","IBCNEHL3",391,0)
UPDIREC(RIEN,IEN312) ; IB*2*595/DM update INSUR RECORD IEN in the response file (#365,.12) 
"RTN","IBCNEHL3",392,0)
 ; RIEN - ien in eIV Response file (365)
"RTN","IBCNEHL3",393,0)
 ; IEN312 - ien in pat. insurance multiple (2.312)
"RTN","IBCNEHL3",394,0)
 ;
"RTN","IBCNEHL3",395,0)
 N DATA,ERROR,IENS
"RTN","IBCNEHL3",396,0)
 I RIEN'>0!(IEN312'>0) Q
"RTN","IBCNEHL3",397,0)
 ; IB*2*595/DM do not update TQ file. 
"RTN","IBCNEHL3",398,0)
 ; The proper INSUR RECORD IEN field is now located in the response file 
"RTN","IBCNEHL3",399,0)
 ;S IENS=$P($G(^IBCN(365,RIEN,0)),U,5)_"," I IENS="," Q
"RTN","IBCNEHL3",400,0)
 ;S DATA(365.1,IENS,.13)=IEN312
"RTN","IBCNEHL3",401,0)
 S DATA(365,RIEN_",",.12)=IEN312
"RTN","IBCNEHL3",402,0)
 D FILE^DIE("ET","DATA","ERROR")
"RTN","IBCNEHL3",403,0)
 Q
"RTN","IBCNEHL3",404,0)
 ;
"RTN","IBCNEHL3",405,0)
LCKERR ; send locking error message
"RTN","IBCNEHL3",406,0)
 N MSG,XMY
"RTN","IBCNEHL3",407,0)
 S MSG(1)="WARNING: Unable to Auto-file Response Message from the EC"
"RTN","IBCNEHL3",408,0)
 S MSG(2)="---------------------------------------------------------"
"RTN","IBCNEHL3",409,0)
 S MSG(3)="Failed to lock patient insurance entry:"
"RTN","IBCNEHL3",410,0)
 S MSG(4)="  Patient name - "_$$GET1^DIQ(2,DFN_",",.01)
"RTN","IBCNEHL3",411,0)
 S MSG(5)="  Insurance - "_$$GET1^DIQ(2.312,IENS,.01)
"RTN","IBCNEHL3",412,0)
 S MSG(6)="  IENS - "_$S($G(IENS)="":"Unknown",1:IENS)
"RTN","IBCNEHL3",413,0)
 S MSG(7)=" "
"RTN","IBCNEHL3",414,0)
 S MSG(8)="The response will be filed into Insurance Buffer instead."
"RTN","IBCNEHL3",415,0)
 S MSG(9)=" "
"RTN","IBCNEHL3",416,0)
 D MSG^IBCNEUT5(MGRP,MSG(1),"MSG(",,.XMY)
"RTN","IBCNEHL3",417,0)
 Q
"RTN","IBCNEHL3",418,0)
 ;
"RTN","IBCNEHL4")
0^17^B209669693^B176214857
"RTN","IBCNEHL4",1,0)
IBCNEHL4 ;DAOU/ALA - HL7 Process Incoming RPI Msgs (cont.) ;26-JUN-2002  ; Compiled December 16, 2004 15:35:46
"RTN","IBCNEHL4",2,0)
 ;;2.0;INTEGRATED BILLING;**300,416,438,497,506,519,621**;21-MAR-94;Build 8
"RTN","IBCNEHL4",3,0)
 ;;Per VA Directive 6402, this routine should not be modified.
"RTN","IBCNEHL4",4,0)
 ;
"RTN","IBCNEHL4",5,0)
 ;**Program Description**
"RTN","IBCNEHL4",6,0)
 ;  This pgm will process the non-repeating segments of the
"RTN","IBCNEHL4",7,0)
 ;  incoming eIV response msgs.
"RTN","IBCNEHL4",8,0)
 ;  It was separated out from IBCNEHL2 to conserve space.
"RTN","IBCNEHL4",9,0)
 ;  
"RTN","IBCNEHL4",10,0)
 ;  This routine is based on IBCNEHLP which was introduced with patch 184, and subsequently
"RTN","IBCNEHL4",11,0)
 ;  patched with patches 252 and 271.  IBCNEHLP is obsolete and deleted with patch 300.
"RTN","IBCNEHL4",12,0)
 ;
"RTN","IBCNEHL4",13,0)
 ; * Each of these tags are called by IBCNEHL2.
"RTN","IBCNEHL4",14,0)
 ;
"RTN","IBCNEHL4",15,0)
 ;  Variables
"RTN","IBCNEHL4",16,0)
 ;    SEG = HL7 Seg Name
"RTN","IBCNEHL4",17,0)
 ;    MSGID = Original Msg Control ID
"RTN","IBCNEHL4",18,0)
 ;    ACK =  Acknowledgment (AA=Accepted, AE=Error)
"RTN","IBCNEHL4",19,0)
 ;    ERTXT = Error Msg Text
"RTN","IBCNEHL4",20,0)
 ;    ERFLG = Error quit flag
"RTN","IBCNEHL4",21,0)
 ;    ERACT = Error Action
"RTN","IBCNEHL4",22,0)
 ;    ERCON = Error Condition
"RTN","IBCNEHL4",23,0)
 ;    RIEN = Response Record IEN
"RTN","IBCNEHL4",24,0)
 ;    IBSEG = Array of the segment
"RTN","IBCNEHL4",25,0)
 ;
"RTN","IBCNEHL4",26,0)
 Q  ; No direct calls
"RTN","IBCNEHL4",27,0)
 ;
"RTN","IBCNEHL4",28,0)
 ; IB*2*519  Only fixed line 2 of the routine. Changed "..497*506" to "..497,506"
"RTN","IBCNEHL4",29,0)
 ; 
"RTN","IBCNEHL4",30,0)
MSA ;  Process the MSA seg
"RTN","IBCNEHL4",31,0)
 ;
"RTN","IBCNEHL4",32,0)
 ;  Input:
"RTN","IBCNEHL4",33,0)
 ;  IBSEG,MGRP
"RTN","IBCNEHL4",34,0)
 ;
"RTN","IBCNEHL4",35,0)
 ;  Output:
"RTN","IBCNEHL4",36,0)
 ;  ERACT,ERCON,ERROR,ERTXT,RIEN,TRACE,ACK
"RTN","IBCNEHL4",37,0)
 ;
"RTN","IBCNEHL4",38,0)
 N MSGID,RSUPDT,VRFDT
"RTN","IBCNEHL4",39,0)
 S ACK=$G(IBSEG(2)),MSGID=$G(IBSEG(3)),TRACE=$G(IBSEG(4))
"RTN","IBCNEHL4",40,0)
 S ERTXT=$$DECHL7^IBCNEHL2($P($G(IBSEG(7)),$E(HLECH),2)),ERACT=$G(IBSEG(6)),ERCON=$P($G(IBSEG(7)),$E(HLECH),1)
"RTN","IBCNEHL4",41,0)
 ;
"RTN","IBCNEHL4",42,0)
 ; If no Control Id, send Mailman error msg
"RTN","IBCNEHL4",43,0)
 I MSGID="" D ERRMSA(TRACE,MGRP) S ERFLG=1 G MSAX
"RTN","IBCNEHL4",44,0)
 ;
"RTN","IBCNEHL4",45,0)
 ; Check for msg id/payer combination and get response IEN
"RTN","IBCNEHL4",46,0)
 D PCK^IBCNEHL3
"RTN","IBCNEHL4",47,0)
 ;
"RTN","IBCNEHL4",48,0)
 ; If no record IEN, quit
"RTN","IBCNEHL4",49,0)
 I $G(RIEN)="" G MSAX
"RTN","IBCNEHL4",50,0)
 ;
"RTN","IBCNEHL4",51,0)
 ;IB*2.0*621/TAZ - Process EICD Error messages
"RTN","IBCNEHL4",52,0)
 I EVENTYP=1 D
"RTN","IBCNEHL4",53,0)
 . N DFN
"RTN","IBCNEHL4",54,0)
 . S DFN=$$GET1^DIQ(365,RIEN_",",.02,"I")
"RTN","IBCNEHL4",55,0)
 . S IBTRACK(0,.04)=TRACE
"RTN","IBCNEHL4",56,0)
 . S IBTRACK(0,.06)=RIEN
"RTN","IBCNEHL4",57,0)
 . I ERTXT="" S IBTRACK(0,.07)=1 Q
"RTN","IBCNEHL4",58,0)
 . I $$UP^XLFSTR(ERTXT)["NO ACTIVE POLICIES" S IBTRACK(0,.07)=2 Q
"RTN","IBCNEHL4",59,0)
 . I $$UP^XLFSTR(ERTXT)["TIMEOUT" D  Q
"RTN","IBCNEHL4",60,0)
 .. S IBTRACK(0,.07)=3
"RTN","IBCNEHL4",61,0)
 .. ;Need to remove (EICD Last Date Run) from Patient File #2 - IB*2.0*621
"RTN","IBCNEHL4",62,0)
 .. S DA=DFN,DIE="^DPT(",DR="2001///@"
"RTN","IBCNEHL4",63,0)
 .. D ^DIE
"RTN","IBCNEHL4",64,0)
 .. K DA,DIE,DR
"RTN","IBCNEHL4",65,0)
 . S IBTRACK(0,.07)=0
"RTN","IBCNEHL4",66,0)
 ; Update record w/info
"RTN","IBCNEHL4",67,0)
 S RSUPDT(365,RIEN_",",.09)=TRACE,RSUPDT(365,RIEN_",",.06)=3
"RTN","IBCNEHL4",68,0)
 S RSUPDT(365,RIEN_",",4.01)=ERTXT
"RTN","IBCNEHL4",69,0)
 S VRFDT=$$NOW^XLFDT(),RSUPDT(365,RIEN_",",.07)=VRFDT
"RTN","IBCNEHL4",70,0)
 ;
"RTN","IBCNEHL4",71,0)
 ; Update w/internal values
"RTN","IBCNEHL4",72,0)
 D FILE^DIE("I","RSUPDT","ERROR")
"RTN","IBCNEHL4",73,0)
 ;
"RTN","IBCNEHL4",74,0)
 S RSUPDT(365,RIEN_",",1.14)=ERCON,RSUPDT(365,RIEN_",",1.15)=ERACT
"RTN","IBCNEHL4",75,0)
 ;
"RTN","IBCNEHL4",76,0)
 ; Update w/external values
"RTN","IBCNEHL4",77,0)
 D FILE^DIE("ET","RSUPDT","ERROR")
"RTN","IBCNEHL4",78,0)
MSAX ;
"RTN","IBCNEHL4",79,0)
 Q
"RTN","IBCNEHL4",80,0)
 ;
"RTN","IBCNEHL4",81,0)
ERRMSA(TRACE,MGRP) ; Msg Control Id is blank -  Send Mailman error msg
"RTN","IBCNEHL4",82,0)
 ;
"RTN","IBCNEHL4",83,0)
 N HCT,ICN,MSG,MSGCT,NAME,XMSUB
"RTN","IBCNEHL4",84,0)
 ;
"RTN","IBCNEHL4",85,0)
 ;1st find the PID seg to extract ICN and patient name
"RTN","IBCNEHL4",86,0)
 D GTICNM^IBCNEHLU(.ICN,.NAME)
"RTN","IBCNEHL4",87,0)
 ;
"RTN","IBCNEHL4",88,0)
 ;Send the Mailman error msg
"RTN","IBCNEHL4",89,0)
 S XMSUB="Message Control Id Field is Blank",MSGCT=$S(TRACE="":4,1:3)
"RTN","IBCNEHL4",90,0)
 S MSG(1)="A response was received w/a blank Message Control Id"
"RTN","IBCNEHL4",91,0)
 I TRACE="" S MSG(1)=MSG(1)_" and Trace #"
"RTN","IBCNEHL4",92,0)
 S MSG(2)="for "_$S(TRACE'="":"Trace #: "_TRACE_", ",1:"")_"ICN #: "_ICN_", Patient: "_NAME_"."
"RTN","IBCNEHL4",93,0)
 I TRACE="" D
"RTN","IBCNEHL4",94,0)
 . S MSG(3)="It is likely that there are communication issues with the EC."
"RTN","IBCNEHL4",95,0)
 S MSG(MSGCT)="This response cannot be processed.  Please contact the Help Desk."
"RTN","IBCNEHL4",96,0)
 D MSG^IBCNEUT5(MGRP,XMSUB,"MSG(")
"RTN","IBCNEHL4",97,0)
 Q
"RTN","IBCNEHL4",98,0)
 ;
"RTN","IBCNEHL4",99,0)
PID ;  Process the PID seg
"RTN","IBCNEHL4",100,0)
 N DFN,DOB,DOD,FLD,ICN,IENSTR,LFAC,LUPDT,NAME,RSUPDT,SEX,SSN,STATE,XDFN,IDLIST
"RTN","IBCNEHL4",101,0)
 N SUBCNT,SUBC,SUBCID,SUBCDATA,IERN
"RTN","IBCNEHL4",102,0)
 ;
"RTN","IBCNEHL4",103,0)
 S ERFLG=0
"RTN","IBCNEHL4",104,0)
 S DOB=$G(IBSEG(8)),SEX=$G(IBSEG(9))
"RTN","IBCNEHL4",105,0)
 S NAME=$G(IBSEG(6))
"RTN","IBCNEHL4",106,0)
 S DOD=$G(IBSEG(30)),LUPDT=$G(IBSEG(34)),LFAC=$G(IBSEG(35))
"RTN","IBCNEHL4",107,0)
 ;
"RTN","IBCNEHL4",108,0)
 ; Parse Repeating ID field to fill in other identifiers
"RTN","IBCNEHL4",109,0)
 S (ICN,SSN,DFN)=""
"RTN","IBCNEHL4",110,0)
 S IDLIST=$G(IBSEG(4))
"RTN","IBCNEHL4",111,0)
 F SUBCNT=1:1:$L(IDLIST,$E(HLECH,2,2)) D
"RTN","IBCNEHL4",112,0)
 . S SUBC=$P(IDLIST,$E(HLECH,2,2),SUBCNT)
"RTN","IBCNEHL4",113,0)
 . S SUBCID=$P(SUBC,$E(HLECH),5)    ; Identifier Type Code
"RTN","IBCNEHL4",114,0)
 . S SUBCDATA=$P(SUBC,$E(HLECH),1) ; Data Value
"RTN","IBCNEHL4",115,0)
 . I SUBCID="PI" S DFN=SUBCDATA
"RTN","IBCNEHL4",116,0)
 . I SUBCID="SS" S SSN=SUBCDATA
"RTN","IBCNEHL4",117,0)
 . I SUBCID="NI" S ICN=SUBCDATA
"RTN","IBCNEHL4",118,0)
 ;
"RTN","IBCNEHL4",119,0)
 ;  Convert data from HL7 format to VistA format
"RTN","IBCNEHL4",120,0)
 S NAME=$$DECHL7^IBCNEHL2($$FMNAME^HLFNC(NAME,HLECH))
"RTN","IBCNEHL4",121,0)
 S DOD=$$FMDATE^HLFNC(DOD),DOB=$$FMDATE^HLFNC(DOB),LUPDT=$$FMDATE^HLFNC(LUPDT)
"RTN","IBCNEHL4",122,0)
 ;
"RTN","IBCNEHL4",123,0)
 ; Use ICN to find the patients DFN at this site
"RTN","IBCNEHL4",124,0)
 I ICN'="" D
"RTN","IBCNEHL4",125,0)
 .S XDFN=$$GETDFN^MPIF001(ICN)
"RTN","IBCNEHL4",126,0)
 .; if unsuccessful, wait 5 sec and try one more time
"RTN","IBCNEHL4",127,0)
 .I +$G(XDFN)'>0 H 5 S XDFN=$$GETDFN^MPIF001(ICN)
"RTN","IBCNEHL4",128,0)
 .Q
"RTN","IBCNEHL4",129,0)
 I +$G(XDFN)'>0,+$G(ICN)>0 D  Q
"RTN","IBCNEHL4",130,0)
 . S ERFLG=1,IERN=$$ERRN^IBCNEUT7("ERROR(""DIERR"")")
"RTN","IBCNEHL4",131,0)
 . S ERROR("DIERR",IERN,"TEXT",1)="Unable to determine the patient's DFN value for this site."
"RTN","IBCNEHL4",132,0)
 . S ERROR("DIERR",IERN,"TEXT",2)=" The ICN for the patient in this response is ICN: "_ICN
"RTN","IBCNEHL4",133,0)
 . S ERROR("DIERR",IERN,"TEXT",3)=" eIV was unable to file the response information."
"RTN","IBCNEHL4",134,0)
 ;
"RTN","IBCNEHL4",135,0)
 I +ICN>0 S DFN=XDFN
"RTN","IBCNEHL4",136,0)
 ;
"RTN","IBCNEHL4",137,0)
 ;  Perform date of death check
"RTN","IBCNEHL4",138,0)
 I DOD'="" D DODCK^IBCNEHLU(DFN,DOD,MGRP,NAME,RIEN,SSN)
"RTN","IBCNEHL4",139,0)
 ;
"RTN","IBCNEHL4",140,0)
 S IENSTR=RIEN_","
"RTN","IBCNEHL4",141,0)
 I $P(^IBCN(365,RIEN,0),U,2)="" S RSUPDT(365,IENSTR,.02)=DFN
"RTN","IBCNEHL4",142,0)
 ;IB*2.0*621/TAZ - Only file DOB, SEX, SSN, PT RELATIONSHIP and ADDRESS on regular 271s
"RTN","IBCNEHL4",143,0)
 I EVENTYP'=1 D
"RTN","IBCNEHL4",144,0)
 . S RSUPDT(365,IENSTR,1.02)=DOB,RSUPDT(365,IENSTR,1.04)=SEX
"RTN","IBCNEHL4",145,0)
 . S RSUPDT(365,IENSTR,1.09)="01"
"RTN","IBCNEHL4",146,0)
 . S RSUPDT(365,IENSTR,1.03)=SSN
"RTN","IBCNEHL4",147,0)
 . ; Subscriber address
"RTN","IBCNEHL4",148,0)
 . S FLD=$G(IBSEG(12))
"RTN","IBCNEHL4",149,0)
 . S RSUPDT(365,IENSTR,5.01)=$P($P(FLD,HLCMP),HLSCMP) ; line 1
"RTN","IBCNEHL4",150,0)
 . S RSUPDT(365,IENSTR,5.02)=$P(FLD,HLCMP,2) ; line 2
"RTN","IBCNEHL4",151,0)
 . S RSUPDT(365,IENSTR,5.03)=$P(FLD,HLCMP,3) ; city
"RTN","IBCNEHL4",152,0)
 . S STATE=+$$FIND1^DIC(5,,"X",$P(FLD,HLCMP,4),"C") I STATE>0 S RSUPDT(365,IENSTR,5.04)=STATE ; state
"RTN","IBCNEHL4",153,0)
 . S RSUPDT(365,IENSTR,5.05)=$P(FLD,HLCMP,5) ; zip
"RTN","IBCNEHL4",154,0)
 . S RSUPDT(365,IENSTR,5.06)=$P(FLD,HLCMP,6) ; country
"RTN","IBCNEHL4",155,0)
 . S RSUPDT(365,IENSTR,5.07)=$P(FLD,HLCMP,8) ; country subdivision
"RTN","IBCNEHL4",156,0)
 S RSUPDT(365,IENSTR,1.16)=DOD
"RTN","IBCNEHL4",157,0)
 S RSUPDT(365,IENSTR,1.08)="v"
"RTN","IBCNEHL4",158,0)
 D FILE^DIE("I","RSUPDT","ERROR") Q:$D(ERROR)
"RTN","IBCNEHL4",159,0)
 ; IB*2*497 - add the following lines 
"RTN","IBCNEHL4",160,0)
 ; the value at NAME OF INSURED (365,13.01) must be validated before it can be filed; pass the 'E' flag to DBS filer
"RTN","IBCNEHL4",161,0)
 ; IB*2.0*621/TAZ Only file NAME OF INSURED on regular 271's
"RTN","IBCNEHL4",162,0)
 I EVENTYP'=1 D
"RTN","IBCNEHL4",163,0)
 . K RSUPDT
"RTN","IBCNEHL4",164,0)
 . S RSUPDT(365,IENSTR,13.01)=NAME
"RTN","IBCNEHL4",165,0)
 . D FILE^DIE("E","RSUPDT","ERROR")
"RTN","IBCNEHL4",166,0)
PIDX ;
"RTN","IBCNEHL4",167,0)
 Q
"RTN","IBCNEHL4",168,0)
 ;
"RTN","IBCNEHL4",169,0)
GT1 ;  Process the GT1 Guarantor seg
"RTN","IBCNEHL4",170,0)
 ;
"RTN","IBCNEHL4",171,0)
 ; Input:
"RTN","IBCNEHL4",172,0)
 ; IBSEG,RIEN
"RTN","IBCNEHL4",173,0)
 ;
"RTN","IBCNEHL4",174,0)
 ; Output:
"RTN","IBCNEHL4",175,0)
 ; ERROR,SUBID
"RTN","IBCNEHL4",176,0)
 ;
"RTN","IBCNEHL4",177,0)
 N DOB,IENSTR,NAME,RSUPDT,SEX,SSN,SUBIDC
"RTN","IBCNEHL4",178,0)
 S NAME=$G(IBSEG(4)),DOB=$G(IBSEG(9)),SEX=$G(IBSEG(10))
"RTN","IBCNEHL4",179,0)
 S SSN=$G(IBSEG(13)) ; fsc NO LONGER SENDS SSN for regular 271's
"RTN","IBCNEHL4",180,0)
 ; 
"RTN","IBCNEHL4",181,0)
 S SUBIDC=$G(IBSEG(3))  ; Raw field with sub-comp.
"RTN","IBCNEHL4",182,0)
 S SUBID=$P(SUBIDC,$E(HLECH),1)
"RTN","IBCNEHL4",183,0)
 S SUBID=$$DECHL7^IBCNEHL2(SUBID)
"RTN","IBCNEHL4",184,0)
 ;
"RTN","IBCNEHL4",185,0)
 S DOB=$$FMDATE^HLFNC(DOB),NAME=$$DECHL7^IBCNEHL2($$FMNAME^HLFNC(NAME,HLECH))
"RTN","IBCNEHL4",186,0)
 ;
"RTN","IBCNEHL4",187,0)
 ;IB*2.0*621/TAZ - Process EICD Identification Response and Quit
"RTN","IBCNEHL4",188,0)
 I EVENTYP=1 D  G GT1X
"RTN","IBCNEHL4",189,0)
 . N FLG,SETID,STATE
"RTN","IBCNEHL4",190,0)
 . S SETID=$G(IBSEG(2))
"RTN","IBCNEHL4",191,0)
 . S IBTRACK(SETID,.04)=SUBID
"RTN","IBCNEHL4",192,0)
 . S IBTRACK(SETID,.06)=SSN
"RTN","IBCNEHL4",193,0)
 . S:DOB'="" IBTRACK(SETID,.07)=DOB
"RTN","IBCNEHL4",194,0)
 . S IBTRACK(SETID,.08)=SEX
"RTN","IBCNEHL4",195,0)
 . S IBTRACK(SETID,.09)=NAME
"RTN","IBCNEHL4",196,0)
 . S FLD=$G(IBSEG(6))
"RTN","IBCNEHL4",197,0)
 . S IBTRACK(SETID,.1)=$P($P(FLD,HLCMP),HLSCMP)  ;Subscriber Address 1
"RTN","IBCNEHL4",198,0)
 . S IBTRACK(SETID,.11)=$P(FLD,HLCMP,2) ;Subscriber Address 2
"RTN","IBCNEHL4",199,0)
 . S IBTRACK(SETID,.12)=$P(FLD,HLCMP,3) ;Subscriber City
"RTN","IBCNEHL4",200,0)
 . S STATE=+$$FIND1^DIC(5,,"X",$P(FLD,HLCMP,4),"C") I STATE>0 S IBTRACK(SETID,.13)=STATE ;Subscriber State
"RTN","IBCNEHL4",201,0)
 . S IBTRACK(SETID,.14)=$P(FLD,HLCMP,5) ;Subscriber Zip
"RTN","IBCNEHL4",202,0)
 . S IBTRACK(SETID,.15)=1
"RTN","IBCNEHL4",203,0)
 S IENSTR=RIEN_","
"RTN","IBCNEHL4",204,0)
 S RSUPDT(365,RIEN_",",1.08)=""
"RTN","IBCNEHL4",205,0)
 S:DOB'="" RSUPDT(365,IENSTR,1.02)=DOB
"RTN","IBCNEHL4",206,0)
 S RSUPDT(365,RIEN_",",1.04)=SEX
"RTN","IBCNEHL4",207,0)
 S RSUPDT(365,IENSTR,1.03)=SSN
"RTN","IBCNEHL4",208,0)
 S RSUPDT(365,IENSTR,1.18)=SUBID
"RTN","IBCNEHL4",209,0)
 ; Subscriber address
"RTN","IBCNEHL4",210,0)
 S FLD=$G(IBSEG(6))
"RTN","IBCNEHL4",211,0)
 S RSUPDT(365,IENSTR,5.01)=$P($P(FLD,HLCMP),HLSCMP) ; line 1
"RTN","IBCNEHL4",212,0)
 S RSUPDT(365,IENSTR,5.02)=$P(FLD,HLCMP,2) ; line 2
"RTN","IBCNEHL4",213,0)
 S RSUPDT(365,IENSTR,5.03)=$P(FLD,HLCMP,3) ; city
"RTN","IBCNEHL4",214,0)
 S STATE=+$$FIND1^DIC(5,,"X",$P(FLD,HLCMP,4),"C") I STATE>0 S RSUPDT(365,IENSTR,5.04)=STATE ; state
"RTN","IBCNEHL4",215,0)
 S RSUPDT(365,IENSTR,5.05)=$P(FLD,HLCMP,5) ; zip
"RTN","IBCNEHL4",216,0)
 S RSUPDT(365,IENSTR,5.06)=$P(FLD,HLCMP,6) ; country
"RTN","IBCNEHL4",217,0)
 S RSUPDT(365,IENSTR,5.07)=$P(FLD,HLCMP,8) ; country subdivision
"RTN","IBCNEHL4",218,0)
 D FILE^DIE("I","RSUPDT","ERROR") Q:$D(ERROR)
"RTN","IBCNEHL4",219,0)
 ; IB*2*497 - add the following lines 
"RTN","IBCNEHL4",220,0)
 ; the value at NAME OF INSURED (365,13.01) must be validated before it can be filed; pass the 'E' flag to DBS filer
"RTN","IBCNEHL4",221,0)
 K RSUPDT
"RTN","IBCNEHL4",222,0)
 S RSUPDT(365,IENSTR,13.01)=NAME
"RTN","IBCNEHL4",223,0)
 D FILE^DIE("E","RSUPDT","ERROR")
"RTN","IBCNEHL4",224,0)
GT1X ;
"RTN","IBCNEHL4",225,0)
 Q
"RTN","IBCNEHL4",226,0)
 ;
"RTN","IBCNEHL4",227,0)
ZHS(EBDA,ERROR,IBSEG,RIEN) ; Process ZHS Healthcare services delivery segment
"RTN","IBCNEHL4",228,0)
 N IENSTR,RSUPDT,QUAL,VALUE
"RTN","IBCNEHL4",229,0)
 Q:$G(EBDA)=""  ; Quit if EB multiple ien is missing
"RTN","IBCNEHL4",230,0)
 S IENSTR="+1,"_EBDA_","_RIEN_","
"RTN","IBCNEHL4",231,0)
 S RSUPDT(365.27,IENSTR,.01)=+$O(^IBCN(365,RIEN,2,EBDA,7,"B",""),-1)+1 ; ZHS sequence
"RTN","IBCNEHL4",232,0)
 ; Benefit quantity & qualifier
"RTN","IBCNEHL4",233,0)
 S QUAL=$P($G(IBSEG(3)),HLCMP),VALUE=$G(IBSEG(4))
"RTN","IBCNEHL4",234,0)
 I VALUE'="",QUAL'="" S RSUPDT(365.27,IENSTR,.02)=$$NUMCHK^IBCNEHL2(VALUE),RSUPDT(365.27,IENSTR,.03)=QUAL
"RTN","IBCNEHL4",235,0)
 ; Sampling frequency & qualifier
"RTN","IBCNEHL4",236,0)
 S QUAL=$P($G(IBSEG(5)),HLCMP),VALUE=$G(IBSEG(6))
"RTN","IBCNEHL4",237,0)
 I VALUE'="",QUAL'="" S RSUPDT(365.27,IENSTR,.04)=VALUE,RSUPDT(365.27,IENSTR,.05)=QUAL
"RTN","IBCNEHL4",238,0)
 ; Time period & qualifier
"RTN","IBCNEHL4",239,0)
 S QUAL=$P($G(IBSEG(7)),HLCMP),VALUE=$G(IBSEG(8))
"RTN","IBCNEHL4",240,0)
 I VALUE'="",QUAL'="" S RSUPDT(365.27,IENSTR,.06)=$$NUMCHK^IBCNEHL2(VALUE),RSUPDT(365.27,IENSTR,.07)=QUAL
"RTN","IBCNEHL4",241,0)
 S RSUPDT(365.27,IENSTR,.08)=$P($G(IBSEG(9)),HLCMP) ; Delivery frequency
"RTN","IBCNEHL4",242,0)
 S RSUPDT(365.27,IENSTR,.09)=$P($G(IBSEG(10)),HLCMP) ; Delivery pattern
"RTN","IBCNEHL4",243,0)
 D CODECHK^IBCNEHLU(.RSUPDT)  ; IB*2*497  check for new coded values
"RTN","IBCNEHL4",244,0)
 D UPDATE^DIE("E","RSUPDT",,"ERROR")
"RTN","IBCNEHL4",245,0)
 Q
"RTN","IBCNEHL4",246,0)
 ;
"RTN","IBCNEHL4",247,0)
ZRF(EBDA,ERROR,IBSEG,RIEN) ; Process ZRF Reference identification segment
"RTN","IBCNEHL4",248,0)
 N IENSTR,RSUPDT,QUAL,VALUE
"RTN","IBCNEHL4",249,0)
 Q:$G(EBDA)=""  ; Quit if EB multiple ien is missing
"RTN","IBCNEHL4",250,0)
 S IENSTR="+1,"_EBDA_","_RIEN_","
"RTN","IBCNEHL4",251,0)
 S RSUPDT(365.291,IENSTR,.01)=+$O(^IBCN(365,RIEN,2,EBDA,10,"B",""),-1)+1 ; ZRF sequence
"RTN","IBCNEHL4",252,0)
 ; Reference id & qualifier
"RTN","IBCNEHL4",253,0)
 S QUAL=$P($G(IBSEG(3)),HLCMP),VALUE=$G(IBSEG(4))
"RTN","IBCNEHL4",254,0)
 I VALUE'="",QUAL'="" S RSUPDT(365.291,IENSTR,.02)=VALUE,RSUPDT(365.291,IENSTR,.03)=QUAL
"RTN","IBCNEHL4",255,0)
 S RSUPDT(365.291,IENSTR,.04)=$G(IBSEG(5)) ; Description
"RTN","IBCNEHL4",256,0)
 D CODECHK^IBCNEHLU(.RSUPDT)  ; IB*2*497  check for new coded values
"RTN","IBCNEHL4",257,0)
 D UPDATE^DIE("E","RSUPDT",,"ERROR")
"RTN","IBCNEHL4",258,0)
 Q
"RTN","IBCNEHL4",259,0)
 ;
"RTN","IBCNEHL4",260,0)
ZSD(EBDA,ERROR,IBSEG,RIEN) ; Process ZSD Subscriber date segment
"RTN","IBCNEHL4",261,0)
 N IENSTR,RSUPDT,QUAL,VALUE
"RTN","IBCNEHL4",262,0)
 Q:$G(EBDA)=""  ; Quit if EB multiple ien is missing
"RTN","IBCNEHL4",263,0)
 S IENSTR="+1,"_EBDA_","_RIEN_","
"RTN","IBCNEHL4",264,0)
 S RSUPDT(365.28,IENSTR,.01)=+$O(^IBCN(365,RIEN,2,EBDA,8,"B",""),-1)+1 ; ZSD sequence
"RTN","IBCNEHL4",265,0)
 ; Date & qualifier
"RTN","IBCNEHL4",266,0)
 S QUAL=$P($G(IBSEG(3)),HLCMP),VALUE=$P($G(IBSEG(5)),HLCMP)
"RTN","IBCNEHL4",267,0)
 I VALUE'="",QUAL'="" S RSUPDT(365.28,IENSTR,.02)=VALUE,RSUPDT(365.28,IENSTR,.03)=QUAL
"RTN","IBCNEHL4",268,0)
 S RSUPDT(365.28,IENSTR,.04)=$P($G(IBSEG(4)),HLCMP) ; Date format
"RTN","IBCNEHL4",269,0)
 D CODECHK^IBCNEHLU(.RSUPDT)  ; IB*2*497  check for new coded values
"RTN","IBCNEHL4",270,0)
 D UPDATE^DIE("E","RSUPDT",,"ERROR")
"RTN","IBCNEHL4",271,0)
 Q
"RTN","IBCNEHL4",272,0)
 ;
"RTN","IBCNEHL4",273,0)
ZII(EBDA,ERROR,IBSEG,RIEN) ; Process ZII Subscriber additional info segment
"RTN","IBCNEHL4",274,0)
 N IENSTR,RSUPDT,QUAL,VALUE
"RTN","IBCNEHL4",275,0)
 Q:$G(EBDA)=""  ; Quit if EB multiple ien is missing
"RTN","IBCNEHL4",276,0)
 S IENSTR="+1,"_EBDA_","_RIEN_","
"RTN","IBCNEHL4",277,0)
 S RSUPDT(365.29,IENSTR,.01)=+$O(^IBCN(365,RIEN,2,EBDA,9,"B",""),-1)+1 ; ZII sequence
"RTN","IBCNEHL4",278,0)
 ; place of service or diagnosis (if qualifier is "BF" or "BK") & qualifier
"RTN","IBCNEHL4",279,0)
 S QUAL=$P($G(IBSEG(3)),HLCMP)
"RTN","IBCNEHL4",280,0)
 ; IB*2*497 set up for Nature of Injury type qualifiers "GR", "NI", or null value
"RTN","IBCNEHL4",281,0)
 I (QUAL="")!(".GR.NI."[("."_QUAL_".")) D
"RTN","IBCNEHL4",282,0)
 . S RSUPDT(365.29,IENSTR,.05)=$P($G(IBSEG(5)),U,2) ;nature of injury code
"RTN","IBCNEHL4",283,0)
 . S RSUPDT(365.29,IENSTR,.06)=$P($G(IBSEG(6)),U,2) ; nature of injury code category
"RTN","IBCNEHL4",284,0)
 . S RSUPDT(365.29,IENSTR,.07)=$G(IBSEG(7))  ; nature of injury code free text description
"RTN","IBCNEHL4",285,0)
 E  S RSUPDT(365.29,IENSTR,$S(".BF.BK."[("."_QUAL_"."):.03,1:.02))=$P($G(IBSEG(4)),HLCMP)
"RTN","IBCNEHL4",286,0)
 S RSUPDT(365.29,IENSTR,.04)=QUAL
"RTN","IBCNEHL4",287,0)
 D CODECHK^IBCNEHLU(.RSUPDT) ; IB*2*497  check for new coded values
"RTN","IBCNEHL4",288,0)
 D UPDATE^DIE("E","RSUPDT",,"ERROR")
"RTN","IBCNEHL4",289,0)
 Q
"RTN","IBCNEHL4",290,0)
 ;
"RTN","IBCNEHL4",291,0)
ZTY(EBDA,ERROR,IBSEG,RIEN) ; Process ZTY Benefit related entity segment
"RTN","IBCNEHL4",292,0)
 N FLD,IENSTR,RSUPDT,QUAL,VALUE
"RTN","IBCNEHL4",293,0)
 Q:$G(EBDA)=""  ; Quit if EB multiple ien is missing
"RTN","IBCNEHL4",294,0)
 S IENSTR=EBDA_","_RIEN_","
"RTN","IBCNEHL4",295,0)
 ; Entity id code & qualifier
"RTN","IBCNEHL4",296,0)
 S QUAL=$P($G(IBSEG(4)),HLCMP),VALUE=$P($G(IBSEG(3)),HLCMP)
"RTN","IBCNEHL4",297,0)
 I VALUE'="",QUAL'="" S RSUPDT(365.02,IENSTR,3.01)=VALUE,RSUPDT(365.02,IENSTR,3.02)=QUAL
"RTN","IBCNEHL4",298,0)
 ; Entity name
"RTN","IBCNEHL4",299,0)
 S FLD=$G(IBSEG(5))
"RTN","IBCNEHL4",300,0)
 ;S RSUPDT(365.02,IENSTR,3.03)=$P($P(FLD,HLCMP),HLSCMP)_","_$P(FLD,HLCMP,2)_" "_$P(FLD,HLCMP,3)_" "_$P(FLD,HLCMP,4)
"RTN","IBCNEHL4",301,0)
 S RSUPDT(365.02,IENSTR,3.03)=$P($P(FLD,HLCMP),HLSCMP)_" "_$P(FLD,HLCMP,2)_" "_$P(FLD,HLCMP,3)_" "_$P(FLD,HLCMP,4)  ;ib*2*497  prevent orphan commas
"RTN","IBCNEHL4",302,0)
 ; make sure that name is not empty
"RTN","IBCNEHL4",303,0)
 ;I $TR(RSUPDT(365.02,IENSTR,3.03),", ")="" K RSUPDT(365.02,IENSTR,3.03)
"RTN","IBCNEHL4",304,0)
 I $TR(RSUPDT(365.02,IENSTR,3.03)," ")="" K RSUPDT(365.02,IENSTR,3.03)  ;ib*2*497  remove comma from $TR statement
"RTN","IBCNEHL4",305,0)
 ; Entity id & qualifier
"RTN","IBCNEHL4",306,0)
 S QUAL=$P($G(IBSEG(6)),HLCMP),VALUE=$G(IBSEG(7))
"RTN","IBCNEHL4",307,0)
 I VALUE'="",QUAL'="" S RSUPDT(365.02,IENSTR,3.04)=VALUE,RSUPDT(365.02,IENSTR,3.05)=QUAL
"RTN","IBCNEHL4",308,0)
 ; IB*2*497 - entity relationship code
"RTN","IBCNEHL4",309,0)
 S RSUPDT(365.02,IENSTR,3.06)=$G(IBSEG(14))
"RTN","IBCNEHL4",310,0)
 ; Entity address
"RTN","IBCNEHL4",311,0)
 S FLD=$G(IBSEG(8))
"RTN","IBCNEHL4",312,0)
 S RSUPDT(365.02,IENSTR,4.01)=$P($P(FLD,HLCMP),HLSCMP) ; line 1
"RTN","IBCNEHL4",313,0)
 S RSUPDT(365.02,IENSTR,4.02)=$P(FLD,HLCMP,2) ; line 2
"RTN","IBCNEHL4",314,0)
 S RSUPDT(365.02,IENSTR,4.03)=$P(FLD,HLCMP,3) ; city
"RTN","IBCNEHL4",315,0)
 S VALUE=+$$FIND1^DIC(5,,"X",$P(FLD,HLCMP,4),"C") I VALUE>0 S RSUPDT(365.02,IENSTR,4.04)=VALUE ; state
"RTN","IBCNEHL4",316,0)
 S RSUPDT(365.02,IENSTR,4.05)=$P(FLD,HLCMP,5) ; zip / postal code
"RTN","IBCNEHL4",317,0)
 S RSUPDT(365.02,IENSTR,4.06)=$P(FLD,HLCMP,6) ; country code
"RTN","IBCNEHL4",318,0)
 S RSUPDT(365.02,IENSTR,4.09)=$P(FLD,HLCMP,8) ; country subdivision code
"RTN","IBCNEHL4",319,0)
 ; Entity location & qualifier
"RTN","IBCNEHL4",320,0)
 S QUAL=$G(IBSEG(9)),VALUE=$G(IBSEG(10))
"RTN","IBCNEHL4",321,0)
 I VALUE'="",QUAL'="" S RSUPDT(365.02,IENSTR,4.07)=VALUE,RSUPDT(365.02,IENSTR,4.08)=QUAL
"RTN","IBCNEHL4",322,0)
 ; Provider code
"RTN","IBCNEHL4",323,0)
 S RSUPDT(365.02,IENSTR,5.01)=$P($G(IBSEG(11)),HLCMP)
"RTN","IBCNEHL4",324,0)
 ; Reference id & qualifier
"RTN","IBCNEHL4",325,0)
 S QUAL=$P($G(IBSEG(12)),HLCMP),VALUE=$G(IBSEG(13))
"RTN","IBCNEHL4",326,0)
 I VALUE'="",QUAL'="" S RSUPDT(365.02,IENSTR,5.02)=VALUE,RSUPDT(365.02,IENSTR,5.03)=QUAL
"RTN","IBCNEHL4",327,0)
 D CODECHK^IBCNEHLU(.RSUPDT)  ; IB*2*497  check for new coded values
"RTN","IBCNEHL4",328,0)
 D FILE^DIE("ET","RSUPDT","ERROR")
"RTN","IBCNEHL4",329,0)
 Q
"RTN","IBCNEHL4",330,0)
 ;
"RTN","IBCNEHL4",331,0)
G2OCTD(EBDA,ERROR,IBSEG,RIEN) ; Process G2O.CTD Benefit related entity contact data segment
"RTN","IBCNEHL4",332,0)
 N FLD,IENSTR,RSUPDT,QUAL,VALUE
"RTN","IBCNEHL4",333,0)
 Q:$G(EBDA)=""  ; Quit if EB multiple ien is missing
"RTN","IBCNEHL4",334,0)
 S IENSTR="+1,"_EBDA_","_RIEN_","
"RTN","IBCNEHL4",335,0)
 S RSUPDT(365.26,IENSTR,.01)=+$O(^IBCN(365,RIEN,2,EBDA,6,"B",""),-1)+1 ; G2O.CTD sequence
"RTN","IBCNEHL4",336,0)
 ; Contact name
"RTN","IBCNEHL4",337,0)
 S FLD=$G(IBSEG(3))
"RTN","IBCNEHL4",338,0)
 S RSUPDT(365.26,IENSTR,.02)=$P(FLD,HLCMP,5)_" "_$P($P(FLD,HLCMP),HLSCMP)_","_$P(FLD,HLCMP,2)_" "_$P(FLD,HLCMP,3)_" "_$P(FLD,HLCMP,4)_" "_$P(FLD,HLCMP,6)
"RTN","IBCNEHL4",339,0)
 ; make sure that name is not empty
"RTN","IBCNEHL4",340,0)
 I $TR(RSUPDT(365.26,IENSTR,.02),", ")="" K RSUPDT(365.26,IENSTR,.02)
"RTN","IBCNEHL4",341,0)
 ; Contact number & qualifier
"RTN","IBCNEHL4",342,0)
 S FLD=$G(IBSEG(6)),QUAL=$P(FLD,HLCMP,9),VALUE=$P(FLD,HLCMP)
"RTN","IBCNEHL4",343,0)
 I VALUE'="",QUAL'="" S RSUPDT(365.26,IENSTR,1)=VALUE,RSUPDT(365.26,IENSTR,.04)=QUAL ;ib*2*497  stuff COMMUNICATION NUMBER data into its new location (365.26,1) 
"RTN","IBCNEHL4",344,0)
 D CODECHK^IBCNEHLU(.RSUPDT)  ; IB*2*497  check for new coded values
"RTN","IBCNEHL4",345,0)
 D UPDATE^DIE("E","RSUPDT",,"ERROR")
"RTN","IBCNEHL4",346,0)
 Q
"RTN","IBCNEHL4",347,0)
 ;
"RTN","IBCNEHL4",348,0)
ERR(ERDA,ERROR,IBSEG,RIEN) ; Process ERR Reject reasons segment
"RTN","IBCNEHL4",349,0)
 N I,IENARR,IENSTR,FLD,LOC,RSUPDT,VAL
"RTN","IBCNEHL4",350,0)
 S IENSTR="+1,"_RIEN_","
"RTN","IBCNEHL4",351,0)
 S RSUPDT(365.06,IENSTR,.01)=+$O(^IBCN(365,RIEN,6,"B",""),-1)+1 ; ERR sequence
"RTN","IBCNEHL4",352,0)
 S FLD=$G(IBSEG(3)),LOC=$P(FLD,HLCMP)
"RTN","IBCNEHL4",353,0)
 F I=2:1:6 S VAL=$P(FLD,HLCMP,2) I VAL'="" S LOC=LOC_$S(I=2!(I=4):"("_VAL_")",1:"."_VAL_".")
"RTN","IBCNEHL4",354,0)
 S RSUPDT(365.06,IENSTR,.02)=LOC ; Error location (HL7)
"RTN","IBCNEHL4",355,0)
 S RSUPDT(365.06,IENSTR,.03)=$P($G(IBSEG(6)),HLCMP) ; Reject reason
"RTN","IBCNEHL4",356,0)
 S RSUPDT(365.06,IENSTR,.04)=$G(IBSEG(9)) ; Action code
"RTN","IBCNEHL4",357,0)
 S RSUPDT(365.06,IENSTR,.05)=$G(IBSEG(8)) ; Loop id
"RTN","IBCNEHL4",358,0)
 S RSUPDT(365.06,IENSTR,.06)=$P($G(IBSEG(6)),HLCMP,3) ; Source
"RTN","IBCNEHL4",359,0)
 D CODECHK^IBCNEHLU(.RSUPDT)  ; IB*2*497  check for new coded values
"RTN","IBCNEHL4",360,0)
 D UPDATE^DIE("E","RSUPDT","IENARR","ERROR")
"RTN","IBCNEHL4",361,0)
 S ERDA=IENARR(1)
"RTN","IBCNEHL4",362,0)
 Q
"RTN","IBCNEHL4",363,0)
 ;
"RTN","IBCNEHL4",364,0)
NTE(ERDA,ERROR,IBSEG,RIEN) ; Process NTE segment
"RTN","IBCNEHL4",365,0)
 N DA,IENS,MSG,MSGSTR,RSUPDT,Z
"RTN","IBCNEHL4",366,0)
 S DA(1)=RIEN,DA=ERDA
"RTN","IBCNEHL4",367,0)
 S IENS=$$IENS^DILF(.DA)
"RTN","IBCNEHL4",368,0)
 S MSGSTR=$G(IBSEG(4))
"RTN","IBCNEHL4",369,0)
 F Z=1:1 S MSG=$P(MSGSTR,HLREP,Z) Q:MSG=""  S RSUPDT(365.061,"+"_Z_","_IENS,".01")=MSG  ;IB*506  Q:'MSG
"RTN","IBCNEHL4",370,0)
 I $D(RSUPDT) D UPDATE^DIE("E","RSUPDT",,"ERROR")
"RTN","IBCNEHL4",371,0)
 Q
"RTN","IBCNEHL4",372,0)
 ;
"RTN","IBCNEHL4",373,0)
ZTP(ERROR,IBSEG,RIEN) ; Process ZTP Subscriber date (subscriber level) segment
"RTN","IBCNEHL4",374,0)
 N IENSTR,QUAL,RSUPDT,VALUE,Z
"RTN","IBCNEHL4",375,0)
 S IENSTR="+1,"_RIEN_","
"RTN","IBCNEHL4",376,0)
 S RSUPDT(365.07,IENSTR,.01)=+$O(^IBCN(365,RIEN,7,"B",""),-1)+1 ; ZTP sequence
"RTN","IBCNEHL4",377,0)
 ; Date & qualifier
"RTN","IBCNEHL4",378,0)
 S QUAL=$P($G(IBSEG(3)),HLCMP),VALUE=$P($P($G(IBSEG(4)),HLCMP),HLSCMP)
"RTN","IBCNEHL4",379,0)
 S Z=$P($P($G(IBSEG(4)),HLCMP,2),HLSCMP) I Z'="" S VALUE=VALUE_" - "_Z
"RTN","IBCNEHL4",380,0)
 I VALUE'="",QUAL'="" S RSUPDT(365.07,IENSTR,.02)=VALUE,RSUPDT(365.07,IENSTR,.03)=QUAL
"RTN","IBCNEHL4",381,0)
 S RSUPDT(365.07,IENSTR,.04)=$G(IBSEG(5)) ; Loop id
"RTN","IBCNEHL4",382,0)
 D CODECHK^IBCNEHLU(.RSUPDT)  ; IB*2*497  check for new coded values
"RTN","IBCNEHL4",383,0)
 D UPDATE^DIE("E","RSUPDT",,"ERROR")
"RTN","IBCNEHL4",384,0)
 Q
"RTN","IBCNEHL6")
0^21^B7440508^B6767366
"RTN","IBCNEHL6",1,0)
IBCNEHL6 ;EDE/DM - HL7 Process Incoming RPI Continued ; 19-OCT-2017
"RTN","IBCNEHL6",2,0)
 ;;2.0;INTEGRATED BILLING;**601,621**;21-MAR-94;Build 8
"RTN","IBCNEHL6",3,0)
 ;;Per VA Directive 6402, this routine should not be modified.
"RTN","IBCNEHL6",4,0)
 ;
"RTN","IBCNEHL6",5,0)
 Q
"RTN","IBCNEHL6",6,0)
FIL ; Finish processing the response message - file into insurance buffer
"RTN","IBCNEHL6",7,0)
 ;
"RTN","IBCNEHL6",8,0)
 ; Input Variables
"RTN","IBCNEHL6",9,0)
 ; ERACT, ERFLG, ERROR, IIVSTAT, MAP, RIEN, TRACE, TRKIEN
"RTN","IBCNEHL6",10,0)
 ;
"RTN","IBCNEHL6",11,0)
 ; If no record IEN, quit
"RTN","IBCNEHL6",12,0)
 I $G(RIEN)="" Q
"RTN","IBCNEHL6",13,0)
 ;
"RTN","IBCNEHL6",14,0)
 N BUFF,CALLEDBY,DFN,FILEIT,IBFDA,IBIEN,IBQFL,RDAT0,RSRVDT,RSTYPE,SYMBOL,TQDATA,TQN,TQSRVDT,IBISMBI
"RTN","IBCNEHL6",15,0)
 ; Initialize variables from the Response File
"RTN","IBCNEHL6",16,0)
 S RDAT0=$G(^IBCN(365,RIEN,0)),TQN=$P(RDAT0,U,5)
"RTN","IBCNEHL6",17,0)
 S TQDATA=$G(^IBCN(365.1,TQN,0))
"RTN","IBCNEHL6",18,0)
 S IBQFL=$P(TQDATA,U,11)
"RTN","IBCNEHL6",19,0)
 S DFN=$P(RDAT0,U,2),BUFF=$P(RDAT0,U,4)
"RTN","IBCNEHL6",20,0)
 S IBISMBI=+$$MBICHK^IBCNEUT7(BUFF) ; IB*2*601/DM
"RTN","IBCNEHL6",21,0)
 S IBIEN=$P(TQDATA,U,5),RSTYPE=$P(RDAT0,U,10)
"RTN","IBCNEHL6",22,0)
 S RSRVDT=$P($G(^IBCN(365,RIEN,1)),U,10)
"RTN","IBCNEHL6",23,0)
 ;
"RTN","IBCNEHL6",24,0)
 ; If an unknown error action or an error filing the response message,
"RTN","IBCNEHL6",25,0)
 ; send a warning email message
"RTN","IBCNEHL6",26,0)
 ; Note - A call to UEACT will always set ERFLAG=1
"RTN","IBCNEHL6",27,0)
 ;
"RTN","IBCNEHL6",28,0)
 ; IB*2.0*506 Removed the following line of code to Treat all AAA Action Codes
"RTN","IBCNEHL6",29,0)
 ; as though the Payer/FSC Responded.
"RTN","IBCNEHL6",30,0)
 ;I ",W,X,R,P,C,N,Y,S,"'[(","_$G(ERACT)_",")&($G(ERACT)'="")!$D(ERROR) D UEACT^IBCNEHL3
"RTN","IBCNEHL6",31,0)
 ;
"RTN","IBCNEHL6",32,0)
 ; If an error occurred, processing complete
"RTN","IBCNEHL6",33,0)
 I $G(ERFLG)=1 Q
"RTN","IBCNEHL6",34,0)
 ;
"RTN","IBCNEHL6",35,0)
 ;  For an original response, set the Transmission Queue Status to 'Response Received' &
"RTN","IBCNEHL6",36,0)
 ;  update remaining retries to comm failure (5)
"RTN","IBCNEHL6",37,0)
 I $G(RSTYPE)="O" D SST^IBCNEUT2(TQN,3),RSTA^IBCNEUT7(TQN)
"RTN","IBCNEHL6",38,0)
 ;
"RTN","IBCNEHL6",39,0)
 ; Update the TQ service date to the date in the response file
"RTN","IBCNEHL6",40,0)
 ; if they are different AND the Error Action <>
"RTN","IBCNEHL6",41,0)
 ; 'P' for 'Please submit original transaction'
"RTN","IBCNEHL6",42,0)
 ;
"RTN","IBCNEHL6",43,0)
 ; *** Temporary change to suppress update of service & freshness dates.
"RTN","IBCNEHL6",44,0)
 ; *** To reinstate, remove comment (;) from next line.
"RTN","IBCNEHL6",45,0)
 ;I TQN'="",$G(RSTYPE)="O" D
"RTN","IBCNEHL6",46,0)
 ;. S TQSRVDT=$P($G(^IBCN(365.1,TQN,0)),U,12)
"RTN","IBCNEHL6",47,0)
 ;. I RSRVDT'="",TQSRVDT'=RSRVDT,$G(ERACT)'="P" D SAVETQ^IBCNEUT2(TQN,RSRVDT)
"RTN","IBCNEHL6",48,0)
 ;. ; update freshness date by same delta
"RTN","IBCNEHL6",49,0)
 ;. D SAVFRSH^IBCNEUT5(TQN,+$$FMDIFF^XLFDT(RSRVDT,TQSRVDT,1))
"RTN","IBCNEHL6",50,0)
 ;
"RTN","IBCNEHL6",51,0)
 ;  Check for error action
"RTN","IBCNEHL6",52,0)
 I $G(ERACT)'=""!($G(ERTXT)'="") D  G:'IBISMBI FILX   ; IB*2*601/DM  If MBI response keep processing
"RTN","IBCNEHL6",53,0)
 . S ERACT=$$ERRACT^IBCNEHLU(RIEN),ERCON=$P(ERACT,U,2),ERACT=$P(ERACT,U)
"RTN","IBCNEHL6",54,0)
 . D ERROR^IBCNEHL3(TQN,ERACT,ERCON,TRACE)
"RTN","IBCNEHL6",55,0)
 ;
"RTN","IBCNEHL6",56,0)
 I EVENTYP=1 D PROCTRK^IBCNEHL7(TRKIEN) Q  ;IB*621  Process EICD Tracking file #365.18
"RTN","IBCNEHL6",57,0)
 ;
"RTN","IBCNEHL6",58,0)
 ; Stop processing if identification response and not an active policy
"RTN","IBCNEHL6",59,0)
 S FILEIT=1
"RTN","IBCNEHL6",60,0)
 I $G(IIVSTAT)=6,TQN]"" D
"RTN","IBCNEHL6",61,0)
 . I TQDATA="" Q
"RTN","IBCNEHL6",62,0)
 . I IBQFL'="I" Q
"RTN","IBCNEHL6",63,0)
 . S FILEIT=0
"RTN","IBCNEHL6",64,0)
 I 'FILEIT G FILX
"RTN","IBCNEHL6",65,0)
 ;
"RTN","IBCNEHL6",66,0)
 ; -
"RTN","IBCNEHL6",67,0)
 ; ** Very important:  Variable 'CALLEDBY' must be set for this routine so
"RTN","IBCNEHL6",68,0)
 ;    that when a payer response is saved to the buffer either as an
"RTN","IBCNEHL6",69,0)
 ;    update to an existing buffer entry or as a new buffer entry a new
"RTN","IBCNEHL6",70,0)
 ;    eIV inquiry is not automatically triggered and resent to the payer again.
"RTN","IBCNEHL6",71,0)
 ;    When certain fields are changed in file #355.33 a trigger calls routine
"RTN","IBCNEHL6",72,0)
 ;    ^IBCNERTQ which can create and send a new inquiry in real time to the payer.
"RTN","IBCNEHL6",73,0)
 ;    We want this to occur in all cases _EXCEPT_ when it is a payer response.
"RTN","IBCNEHL6",74,0)
 ;    Which means _EXCEPT_ when it is triggered as a result of this routine.
"RTN","IBCNEHL6",75,0)
 ;
"RTN","IBCNEHL6",76,0)
 S CALLEDBY="IBCNEHL1"
"RTN","IBCNEHL6",77,0)
 ;
"RTN","IBCNEHL6",78,0)
 ;  If there is an associated buffer entry & one or both of the following
"RTN","IBCNEHL6",79,0)
 ;  is true, stop filing (don't update buffer entry)
"RTN","IBCNEHL6",80,0)
 ;  1) buffer status is not 'Entered'
"RTN","IBCNEHL6",81,0)
 ;  2) the buffer entry is verified (* symbol)
"RTN","IBCNEHL6",82,0)
 I BUFF'="",($P($G(^IBA(355.33,BUFF,0)),U,4)'="E")!($$SYMBOL^IBCNBLL(BUFF)="*") G FILX
"RTN","IBCNEHL6",83,0)
 ;
"RTN","IBCNEHL6",84,0)
 ; Set buffer symbol based on value returned from EC
"RTN","IBCNEHL6",85,0)
 ; IB*2*601/DM
"RTN","IBCNEHL6",86,0)
 ;S SYMBOL=MAP(IIVSTAT)
"RTN","IBCNEHL6",87,0)
 I 'IBISMBI S SYMBOL=MAP(IIVSTAT)
"RTN","IBCNEHL6",88,0)
 ; if subscriber ID is populated set SYMBOL to '%' otherwise a '#'
"RTN","IBCNEHL6",89,0)
 I IBISMBI S SYMBOL=$S($$GET1^DIQ(365,RIEN_",","SUBSCRIBER ID")'="":MAP("MBI%"),1:MAP("MBI#"))
"RTN","IBCNEHL6",90,0)
 ;
"RTN","IBCNEHL6",91,0)
 ;  If there is an associated buffer entry, update the buffer entry w/
"RTN","IBCNEHL6",92,0)
 ;  response data
"RTN","IBCNEHL6",93,0)
 I BUFF'="" D RP^IBCNEBF(RIEN,"",BUFF)
"RTN","IBCNEHL6",94,0)
 ;
"RTN","IBCNEHL6",95,0)
 ;  If no associated buffer entry, create one & populate w/ response
"RTN","IBCNEHL6",96,0)
 ;  data (routine call sets IBFDA)
"RTN","IBCNEHL6",97,0)
 I BUFF="" D RP^IBCNEBF(RIEN,1) S BUFF=+IBFDA,UP(365,RIEN_",",.04)=BUFF
"RTN","IBCNEHL6",98,0)
 ;
"RTN","IBCNEHL6",99,0)
 ; IB*2*601/DM for an MBI query, set the patient relationship to insured to "Patient"
"RTN","IBCNEHL6",100,0)
 I IBISMBI S UP(355.33,BUFF_",",60.06)="01"
"RTN","IBCNEHL6",101,0)
 ;
"RTN","IBCNEHL6",102,0)
 ;  Set eIV Processed Date to now
"RTN","IBCNEHL6",103,0)
 S UP(355.33,BUFF_",",.15)=$$NOW^XLFDT()
"RTN","IBCNEHL6",104,0)
 D FILE^DIE("I","UP","ERROR")
"RTN","IBCNEHL6",105,0)
FILX ;
"RTN","IBCNEHL6",106,0)
 Q
"RTN","IBCNEHL6",107,0)
 ;
"RTN","IBCNEHL7")
0^18^B33947813^n/a
"RTN","IBCNEHL7",1,0)
IBCNEHL7 ;AITC/DM - HL7 Process Incoming 271 Messages Continued;05-MAY-2018
"RTN","IBCNEHL7",2,0)
 ;;2.0;INTEGRATED BILLING;**621**;21-MAR-94;Build 8
"RTN","IBCNEHL7",3,0)
 ;;Per VA Directive 6402, this routine should not be modified.
"RTN","IBCNEHL7",4,0)
 ;
"RTN","IBCNEHL7",5,0)
 ;This routine is used to process EICD associated entries.
"RTN","IBCNEHL7",6,0)
 Q
"RTN","IBCNEHL7",7,0)
 ;
"RTN","IBCNEHL7",8,0)
SVEICD() ; Save EICD Identification Data into the EIV EICD TRACKING (#365.18) file.
"RTN","IBCNEHL7",9,0)
 ; INPUT:  IBTRACK array indexed by SETID
"RTN","IBCNEHL7",10,0)
 ;         RIEN Internal Entry Number of the IIV RESPONSE (#365) File.
"RTN","IBCNEHL7",11,0)
 ;
"RTN","IBCNEHL7",12,0)
 N CNT,IENS,RSUPDT,TQIEN,TRKIEN
"RTN","IBCNEHL7",13,0)
 S TQIEN=$$GET1^DIQ(365,RIEN_",",.05,"I")  ;Transmission Queue IEN
"RTN","IBCNEHL7",14,0)
 S TRKIEN=$O(^IBCN(365.18,"B",TQIEN,"")),IENS=TRKIEN_","
"RTN","IBCNEHL7",15,0)
 S RSUPDT(365.18,IENS,.04)=IBTRACK(0,.04)
"RTN","IBCNEHL7",16,0)
 S RSUPDT(365.18,IENS,.06)=IBTRACK(0,.06)
"RTN","IBCNEHL7",17,0)
 S RSUPDT(365.18,IENS,.07)=IBTRACK(0,.07)
"RTN","IBCNEHL7",18,0)
 D FILE^DIE("","RSUPDT","ERROR")
"RTN","IBCNEHL7",19,0)
 S CNT=0 F  S CNT=$O(IBTRACK(CNT)) Q:'CNT  D
"RTN","IBCNEHL7",20,0)
 . N IENS,RSUPDT,RSUPDT9IEN
"RTN","IBCNEHL7",21,0)
 . S IENS="+"_CNT_","_TRKIEN_","
"RTN","IBCNEHL7",22,0)
 . S RSUPDT(365.185,IENS,.01)=$G(IBTRACK(CNT,.01))
"RTN","IBCNEHL7",23,0)
 . S RSUPDT(365.185,IENS,.02)=$G(IBTRACK(CNT,.02))
"RTN","IBCNEHL7",24,0)
 . S RSUPDT(365.185,IENS,.03)=$G(IBTRACK(CNT,.03))
"RTN","IBCNEHL7",25,0)
 . S RSUPDT(365.185,IENS,.04)=$G(IBTRACK(CNT,.04))
"RTN","IBCNEHL7",26,0)
 . S RSUPDT(365.185,IENS,.05)=$G(IBTRACK(CNT,.05))
"RTN","IBCNEHL7",27,0)
 . S RSUPDT(365.185,IENS,.06)=$G(IBTRACK(CNT,.06))
"RTN","IBCNEHL7",28,0)
 . S RSUPDT(365.185,IENS,.07)=$G(IBTRACK(CNT,.07))
"RTN","IBCNEHL7",29,0)
 . S RSUPDT(365.185,IENS,.08)=$G(IBTRACK(CNT,.08))
"RTN","IBCNEHL7",30,0)
 . S RSUPDT(365.185,IENS,.09)=$G(IBTRACK(CNT,.09))
"RTN","IBCNEHL7",31,0)
 . S RSUPDT(365.185,IENS,.1)=$G(IBTRACK(CNT,.1))
"RTN","IBCNEHL7",32,0)
 . S RSUPDT(365.185,IENS,.11)=$G(IBTRACK(CNT,.11))
"RTN","IBCNEHL7",33,0)
 . S RSUPDT(365.185,IENS,.12)=$G(IBTRACK(CNT,.12))
"RTN","IBCNEHL7",34,0)
 . S RSUPDT(365.185,IENS,.13)=$G(IBTRACK(CNT,.13))
"RTN","IBCNEHL7",35,0)
 . S RSUPDT(365.185,IENS,.14)=$G(IBTRACK(CNT,.14))
"RTN","IBCNEHL7",36,0)
 . S RSUPDT(365.185,IENS,.15)=+$G(IBTRACK(CNT,.15))
"RTN","IBCNEHL7",37,0)
 . D UPDATE^DIE("","RSUPDT","RSUPIEN","ERROR")
"RTN","IBCNEHL7",38,0)
SVEICDQ ;
"RTN","IBCNEHL7",39,0)
 Q TRKIEN
"RTN","IBCNEHL7",40,0)
 ;
"RTN","IBCNEHL7",41,0)
PROCTRK(TRKIEN) ; Process the EICD Tracking File entries.
"RTN","IBCNEHL7",42,0)
 ; TRKIEN = EIV EICD TRACKING Identification IEN
"RTN","IBCNEHL7",43,0)
 ;
"RTN","IBCNEHL7",44,0)
 N DATA1,DATA2,DATA5,IBBUF,IBBUFIEN,IBCSIEN,IBDFN,IBERR,IBFDA,IBFMIEN
"RTN","IBCNEHL7",45,0)
 N IBFRESH,IBIDIEN,IBINSDTA,IBMSG,IBPYRIEN,IBPYROK,IBSUBID,IBTQIEN,IBTQSTAT
"RTN","IBCNEHL7",46,0)
 ; 
"RTN","IBCNEHL7",47,0)
 S IBFRESH=$$FMADD^XLFDT(DT,-($$GET1^DIQ(350.9,"1,",51.01,"I"))) ; DT - "FRESHNESS DAYS"
"RTN","IBCNEHL7",48,0)
 S IBTQSTAT=$$FIND1^DIC(365.14,,,"Ready to Transmit","B")
"RTN","IBCNEHL7",49,0)
 S IBCSIEN=$$FIND1^DIC(355.12,,"X","CONTRACT SERVICES","C")
"RTN","IBCNEHL7",50,0)
 S IBDFN=$$GET1^DIQ(365.18,TRKIEN_",",.05,"I") ; "EICD PATIENT"
"RTN","IBCNEHL7",51,0)
 ; loop through any discovered insurance creating TQ/Buffer/Tracking entries 
"RTN","IBCNEHL7",52,0)
 S IBIDIEN=0 F  S IBIDIEN=$O(^IBCN(365.18,TRKIEN,"INS-FND",IBIDIEN)) Q:'IBIDIEN  D
"RTN","IBCNEHL7",53,0)
 . S IBFMIEN=IBIDIEN_","_TRKIEN_","
"RTN","IBCNEHL7",54,0)
 . K IBINSDTA D GETS^DIQ(365.185,IBFMIEN,"*",,"IBINSDTA") ; grab selected fields (external)  
"RTN","IBCNEHL7",55,0)
 . Q:'$D(IBINSDTA)  ; no data
"RTN","IBCNEHL7",56,0)
 . ; see if PAYER VA ID is on file and active
"RTN","IBCNEHL7",57,0)
 . S IBPYRIEN=0,IBPYROK=1
"RTN","IBCNEHL7",58,0)
 . S:IBINSDTA(365.185,IBFMIEN,.01)="UNKNOWN" IBPYROK=0
"RTN","IBCNEHL7",59,0)
 . S:IBPYROK IBPYRIEN=$$FIND1^DIC(365.12,,"X",IBINSDTA(365.185,IBFMIEN,.01),"C")
"RTN","IBCNEHL7",60,0)
 . S:'IBPYRIEN IBPYROK=0
"RTN","IBCNEHL7",61,0)
 . I IBPYROK,'($$GET1^DIQ(365.121,"1,"_IBPYRIEN_",",.02,"I")) S IBPYROK=0  ; "NATIONAL ACTIVE"
"RTN","IBCNEHL7",62,0)
 . I IBPYROK,'($$GET1^DIQ(365.121,"1,"_IBPYRIEN_",",.03,"I")) S IBPYROK=0  ; "LOCAL ACTIVE"
"RTN","IBCNEHL7",63,0)
 . I IBPYROK D  Q 
"RTN","IBCNEHL7",64,0)
 .. S IBSUBID=IBINSDTA(365.185,IBFMIEN,.04)            ; SUBSCRIBER ID
"RTN","IBCNEHL7",65,0)
 .. S:IBSUBID="" IBSUBID=IBINSDTA(365.185,IBFMIEN,.05) ; MEMBER ID
"RTN","IBCNEHL7",66,0)
 .. ; SET prepare and file the TQ
"RTN","IBCNEHL7",67,0)
 .. ; IBDFN:Patient IEN
"RTN","IBCNEHL7",68,0)
 .. ; IBPYRIEN:Payer IEN
"RTN","IBCNEHL7",69,0)
 .. ; IBTQSTAT:TQ STATUS IEN - Ready to Transmit
"RTN","IBCNEHL7",70,0)
 .. ; IBSUBID:SUBSCRIBER ID (may be MEMBERID)
"RTN","IBCNEHL7",71,0)
 .. ; IBFRESH:Freshness date
"RTN","IBCNEHL7",72,0)
 .. ; IBINSDTA(365.185,IBFMIEN,.05):MEMBER ID  
"RTN","IBCNEHL7",73,0)
 .. ; 4:EICD data extract (#4)
"RTN","IBCNEHL7",74,0)
 .. ; V:Verification 
"RTN","IBCNEHL7",75,0)
 .. ; DT:Todays date 
"RTN","IBCNEHL7",76,0)
 .. ; IBCSIEN:Source of Information IEN - Contract Services
"RTN","IBCNEHL7",77,0)
 .. ; IBIDIEN:IEN of the INS-FND multiple (discovered insurance) in #365.185
"RTN","IBCNEHL7",78,0)
 .. S DATA1=IBDFN_U_IBPYRIEN_U_IBTQSTAT_U_""_U_IBSUBID_U_IBFRESH_U_""_U_IBINSDTA(365.185,IBFMIEN,.05)
"RTN","IBCNEHL7",79,0)
 .. S DATA2=4_U_"V"_U_DT
"RTN","IBCNEHL7",80,0)
 .. S DATA5=IBCSIEN_U_IBIDIEN
"RTN","IBCNEHL7",81,0)
 .. S IBTQIEN=$$SETTQ^IBCNEDE7(DATA1,DATA2,,,DATA5) ; Sets in TQ
"RTN","IBCNEHL7",82,0)
 .. I IBTQIEN="" Q  ; didn't file
"RTN","IBCNEHL7",83,0)
 .. ; update the EIV EICD TRACKING (#365.185)
"RTN","IBCNEHL7",84,0)
 .. K IBFDA,IBERR
"RTN","IBCNEHL7",85,0)
 .. S IBFDA(365.185,IBFMIEN,1.01)=IBTQIEN ; EICD VER INQ TRANSMISSION
"RTN","IBCNEHL7",86,0)
 .. S IBFDA(365.185,IBFMIEN,1.02)=DT      ; EICD VER INQ DATE CREATED
"RTN","IBCNEHL7",87,0)
 .. D FILE^DIE(,"IBFDA","IBERR")
"RTN","IBCNEHL7",88,0)
 .. I $G(IBERR("DIERR",1,"TEXT",1))'="" D  Q
"RTN","IBCNEHL7",89,0)
 ... S IBMSG=""
"RTN","IBCNEHL7",90,0)
 ... D MSG002^IBCNEMS1(.IBMSG,.IBERR,IBTQIEN)
"RTN","IBCNEHL7",91,0)
 ... D MSG^IBCNEUT5($$MGRP^IBCNEUT5(),"eIV Problem: Error updating EIV EICD TRACKING (#365.185)","IBMSG(")
"RTN","IBCNEHL7",92,0)
 .. ;Load and Send the HL7 Message
"RTN","IBCNEHL7",93,0)
 .. S DATA1=$$PROCSEND^IBCNERTQ(IBTQIEN)
"RTN","IBCNEHL7",94,0)
 .. K ^TMP("DIERR",$J) ; safety, cleanup
"RTN","IBCNEHL7",95,0)
 .. Q  ; next insurance discovery 
"RTN","IBCNEHL7",96,0)
 . ; Payer had issues, place an entry in the buffer for manual processing 
"RTN","IBCNEHL7",97,0)
 . D
"RTN","IBCNEHL7",98,0)
 .. ; we're forcing a new block so we can redefine DUZ safely
"RTN","IBCNEHL7",99,0)
 .. N DUZ
"RTN","IBCNEHL7",100,0)
 .. S DUZ=$$FIND1^DIC(200,,,"INTERFACE,IB EIV","B")
"RTN","IBCNEHL7",101,0)
 .. K IBBUF
"RTN","IBCNEHL7",102,0)
 .. ; Patient fields, name, dob and ssn will be populated automatically
"RTN","IBCNEHL7",103,0)
 .. S IBBUF(.02)=DUZ  ; entered By
"RTN","IBCNEHL7",104,0)
 .. S IBBUF(.12)=""   ; setting to Null for the Buffer Symbol 
"RTN","IBCNEHL7",105,0)
 .. S IBBUF(.18)=$$FMTE^XLFDT(DT) ; Service Date
"RTN","IBCNEHL7",106,0)
 .. S IBBUF(20.01)=IBINSDTA(365.185,IBFMIEN,.02) ; PAYER NAME, used to populate INSURANCE COMPANY NAME
"RTN","IBCNEHL7",107,0)
 .. S IBBUF(60.01)=IBDFN ; Patient IEN
"RTN","IBCNEHL7",108,0)
 .. S IBBUF(60.06)=$S(IBINSDTA(365.185,IBFMIEN,.15)="Y":"",1:"PATIENT") ; Patient relationship to Insured
"RTN","IBCNEHL7",109,0)
 .. S IBBUF(60.08)=IBINSDTA(365.185,IBFMIEN,.07) ; INSURED DOB
"RTN","IBCNEHL7",110,0)
 .. S IBBUF(60.13)=IBINSDTA(365.185,IBFMIEN,.08) ; INSURED SEX 
"RTN","IBCNEHL7",111,0)
 .. S IBBUF(62.01)=IBINSDTA(365.185,IBFMIEN,.05) ; MEMBER/PATIENT ID
"RTN","IBCNEHL7",112,0)
 .. S IBBUF(80.01)=$$GET1^DIQ(350.9,"1,",60.01,"E")  ; DEFAULT SERVICE TYPE CODE 1
"RTN","IBCNEHL7",113,0)
 .. S IBBUF(90.02)=IBINSDTA(365.185,IBFMIEN,.03) ; GROUP NUMBER
"RTN","IBCNEHL7",114,0)
 .. S IBBUF(90.03)=IBINSDTA(365.185,IBFMIEN,.04) ; SUBSCRIBER ID
"RTN","IBCNEHL7",115,0)
 .. ; the following call in-turn, calls EDITSTF^IBCNBES which will make sure to file subscriber ID last, automatically
"RTN","IBCNEHL7",116,0)
 .. S IBBUFIEN=$$ADDSTF^IBCNBES(IBCSIEN,IBDFN,.IBBUF)
"RTN","IBCNEHL7",117,0)
 . Q  ; next insurance discovery
"RTN","IBCNEHL7",118,0)
 ;
"RTN","IBCNEHL7",119,0)
 Q
"RTN","IBCNEHL7",120,0)
 ;
"RTN","IBCNEHLI")
0^19^B11183366^B8125280
"RTN","IBCNEHLI",1,0)
IBCNEHLI ;DAOU/ALA - Incoming HL7 messages ;16-JUN-2002
"RTN","IBCNEHLI",2,0)
 ;;2.0;INTEGRATED BILLING;**184,252,251,271,300,416,550,601,621**;21-MAR-94;Build 8
"RTN","IBCNEHLI",3,0)
 ;;Per VA Directive 6402, this routine should not be modified.
"RTN","IBCNEHLI",4,0)
 ;
"RTN","IBCNEHLI",5,0)
 ;**Program Description**
"RTN","IBCNEHLI",6,0)
 ;  This program parses each incoming HL7 message.
"RTN","IBCNEHLI",7,0)
 ;
"RTN","IBCNEHLI",8,0)
EN ;  Starting point - put message into a TMP global
"RTN","IBCNEHLI",9,0)
 ;
"RTN","IBCNEHLI",10,0)
 N ACK,BUFF,DFN,ERACT,ERCON,ERFLG,ERTXT,EVENT,HCT,HLECH,HLEID
"RTN","IBCNEHLI",11,0)
 N HLEIDS,HLFS,HLQ,IBPRTCL,IDUZ,MGRP,MSGID,RDAT0,RIEN,SBDEP,SEG
"RTN","IBCNEHLI",12,0)
 N SEGMT,SEGMT2,TAG,TQN,TRACE,VRFDT,DISYS,IPCT,PAYRID,PIEN,CNT
"RTN","IBCNEHLI",13,0)
 N ERROR,IRIEN,RSTYPE,SUBID,TQIEN
"RTN","IBCNEHLI",14,0)
 N DA,EBDA,IBFDA,II,MSGP,SYMBOL,IBSEG,PP,PRIEN,QFL,IBIEN,TQDATA,IBQFL
"RTN","IBCNEHLI",15,0)
 N DATAMFK,EPHARM
"RTN","IBCNEHLI",16,0)
 ;
"RTN","IBCNEHLI",17,0)
 K ^TMP($J,"IBCNEHLI")
"RTN","IBCNEHLI",18,0)
 F SEGCNT=1:1 X HLNEXT Q:HLQUIT'>0  D
"RTN","IBCNEHLI",19,0)
 . S CNT=0
"RTN","IBCNEHLI",20,0)
 . S ^TMP($J,"IBCNEHLI",SEGCNT,CNT)=HLNODE
"RTN","IBCNEHLI",21,0)
 . F  S CNT=$O(HLNODE(CNT)) Q:'CNT  D
"RTN","IBCNEHLI",22,0)
 .. S ^TMP($J,"IBCNEHLI",SEGCNT,CNT)=HLNODE(CNT)
"RTN","IBCNEHLI",23,0)
 ;
"RTN","IBCNEHLI",24,0)
 ;  Get the eIV user
"RTN","IBCNEHLI",25,0)
 S IDUZ=$$FIND1^DIC(200,"","X","INTERFACE,IB EIV")
"RTN","IBCNEHLI",26,0)
 ;   Determine which protocol to use
"RTN","IBCNEHLI",27,0)
 S SEGMT=$G(^TMP($J,"IBCNEHLI",1,0))
"RTN","IBCNEHLI",28,0)
 I $E(SEGMT,1,3)'="MSH" D  D ERR Q
"RTN","IBCNEHLI",29,0)
 . S MSG(1)="MSH Segment is not the first segment found"
"RTN","IBCNEHLI",30,0)
 . S MSG(2)="Please call the Help Desk and report this problem."
"RTN","IBCNEHLI",31,0)
 S HLFS=$E(SEGMT,4)
"RTN","IBCNEHLI",32,0)
 S EVENT=$P(SEGMT,HLFS,9),IBPRTCL=""
"RTN","IBCNEHLI",33,0)
 ;
"RTN","IBCNEHLI",34,0)
 ;  The event type determines protocol
"RTN","IBCNEHLI",35,0)
 ; IB*2.0*601 - Added logic for MFN^M01 event
"RTN","IBCNEHLI",36,0)
 I EVENT="MFN^M01" S TAG="TBL",IBPRTCL="IBCNE IIV MFN IN"
"RTN","IBCNEHLI",37,0)
 I EVENT="RPI^I01" S TAG="RSP",IBPRTCL="IBCNE IIV IN" I '$$HL7VAL G XIT
"RTN","IBCNEHLI",38,0)
 I EVENT="MFK^M01" S TAG="ACK",IBPRTCL="IBCNE IIV REGISTER"
"RTN","IBCNEHLI",39,0)
 ;IB*2.0*621/TAZ - Added new event
"RTN","IBCNEHLI",40,0)
 I EVENT="RPI^I04" S TAG="EICD",IBPRTCL="IBCNE EIV RPI IN"
"RTN","IBCNEHLI",41,0)
 I IBPRTCL="" S MSG(1)="Unable to find a protocol for Event = "_EVENT D ERR G XIT
"RTN","IBCNEHLI",42,0)
 ;
"RTN","IBCNEHLI",43,0)
 ;  Initialize the HL7 variables
"RTN","IBCNEHLI",44,0)
 D INIT^HLFNC2(IBPRTCL,.HL)
"RTN","IBCNEHLI",45,0)
 ;
"RTN","IBCNEHLI",46,0)
 ;  Call the event tag
"RTN","IBCNEHLI",47,0)
 D @TAG
"RTN","IBCNEHLI",48,0)
 ;
"RTN","IBCNEHLI",49,0)
XIT K ^TMP($J,"IBCNEHLI"),HL,HLNEXT,HLNODE,HLQUIT,SEGCNT,EVENTYP
"RTN","IBCNEHLI",50,0)
 Q
"RTN","IBCNEHLI",51,0)
 ;
"RTN","IBCNEHLI",52,0)
TBL ;  Table Update Processing
"RTN","IBCNEHLI",53,0)
 N IBACK
"RTN","IBCNEHLI",54,0)
 S IBACK="AE"
"RTN","IBCNEHLI",55,0)
 D ^IBCNEHLT
"RTN","IBCNEHLI",56,0)
 ;
"RTN","IBCNEHLI",57,0)
 I ERFLG D ERR
"RTN","IBCNEHLI",58,0)
 K ERFLG
"RTN","IBCNEHLI",59,0)
 ;
"RTN","IBCNEHLI",60,0)
 D ACK^IBCNEHLK
"RTN","IBCNEHLI",61,0)
 Q
"RTN","IBCNEHLI",62,0)
 ;
"RTN","IBCNEHLI",63,0)
RSP ;  Response Processing
"RTN","IBCNEHLI",64,0)
 D EN^IBCNEHL1(2) ;IB*2.0*621 Added Parameter
"RTN","IBCNEHLI",65,0)
 ;
"RTN","IBCNEHLI",66,0)
 K ACK,BUFF,DFN,ERACT,ERCON,ERFLG,ERTXT,EVENT,HCT,HL,HLECH,HLEID
"RTN","IBCNEHLI",67,0)
 K HLEIDS,HLFS,HLQ,IBPRTCL,IDUZ,MGRP,MSGID,RDAT0,RIEN,SBDEP,SEG
"RTN","IBCNEHLI",68,0)
 K SEGMT,SEGMT2,TAG,TQN,TRACE,VRFDT,DISYS,IPCT,PAYRID,PIEN
"RTN","IBCNEHLI",69,0)
 K ERROR,IRIEN,RSTYPE,SUBID,TQIEN
"RTN","IBCNEHLI",70,0)
 K DA,EBDA,IBFDA,II,MSGP,SYMBOL,IBSEG,PP,PRIEN,QFL
"RTN","IBCNEHLI",71,0)
 Q
"RTN","IBCNEHLI",72,0)
 ;
"RTN","IBCNEHLI",73,0)
 ;IB*2.0*621/TAZ - Added section to process the EICD Inquiry Response.
"RTN","IBCNEHLI",74,0)
EICD ; Insurance Discovery Inquiry Response.
"RTN","IBCNEHLI",75,0)
 D EN^IBCNEHL1(1)
"RTN","IBCNEHLI",76,0)
 ;
"RTN","IBCNEHLI",77,0)
 K ACK,BUFF,DFN,ERACT,ERCON,ERFLG,ERTXT,EVENT,HCT,HL,HLECH,HLEID
"RTN","IBCNEHLI",78,0)
 K HLEIDS,HLFS,HLQ,IBPRTCL,IDUZ,MGRP,MSGID,RDAT0,RIEN,SBDEP,SEG
"RTN","IBCNEHLI",79,0)
 K SEGMT,SEGMT2,TAG,TQN,TRACE,VRFDT,DISYS,IPCT,PAYRID,PIEN
"RTN","IBCNEHLI",80,0)
 K ERROR,IRIEN,RSTYPE,SUBID,TQIEN
"RTN","IBCNEHLI",81,0)
 K DA,EBDA,IBFDA,II,MSGP,SYMBOL,IBSEG,PP,PRIEN,QFL,IBTRACK,TRKIEN
"RTN","IBCNEHLI",82,0)
 Q
"RTN","IBCNEHLI",83,0)
 ;
"RTN","IBCNEHLI",84,0)
ACK ;  Acknowledgement Processing
"RTN","IBCNEHLI",85,0)
 D ^IBCNEHLK
"RTN","IBCNEHLI",86,0)
 ;
"RTN","IBCNEHLI",87,0)
 Q
"RTN","IBCNEHLI",88,0)
 ;
"RTN","IBCNEHLI",89,0)
ERR ; Process an error
"RTN","IBCNEHLI",90,0)
 S MGRP=$$MGRP^IBCNEUT5()
"RTN","IBCNEHLI",91,0)
 D MSG^IBCNEUT5(MGRP,"INCOMING eIV HL7 PROBLEM","MSG(")
"RTN","IBCNEHLI",92,0)
 K MSG,MGRP
"RTN","IBCNEHLI",93,0)
 Q
"RTN","IBCNEHLI",94,0)
 ; 
"RTN","IBCNEHLI",95,0)
HL7VAL() ; Check for valid post 300 response
"RTN","IBCNEHLI",96,0)
 N X,HCT
"RTN","IBCNEHLI",97,0)
 S X=0,HCT=0
"RTN","IBCNEHLI",98,0)
 F  S HCT=$O(^TMP($J,"IBCNEHLI",HCT)) Q:HCT=""  D SPAR^IBCNEHLU I $G(IBSEG(1))="PRD" S X=1 Q
"RTN","IBCNEHLI",99,0)
 Q X
"RTN","IBCNEHLM")
0^7^B24096430^B23949973
"RTN","IBCNEHLM",1,0)
IBCNEHLM ;DAOU/ALA - HL7 Registration MFN Message ;02-JUN-2015
"RTN","IBCNEHLM",2,0)
 ;;2.0;INTEGRATED BILLING;**184,251,300,416,438,497,506,549,601,621**;21-MAR-94;Build 8
"RTN","IBCNEHLM",3,0)
 ;;Per VA Directive 6402, this routine should not be modified.
"RTN","IBCNEHLM",4,0)
 ;
"RTN","IBCNEHLM",5,0)
 ;**Program Description**
"RTN","IBCNEHLM",6,0)
 ;  This program will process the outgoing registration MFN message
"RTN","IBCNEHLM",7,0)
 ;
"RTN","IBCNEHLM",8,0)
 ;  Variables
"RTN","IBCNEHLM",9,0)
 ;    MCT = Lines of MailMan message counter
"RTN","IBCNEHLM",10,0)
 ;    QFL = Quit flag
"RTN","IBCNEHLM",11,0)
 ;    HL* = HL7 package specific variables
"RTN","IBCNEHLM",12,0)
 ;    TAXID = Tax ID
"RTN","IBCNEHLM",13,0)
 ;    CNTCPH = Contact Phone
"RTN","IBCNEHLM",14,0)
 ;    CNTCEM = Contact Email
"RTN","IBCNEHLM",15,0)
 ;    FRSH = Freshness Days
"RTN","IBCNEHLM",16,0)
 ;    MGRP = Mailgroup to email messages to
"RTN","IBCNEHLM",17,0)
 ;    INACT = Inactive Insurance Flag
"RTN","IBCNEHLM",18,0)
 ;    APP = Application
"RTN","IBCNEHLM",19,0)
 ;    EVENT = HL7 Event
"RTN","IBCNEHLM",20,0)
 ;    CODE = Values sent in the MFN message
"RTN","IBCNEHLM",21,0)
 ;    IPP = IP Port
"RTN","IBCNEHLM",22,0)
 ;    IPA = IP Address
"RTN","IBCNEHLM",23,0)
 ;    RESP = Response Code
"RTN","IBCNEHLM",24,0)
 ;    IHLP = Interface HL7 Processing Type
"RTN","IBCNEHLM",25,0)
 ;    IHLT = Interface HL7 Batch Start Time
"RTN","IBCNEHLM",26,0)
 ;    IHLS = Interface HL7 Batch Stop Time
"RTN","IBCNEHLM",27,0)
 ;    IVER = Interface Version
"RTN","IBCNEHLM",28,0)
 ;    TIMOUT = Timeout Days Site Parameter
"RTN","IBCNEHLM",29,0)
 ;    RETRY = Retry Flag Site Parameter
"RTN","IBCNEHLM",30,0)
 ;
"RTN","IBCNEHLM",31,0)
 N IBPERSIST
"RTN","IBCNEHLM",32,0)
 S IBPERSIST="N" ; persistence flag - If "N", FSC will not use the statistics on the NTE segment
"RTN","IBCNEHLM",33,0)
 D REG
"RTN","IBCNEHLM",34,0)
 Q
"RTN","IBCNEHLM",35,0)
 ;
"RTN","IBCNEHLM",36,0)
EN1 ; TaskMan entry point
"RTN","IBCNEHLM",37,0)
 N IBPERSIST
"RTN","IBCNEHLM",38,0)
 S IBPERSIST="Y" ; persistence flag - If "Y", FSC will use NTE segment to update their copy of the site's stats
"RTN","IBCNEHLM",39,0)
 D REG
"RTN","IBCNEHLM",40,0)
 ; Purge the task record
"RTN","IBCNEHLM",41,0)
 S ZTREQ="@"
"RTN","IBCNEHLM",42,0)
 Q
"RTN","IBCNEHLM",43,0)
 ;
"RTN","IBCNEHLM",44,0)
REG ;  Registration message for when a site installs
"RTN","IBCNEHLM",45,0)
 N APP,CNTCEM,CNTCNM,CNTCPH,CODE,EDT,EVENT,FRSH,HL,HLCDOM,HLCINS,HLCS
"RTN","IBCNEHLM",46,0)
 N HLCSTCP,HLECH,HLEID,HLFS,HLHDR,HLINST,HLIP,HLN,HLNHLQ,HLPROD,HLQ,HLREP
"RTN","IBCNEHLM",47,0)
 N HLRESLT,HLSAN,HLTYPE,HLX,IBCNE,IBCNEDAT,IHLP,IHLS,IHLT,ID,INACT,IPA,IPP
"RTN","IBCNEHLM",48,0)
 N MCT,MFE,MFN,MGRP,QFL,RESP,TAXID,ZMID,%I
"RTN","IBCNEHLM",49,0)
 N IVER,RETRY,TIMOUT,VMFE         ; IB*2.0*506
"RTN","IBCNEHLM",50,0)
 K ^TMP("HLS",$J) S MCT=0,QFL=0
"RTN","IBCNEHLM",51,0)
 ;
"RTN","IBCNEHLM",52,0)
 ;  Get data from IB Parameters File
"RTN","IBCNEHLM",53,0)
 S TAXID=$TR($P($G(^IBE(350.9,1,1)),U,5),"-",""),CNTCPH="",CNTCEM="",CNTCNM=""
"RTN","IBCNEHLM",54,0)
 S IBCNE=$G(^IBE(350.9,1,51))
"RTN","IBCNEHLM",55,0)
 S FRSH=$P(IBCNE,U,1),TIMOUT=$P(IBCNE,U,5),RETRY=$P(IBCNE,U,26) ; IB*2.0*506
"RTN","IBCNEHLM",56,0)
 S MGRP=$$MGRP^IBCNEUT5()
"RTN","IBCNEHLM",57,0)
 S INACT=$E($$GET1^DIQ(350.9,"1,",51.08,"E"))
"RTN","IBCNEHLM",58,0)
 S IHLP=$P(IBCNE,U,13),IHLT=$P(IBCNE,U,14)
"RTN","IBCNEHLM",59,0)
 S IHLS=$P(IBCNE,U,19)
"RTN","IBCNEHLM",60,0)
 ;
"RTN","IBCNEHLM",61,0)
 ; IB*2.0*549 Updated version to 7, Removed retrieval of Contact Name, Phone, email
"RTN","IBCNEHLM",62,0)
 ; IB*2.0*601 Updated version to 8
"RTN","IBCNEHLM",63,0)
 ; IB*2.0*621 Updated version to 9, EICD
"RTN","IBCNEHLM",64,0)
 S IVER="9"
"RTN","IBCNEHLM",65,0)
 I IHLP="I" S (IHLT,IHLS)=""
"RTN","IBCNEHLM",66,0)
 ;
"RTN","IBCNEHLM",67,0)
 I IHLP="B",IHLT=""!(IHLS="") D  S QFL=1
"RTN","IBCNEHLM",68,0)
 . S MCT=MCT+1,MSG(MCT)="The ""HL7 Response Processing Method"" selected is Batch but the HL7 Batch "
"RTN","IBCNEHLM",69,0)
 . I IHLT="",IHLS="" S MSG(MCT)=MSG(MCT)_"Start and End Times are blank.  " Q
"RTN","IBCNEHLM",70,0)
 . S MSG(MCT)=MSG(MCT)_$S(IHLT="":"Start",1:"End")_" Time is blank.  "
"RTN","IBCNEHLM",71,0)
 ;
"RTN","IBCNEHLM",72,0)
 I FRSH=""!(INACT="")!(IHLP="") D
"RTN","IBCNEHLM",73,0)
 . S MCT=MCT+1,MSG(MCT)="The following eIV Site Parameters are not defined:  "
"RTN","IBCNEHLM",74,0)
 . I FRSH="" S MCT=MCT+1,MSG(MCT)="""Days between electronic re-verification checks"" is blank.  "
"RTN","IBCNEHLM",75,0)
 . I INACT="" S MCT=MCT+1,MSG(MCT)="""Look at a patient's inactive insurance?"" is blank.  "
"RTN","IBCNEHLM",76,0)
 . I IHLP="" S MCT=MCT+1,MSG(MCT)="""HL7 Response Processing Method"" is blank.  "
"RTN","IBCNEHLM",77,0)
 . Q
"RTN","IBCNEHLM",78,0)
 ;
"RTN","IBCNEHLM",79,0)
 I $O(MSG(""))'="" D MLMN
"RTN","IBCNEHLM",80,0)
 I QFL=1 Q
"RTN","IBCNEHLM",81,0)
 ;
"RTN","IBCNEHLM",82,0)
HL ;  When a site installs, the enrollment should be an
"RTN","IBCNEHLM",83,0)
 ;  "MUP" (update) record.
"RTN","IBCNEHLM",84,0)
 N DSTAT,DSTAT2,VNTE,VZRR                   ; IB*2.0*549 added DSTAT2
"RTN","IBCNEHLM",85,0)
 S MFE(1)="MUP"
"RTN","IBCNEHLM",86,0)
 ;
"RTN","IBCNEHLM",87,0)
 ;  Initialize the HL7
"RTN","IBCNEHLM",88,0)
 D INIT^HLFNC2("IBCNE IIV REGISTER",.HL)
"RTN","IBCNEHLM",89,0)
 S HLFS=HL("FS"),HLECH=HL("ECH"),HL("SAF")=$P($$SITE^VASITE,U,2,3),HLREP=$E(HL("ECH"),2)
"RTN","IBCNEHLM",90,0)
 ; S HLEID=$$HLP^IBCNEHLU("IBCNE IIV REGISTER")
"RTN","IBCNEHLM",91,0)
 ;
"RTN","IBCNEHLM",92,0)
 ;   Set the MFI segment
"RTN","IBCNEHLM",93,0)
 S ID="Facility Table",APP="",EVENT="UPD",RESP="NE"
"RTN","IBCNEHLM",94,0)
 S ^TMP("HLS",$J,1)=$$MFI^VAFHLMFI(ID,APP,EVENT,,,RESP)
"RTN","IBCNEHLM",95,0)
 ;
"RTN","IBCNEHLM",96,0)
 ;  Set the MFE segment
"RTN","IBCNEHLM",97,0)
 S EVENT=MFE(1),MFN="",EDT=$$DT^XLFDT()
"RTN","IBCNEHLM",98,0)
 S CODE=$P($$SITE^VASITE,U,3)_$E(HLECH)
"RTN","IBCNEHLM",99,0)
 S VMFE=$$MFE^VAFHLMFE(EVENT,MFN,EDT,CODE)
"RTN","IBCNEHLM",100,0)
 S ^TMP("HLS",$J,2)=VMFE_HLFS_"CE"
"RTN","IBCNEHLM",101,0)
 ;
"RTN","IBCNEHLM",102,0)
 ; Set the ZRR segment
"RTN","IBCNEHLM",103,0)
 ;IB*549 Added line to send null values for removed fields so msg layout remains unchanged
"RTN","IBCNEHLM",104,0)
 S (CNTCPH,CNTCEM,CNTCNM)=""
"RTN","IBCNEHLM",105,0)
 S VZRR="ZRR"_HLFS_"1"_HLFS_TAXID_HLFS_HLFS_$$HLNAME^HLFNC(CNTCNM,$E(HLECH))_"^C"_HLFS
"RTN","IBCNEHLM",106,0)
 S VZRR=VZRR_CNTCPH_$E(HLECH)_$E(HLECH)_$E(HLECH)_CNTCEM_HLFS_FRSH_HLFS_IHLP_HLFS_IHLT_$E(HLECH)_IHLS_HLFS_INACT_HLFS_IVER
"RTN","IBCNEHLM",107,0)
 S ^TMP("HLS",$J,3)=VZRR
"RTN","IBCNEHLM",108,0)
 ;
"RTN","IBCNEHLM",109,0)
 ; Set the NTE segment
"RTN","IBCNEHLM",110,0)
 S DSTAT=$$GETSTAT^IBCNEDST()
"RTN","IBCNEHLM",111,0)
 S DSTAT2=$$GETSTAT2^IBCNEDST()                 ; IB*2.0*549 Added line
"RTN","IBCNEHLM",112,0)
 S VNTE="NTE"_HLFS_"1"_HLFS_HLFS_IBPERSIST_HLREP_$TR(DSTAT,U,HLREP)
"RTN","IBCNEHLM",113,0)
 S VNTE=VNTE_HLREP_RETRY_HLREP_TIMOUT           ; IB*2.0*506
"RTN","IBCNEHLM",114,0)
 S VNTE=VNTE_HLREP_$TR(DSTAT2,U,HLREP)          ; IB*2.0*549 Added line
"RTN","IBCNEHLM",115,0)
 S ^TMP("HLS",$J,4)=VNTE
"RTN","IBCNEHLM",116,0)
 ;
"RTN","IBCNEHLM",117,0)
 D GENERATE^HLMA("IBCNE IIV REGISTER","GM",1,.HLRESLT,"")
"RTN","IBCNEHLM",118,0)
 I $P(HLRESLT,U,2)]"" S HLRESLT="Error - "_$P(HLRESLT,U,2,99) D  Q
"RTN","IBCNEHLM",119,0)
 . S MSG(1)="HL7 eIV Registration Message not created."
"RTN","IBCNEHLM",120,0)
 . S MSG(2)=HLRESLT
"RTN","IBCNEHLM",121,0)
 . D MLMN
"RTN","IBCNEHLM",122,0)
 K ^TMP("HLS",$J)
"RTN","IBCNEHLM",123,0)
 Q
"RTN","IBCNEHLM",124,0)
 ;
"RTN","IBCNEHLM",125,0)
MLMN ;  MailMan Message
"RTN","IBCNEHLM",126,0)
 D TXT^IBCNEUT7("MSG")
"RTN","IBCNEHLM",127,0)
 S XMSUB="eIV Registration Failure"
"RTN","IBCNEHLM",128,0)
 D MSG^IBCNEUT5(MGRP,XMSUB,"MSG(")
"RTN","IBCNEHLM",129,0)
 K XMSUB,XMY,MSG,XMZ,XMDUZ
"RTN","IBCNEHLM",130,0)
 Q
"RTN","IBCNEHLQ")
0^8^B100140677^B60954828
"RTN","IBCNEHLQ",1,0)
IBCNEHLQ ;DAOU/ALA - HL7 RQI Message ;17-JUN-2002
"RTN","IBCNEHLQ",2,0)
 ;;2.0;INTEGRATED BILLING;**184,271,300,361,416,438,467,497,533,516,601,621**;21-MAR-94;Build 8
"RTN","IBCNEHLQ",3,0)
 ;;Per VA Directive 6402, this routine should not be modified.
"RTN","IBCNEHLQ",4,0)
 ;
"RTN","IBCNEHLQ",5,0)
 ;**Program Description**
"RTN","IBCNEHLQ",6,0)
 ;  This routine builds an eIV Verification (RQI^I01) or
"RTN","IBCNEHLQ",7,0)
 ;  Identification (RQI^I03) request
"RTN","IBCNEHLQ",8,0)
 ;
"RTN","IBCNEHLQ",9,0)
 ;**Modified by  Date        Reason
"RTN","IBCNEHLQ",10,0)
 ;  DAOU/BHS     10/04/2002  Implementing Transmit SSN logic
"RTN","IBCNEHLQ",11,0)
 ;  DAOU/DB      03/19/2004  Stripped dashes from SSN (PID, GT1)
"RTN","IBCNEHLQ",12,0)
 ;
"RTN","IBCNEHLQ",13,0)
EN ;  Entry Point
"RTN","IBCNEHLQ",14,0)
 ;  Variables
"RTN","IBCNEHLQ",15,0)
 ;    HLFS = Field Separator
"RTN","IBCNEHLQ",16,0)
 ;    DFN = Patient IEN
"RTN","IBCNEHLQ",17,0)
 ;    PAYR = Payer IEN
"RTN","IBCNEHLQ",18,0)
 ;    BUFF = Buffer IEN
"RTN","IBCNEHLQ",19,0)
 ;    FRDT = Freshness Date
"RTN","IBCNEHLQ",20,0)
 ;
"RTN","IBCNEHLQ",21,0)
PID ; Patient Identification Segment
"RTN","IBCNEHLQ",22,0)
 N VAFSTR,ICN,NM,I,PID11,EDQ,IBWHO,IBDOB,PID19
"RTN","IBCNEHLQ",23,0)
 ; IB*2.0*601 
"RTN","IBCNEHLQ",24,0)
 S VAFSTR=",1,7,8,11,",DFN=+$G(DFN) I $$MBICHK^IBCNEUT7(BUFF)!(EXT=4) S VAFSTR=VAFSTR_"19," ; IB*2.0*621 HAN
"RTN","IBCNEHLQ",25,0)
 S PID=$$EN^VAFHLPID(DFN,VAFSTR,1)
"RTN","IBCNEHLQ",26,0)
 S PID11=$P(PID,HLFS,12)
"RTN","IBCNEHLQ",27,0)
 I PID11'="" D
"RTN","IBCNEHLQ",28,0)
 . I $P(PID11,HLECH,1)="""""" S $P(PID11,HLECH,1)=""
"RTN","IBCNEHLQ",29,0)
 . I $P(PID11,HLECH,2)="""""" S $P(PID11,HLECH,2)=""
"RTN","IBCNEHLQ",30,0)
 . I $P(PID11,HLECH,3)="""""" S $P(PID11,HLECH,3)="UNKNOWN"
"RTN","IBCNEHLQ",31,0)
 . S $P(PID,HLFS,12)=PID11
"RTN","IBCNEHLQ",32,0)
 S PID19=$P(PID,HLFS,20)
"RTN","IBCNEHLQ",33,0)
 ; Encode special characters into Name and address pieces
"RTN","IBCNEHLQ",34,0)
 ; **NOTE: If $$EN^VAFHLPID should, in the future, return more than 11 pieces than the lines below may
"RTN","IBCNEHLQ",35,0)
 ;         need to be modified as they currently expect 11 pieces to be returned.
"RTN","IBCNEHLQ",36,0)
 I DFN D
"RTN","IBCNEHLQ",37,0)
 .; try to get name of insured from NAME OF INSURED
"RTN","IBCNEHLQ",38,0)
 .I EXT'=1,$G(IRIEN)'="" D
"RTN","IBCNEHLQ",39,0)
 .. S IBWHO=$P($G(^DPT(DFN,.312,IRIEN,0)),U,6)
"RTN","IBCNEHLQ",40,0)
 .. I IBWHO'="",IBWHO'="v" Q
"RTN","IBCNEHLQ",41,0)
 ..;IB*2.0*601/DM for "self" appt extract, use patient's insurance insured DOB
"RTN","IBCNEHLQ",42,0)
 .. S IBDOB=$$GET1^DIQ(2.312,IRIEN_","_DFN_",","INSURED'S DOB","I")
"RTN","IBCNEHLQ",43,0)
 .. I IBDOB S $P(PID,HLFS,8)=$$HLDATE^HLFNC(IBDOB)
"RTN","IBCNEHLQ",44,0)
 .. S NM=$P($G(^DPT(DFN,.312,IRIEN,7)),U,1)
"RTN","IBCNEHLQ",45,0)
 .I EXT=1,BUFF,$G(NM)="" D
"RTN","IBCNEHLQ",46,0)
 .. S IBWHO=$P($G(^IBA(355.33,BUFF,60)),U,5)
"RTN","IBCNEHLQ",47,0)
 .. I IBWHO'="",IBWHO'="v" Q
"RTN","IBCNEHLQ",48,0)
 ..;IB*2.0*601/DM for "self" buffer extract, use buff's insured DOB
"RTN","IBCNEHLQ",49,0)
 ..;otherwise, use patient's insurance insured DOB, otherwise use patient's DOB 
"RTN","IBCNEHLQ",50,0)
 .. S IBDOB=$$GET1^DIQ(355.33,BUFF_",","INSURED'S DOB","I")
"RTN","IBCNEHLQ",51,0)
 .. I 'IBDOB,$G(IRIEN)'="" S IBDOB=$$GET1^DIQ(2.312,IRIEN_","_DFN_",","INSURED'S DOB","I")
"RTN","IBCNEHLQ",52,0)
 .. I IBDOB S $P(PID,HLFS,8)=$$HLDATE^HLFNC(IBDOB)
"RTN","IBCNEHLQ",53,0)
 .. S NM=$P($G(^IBA(355.33,BUFF,91)),U)
"RTN","IBCNEHLQ",54,0)
 .I $G(NM)'="" S NM=$$HLNAME^HLFNC(NM,HLECH)
"RTN","IBCNEHLQ",55,0)
 .; if unsuccessful, get patient name from 2/.01
"RTN","IBCNEHLQ",56,0)
 .I $G(NM)="" D
"RTN","IBCNEHLQ",57,0)
 ..S NM("FILE")=2,NM("IENS")=DFN,NM("FIELD")=.01
"RTN","IBCNEHLQ",58,0)
 ..S NM=$$HLNAME^XLFNAME(.NM,"",$E(HLECH)),NM=$S(NM]"":NM,1:HLQ)
"RTN","IBCNEHLQ",59,0)
 ..Q
"RTN","IBCNEHLQ",60,0)
 .S I=$L(NM,HLFS),NM=$$ENCHL7(NM),$P(PID,HLFS,6,5+I)=NM
"RTN","IBCNEHLQ",61,0)
 .; IB*2.0*601
"RTN","IBCNEHLQ",62,0)
 .S $P(PID,HLFS,20,99)=$$ENCHL7($P(PID,HLFS,20,99))
"RTN","IBCNEHLQ",63,0)
 .S ICN=$P($G(^DPT(DFN,"MPI")),U,1)
"RTN","IBCNEHLQ",64,0)
 .S $P(PID,HLFS,4)=ICN_HLECH_HLECH_HLECH_"USVHA"_HLECH_"NI"_HLECH_"~"_DFN_HLECH_HLECH_HLECH_"USVHA"_HLECH_"PI"_HLECH_$P($$SITE^VASITE,U,3)_HLECH
"RTN","IBCNEHLQ",65,0)
 .Q
"RTN","IBCNEHLQ",66,0)
 S FRDT=$$HLDATE^HLFNC($G(FRDT))
"RTN","IBCNEHLQ",67,0)
 I PID19'="" S $P(PID,HLFS,13)="",$P(PID,HLFS,20)=PID19
"RTN","IBCNEHLQ",68,0)
 I EXT'=4 S $P(PID,HLFS,34)=FRDT ; IB*2.0*621 Not for A1 transaction
"RTN","IBCNEHLQ",69,0)
 Q
"RTN","IBCNEHLQ",70,0)
 ;
"RTN","IBCNEHLQ",71,0)
GT1 ;  Guarantor Segment
"RTN","IBCNEHLQ",72,0)
 N WHO,NM,IDOB,ISEX,SEX,RLIEN,PER,PLIEN,RDATA,IBSDATA,IBADDR
"RTN","IBCNEHLQ",73,0)
 N EICDIIEN,IBFMIEN,IBTRKDTA ; IB*2.0*621/DM variables 
"RTN","IBCNEHLQ",74,0)
 ;
"RTN","IBCNEHLQ",75,0)
 S GT1=""
"RTN","IBCNEHLQ",76,0)
 I $G(QUERY)="I" Q
"RTN","IBCNEHLQ",77,0)
 ;
"RTN","IBCNEHLQ",78,0)
 ;  If the data was extracted from Buffer get specifics from Buffer file
"RTN","IBCNEHLQ",79,0)
 I EXT=1 D
"RTN","IBCNEHLQ",80,0)
 . S WHO=$P($G(^IBA(355.33,BUFF,60)),U,5)
"RTN","IBCNEHLQ",81,0)
 . I WHO="v"!(WHO="") Q
"RTN","IBCNEHLQ",82,0)
 . ;S NM=$P($G(^IBA(355.33,BUFF,60)),U,7),NM=$$NAME^IBCNEHLU(NM)
"RTN","IBCNEHLQ",83,0)
 . S NM=$$GET1^DIQ(355.33,BUFF,91.01),NM=$$NAME^IBCNEHLU(NM) ;Get HIPAA data from new fields - IB*2*516
"RTN","IBCNEHLQ",84,0)
 . S NM=$$HLNAME^HLFNC(NM,HLECH)
"RTN","IBCNEHLQ",85,0)
 . S NM=$$ENCHL7(NM)
"RTN","IBCNEHLQ",86,0)
 . S $P(GT1,HLFS,3)=NM_HLECH_HLECH_HLECH
"RTN","IBCNEHLQ",87,0)
 . S IDOB=$P($G(^IBA(355.33,BUFF,60)),U,8),IDOB=$$HLDATE^HLFNC(IDOB)
"RTN","IBCNEHLQ",88,0)
 . S $P(GT1,HLFS,8)=IDOB
"RTN","IBCNEHLQ",89,0)
 . S $P(GT1,HLFS,2)=$$SCRUB($G(SUBID))_HLECH_HLECH_HLECH_HLECH_"HC"
"RTN","IBCNEHLQ",90,0)
 . Q
"RTN","IBCNEHLQ",91,0)
 ;
"RTN","IBCNEHLQ",92,0)
 ;  If the data was from the appointment extract, check Patient file, IB*2.0*621/DM
"RTN","IBCNEHLQ",93,0)
 I EXT=2 D
"RTN","IBCNEHLQ",94,0)
 . I IRIEN="" Q
"RTN","IBCNEHLQ",95,0)
 . S WHO=$P($G(^DPT(DFN,.312,IRIEN,0)),U,6)
"RTN","IBCNEHLQ",96,0)
 . I WHO="v"!(WHO="") Q
"RTN","IBCNEHLQ",97,0)
 . ;S NM=$P($G(^DPT(DFN,.312,IRIEN,0)),U,17)  ; WCJ;IB*2.0*497
"RTN","IBCNEHLQ",98,0)
 . S NM=$P($G(^DPT(DFN,.312,IRIEN,7)),U,1)  ; WCJ;IB*2.0*497
"RTN","IBCNEHLQ",99,0)
 . S NM=$$HLNAME^HLFNC(NM,HLECH)
"RTN","IBCNEHLQ",100,0)
 . S NM=$$ENCHL7(NM)
"RTN","IBCNEHLQ",101,0)
 . S $P(GT1,HLFS,3)=NM_HLECH_HLECH_HLECH
"RTN","IBCNEHLQ",102,0)
 . S IDOB=$P($G(^DPT(DFN,.312,IRIEN,3)),U,1),IDOB=$$HLDATE^HLFNC(IDOB)
"RTN","IBCNEHLQ",103,0)
 . S $P(GT1,HLFS,8)=IDOB
"RTN","IBCNEHLQ",104,0)
 . S $P(GT1,HLFS,2)=$$SCRUB($G(SUBID))_HLECH_HLECH_HLECH_HLECH_"HC"
"RTN","IBCNEHLQ",105,0)
 . ;
"RTN","IBCNEHLQ",106,0)
 . S IBSDATA=$G(^DPT(DFN,.312,IRIEN,3))
"RTN","IBCNEHLQ",107,0)
 . S IBADDR=$$HLADDR^HLFNC($P(IBSDATA,U,6,7),$P(IBSDATA,U,8,10))
"RTN","IBCNEHLQ",108,0)
 . S $P(GT1,HLFS,5)=$$ENCHL7(IBADDR)
"RTN","IBCNEHLQ",109,0)
 . ;
"RTN","IBCNEHLQ",110,0)
 . D CHK
"RTN","IBCNEHLQ",111,0)
 . I $P(GT1,HLFS,8)=""&(IDOB'="") S $P(GT1,HLFS,8)=$$HLDATE^HLFNC(IDOB)
"RTN","IBCNEHLQ",112,0)
 . I $P(GT1,HLFS,9)=""&(ISEX'="") S $P(GT1,HLFS,9)=ISEX
"RTN","IBCNEHLQ",113,0)
 . I $P(GT1,HLFS,9)="",WHO="s" D
"RTN","IBCNEHLQ",114,0)
 .. S SEX=$P($G(^DPT(DFN,.312,IRIEN,3)),U,12) ; get policy holder sex
"RTN","IBCNEHLQ",115,0)
 .. I SEX="" S SEX=$P(^DPT(DFN,0),U,2),SEX=$S(SEX="M":"F",1:"M") ; if null, use alternative method
"RTN","IBCNEHLQ",116,0)
 .. S $P(GT1,HLFS,9)=SEX
"RTN","IBCNEHLQ",117,0)
 ;
"RTN","IBCNEHLQ",118,0)
 ; IB*2.0*621/DM add EICD Verification, use data from EIV EICD TRACKING (#365.18) 
"RTN","IBCNEHLQ",119,0)
 I EXT=4,$G(QUERY)="V" D
"RTN","IBCNEHLQ",120,0)
 . S EICDIIEN=+$O(^IBCN(365.18,"C",IEN,0)) ; IEN is the TQ from IBCNEDEP
"RTN","IBCNEHLQ",121,0)
 . I ('EICDIIEN)!(EICDVIEN="") Q 
"RTN","IBCNEHLQ",122,0)
 . S IBFMIEN=EICDVIEN_","_EICDIIEN_","
"RTN","IBCNEHLQ",123,0)
 . K IBTRKDTA D GETS^DIQ(365.185,IBFMIEN,".04;.07;.08;.09","I","IBTRKDTA") ; grab selected fields (internal)
"RTN","IBCNEHLQ",124,0)
 . ;
"RTN","IBCNEHLQ",125,0)
 . S NM=IBTRKDTA(365.185,IBFMIEN,.09,"I")
"RTN","IBCNEHLQ",126,0)
 . Q:NM=""  ; no name means subscriber -- GT1 is not needed
"RTN","IBCNEHLQ",127,0)
 . S NM=$$HLNAME^HLFNC(NM,HLECH)
"RTN","IBCNEHLQ",128,0)
 . S NM=$$ENCHL7(NM)
"RTN","IBCNEHLQ",129,0)
 . S $P(GT1,HLFS,3)=NM_HLECH_HLECH_HLECH
"RTN","IBCNEHLQ",130,0)
 . S IDOB=IBTRKDTA(365.185,IBFMIEN,.07,"I"),IDOB=$$HLDATE^HLFNC(IDOB)
"RTN","IBCNEHLQ",131,0)
 . S $P(GT1,HLFS,8)=IDOB
"RTN","IBCNEHLQ",132,0)
 . ; Subscriber ID -- Guarantor Number 
"RTN","IBCNEHLQ",133,0)
 . S $P(GT1,HLFS,2)=$$SCRUB(IBTRKDTA(365.185,IBFMIEN,.04,"I"))_HLECH_HLECH_HLECH_HLECH_"HC"
"RTN","IBCNEHLQ",134,0)
 . ; skip address data
"RTN","IBCNEHLQ",135,0)
 . S ISEX=IBTRKDTA(365.185,IBFMIEN,.08,"I")
"RTN","IBCNEHLQ",136,0)
 . I $P(GT1,HLFS,8)=""&(IDOB'="") S $P(GT1,HLFS,8)=$$HLDATE^HLFNC(IDOB)
"RTN","IBCNEHLQ",137,0)
 . I $P(GT1,HLFS,9)=""&(ISEX'="") S $P(GT1,HLFS,9)=ISEX
"RTN","IBCNEHLQ",138,0)
 ;
"RTN","IBCNEHLQ",139,0)
 I GT1="" Q
"RTN","IBCNEHLQ",140,0)
 S $P(GT1,HLFS,1)=1
"RTN","IBCNEHLQ",141,0)
 S GT1="GT1"_HLFS_GT1
"RTN","IBCNEHLQ",142,0)
 Q
"RTN","IBCNEHLQ",143,0)
 ;
"RTN","IBCNEHLQ",144,0)
IN1 ;  Insurance Segment
"RTN","IBCNEHLQ",145,0)
 N EFFDT,ELIGDT,EXPDT,PREL,ADMN,ADMDT,IENS
"RTN","IBCNEHLQ",146,0)
 N EICDIIEN,IBFMIEN,IBPYIEN,IBTRKDTA ; IB*2.0*621/DM variables
"RTN","IBCNEHLQ",147,0)
 S IN1=""
"RTN","IBCNEHLQ",148,0)
 ;
"RTN","IBCNEHLQ",149,0)
 ;  If the data was extracted from Buffer get specifics from Buffer file
"RTN","IBCNEHLQ",150,0)
 I EXT=1 D
"RTN","IBCNEHLQ",151,0)
 .S PREL=$P($G(^IBA(355.33,BUFF,60)),U,14)
"RTN","IBCNEHLQ",152,0)
 .S ELIGDT=$P($G(TRANSR),U,12) I ELIGDT=DT S ELIGDT=""
"RTN","IBCNEHLQ",153,0)
 .S $P(IN1,HLFS,2)=$S(PREL=18:$$SCRUB($G(SUBID)),PREL="":$$SCRUB($G(SUBID)),1:$$SCRUB($G(PATID)))
"RTN","IBCNEHLQ",154,0)
 .I PAYR'=$$FIND1^DIC(365.12,"","X","~NO PAYER") D
"RTN","IBCNEHLQ",155,0)
 ..S $P(IN1,HLFS,3)=$$ENCHL7($P(^IBE(365.12,PAYR,0),U,2))_HLECH_HLECH_HLECH_"USVHA"_HLECH_"VP"_HLECH
"RTN","IBCNEHLQ",156,0)
 ..S $P(IN1,HLFS,4)=$$ENCHL7($P(^IBE(365.12,PAYR,0),U,1))
"RTN","IBCNEHLQ",157,0)
 . ;IB*2.0*516/TAZ - Use HIPAA compliant fields
"RTN","IBCNEHLQ",158,0)
 .;S $P(IN1,HLFS,8)=$$ENCHL7($P($G(^IBA(355.33,BUFF,40)),U,3))
"RTN","IBCNEHLQ",159,0)
 .;S $P(IN1,HLFS,9)=$$ENCHL7($P($G(^IBA(355.33,BUFF,40)),U,2))
"RTN","IBCNEHLQ",160,0)
 .S $P(IN1,HLFS,8)=$$ENCHL7($$GET1^DIQ(355.33,BUFF_",",90.02))
"RTN","IBCNEHLQ",161,0)
 .S $P(IN1,HLFS,9)=$$ENCHL7($$GET1^DIQ(355.33,BUFF_",",90.01))
"RTN","IBCNEHLQ",162,0)
 .S EFFDT=$P($G(^IBA(355.33,BUFF,60)),U,2),EFFDT=$$HLDATE^HLFNC(EFFDT)
"RTN","IBCNEHLQ",163,0)
 .S EXPDT=$P($G(^IBA(355.33,BUFF,60)),U,3),EXPDT=$$HLDATE^HLFNC(EXPDT)
"RTN","IBCNEHLQ",164,0)
 .S $P(IN1,HLFS,12)=EFFDT
"RTN","IBCNEHLQ",165,0)
 .S $P(IN1,HLFS,13)=EXPDT
"RTN","IBCNEHLQ",166,0)
 .S $P(IN1,HLFS,17)=$$PATREL(PREL)
"RTN","IBCNEHLQ",167,0)
 .S $P(IN1,HLFS,26)=$$HLDATE^HLFNC(ELIGDT)
"RTN","IBCNEHLQ",168,0)
 .I $P(IN1,HLFS,17)="" S $P(IN1,HLFS,17)=18
"RTN","IBCNEHLQ",169,0)
 ;
"RTN","IBCNEHLQ",170,0)
 ; If the data was from the appointment extract, check Patient file, IB*2.0*621/DM
"RTN","IBCNEHLQ",171,0)
 I EXT=2 D
"RTN","IBCNEHLQ",172,0)
 . I IRIEN="" Q
"RTN","IBCNEHLQ",173,0)
 . I $$SCRUB($G(SUBID))'=$$SCRUB($P($G(^DPT(DFN,.312,IRIEN,0)),U,2)) Q
"RTN","IBCNEHLQ",174,0)
 . S EFFDT=$P($G(^DPT(DFN,.312,IRIEN,0)),U,8),EFFDT=$$HLDATE^HLFNC(EFFDT)
"RTN","IBCNEHLQ",175,0)
 . S EXPDT=$P($G(^DPT(DFN,.312,IRIEN,0)),U,4),EXPDT=$$HLDATE^HLFNC(EXPDT)
"RTN","IBCNEHLQ",176,0)
 . S $P(IN1,HLFS,12)=EFFDT
"RTN","IBCNEHLQ",177,0)
 . S $P(IN1,HLFS,13)=EXPDT
"RTN","IBCNEHLQ",178,0)
 . S PREL=$P($G(^DPT(DFN,.312,IRIEN,4)),U,3)
"RTN","IBCNEHLQ",179,0)
 . S $P(IN1,HLFS,2)=$S(PREL=18:$$SCRUB($G(SUBID)),PREL="":$$SCRUB($G(SUBID)),1:$$SCRUB($G(PATID)))
"RTN","IBCNEHLQ",180,0)
 . I PAYR'=$$FIND1^DIC(365.12,"","X","~NO PAYER") D
"RTN","IBCNEHLQ",181,0)
 .. S $P(IN1,HLFS,3)=$$ENCHL7($P(^IBE(365.12,PAYR,0),U,2))_HLECH_HLECH_HLECH_"USVHA"_HLECH_"VP"_HLECH
"RTN","IBCNEHLQ",182,0)
 .. S $P(IN1,HLFS,4)=$$ENCHL7($P(^IBE(365.12,PAYR,0),U,1))
"RTN","IBCNEHLQ",183,0)
 . S $P(IN1,HLFS,17)=$$PATREL(PREL)
"RTN","IBCNEHLQ",184,0)
 . S IENS=IRIEN_","_DFN_","
"RTN","IBCNEHLQ",185,0)
 . S $P(IN1,HLFS,8)=$$ENCHL7($$GET1^DIQ(2.312,IENS,21,"E"))
"RTN","IBCNEHLQ",186,0)
 . S $P(IN1,HLFS,9)=$$ENCHL7($$GET1^DIQ(2.312,IENS,20,"E"))
"RTN","IBCNEHLQ",187,0)
 . I $P(IN1,HLFS,17)="" S $P(IN1,HLFS,17)=18
"RTN","IBCNEHLQ",188,0)
 ;
"RTN","IBCNEHLQ",189,0)
 ; IB*2.0*621/DM add EICD Verification, use data from EIV EICD TRACKING (#365.18) 
"RTN","IBCNEHLQ",190,0)
 I EXT=4,$G(QUERY)="V" D
"RTN","IBCNEHLQ",191,0)
 . S EICDIIEN=+$O(^IBCN(365.18,"C",IEN,0)) ; IEN is the TQ from IBCNEDEP
"RTN","IBCNEHLQ",192,0)
 . I ('EICDIIEN)!(EICDVIEN="") Q
"RTN","IBCNEHLQ",193,0)
 . S IBFMIEN=EICDVIEN_","_EICDIIEN_","
"RTN","IBCNEHLQ",194,0)
 . K IBTRKDTA D GETS^DIQ(365.185,IBFMIEN,".01;.03;.05;.09","I","IBTRKDTA") ; grab selected fields (internal)
"RTN","IBCNEHLQ",195,0)
 . ;
"RTN","IBCNEHLQ",196,0)
 . S PREL="18"  ; means self/veteran
"RTN","IBCNEHLQ",197,0)
 . S:IBTRKDTA(365.185,IBFMIEN,.09,"I")'="" PREL="" ; not subscriber 
"RTN","IBCNEHLQ",198,0)
 . S $P(IN1,HLFS,2)=IBTRKDTA(365.185,IBFMIEN,.05,"I")
"RTN","IBCNEHLQ",199,0)
 . S $P(IN1,HLFS,3)=$$ENCHL7(IBTRKDTA(365.185,IBFMIEN,.01,"I"))_HLECH_HLECH_HLECH_"USVHA"_HLECH_"VP"_HLECH ; PAYER VA ID
"RTN","IBCNEHLQ",200,0)
 . S IBPYIEN=+$$FIND1^DIC(365.12,,"QX",IBTRKDTA(365.185,IBFMIEN,.01,"I"),"C") ; PAYER IEN
"RTN","IBCNEHLQ",201,0)
 . S $P(IN1,HLFS,4)=$$ENCHL7($$GET1^DIQ(365.12,IBPYIEN_",",.01)) ; PAYER NAME
"RTN","IBCNEHLQ",202,0)
 . S $P(IN1,HLFS,17)=$$PATREL(PREL)
"RTN","IBCNEHLQ",203,0)
 . S $P(IN1,HLFS,8)=IBTRKDTA(365.185,IBFMIEN,.03,"I") ; GROUP NUMBER
"RTN","IBCNEHLQ",204,0)
 I IN1="" Q
"RTN","IBCNEHLQ",205,0)
 ;
"RTN","IBCNEHLQ",206,0)
 S $P(IN1,HLFS,1)=1
"RTN","IBCNEHLQ",207,0)
 S IN1="IN1"_HLFS_IN1
"RTN","IBCNEHLQ",208,0)
 Q
"RTN","IBCNEHLQ",209,0)
 ;
"RTN","IBCNEHLQ",210,0)
NTE(CTR) ;  NTE Segment
"RTN","IBCNEHLQ",211,0)
 N EICDIIEN
"RTN","IBCNEHLQ",212,0)
 ; TRANSR is 0 node of TQ, set in PROC^IBCNEDEP
"RTN","IBCNEHLQ",213,0)
 I CTR=1 S NTE=$$EXTERNAL^DILFD(365.1,.2,,$P($G(TRANSR),U,20)) ; service code from 365.1/.2
"RTN","IBCNEHLQ",214,0)
 ; IB*2.0*601 - Added NTE2 and NTE3
"RTN","IBCNEHLQ",215,0)
 I CTR=2 D
"RTN","IBCNEHLQ",216,0)
 . S NTE=$$GET1^DIQ(365.1,IEN_",","SOURCE OF INFORMATION","I")  ; IEN = ien of TQ
"RTN","IBCNEHLQ",217,0)
 . S NTE=$$GET1^DIQ(355.12,NTE_",","IB BUFFER ACRONYM")
"RTN","IBCNEHLQ",218,0)
 I CTR=3 S NTE=$S(((EXT=4)&(QUERY="I")):"OHI",$$MBICHK^IBCNEUT7(BUFF):"MBI",1:"ELI") ; IB*2.0*621
"RTN","IBCNEHLQ",219,0)
 ; IB*2.0*621
"RTN","IBCNEHLQ",220,0)
 I CTR=4 S NTE="" ; Reporting of known insurance infomation will happen at a later release
"RTN","IBCNEHLQ",221,0)
 I CTR=5 S NTE=""
"RTN","IBCNEHLQ",222,0)
 I CTR=5,EXT=4,QUERY="V" D
"RTN","IBCNEHLQ",223,0)
 . ; on EICD Verifications, pass the TRACE # from the associted EICD Inquiry
"RTN","IBCNEHLQ",224,0)
 . S EICDIIEN=+$O(^IBCN(365.18,"C",IEN,0)) ; IEN is the TQ from IBCNEDEP
"RTN","IBCNEHLQ",225,0)
 . S NTE=$$GET1^DIQ(365.18,EICDIIEN_",",.04,"I") ; EICD TRACE NUMBER 
"RTN","IBCNEHLQ",226,0)
 S NTE="NTE"_HLFS_CTR_HLFS_HLFS_NTE
"RTN","IBCNEHLQ",227,0)
 K CTR
"RTN","IBCNEHLQ",228,0)
 Q
"RTN","IBCNEHLQ",229,0)
 ; 
"RTN","IBCNEHLQ",230,0)
CHK ;  Check for spouse or other information in the Patient Relation File
"RTN","IBCNEHLQ",231,0)
 ;  DGREL = Relationship (1=Self, 2=Spouse, 3-34,99=Other)
"RTN","IBCNEHLQ",232,0)
 NEW IEN,QFL
"RTN","IBCNEHLQ",233,0)
 S IEN="",RLIEN="",ISEX="",QFL=0
"RTN","IBCNEHLQ",234,0)
 F  S IEN=$O(^DGPR(408.12,"B",DFN,IEN)) Q:IEN=""  D  Q:QFL
"RTN","IBCNEHLQ",235,0)
 . S DGREL=$P($G(^DGPR(408.12,IEN,0)),U,2)
"RTN","IBCNEHLQ",236,0)
 . ;
"RTN","IBCNEHLQ",237,0)
 . ;  If person is veteran, quit
"RTN","IBCNEHLQ",238,0)
 . I DGREL=1 Q
"RTN","IBCNEHLQ",239,0)
 . ;
"RTN","IBCNEHLQ",240,0)
 . ;  If person is spouse, pick that record and quit
"RTN","IBCNEHLQ",241,0)
 . I WHO="s",DGREL=2 S RLIEN=IEN,QFL=1 Q
"RTN","IBCNEHLQ",242,0)
 . ;
"RTN","IBCNEHLQ",243,0)
 . ;  Otherwise it should be an 'other' dependent
"RTN","IBCNEHLQ",244,0)
 . S RLIEN=IEN
"RTN","IBCNEHLQ",245,0)
 ;
"RTN","IBCNEHLQ",246,0)
 I RLIEN="" Q
"RTN","IBCNEHLQ",247,0)
 ;
"RTN","IBCNEHLQ",248,0)
 ;  Check for Sex, SSN, DOB in INCOME PERSON File
"RTN","IBCNEHLQ",249,0)
 S PER=$P(^DGPR(408.12,RLIEN,0),U,3)
"RTN","IBCNEHLQ",250,0)
 I PER'["DGPR(408.13" Q
"RTN","IBCNEHLQ",251,0)
 S PLIEN=$P(PER,";",1)
"RTN","IBCNEHLQ",252,0)
 I PLIEN="" Q
"RTN","IBCNEHLQ",253,0)
 S RDATA=$G(^DGPR(408.13,PLIEN,0)),ISEX=$P(RDATA,U,2),IDOB=$P(RDATA,U,3)
"RTN","IBCNEHLQ",254,0)
 I $P(RDATA,U,4)'="" N DFN S DFN=$P(RDATA,U,4),ISEX=$P(^DPT(DFN,0),U,2),IDOB=$P(^DPT(DFN,0),U,3)
"RTN","IBCNEHLQ",255,0)
 Q
"RTN","IBCNEHLQ",256,0)
 ;
"RTN","IBCNEHLQ",257,0)
ENCHL7(STR) ; Encode HL7 escape seqs in data fields
"RTN","IBCNEHLQ",258,0)
 ;
"RTN","IBCNEHLQ",259,0)
 ; Input:
"RTN","IBCNEHLQ",260,0)
 ; STR = Field data possible containing HL7 encoding chars
"RTN","IBCNEHLQ",261,0)
 ;
"RTN","IBCNEHLQ",262,0)
 ; Output Values
"RTN","IBCNEHLQ",263,0)
 ; Fn returns string w/converted escape seqs
"RTN","IBCNEHLQ",264,0)
 ;
"RTN","IBCNEHLQ",265,0)
 N CHR,NEW,RPLC,CNT,LOOP
"RTN","IBCNEHLQ",266,0)
 ;
"RTN","IBCNEHLQ",267,0)
 ; Replace "\" "&" "~" "|" with \F\ \R\ \E\ \T\ respectively
"RTN","IBCNEHLQ",268,0)
 F CHR="\","&","~","|" S CNT=$L(STR,CHR) I CNT>1 D
"RTN","IBCNEHLQ",269,0)
 . S NEW=$P(STR,CHR)
"RTN","IBCNEHLQ",270,0)
 . S RPLC="\"_$TR(CHR,"|~\&","FRET")_"\"
"RTN","IBCNEHLQ",271,0)
 . F LOOP=2:1:CNT S NEW=NEW_RPLC_$P(STR,CHR,LOOP)
"RTN","IBCNEHLQ",272,0)
 . S STR=NEW
"RTN","IBCNEHLQ",273,0)
 ;
"RTN","IBCNEHLQ",274,0)
 Q STR
"RTN","IBCNEHLQ",275,0)
 ;
"RTN","IBCNEHLQ",276,0)
SCRUB(Z) ; remove all punctuation from the string and convert lowercase to uppercase
"RTN","IBCNEHLQ",277,0)
 ; IB*2*416 - used for subscriber and patient ID fields
"RTN","IBCNEHLQ",278,0)
 S Z=$$NOPUNCT^IBCEF(Z,1)
"RTN","IBCNEHLQ",279,0)
 S Z=$$UP^XLFSTR(Z)
"RTN","IBCNEHLQ",280,0)
SCRUBX ;
"RTN","IBCNEHLQ",281,0)
 Q Z
"RTN","IBCNEHLQ",282,0)
 ;
"RTN","IBCNEHLQ",283,0)
PATREL(REL) ; convert pat.relationship to insured from VistA to X12 and return X12 value
"RTN","IBCNEHLQ",284,0)
 ; REL - VistA value
"RTN","IBCNEHLQ",285,0)
 ; 
"RTN","IBCNEHLQ",286,0)
 ; VistA values of Self (18), Spouse (01), and Child (19) remain unchanged,
"RTN","IBCNEHLQ",287,0)
 ; anything else is converted to X12 value of Other Adult (34)
"RTN","IBCNEHLQ",288,0)
 ;
"RTN","IBCNEHLQ",289,0)
 Q $S($G(REL)="":"",".01.18.19."[("."_REL_"."):REL,1:34)
"RTN","IBCNEHLT")
0^9^B95865249^B94982650
"RTN","IBCNEHLT",1,0)
IBCNEHLT ;DAOU/ALA - HL7 Process Incoming MFN Messages ; 15 Mar 2016  3:00 PM
"RTN","IBCNEHLT",2,0)
 ;;2.0;INTEGRATED BILLING;**184,251,271,300,416,438,506,549,582,601,621**;21-MAR-94;Build 8
"RTN","IBCNEHLT",3,0)
 ;;Per VA Directive 6402, this routine should not be modified.
"RTN","IBCNEHLT",4,0)
 ;
"RTN","IBCNEHLT",5,0)
 ;**Program Description**
"RTN","IBCNEHLT",6,0)
 ;  This program will process incoming MFN messages and
"RTN","IBCNEHLT",7,0)
 ;  update the appropriate tables
"RTN","IBCNEHLT",8,0)
 ;
"RTN","IBCNEHLT",9,0)
EN ;  Entry Point
"RTN","IBCNEHLT",10,0)
 NEW AIEN,APIEN,APP,D0,D,DESC,DQ,DR,FILE,FLN,HEDI,ID,IEN
"RTN","IBCNEHLT",11,0)
 NEW PEDI,SEG,STAT,HCT,NEWID,TSSN,REQSUB,NAFLG,NPFLG,TRUSTED
"RTN","IBCNEHLT",12,0)
 NEW IBCNACT,IBCNADT,FSVDY,PSVDY
"RTN","IBCNEHLT",13,0)
 NEW BPSIEN,CMIEN,DATA,DATAAP,DATABPS,DATACM,DATE,ERROR,FIELDNO,FILENO
"RTN","IBCNEHLT",14,0)
 NEW IBSEG,MSG,BUFF
"RTN","IBCNEHLT",15,0)
 NEW X12TABLE,BADFMT
"RTN","IBCNEHLT",16,0)
 ;
"RTN","IBCNEHLT",17,0)
 ; BADFMT is true if a site with patch 300 receives an eIV message in the previous HL7 interface structure (pre-300)
"RTN","IBCNEHLT",18,0)
 ;
"RTN","IBCNEHLT",19,0)
 ; ** With national release of IB*2*550 ePharmacy will no longer use this routine to process table
"RTN","IBCNEHLT",20,0)
 ;    updates.
"RTN","IBCNEHLT",21,0)
 ; ** Therefore, several lines of code will become obsolete as commented in this routine.
"RTN","IBCNEHLT",22,0)
 ;
"RTN","IBCNEHLT",23,0)
 ; ** Upon national release of IB*2*550 reword statement below to drop ePHARM reference
"RTN","IBCNEHLT",24,0)
 ;
"RTN","IBCNEHLT",25,0)
 ; Build local table of file numbers to determine if response is eIV or ePHARM
"RTN","IBCNEHLT",26,0)
 ; * Warning: Before adding a new table to be updated by FSC, one must get FSC
"RTN","IBCNEHLT",27,0)
 ;            to agree and the eIV ICD documentation has to be updated and 
"RTN","IBCNEHLT",28,0)
 ;            approved by the VA HL7 team. Just adding a table number here does
"RTN","IBCNEHLT",29,0)
 ;            absolutely nothing without involving the other teams.
"RTN","IBCNEHLT",30,0)
 ;
"RTN","IBCNEHLT",31,0)
 F D=11:1:18 S X12TABLE("365.0"_D)=""
"RTN","IBCNEHLT",32,0)
 ;F D=21:1:28 S X12TABLE("365.0"_D)=""
"RTN","IBCNEHLT",33,0)
 S X12TABLE(350.021)=""
"RTN","IBCNEHLT",34,0)
 S X12TABLE(350.9)=""     ; IB*2.0*506
"RTN","IBCNEHLT",35,0)
 S X12TABLE(350.9002)=""  ; IB*2.0*549
"RTN","IBCNEHLT",36,0)
 ;
"RTN","IBCNEHLT",37,0)
 ; Decide if message belongs to "E-Pharm" or "eIV"
"RTN","IBCNEHLT",38,0)
 S APP=""
"RTN","IBCNEHLT",39,0)
 S HCT=0,ERFLG=0
"RTN","IBCNEHLT",40,0)
 F  S HCT=$O(^TMP($J,"IBCNEHLI",HCT)) Q:HCT=""  D SPAR^IBCNEHLU I $G(IBSEG(1))="MFI" S FILE=$G(IBSEG(2)),FLN=$P(FILE,$E(HLECH,1),1) Q
"RTN","IBCNEHLT",41,0)
 I ",366.01,366.02,366.03,365.12,355.3,"[(","_FLN_",") S APP="E-PHARM"   ; ** Obsolete line upon release of IB*2*550
"RTN","IBCNEHLT",42,0)
 I FLN=365.12 D
"RTN","IBCNEHLT",43,0)
 . S HCT=0,BADFMT=0
"RTN","IBCNEHLT",44,0)
 . F  S HCT=$O(^TMP($J,"IBCNEHLI",HCT)) Q:HCT=""  D  Q:(APP="IIV")!BADFMT
"RTN","IBCNEHLT",45,0)
 .. D SPAR^IBCNEHLU
"RTN","IBCNEHLT",46,0)
 .. I $G(IBSEG(1))="MFE",$P($G(IBSEG(5)),$E(HLECH,1),3)'="" D  Q
"RTN","IBCNEHLT",47,0)
 ... S BADFMT=1,APP=""
"RTN","IBCNEHLT",48,0)
 ... S MSG(1)="Log a Remedy Ticket for this issue."
"RTN","IBCNEHLT",49,0)
 ... S MSG(2)="Please include in the Remedy Ticket that the Vista eIV payer tables may be out"
"RTN","IBCNEHLT",50,0)
 ... S MSG(3)="of sync with the master list and will need a new copy of the payer table"
"RTN","IBCNEHLT",51,0)
 ... S MSG(4)="update message from Austin."
"RTN","IBCNEHLT",52,0)
 ... D MSG^IBCNEUT5($$MGRP^IBCNEUT5(),"eIV payer tables may be out of synch with master list","MSG(")
"RTN","IBCNEHLT",53,0)
 .. I $G(IBSEG(1))="ZPA" S APP="IIV"
"RTN","IBCNEHLT",54,0)
 I $D(X12TABLE(FLN)) S APP="IIV"
"RTN","IBCNEHLT",55,0)
 ;
"RTN","IBCNEHLT",56,0)
 ; ** Upon release of IB*2*550, drop the ePharm reference in the comment below
"RTN","IBCNEHLT",57,0)
 ; If neither eIV or ePHARM then quit
"RTN","IBCNEHLT",58,0)
 I APP="" Q
"RTN","IBCNEHLT",59,0)
 ;
"RTN","IBCNEHLT",60,0)
 S HCT=1,NAFLG=0,NPFLG=0,D=""
"RTN","IBCNEHLT",61,0)
 F  S HCT=$O(^TMP($J,"IBCNEHLI",HCT)) Q:HCT=""  D  Q:ERFLG
"RTN","IBCNEHLT",62,0)
 . D SPAR^IBCNEHLU
"RTN","IBCNEHLT",63,0)
 . S SEG=$G(IBSEG(1))
"RTN","IBCNEHLT",64,0)
 . ;
"RTN","IBCNEHLT",65,0)
 . I APP="E-PHARM" D   ;  ** This Do-loop is obsolete upon release of IB*2*550
"RTN","IBCNEHLT",66,0)
 .. I SEG="MFI" D
"RTN","IBCNEHLT",67,0)
 ... S FILE=$G(IBSEG(2))
"RTN","IBCNEHLT",68,0)
 ... S FLN=$P(FILE,$E(HLECH,1),1)
"RTN","IBCNEHLT",69,0)
 ... ;
"RTN","IBCNEHLT",70,0)
 ... ; Initialize MFK Message (Application Acknowledgement) variables
"RTN","IBCNEHLT",71,0)
 ... ; Master File Identifier
"RTN","IBCNEHLT",72,0)
 ... S DATAMFK("MFI-1")=$G(IBSEG(2))
"RTN","IBCNEHLT",73,0)
 ... ;
"RTN","IBCNEHLT",74,0)
 ... ; File-Level Event Code
"RTN","IBCNEHLT",75,0)
 ... S DATAMFK("MFI-3")=$G(IBSEG(4))
"RTN","IBCNEHLT",76,0)
 .. ;
"RTN","IBCNEHLT",77,0)
 .. I SEG="MFE" D
"RTN","IBCNEHLT",78,0)
 ... I $G(FLN)="" S ERFLG=1,MSG(1)="File Number not found in MFN message" Q
"RTN","IBCNEHLT",79,0)
 ... I '$$VFILE^DILFD(FLN) S ERFLG=1,MSG(1)="File "_FLN_" not found in the Data Dictionary" Q
"RTN","IBCNEHLT",80,0)
 ... ;
"RTN","IBCNEHLT",81,0)
 ... ; Initialize MFK Message (Application Acknowledgement) variables
"RTN","IBCNEHLT",82,0)
 ... ; Record-Level Event Code
"RTN","IBCNEHLT",83,0)
 ... S DATAMFK("MFE-1")=$G(IBSEG(2))
"RTN","IBCNEHLT",84,0)
 ... ;
"RTN","IBCNEHLT",85,0)
 ... ; Primary Key Value
"RTN","IBCNEHLT",86,0)
 ... S DATAMFK("MFE-4")=$G(IBSEG(5))
"RTN","IBCNEHLT",87,0)
 ... ;
"RTN","IBCNEHLT",88,0)
 ... ; Primary Key Value Type
"RTN","IBCNEHLT",89,0)
 ... S DATAMFK("MFE-5")=$G(IBSEG(6))
"RTN","IBCNEHLT",90,0)
 ... ;
"RTN","IBCNEHLT",91,0)
 ... ; Transfer control to e-Pharmacy
"RTN","IBCNEHLT",92,0)
 ... D ^IBCNRHLT Q
"RTN","IBCNEHLT",93,0)
 .. ;
"RTN","IBCNEHLT",94,0)
 .. ; Transfer control on other segments
"RTN","IBCNEHLT",95,0)
 .. I ",ZCM,ZP0,ZPB,ZPL,ZPT,ZRX,"[(","_SEG_",") D ^IBCNRHLT
"RTN","IBCNEHLT",96,0)
 . ; ** end of obsolete do-loop upon national release of IB*2*550
"RTN","IBCNEHLT",97,0)
 . ;
"RTN","IBCNEHLT",98,0)
 . ;
"RTN","IBCNEHLT",99,0)
 . ;** Upon release of IB*2*550 this if statement (I APP="IIV") won't be necessary but it DOES NOT
"RTN","IBCNEHLT",100,0)
 . ;   hurt to leave it in moving forward as a safety valve.
"RTN","IBCNEHLT",101,0)
 . I APP="IIV" D
"RTN","IBCNEHLT",102,0)
 .. I SEG="MFI" D
"RTN","IBCNEHLT",103,0)
 ... S FILE=$G(IBSEG(2))
"RTN","IBCNEHLT",104,0)
 ... S FLN=$P(FILE,$E(HLECH,1),1)
"RTN","IBCNEHLT",105,0)
 .. ;
"RTN","IBCNEHLT",106,0)
 .. I SEG="MFE" D
"RTN","IBCNEHLT",107,0)
 ... I $G(FLN)="" S ERFLG=1,MSG(1)="File Number not found in MFN message" Q
"RTN","IBCNEHLT",108,0)
 ... I '$$VFILE^DILFD(FLN) S ERFLG=1,MSG(1)="File "_FLN_" not found in the Data Dictionary" Q
"RTN","IBCNEHLT",109,0)
 ... ;
"RTN","IBCNEHLT",110,0)
 ... I FLN'=365.12 D  Q
"RTN","IBCNEHLT",111,0)
 .... S DATA=$G(IBSEG(5))
"RTN","IBCNEHLT",112,0)
 .... S ID=$$DECHL7^IBCNEHL2($P(DATA,$E(HLECH,1),1)),DESC=$$DECHL7^IBCNEHL2($P(DATA,$E(HLECH,1),2))
"RTN","IBCNEHLT",113,0)
 .... D TFIL
"RTN","IBCNEHLT",114,0)
 ... ;
"RTN","IBCNEHLT",115,0)
 ... ; Pull the action code
"RTN","IBCNEHLT",116,0)
 ... S IBCNACT=$G(IBSEG(2))
"RTN","IBCNEHLT",117,0)
 ... ; Effective Date
"RTN","IBCNEHLT",118,0)
 ... S IBCNADT=$G(IBSEG(4))
"RTN","IBCNEHLT",119,0)
 .. ;
"RTN","IBCNEHLT",120,0)
 .. I SEG="ZP0" D
"RTN","IBCNEHLT",121,0)
 ... S ID=$$DECHL7^IBCNEHL2(IBSEG(3)),NEWID=$$DECHL7^IBCNEHL2(IBSEG(4))
"RTN","IBCNEHLT",122,0)
 ... S DESC=$$DECHL7^IBCNEHL2(IBSEG(5)),HEDI=$$DECHL7^IBCNEHL2(IBSEG(6)),PEDI=$$DECHL7^IBCNEHL2(IBSEG(7))
"RTN","IBCNEHLT",123,0)
 .. ;
"RTN","IBCNEHLT",124,0)
 .. I SEG="ZPA" D
"RTN","IBCNEHLT",125,0)
 ... S STAT=$S(IBSEG(4)="Y":1,1:0)
"RTN","IBCNEHLT",126,0)
 ... S TSSN=IBSEG(5),REQSUB=IBSEG(7)
"RTN","IBCNEHLT",127,0)
 ... S FSVDY=IBSEG(8),PSVDY=IBSEG(9)
"RTN","IBCNEHLT",128,0)
 ... S TRUSTED=$S(IBSEG(10)="N":0,1:1)
"RTN","IBCNEHLT",129,0)
 ... D PFIL
"RTN","IBCNEHLT",130,0)
 Q
"RTN","IBCNEHLT",131,0)
 ;
"RTN","IBCNEHLT",132,0)
PFIL ;  Payer Table Filer
"RTN","IBCNEHLT",133,0)
 ;  Set the action:
"RTN","IBCNEHLT",134,0)
 ;     MAD=Add, MUP=Update, MDC=Deactivate, MAC=Reactivate
"RTN","IBCNEHLT",135,0)
 N OLDAF,OLDTF
"RTN","IBCNEHLT",136,0)
 S IBCNADT=$$FMDATE^HLFNC(IBCNADT)
"RTN","IBCNEHLT",137,0)
 I IBCNADT="" S IBCNADT=$$NOW^XLFDT()
"RTN","IBCNEHLT",138,0)
 ;  If the action is MAD - Add the payer as new
"RTN","IBCNEHLT",139,0)
 ;  IB*582/TAZ if the action is MUP and the entry doesn't exist, add the payer as new
"RTN","IBCNEHLT",140,0)
 N IBNOK,IBAPP,IBID,IBDESC,IBSTR,IBCNTYPE
"RTN","IBCNEHLT",141,0)
 S IBNOK=0,IBAPP=($TR(APP," ")=""),IBID=($TR(ID," ")=""),IBDESC=($TR(DESC," ")=""),IBNOK=IBAPP!IBID!IBDESC
"RTN","IBCNEHLT",142,0)
 I IBNOK D  G PFILX
"RTN","IBCNEHLT",143,0)
 . S IBCNTYPE=$S(IBCNACT="MAD":"Add",IBCNACT="MUP":"Update",IBCNACT="MDC":"Deactivate",IBCNACT="MAC":"Reactivate",1:"Unknown")
"RTN","IBCNEHLT",144,0)
 . S MSG(1)=IBCNTYPE_" ("_IBCNACT_") action received. Payer and/or Application may be unknown."
"RTN","IBCNEHLT",145,0)
 . S MSG(2)=""
"RTN","IBCNEHLT",146,0)
 . S MSG(3)="VA National : "_ID
"RTN","IBCNEHLT",147,0)
 . S MSG(4)="Payer Name : "_DESC
"RTN","IBCNEHLT",148,0)
 . S MSG(5)="Application : "_APP
"RTN","IBCNEHLT",149,0)
 . S MSG(6)=""
"RTN","IBCNEHLT",150,0)
 . S MSG(7)="Log a Remedy Ticket for this issue."
"RTN","IBCNEHLT",151,0)
 . S MSG(8)=""
"RTN","IBCNEHLT",152,0)
 . S MSG(9)="Please include in the Remedy Ticket that VISTA did not receive the required"
"RTN","IBCNEHLT",153,0)
 . S MSG(10)="information or the accurate information to add/update this Payer."
"RTN","IBCNEHLT",154,0)
 . D MSG^IBCNEUT5($$MGRP^IBCNEUT5(),"eIV payer tables may be out of synch with master list","MSG(")
"RTN","IBCNEHLT",155,0)
 D FND I IEN<0 D MAD(DESC)
"RTN","IBCNEHLT",156,0)
 ;
"RTN","IBCNEHLT",157,0)
 S DESC=$E(DESC,1,80)    ;restriction of the field in the DD
"RTN","IBCNEHLT",158,0)
 S DIC=$$ROOT^DILFD(FLN)
"RTN","IBCNEHLT",159,0)
 S DR=".01///^S X=DESC;.02////^S X=NEWID;.05////^S X=PEDI;.06////^S X=HEDI"
"RTN","IBCNEHLT",160,0)
 ;
"RTN","IBCNEHLT",161,0)
 ;  If new payer, add the Date/Time created
"RTN","IBCNEHLT",162,0)
 I NPFLG S DR=DR_";.04///^S X=$$NOW^XLFDT()"
"RTN","IBCNEHLT",163,0)
 S DIE=DIC,DA=IEN D ^DIE
"RTN","IBCNEHLT",164,0)
 ;
"RTN","IBCNEHLT",165,0)
 ;  Check for application
"RTN","IBCNEHLT",166,0)
 S DIC="^IBE(365.13,",DIC(0)="X",X=APP D ^DIC
"RTN","IBCNEHLT",167,0)
 S AIEN=+Y I AIEN<1 D
"RTN","IBCNEHLT",168,0)
 . S DLAYGO=365.13,DIC(0)="L",DIC("P")=DLAYGO
"RTN","IBCNEHLT",169,0)
 . S DIE=DIC,X=APP
"RTN","IBCNEHLT",170,0)
 . K DD,DO
"RTN","IBCNEHLT",171,0)
 . D FILE^DICN
"RTN","IBCNEHLT",172,0)
 . K DO
"RTN","IBCNEHLT",173,0)
 . S AIEN=+Y
"RTN","IBCNEHLT",174,0)
 ;
"RTN","IBCNEHLT",175,0)
 S APIEN=$O(^IBE(365.12,IEN,1,"B",AIEN,""))
"RTN","IBCNEHLT",176,0)
 I APIEN="" D
"RTN","IBCNEHLT",177,0)
 . S DLAYGO=365.121,DIC(0)="L",DIC("P")=DLAYGO,DA(1)=IEN,X=AIEN
"RTN","IBCNEHLT",178,0)
 . S DIC="^IBE(365.12,"_DA(1)_",1,",DIE=DIC
"RTN","IBCNEHLT",179,0)
 . I '$D(^IBE(365.12,IEN,1,0)) S ^IBE(365.12,IEN,1,0)="^365.121P^^"
"RTN","IBCNEHLT",180,0)
 . K DD,DO
"RTN","IBCNEHLT",181,0)
 . D FILE^DICN
"RTN","IBCNEHLT",182,0)
 . K DO
"RTN","IBCNEHLT",183,0)
 . S APIEN=+Y,NAFLG=1
"RTN","IBCNEHLT",184,0)
 ; get current values for Active and Trusted flags
"RTN","IBCNEHLT",185,0)
 S OLDAF=$P(^IBE(365.12,IEN,1,APIEN,0),U,2),OLDTF=$P(^IBE(365.12,IEN,1,APIEN,0),U,7)
"RTN","IBCNEHLT",186,0)
 S DA(1)=IEN,DA=APIEN,DIC="^IBE(365.12,"_DA(1)_",1,",DR=""
"RTN","IBCNEHLT",187,0)
 ;
"RTN","IBCNEHLT",188,0)
 I IBCNACT="MDC" S DR=DR_".11///^S X=1;.12////^S X=IBCNADT;",STAT=0
"RTN","IBCNEHLT",189,0)
 I IBCNACT="MAC" S DR=DR_".11///^S X=0;.12///@;"
"RTN","IBCNEHLT",190,0)
 S DR=DR_".02///^S X=STAT;.06///^S X=$$NOW^XLFDT();.07///^S X=TRUSTED"
"RTN","IBCNEHLT",191,0)
 I IBCNACT'="MDC" S DR=DR_";.08///^S X=REQSUB;.1///^S X=TSSN;.14///^S X=FSVDY;.15///^S X=PSVDY"
"RTN","IBCNEHLT",192,0)
 ;
"RTN","IBCNEHLT",193,0)
 ;  If new application, add the Date/Time created
"RTN","IBCNEHLT",194,0)
 I NAFLG S DR=DR_";.13///^S X=$$NOW^XLFDT()"
"RTN","IBCNEHLT",195,0)
 ;
"RTN","IBCNEHLT",196,0)
 S DIE=DIC D ^DIE
"RTN","IBCNEHLT",197,0)
 S IBACK="AA"
"RTN","IBCNEHLT",198,0)
 ; Update flag logs
"RTN","IBCNEHLT",199,0)
 I STAT'=OLDAF D UPDLOG("A",STAT,IEN,APIEN)
"RTN","IBCNEHLT",200,0)
 I TRUSTED'=OLDTF D UPDLOG("T",TRUSTED,IEN,APIEN)
"RTN","IBCNEHLT",201,0)
 I IBCNACT="MDC" D MDC Q
"RTN","IBCNEHLT",202,0)
PFILX ;
"RTN","IBCNEHLT",203,0)
 Q
"RTN","IBCNEHLT",204,0)
 ;
"RTN","IBCNEHLT",205,0)
TFIL ;  Non Payer Tables Filer
"RTN","IBCNEHLT",206,0)
 ; Input: DESC  - Field Number
"RTN","IBCNEHLT",207,0)
 ;        ID    - Field Value
"RTN","IBCNEHLT",208,0)
 ;        FLN   - File Number
"RTN","IBCNEHLT",209,0)
 N DA,DIC,DIE,DLAYGO,DR,EXTRACT,IEN,MAX,XX,X,Y   ;IB*2.0*549 - Added DA,DIE,DR,EXTRACT,XX
"RTN","IBCNEHLT",210,0)
 ;
"RTN","IBCNEHLT",211,0)
 ; store the FILENAME, FIELDNAME and VALUE if the APP is IIV and FLN is 350.9.  - IB*2.0*506
"RTN","IBCNEHLT",212,0)
 ; For file #350.9, DESC represents the FIELD NUMBER and ID represents the VALUE.
"RTN","IBCNEHLT",213,0)
 I APP="IIV",FLN=350.9 D  Q
"RTN","IBCNEHLT",214,0)
 . S DIE=FLN,DA=1,DR=DESC_"///"_ID
"RTN","IBCNEHLT",215,0)
 . D ^DIE
"RTN","IBCNEHLT",216,0)
 . S IBACK="AA"
"RTN","IBCNEHLT",217,0)
 ;
"RTN","IBCNEHLT",218,0)
 ; IB*2.0*549 Added if statement 
"RTN","IBCNEHLT",219,0)
 I APP="IIV",FLN=350.9002 D  Q
"RTN","IBCNEHLT",220,0)
 . S EXTRACT=$E(DESC,1,4)                   ; Either "Buff", "Appt" or "EICD"
"RTN","IBCNEHLT",221,0)
 . S XX=$S(EXTRACT="Buff":1,EXTRACT="Appt":2,EXTRACT="EICD":4,1:3) ; IB*2.0*621/DM add EICD 
"RTN","IBCNEHLT",222,0)
 . S DESC=$E(DESC,5,99)                     ; Field number
"RTN","IBCNEHLT",223,0)
 . S DA(1)=1
"RTN","IBCNEHLT",224,0)
 . S DA=$O(^IBE(350.9,1,51.17,"B",XX,""))   ; Find correct multiple
"RTN","IBCNEHLT",225,0)
 . ;
"RTN","IBCNEHLT",226,0)
 . ; File the new value
"RTN","IBCNEHLT",227,0)
 . S DIE="^IBE(350.9,1,51.17,"
"RTN","IBCNEHLT",228,0)
 . S DR=DESC_"///"_ID
"RTN","IBCNEHLT",229,0)
 . D ^DIE
"RTN","IBCNEHLT",230,0)
 . S IBACK="AA"
"RTN","IBCNEHLT",231,0)
 ;
"RTN","IBCNEHLT",232,0)
 ;IB*582/TAZ - Add new entries and update existing entries
"RTN","IBCNEHLT",233,0)
 ;
"RTN","IBCNEHLT",234,0)
 S DIC(0)="X",X=ID,DIC=$$ROOT^DILFD(FLN)
"RTN","IBCNEHLT",235,0)
 D ^DIC S IEN=+Y
"RTN","IBCNEHLT",236,0)
 ; don't update existing entries
"RTN","IBCNEHLT",237,0)
 ;I IEN>0 Q
"RTN","IBCNEHLT",238,0)
 ;Add new entry to table
"RTN","IBCNEHLT",239,0)
 I IEN<1 D
"RTN","IBCNEHLT",240,0)
 . S DLAYGO=FLN,DIC(0)="L"
"RTN","IBCNEHLT",241,0)
 . K DD,DO D FILE^DICN K DO
"RTN","IBCNEHLT",242,0)
 ;
"RTN","IBCNEHLT",243,0)
 ;Update Description
"RTN","IBCNEHLT",244,0)
 ;
"RTN","IBCNEHLT",245,0)
 D FIELD^DID(FLN,.02,,"FIELD LENGTH","MAX")
"RTN","IBCNEHLT",246,0)
 I MAX("FIELD LENGTH")>0 S DESC=$E(DESC,1,MAX("FIELD LENGTH")) ; restriction of the field in the DD
"RTN","IBCNEHLT",247,0)
 ; add new entry to the table
"RTN","IBCNEHLT",248,0)
 ;S DLAYGO=FLN,DIC(0)="L",DIC("DR")=".02///"_DESC
"RTN","IBCNEHLT",249,0)
 ;S DLAYGO=FLN,DIC(0)="L",DIC("DR")=".02///^S X=DESC"
"RTN","IBCNEHLT",250,0)
 ;K DD,DO D FILE^DICN K DO
"RTN","IBCNEHLT",251,0)
 ;IB*2*601/HN corrected use of the DR variable 
"RTN","IBCNEHLT",252,0)
 ;S DIE=DIC,DA=IEN,DIC("DR")=".02///^S X=DESC" D ^DIE
"RTN","IBCNEHLT",253,0)
 S DIE=DIC,DA=IEN,DR=".02///^S X=DESC" D ^DIE
"RTN","IBCNEHLT",254,0)
 S IBACK="AA"
"RTN","IBCNEHLT",255,0)
 Q
"RTN","IBCNEHLT",256,0)
 ;
"RTN","IBCNEHLT",257,0)
MAD(X) ;  Add an entry
"RTN","IBCNEHLT",258,0)
 ;IB*582/TAZ - Moved check to PFIL MAD is called for any record that is not found in the file.
"RTN","IBCNEHLT",259,0)
 ;D FND
"RTN","IBCNEHLT",260,0)
 ;I IEN>0 G MADX
"RTN","IBCNEHLT",261,0)
 NEW DIC,DIE,DA,DLAYGO,Y,DR
"RTN","IBCNEHLT",262,0)
 S DIC=$$ROOT^DILFD(FLN)
"RTN","IBCNEHLT",263,0)
 S DLAYGO=FLN,DIC(0)="L",DIC("P")=DLAYGO,DIE=DIC
"RTN","IBCNEHLT",264,0)
 K DD,DO
"RTN","IBCNEHLT",265,0)
 D FILE^DICN
"RTN","IBCNEHLT",266,0)
 K DO
"RTN","IBCNEHLT",267,0)
 S IEN=+Y,NPFLG=1
"RTN","IBCNEHLT",268,0)
MADX ;
"RTN","IBCNEHLT",269,0)
 Q
"RTN","IBCNEHLT",270,0)
 ;
"RTN","IBCNEHLT",271,0)
FND ;  Find an existing Payer entry
"RTN","IBCNEHLT",272,0)
 NEW DIC,DIE,X,DA,DLAYGO,Y,DR
"RTN","IBCNEHLT",273,0)
 S X=ID,DIC(0)="X",D="C",DIC=$$ROOT^DILFD(FLN)
"RTN","IBCNEHLT",274,0)
 ;
"RTN","IBCNEHLT",275,0)
 ;  Do a lookup with the "C" cross-reference
"RTN","IBCNEHLT",276,0)
 D IX^DIC
"RTN","IBCNEHLT",277,0)
 S IEN=+Y
"RTN","IBCNEHLT",278,0)
 Q
"RTN","IBCNEHLT",279,0)
 ;
"RTN","IBCNEHLT",280,0)
MDC ;  Check for active transmissions and cancel
"RTN","IBCNEHLT",281,0)
 NEW STA,HIEN,RIEN,TQIEN
"RTN","IBCNEHLT",282,0)
 F STA=1,2,4,6 S TQIEN="" D
"RTN","IBCNEHLT",283,0)
 . F  S TQIEN=$O(^IBCN(365.1,"AC",STA,TQIEN)) Q:TQIEN=""  D
"RTN","IBCNEHLT",284,0)
 .. ;
"RTN","IBCNEHLT",285,0)
 .. ;  If the record doesn't match the payer, quit
"RTN","IBCNEHLT",286,0)
 .. I $P(^IBCN(365.1,TQIEN,0),U,3)'=IEN Q
"RTN","IBCNEHLT",287,0)
 .. ;
"RTN","IBCNEHLT",288,0)
 .. ;  Set the status to 'Cancelled'
"RTN","IBCNEHLT",289,0)
 .. D SST^IBCNEUT2(TQIEN,7)
"RTN","IBCNEHLT",290,0)
 .. ;
"RTN","IBCNEHLT",291,0)
 .. ;  If a buffer entry, set to ! (bang)
"RTN","IBCNEHLT",292,0)
 .. S BUFF=$P(^IBCN(365.1,TQIEN,0),U,5)
"RTN","IBCNEHLT",293,0)
 .. I BUFF'="" D BUFF^IBCNEUT2(BUFF,17)
"RTN","IBCNEHLT",294,0)
 .. ;
"RTN","IBCNEHLT",295,0)
 .. ;  Change any responses status also
"RTN","IBCNEHLT",296,0)
 .. S HIEN=0 F  S HIEN=$O(^IBCN(365.1,TQIEN,2,HIEN)) Q:'HIEN  D
"RTN","IBCNEHLT",297,0)
 ... S RIEN=$P(^IBCN(365.1,TQIEN,2,HIEN,0),U,3)
"RTN","IBCNEHLT",298,0)
 ... ;  If the Response status is 'Response Received', don't change it
"RTN","IBCNEHLT",299,0)
 ... I $P(^IBCN(365,RIEN,0),U,6)=3 Q
"RTN","IBCNEHLT",300,0)
 ... D RSP^IBCNEUT2(RIEN,7)
"RTN","IBCNEHLT",301,0)
 Q
"RTN","IBCNEHLT",302,0)
 ;
"RTN","IBCNEHLT",303,0)
UPDLOG(FLAG,VALUE,PIEN,APIEN) ; Update active/trusted flag logs
"RTN","IBCNEHLT",304,0)
 ; FLAG - "A" for Active flag, "T" for Trusted flag
"RTN","IBCNEHLT",305,0)
 ; VALUE - new flag value (0 or 1)
"RTN","IBCNEHLT",306,0)
 ; PIEN - ien in PAYER file (365.12)
"RTN","IBCNEHLT",307,0)
 ; APIEN - ien in APPLICATION sub-file (365.121)
"RTN","IBCNEHLT",308,0)
 ;
"RTN","IBCNEHLT",309,0)
 N FILE,IENSTR,UPDT
"RTN","IBCNEHLT",310,0)
 I $G(FLAG)=""!($G(VALUE)="") Q
"RTN","IBCNEHLT",311,0)
 I +$G(PIEN)=0!(+$G(APIEN)=0) Q
"RTN","IBCNEHLT",312,0)
 S FILE=$S(FLAG="A":"365.1212",FLAG="T":"365.1213",1:"") I FILE="" Q
"RTN","IBCNEHLT",313,0)
 S IENSTR="+1,"_APIEN_","_PIEN_","
"RTN","IBCNEHLT",314,0)
 S UPDT(FILE,IENSTR,.01)=$$NOW^XLFDT()
"RTN","IBCNEHLT",315,0)
 S UPDT(FILE,IENSTR,.02)=VALUE
"RTN","IBCNEHLT",316,0)
 D UPDATE^DIE("E","UPDT")
"RTN","IBCNEHLT",317,0)
 Q
"RTN","IBCNEKIT")
0^10^B147072833^B78057141
"RTN","IBCNEKIT",1,0)
IBCNEKIT ;DAOU/ESG - PURGE eIV DATA FILES ;11-JUL-2002
"RTN","IBCNEKIT",2,0)
 ;;2.0;INTEGRATED BILLING;**184,271,316,416,549,595,621**;21-MAR-94;Build 8
"RTN","IBCNEKIT",3,0)
 ;;Per VA Directive 6402, this routine should not be modified.
"RTN","IBCNEKIT",4,0)
 ;
"RTN","IBCNEKIT",5,0)
 ; This routine handles the purging of the eIV data stored in the
"RTN","IBCNEKIT",6,0)
 ; eIV Transmission Queue file (#365.1), the eIV Response file (#365) and
"RTN","IBCNEKIT",7,0)
 ; the EIV EICD TRACKING file (#365.18) IB*2.0*621/DM
"RTN","IBCNEKIT",8,0)
 ; User can pick a date range for the purge.  Data created within 6 months
"RTN","IBCNEKIT",9,0)
 ; cannot be purged.  The actual global kills are done by a background
"RTN","IBCNEKIT",10,0)
 ; task after hours (8:00pm).
"RTN","IBCNEKIT",11,0)
 ;
"RTN","IBCNEKIT",12,0)
EN ;
"RTN","IBCNEKIT",13,0)
 NEW STOP,BEGDT,ENDDT,STATLIST,IBVER
"RTN","IBCNEKIT",14,0)
 S IBVER=1
"RTN","IBCNEKIT",15,0)
 D INIT I STOP G EXIT       ; initialize/calculate default dates
"RTN","IBCNEKIT",16,0)
 D DEFLT I STOP G EXIT      ; allow user to change default end date if test system ;IB*2.0*621
"RTN","IBCNEKIT",17,0)
 D BEGDT I STOP G EXIT      ; user interface for beginning date
"RTN","IBCNEKIT",18,0)
 D ENDDT I STOP G EXIT      ; user interface for ending date
"RTN","IBCNEKIT",19,0)
 D CONFIRM I STOP G EXIT    ; confirmation message/final check
"RTN","IBCNEKIT",20,0)
 D QUEUE                    ; queuing process
"RTN","IBCNEKIT",21,0)
EXIT ;
"RTN","IBCNEKIT",22,0)
 Q
"RTN","IBCNEKIT",23,0)
 ;
"RTN","IBCNEKIT",24,0)
EN1 ; Automated Monthly Purge *IB*2*595
"RTN","IBCNEKIT",25,0)
 NEW STOP,BEGDT,ENDDT,STATLIST,IBVER
"RTN","IBCNEKIT",26,0)
 S IBVER=2
"RTN","IBCNEKIT",27,0)
 D INIT I STOP G EXIT1       ; initialize/calculate default dates
"RTN","IBCNEKIT",28,0)
 D QUEUE                    ; queuing process
"RTN","IBCNEKIT",29,0)
EXIT1 ;
"RTN","IBCNEKIT",30,0)
 Q
"RTN","IBCNEKIT",31,0)
PURGE ; This procedure is queued to run in the background and does the
"RTN","IBCNEKIT",32,0)
 ; actual purging.  Variables available from the TaskMan call are:
"RTN","IBCNEKIT",33,0)
 ;
"RTN","IBCNEKIT",34,0)
 ; STATLIST = list of statuses that are OK to purge
"RTN","IBCNEKIT",35,0)
 ;    BEGDT = beginning date for purging
"RTN","IBCNEKIT",36,0)
 ;    ENDDT = ending date for purging
"RTN","IBCNEKIT",37,0)
 ;
"RTN","IBCNEKIT",38,0)
 ; First loop through the eIV Transmission Queue file and delete all
"RTN","IBCNEKIT",39,0)
 ; records in the date range whose status is in the list
"RTN","IBCNEKIT",40,0)
 ;
"RTN","IBCNEKIT",41,0)
 N CNT,DA,DATE,DIK,HLIEN,PFLAG,TQIEN,TQS   ;IB*2.0*549 added PFLAG
"RTN","IBCNEKIT",42,0)
 N IBWEXT,IBIORV                           ;IB*2.0*621/DM added IBWEXT,IBIORV
"RTN","IBCNEKIT",43,0)
 S DATE=$O(^IBCN(365.1,"AE",BEGDT),-1),CNT=0
"RTN","IBCNEKIT",44,0)
 F  S DATE=$O(^IBCN(365.1,"AE",DATE)) Q:'DATE!($P(DATE,".",1)>ENDDT)!$G(ZTSTOP)  S TQIEN=0 F  S TQIEN=$O(^IBCN(365.1,"AE",DATE,TQIEN)) Q:'TQIEN  D  Q:$G(ZTSTOP)
"RTN","IBCNEKIT",45,0)
 . S CNT=CNT+1
"RTN","IBCNEKIT",46,0)
 . I $D(ZTQUEUED),CNT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 Q
"RTN","IBCNEKIT",47,0)
 . S TQS=$P($G(^IBCN(365.1,TQIEN,0)),U,4)     ; trans queue status
"RTN","IBCNEKIT",48,0)
 . S IBWEXT=$P($G(^IBCN(365.1,TQIEN,0)),U,10) ; IB*2.0*621/DM WHICH EXTRACT
"RTN","IBCNEKIT",49,0)
 . S IBIORV=$P($G(^IBCN(365.1,TQIEN,0)),U,11) ; IB*2.0*621/DM QUERY FLAG
"RTN","IBCNEKIT",50,0)
 . I IBWEXT=4,IBIORV="V" Q                    ; skip EICD Verification entries as they 
"RTN","IBCNEKIT",51,0)
 . ;                                            will be addressed with EICD Identifications
"RTN","IBCNEKIT",52,0)
 . I '$F(STATLIST,","_TQS_",") Q              ; must be in the list
"RTN","IBCNEKIT",53,0)
 . I IBWEXT=4,IBIORV="I" D CHKTRK(TQIEN) Q    ; check EIV EICD TRACKING for purge
"RTN","IBCNEKIT",54,0)
 . ; loop through the HL7 messages multiple and kill any response
"RTN","IBCNEKIT",55,0)
 . ; records that are found for this transmission queue entry
"RTN","IBCNEKIT",56,0)
 . ; IB*2.0*621/DM Preserve any TQ and response that has DO NOT PURGE set to 1 (YES) 
"RTN","IBCNEKIT",57,0)
 . S PFLAG=0,HLIEN=0,DIK="^IBCN(365,"
"RTN","IBCNEKIT",58,0)
 . F  S HLIEN=$O(^IBCN(365.1,TQIEN,2,HLIEN)) Q:'HLIEN  D
"RTN","IBCNEKIT",59,0)
 .. S DA=$P($G(^IBCN(365.1,TQIEN,2,HLIEN,0)),U,3) Q:'DA
"RTN","IBCNEKIT",60,0)
 .. I +$$GET1^DIQ(365,DA_",",.11,"I") S PFLAG=1 Q  ;"DO NOT PURGE"
"RTN","IBCNEKIT",61,0)
 .. D ^DIK
"RTN","IBCNEKIT",62,0)
 .. Q
"RTN","IBCNEKIT",63,0)
 . ;
"RTN","IBCNEKIT",64,0)
 . ; now we can kill the transmission queue entry itself
"RTN","IBCNEKIT",65,0)
 . ; as long as there was no DO NOT PURGE responses IB*2.0*621/DM 
"RTN","IBCNEKIT",66,0)
 . I 'PFLAG S DA=TQIEN,DIK="^IBCN(365.1," D ^DIK K DA,DIK
"RTN","IBCNEKIT",67,0)
 . Q
"RTN","IBCNEKIT",68,0)
 ;
"RTN","IBCNEKIT",69,0)
 ; Check for a stop request
"RTN","IBCNEKIT",70,0)
 I $G(ZTSTOP) G PURGEX
"RTN","IBCNEKIT",71,0)
 ;
"RTN","IBCNEKIT",72,0)
 ; Now we must loop through the eIV Response file itself to purge any
"RTN","IBCNEKIT",73,0)
 ; response records that do not have a corresponding transmission
"RTN","IBCNEKIT",74,0)
 ; queue entry.  These are the unsolicited responses.  The status of
"RTN","IBCNEKIT",75,0)
 ; these responses is always 'response received' so we don't need to
"RTN","IBCNEKIT",76,0)
 ; check the status. For this loop, start from the very beginning of
"RTN","IBCNEKIT",77,0)
 ; the file.
"RTN","IBCNEKIT",78,0)
 ;
"RTN","IBCNEKIT",79,0)
 S DATE="",DIK="^IBCN(365,",CNT=0
"RTN","IBCNEKIT",80,0)
 F  S DATE=$O(^IBCN(365,"AE",DATE)) Q:'DATE!($P(DATE,".",1)>ENDDT)!$G(ZTSTOP)  S DA=0 F  S DA=$O(^IBCN(365,"AE",DATE,DA)) Q:'DA  D  Q:$G(ZTSTOP)
"RTN","IBCNEKIT",81,0)
 . S CNT=CNT+1
"RTN","IBCNEKIT",82,0)
 . I $D(ZTQUEUED),CNT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 Q
"RTN","IBCNEKIT",83,0)
 . ;
"RTN","IBCNEKIT",84,0)
 . ; If there is a pointer to the transmission queue file, then we
"RTN","IBCNEKIT",85,0)
 . ; should get out of this loop because the purpose of this section
"RTN","IBCNEKIT",86,0)
 . ; is to purge those responses with no link to the transmission
"RTN","IBCNEKIT",87,0)
 . ; queue file.
"RTN","IBCNEKIT",88,0)
 . ;
"RTN","IBCNEKIT",89,0)
 . I $P($G(^IBCN(365,DA,0)),U,5) Q
"RTN","IBCNEKIT",90,0)
 . D ^DIK
"RTN","IBCNEKIT",91,0)
 . Q
"RTN","IBCNEKIT",92,0)
 K DA,DIK
"RTN","IBCNEKIT",93,0)
PURGEX ;
"RTN","IBCNEKIT",94,0)
 ; Tell TaskManager to delete the task's record
"RTN","IBCNEKIT",95,0)
 I $D(ZTQUEUED) S ZTREQ="@"
"RTN","IBCNEKIT",96,0)
 Q
"RTN","IBCNEKIT",97,0)
 ;
"RTN","IBCNEKIT",98,0)
INIT ; This procedure calculates the default beginning and ending dates
"RTN","IBCNEKIT",99,0)
 ; and displays screen messages about this option to the user.
"RTN","IBCNEKIT",100,0)
 ;
"RTN","IBCNEKIT",101,0)
 NEW DATE,FOUND,TQIEN,TQS,RPIEN,RPS
"RTN","IBCNEKIT",102,0)
 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
"RTN","IBCNEKIT",103,0)
 ;
"RTN","IBCNEKIT",104,0)
 S STOP=0
"RTN","IBCNEKIT",105,0)
 ;
"RTN","IBCNEKIT",106,0)
 ; This is the list of statuses that are OK to purge
"RTN","IBCNEKIT",107,0)
 ;   3=Response Received
"RTN","IBCNEKIT",108,0)
 ;   5=Communication Failure
"RTN","IBCNEKIT",109,0)
 ;   7=Cancelled
"RTN","IBCNEKIT",110,0)
 S STATLIST=",3,5,7,"
"RTN","IBCNEKIT",111,0)
 ;
"RTN","IBCNEKIT",112,0)
 ; Try to find a beginning date in the eIV Transmission Queue file
"RTN","IBCNEKIT",113,0)
 S DATE="",FOUND=0,BEGDT=DT
"RTN","IBCNEKIT",114,0)
 F  S DATE=$O(^IBCN(365.1,"AE",DATE)) Q:'DATE!FOUND  S TQIEN=0 F  S TQIEN=$O(^IBCN(365.1,"AE",DATE,TQIEN)) Q:'TQIEN  D  Q:FOUND
"RTN","IBCNEKIT",115,0)
 . S TQS=$P($G(^IBCN(365.1,TQIEN,0)),U,4)    ; status
"RTN","IBCNEKIT",116,0)
 . I '$F(STATLIST,","_TQS_",") Q
"RTN","IBCNEKIT",117,0)
 . S FOUND=1
"RTN","IBCNEKIT",118,0)
 . S BEGDT=$P(DATE,".",1)
"RTN","IBCNEKIT",119,0)
 . Q
"RTN","IBCNEKIT",120,0)
 ;
"RTN","IBCNEKIT",121,0)
 ; If not successful, try to find a beginning date in the eIV Response file.
"RTN","IBCNEKIT",122,0)
 I 'FOUND D
"RTN","IBCNEKIT",123,0)
 . S DATE=""
"RTN","IBCNEKIT",124,0)
 . F  S DATE=$O(^IBCN(365,"AE",DATE)) Q:'DATE!FOUND  S RPIEN=0 F  S RPIEN=$O(^IBCN(365,"AE",DATE,RPIEN)) Q:'RPIEN  D  Q:FOUND
"RTN","IBCNEKIT",125,0)
 .. S RPS=$P($G(^IBCN(365,RPIEN,0)),U,6)    ; status
"RTN","IBCNEKIT",126,0)
 .. I '$F(STATLIST,","_RPS_",") Q
"RTN","IBCNEKIT",127,0)
 .. S FOUND=1
"RTN","IBCNEKIT",128,0)
 .. S BEGDT=$P(DATE,".",1)
"RTN","IBCNEKIT",129,0)
 .. Q
"RTN","IBCNEKIT",130,0)
 . Q
"RTN","IBCNEKIT",131,0)
 ;
"RTN","IBCNEKIT",132,0)
 ; default end date, Today minus 182 days (approx 6 months)
"RTN","IBCNEKIT",133,0)
 S ENDDT=$$FMADD^XLFDT(DT,-182)
"RTN","IBCNEKIT",134,0)
 ;
"RTN","IBCNEKIT",135,0)
 ;I IBVER=1,'FOUND!(BEGDT>ENDDT) D  S STOP=1 G INITX ; IB*2.0*621
"RTN","IBCNEKIT",136,0)
 I IBVER=1,'FOUND,'$$PROD^XUPROD(1)!(BEGDT>ENDDT) D  S STOP=1 G INITX
"RTN","IBCNEKIT",137,0)
 . W !!?5,"Purging of eIV data is not possible at this time."
"RTN","IBCNEKIT",138,0)
 . I 'FOUND W !?5,"There are no entries in the file that are eligible to be",!?5,"purged or there is no data in the file."
"RTN","IBCNEKIT",139,0)
 . E  W !?5,"The oldest date in the file is ",$$FMTE^XLFDT(BEGDT,"5Z"),".",!?5,"Data cannot be purged unless it is at least 6 months old."
"RTN","IBCNEKIT",140,0)
 . W ! S DIR(0)="E" D ^DIR K DIR
"RTN","IBCNEKIT",141,0)
 . Q
"RTN","IBCNEKIT",142,0)
 I IBVER=2,'FOUND!(BEGDT>ENDDT) D  S STOP=1 G INITX
"RTN","IBCNEKIT",143,0)
 .; Send a MailMan message with Eligible Purge counts ; IB*2.0*621 - Updated Message
"RTN","IBCNEKIT",144,0)
 .N MGRP,MSG,IBXMY
"RTN","IBCNEKIT",145,0)
 .S MSG(1)="Purge Electronic Insurance Verification (eIV) Data Files did not find records"
"RTN","IBCNEKIT",146,0)
 .S MSG(2)="for station "_+$$SITE^VASITE()_"."
"RTN","IBCNEKIT",147,0)
 .S MSG(3)=""
"RTN","IBCNEKIT",148,0)
 .S MSG(4)="The option runs automatically on a monthly basis and purges data from the"
"RTN","IBCNEKIT",149,0)
 .S MSG(5)="IIV RESPONSE file (#365), the IIV TRANSMISSION QUEUE file (#365.1), and the"
"RTN","IBCNEKIT",150,0)
 .S MSG(6)="EIV EICD TRACKING file (#365.18).  The data must be at least six months old"
"RTN","IBCNEKIT",151,0)
 .S MSG(7)="before it can be purged.  Only insurance transactions that have a transmission"
"RTN","IBCNEKIT",152,0)
 .S MSG(8)="status of ""Response Received"", ""Communication Failure"", or ""Cancelled"""
"RTN","IBCNEKIT",153,0)
 .S MSG(9)="may be purged."
"RTN","IBCNEKIT",154,0)
 .; Set to IB site parameter MAILGROUP - IBCNE EIV MESSAGE
"RTN","IBCNEKIT",155,0)
 .S MGRP=$$MGRP^IBCNEUT5()
"RTN","IBCNEKIT",156,0)
 .S IBXMY("PII                   ")=""
"RTN","IBCNEKIT",157,0)
 .D MSG^IBCNEUT5(MGRP,"eIV Purge No Data Found for Station "_+$$SITE^VASITE(),"MSG(",,.IBXMY)
"RTN","IBCNEKIT",158,0)
 .; Duplicate message to Outlook group
"RTN","IBCNEKIT",159,0)
 .; S MGRP="PII                     "
"RTN","IBCNEKIT",160,0)
 .; D MSG^IBCNEUT5(MGRP,"eIV Data Background Purge","MSG(")
"RTN","IBCNEKIT",161,0)
 .Q
"RTN","IBCNEKIT",162,0)
 ;
"RTN","IBCNEKIT",163,0)
 ; At this point, we know that there are some entries eligible for
"RTN","IBCNEKIT",164,0)
 ; purging.  Display a message to the user about this option.
"RTN","IBCNEKIT",165,0)
 I IBVER=2 G INITX
"RTN","IBCNEKIT",166,0)
 W @IOF
"RTN","IBCNEKIT",167,0)
 W !?8,"Purge Electronic Insurance Verification (eIV) Data Files"
"RTN","IBCNEKIT",168,0)
 W !!!," This option will allow you to purge data from the eIV Response File (#365)"
"RTN","IBCNEKIT",169,0)
 W !," and the eIV Transmission Queue File (#365.1).  The data must be at least six"
"RTN","IBCNEKIT",170,0)
 W !," months old before it can be purged.  Only insurance transactions that have a"
"RTN","IBCNEKIT",171,0)
 W !," transmission status of ""Response Received"", ""Communication Failure"", or"
"RTN","IBCNEKIT",172,0)
 W !," ""Cancelled"" may be purged.  You will be allowed to select a date range for"
"RTN","IBCNEKIT",173,0)
 W !," this purging.  The default beginning date will be the date of the oldest"
"RTN","IBCNEKIT",174,0)
 W !," eligible record in the system.  The default ending date will be six months"
"RTN","IBCNEKIT",175,0)
 W !," ago from today's date.  You may modify this default date range.  However, you"
"RTN","IBCNEKIT",176,0)
 W !," may not select an ending date that is more recent than six months ago."
"RTN","IBCNEKIT",177,0)
 W !!
"RTN","IBCNEKIT",178,0)
INITX ;
"RTN","IBCNEKIT",179,0)
 Q
"RTN","IBCNEKIT",180,0)
 ;
"RTN","IBCNEKIT",181,0)
DEFLT ;  IB*621/DW Added to assist with testing
"RTN","IBCNEKIT",182,0)
 I IBVER=1,('$$PROD^XUPROD(1)) D
"RTN","IBCNEKIT",183,0)
 . W ?5,"*** For Test Purposes Only:"
"RTN","IBCNEKIT",184,0)
 . W !!?5,"In test systems one may override the DEFAULT end date."
"RTN","IBCNEKIT",185,0)
 . W !!?5,"Current default end date is TODAY - 182 DAYS: "_$$FMTE^XLFDT(ENDDT,"5Z"),!!
"RTN","IBCNEKIT",186,0)
 . NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
"RTN","IBCNEKIT",187,0)
 . S DIR(0)="DOA^"_BEGDT_":"_DT_":AEX"
"RTN","IBCNEKIT",188,0)
 . S DIR("A")="Enter the purge default date: "
"RTN","IBCNEKIT",189,0)
 . S DIR("B")=$$FMTE^XLFDT(ENDDT,"5Z")
"RTN","IBCNEKIT",190,0)
 . S DIR("?")="This response must be a date between "_$$FMTE^XLFDT(BEGDT,"5Z")_" and "_$$FMTE^XLFDT(DT,"5Z")_"."
"RTN","IBCNEKIT",191,0)
 . D ^DIR K DIR
"RTN","IBCNEKIT",192,0)
 . I $D(DIRUT)!'Y S STOP=1 G DEFLTX
"RTN","IBCNEKIT",193,0)
 . S ENDDT=Y
"RTN","IBCNEKIT",194,0)
 W !!!
"RTN","IBCNEKIT",195,0)
DEFLTX ;
"RTN","IBCNEKIT",196,0)
 Q
"RTN","IBCNEKIT",197,0)
 ;
"RTN","IBCNEKIT",198,0)
BEGDT ; This procedure captures the beginning date from the user.
"RTN","IBCNEKIT",199,0)
 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
"RTN","IBCNEKIT",200,0)
 S DIR(0)="DOA^"_BEGDT_":"_ENDDT_":AEX"
"RTN","IBCNEKIT",201,0)
 S DIR("A")="Enter the purge begin date: "
"RTN","IBCNEKIT",202,0)
 S DIR("B")=$$FMTE^XLFDT(BEGDT,"5Z")
"RTN","IBCNEKIT",203,0)
 S DIR("?")="This response must be a date between "_$$FMTE^XLFDT(BEGDT,"5Z")_" and "_$$FMTE^XLFDT(ENDDT,"5Z")_"."
"RTN","IBCNEKIT",204,0)
 D ^DIR K DIR
"RTN","IBCNEKIT",205,0)
 I $D(DIRUT)!'Y S STOP=1 G BEGDTX
"RTN","IBCNEKIT",206,0)
 S BEGDT=Y
"RTN","IBCNEKIT",207,0)
BEGDTX ;
"RTN","IBCNEKIT",208,0)
 Q
"RTN","IBCNEKIT",209,0)
 ;
"RTN","IBCNEKIT",210,0)
ENDDT ; This procedure captures the ending date from the user.
"RTN","IBCNEKIT",211,0)
 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
"RTN","IBCNEKIT",212,0)
 W !
"RTN","IBCNEKIT",213,0)
 S DIR(0)="DOA^"_BEGDT_":"_ENDDT_":AEX"
"RTN","IBCNEKIT",214,0)
 S DIR("A")="  Enter the purge end date: "
"RTN","IBCNEKIT",215,0)
 S DIR("B")=$$FMTE^XLFDT(ENDDT,"5Z")
"RTN","IBCNEKIT",216,0)
 S DIR("?")="This response must be a date between "_$$FMTE^XLFDT(BEGDT,"5Z")_" and "_$$FMTE^XLFDT(ENDDT,"5Z")_"."
"RTN","IBCNEKIT",217,0)
 D ^DIR K DIR
"RTN","IBCNEKIT",218,0)
 I $D(DIRUT)!'Y S STOP=1 G ENDDTX
"RTN","IBCNEKIT",219,0)
 S ENDDT=Y
"RTN","IBCNEKIT",220,0)
ENDDTX ;
"RTN","IBCNEKIT",221,0)
 Q
"RTN","IBCNEKIT",222,0)
 ;
"RTN","IBCNEKIT",223,0)
CONFIRM ; This procedure displays a confirmation message to the user and
"RTN","IBCNEKIT",224,0)
 ; asks if it is OK to proceed with the purge.
"RTN","IBCNEKIT",225,0)
 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
"RTN","IBCNEKIT",226,0)
 W !!!," You want to purge all eIV data created between "
"RTN","IBCNEKIT",227,0)
 W $$FMTE^XLFDT(BEGDT,"5Z")," and ",$$FMTE^XLFDT(ENDDT,"5Z"),"."
"RTN","IBCNEKIT",228,0)
 W !
"RTN","IBCNEKIT",229,0)
 S DIR(0)="YO",DIR("A")=" OK to continue"
"RTN","IBCNEKIT",230,0)
 S DIR("B")="NO"
"RTN","IBCNEKIT",231,0)
 D ^DIR K DIR
"RTN","IBCNEKIT",232,0)
 I 'Y S STOP=1
"RTN","IBCNEKIT",233,0)
CONFX ;
"RTN","IBCNEKIT",234,0)
 Q
"RTN","IBCNEKIT",235,0)
 ;
"RTN","IBCNEKIT",236,0)
QUEUE ; This procedure queues the purge process for later at night.
"RTN","IBCNEKIT",237,0)
 ; The concept for queuing the purge came from the insurance buffer
"RTN","IBCNEKIT",238,0)
 ; purge routine, IBCNBPG.  That purge process is also hard-coded to
"RTN","IBCNEKIT",239,0)
 ; be run at 8:00 PM just like this one is.
"RTN","IBCNEKIT",240,0)
 ;
"RTN","IBCNEKIT",241,0)
 NEW ZTRTN,ZTDESC,ZTDTH,ZTIO,ZTUCI,ZTCPU,ZTPRI,ZTSAVE,ZTKIL,ZTSYNC,ZTSK
"RTN","IBCNEKIT",242,0)
 NEW DIR,X,Y,DTOUT,DUOUT,DIRUT,DIROUT
"RTN","IBCNEKIT",243,0)
 ;
"RTN","IBCNEKIT",244,0)
 ; IB*621/DW Added loop below to assist with testing
"RTN","IBCNEKIT",245,0)
 I IBVER=1,('$$PROD^XUPROD(1)) D  I Y D PURGE^IBCNEKIT G QUEUEX
"RTN","IBCNEKIT",246,0)
 . W !!!!,"*** TEST System only - you may run this immediately",!
"RTN","IBCNEKIT",247,0)
 . S DIR("A")="Do you want to run this now instead of tasking it for 8:00pm"
"RTN","IBCNEKIT",248,0)
 . S DIR(0)="Y",DIR("B")="YES"
"RTN","IBCNEKIT",249,0)
 . D ^DIR
"RTN","IBCNEKIT",250,0)
 . I Y="^" S STOP=1
"RTN","IBCNEKIT",251,0)
 ;
"RTN","IBCNEKIT",252,0)
 I STOP G QUEUEX              ; IB*2.0*621
"RTN","IBCNEKIT",253,0)
 S ZTRTN="PURGE^IBCNEKIT"     ; TaskMan task entry point
"RTN","IBCNEKIT",254,0)
 S ZTDESC="Purge eIV Data"    ; Task description
"RTN","IBCNEKIT",255,0)
 S ZTDTH=DT_".20"             ; start it at 8:00 PM tonight
"RTN","IBCNEKIT",256,0)
 S ZTIO=""
"RTN","IBCNEKIT",257,0)
 S ZTSAVE("BEGDT")=""
"RTN","IBCNEKIT",258,0)
 S ZTSAVE("ENDDT")=""
"RTN","IBCNEKIT",259,0)
 S ZTSAVE("STATLIST")=""
"RTN","IBCNEKIT",260,0)
 D ^%ZTLOAD
"RTN","IBCNEKIT",261,0)
 I IBVER=2 G QUEUEX
"RTN","IBCNEKIT",262,0)
 I $G(ZTSK) W !!," Task# ",ZTSK," has been scheduled to purge the eIV data tonight at 8:00 PM."
"RTN","IBCNEKIT",263,0)
 E  W !!," TaskManager could not schedule this task.",!," Contact IRM for technical assistance."
"RTN","IBCNEKIT",264,0)
 W ! S DIR(0)="E" D ^DIR K DIR
"RTN","IBCNEKIT",265,0)
QUEUEX ;
"RTN","IBCNEKIT",266,0)
 Q
"RTN","IBCNEKIT",267,0)
 ;
"RTN","IBCNEKIT",268,0)
CHKTRK(IBTQ1) ; IB*621, Evaluate associated records for one EICD transaction
"RTN","IBCNEKIT",269,0)
 ; IBTQ1 = EICD Identification TQ IEN
"RTN","IBCNEKIT",270,0)
 ;
"RTN","IBCNEKIT",271,0)
 N FILE,HLIEN,IBTQIEN1,IBTQIEN2,IBFIELDS,IBPURGE,IBSKIP,IBTQIEN,IBTQS
"RTN","IBCNEKIT",272,0)
 N IBTRKIEN,PFLAG
"RTN","IBCNEKIT",273,0)
 ;
"RTN","IBCNEKIT",274,0)
 S (IBSKIP,PFLAG)=0
"RTN","IBCNEKIT",275,0)
 K IBPURGE
"RTN","IBCNEKIT",276,0)
 S IBTQIEN1=+$$FIND1^DIC(365.18,,"QX",IBTQ1,"B")
"RTN","IBCNEKIT",277,0)
 Q:'IBTQIEN1  ; the passed TQ IEN is not in the tracking file
"RTN","IBCNEKIT",278,0)
 S IBPURGE("EICD",365.1,IBTQ1)=""               ;EICD TQ for identifications
"RTN","IBCNEKIT",279,0)
 S IBTQIEN=+$$GET1^DIQ(365.18,IBTQIEN1,.06,"I") ;EICD RESPONSE for identifications
"RTN","IBCNEKIT",280,0)
 I IBTQIEN S IBPURGE("EICD",365,IBTQIEN)=""
"RTN","IBCNEKIT",281,0)
 ; 
"RTN","IBCNEKIT",282,0)
 ; loop through the EICD verification entries looking for exclusions  
"RTN","IBCNEKIT",283,0)
 S IBTRKIEN=0 F  S IBTRKIEN=$O(^IBCN(365.18,IBTQIEN1,"INS-FND",IBTRKIEN)) Q:'IBTRKIEN  D  Q:IBSKIP
"RTN","IBCNEKIT",284,0)
 . ;
"RTN","IBCNEKIT",285,0)
 . ; check the 1 node data for associated TQs & their responses
"RTN","IBCNEKIT",286,0)
 . S IBTQIEN2=IBTRKIEN_","_IBTQIEN1_","
"RTN","IBCNEKIT",287,0)
 . K IBFIELDS D GETS^DIQ(365.185,IBTQIEN2,"1.01:1.04","I","IBFIELDS")
"RTN","IBCNEKIT",288,0)
 . ;
"RTN","IBCNEKIT",289,0)
 . I IBFIELDS(365.185,IBTQIEN2,1.02,"I")="" Q                ; No TQ was created
"RTN","IBCNEKIT",290,0)
 . I IBFIELDS(365.185,IBTQIEN2,1.02,"I")>ENDDT S IBSKIP=1 Q  ; TQ not old enough 
"RTN","IBCNEKIT",291,0)
 . S IBTQIEN=+IBFIELDS(365.185,IBTQIEN2,1.01,"I")            ; EICD VER INQ TQ
"RTN","IBCNEKIT",292,0)
 . S IBTQS=+$$GET1^DIQ(365.1,IBTQIEN_",",.04,"I")            ; TQ Transmission Status 
"RTN","IBCNEKIT",293,0)
 . I IBTQS,('$F(STATLIST,","_IBTQS_",")) S IBSKIP=1 Q        ; must be in the list
"RTN","IBCNEKIT",294,0)
 . ;
"RTN","IBCNEKIT",295,0)
 . ; Loop thru all EICD Verifications if any are DO NOT PURGE then kill
"RTN","IBCNEKIT",296,0)
 . ; nothing associated with it
"RTN","IBCNEKIT",297,0)
 . S HLIEN=0
"RTN","IBCNEKIT",298,0)
 . F  S HLIEN=$O(^IBCN(365.1,IBTQIEN,2,HLIEN)) Q:'HLIEN!PFLAG  D
"RTN","IBCNEKIT",299,0)
 .. S DA=$P($G(^IBCN(365.1,IBTQIEN,2,HLIEN,0)),U,3) Q:'DA
"RTN","IBCNEKIT",300,0)
 .. I +$$GET1^DIQ(365,DA_",",.11,"I") S PFLAG=1 Q  ;"DO NOT PURGE"
"RTN","IBCNEKIT",301,0)
 .. S IBPURGE("EICD",365,DA)=""  ; array of Verifications to purge (responses)
"RTN","IBCNEKIT",302,0)
 . I PFLAG Q
"RTN","IBCNEKIT",303,0)
 . S IBPURGE("EICD",365.1,IBTQIEN)="" ; array of Verifications to purge (inquiries)
"RTN","IBCNEKIT",304,0)
 ;
"RTN","IBCNEKIT",305,0)
 I PFLAG!IBSKIP K IBPURGE  ; DO NOT PURGE is set or Not all records are old enough
"RTN","IBCNEKIT",306,0)
 ;
"RTN","IBCNEKIT",307,0)
 I '$D(IBPURGE) Q  ; No records associated with this entry to purge
"RTN","IBCNEKIT",308,0)
 S IBPURGE("EICD",365.18,IBTQ1)=""
"RTN","IBCNEKIT",309,0)
 S FILE="" F  S FILE=$O(IBPURGE("EICD",FILE)) Q:'FILE  D
"RTN","IBCNEKIT",310,0)
 . S DIK="^IBCN("_FILE_","
"RTN","IBCNEKIT",311,0)
 . S DA="" F  S DA=$O(IBPURGE("EICD",FILE,DA)) Q:'DA  D
"RTN","IBCNEKIT",312,0)
 .. D ^DIK
"RTN","IBCNEKIT",313,0)
 K IBPURGE,DA,DIK
"RTN","IBCNEKIT",314,0)
 Q
"RTN","IBCNEKIT",315,0)
 ;
"RTN","IBCNEMS1")
0^11^B7021261^n/a
"RTN","IBCNEMS1",1,0)
IBCNEMS1 ;AITC/DM - Consolidated Mailman messages; 12-JUNE-2018
"RTN","IBCNEMS1",2,0)
 ;;2.0;INTEGRATED BILLING;**621**;21-MAR-94;Build 8
"RTN","IBCNEMS1",3,0)
 ;;Per VA Directive 6402, this routine should not be modified.
"RTN","IBCNEMS1",4,0)
 ;
"RTN","IBCNEMS1",5,0)
 ; 
"RTN","IBCNEMS1",6,0)
 ; These routines are being consolidated in one area for ease in maintenance 
"RTN","IBCNEMS1",7,0)
 ; The calling routine is responsible for setting the target MAILGROUP, Subject text 
"RTN","IBCNEMS1",8,0)
 ; and finally calling MSG^IBCNEUT5(...) to send the actual Mailman message
"RTN","IBCNEMS1",9,0)
 ; 
"RTN","IBCNEMS1",10,0)
MSG001(MSG,EXNAME) ; error msg for $$SDAPI^SDAMA301 appointment api issue from an extract 
"RTN","IBCNEMS1",11,0)
 ; MSG is the global that will be populated with message text.
"RTN","IBCNEMS1",12,0)
 ; EXNAME is the extract that had the issue (e.g. "EICD") 
"RTN","IBCNEMS1",13,0)
 ; It is assumed that ^TMP($J,"SDAMA301") has been populated by the failed call
"RTN","IBCNEMS1",14,0)
 ;
"RTN","IBCNEMS1",15,0)
 N IBMSG,IBII
"RTN","IBCNEMS1",16,0)
 S MSG(1)="On "_$$FMTE^XLFDT(DT)_" the "_EXNAME_" Extract for eIV encountered"
"RTN","IBCNEMS1",17,0)
 S MSG(2)="one or more errors while attempting to get Appointment data"
"RTN","IBCNEMS1",18,0)
 S MSG(3)="from the scheduling package."
"RTN","IBCNEMS1",19,0)
 S MSG(4)=""
"RTN","IBCNEMS1",20,0)
 S MSG(5)="Error(s) encountered: "
"RTN","IBCNEMS1",21,0)
 S MSG(6)=""
"RTN","IBCNEMS1",22,0)
 S MSG(7)="  Error Code   Error Message"
"RTN","IBCNEMS1",23,0)
 S MSG(8)="  ----------   -------------"
"RTN","IBCNEMS1",24,0)
 S IBMSG=8,IBII=0
"RTN","IBCNEMS1",25,0)
 F  S IBII=$O(^TMP($J,"SDAMA301",IBII)) Q:IBII=""  S IBMSG=IBMSG+1,MSG(IBMSG)="  "_$$LJ^XLFSTR(IBII,13)_$G(^TMP($J,"SDAMA301",IBII))
"RTN","IBCNEMS1",26,0)
 S IBMSG=IBMSG+1,MSG(IBMSG)=""
"RTN","IBCNEMS1",27,0)
 S IBMSG=IBMSG+1,MSG(IBMSG)="As a result of this error the extract was not done.  The extract"
"RTN","IBCNEMS1",28,0)
 S IBMSG=IBMSG+1,MSG(IBMSG)="will be attempted again the next night automatically.  If you"
"RTN","IBCNEMS1",29,0)
 S IBMSG=IBMSG+1,MSG(IBMSG)="continue to receive error messages you should contact your IRM"
"RTN","IBCNEMS1",30,0)
 S IBMSG=IBMSG+1,MSG(IBMSG)="and possibly call the Help Desk for assistance."
"RTN","IBCNEMS1",31,0)
 ;
"RTN","IBCNEMS1",32,0)
 Q
"RTN","IBCNEMS1",33,0)
 ;
"RTN","IBCNEMS1",34,0)
MSG002(MSG,ERRGB,TQ) ; error msg when writing to EIV EICD TRACKING (#365.18) from IBCNEDE4
"RTN","IBCNEMS1",35,0)
 ; MSG is the global that will be populated with message text.
"RTN","IBCNEMS1",36,0)
 ; ERRBG is the ERROR global that was passed to a Fileman ^DIE call
"RTN","IBCNEMS1",37,0)
 ; TQ IEN of the associated IIV Transmission Queue
"RTN","IBCNEMS1",38,0)
 ; The user should verify that there is an existing error before making this call  
"RTN","IBCNEMS1",39,0)
 ; Set to IB site parameter MAILGROUP
"RTN","IBCNEMS1",40,0)
 ;
"RTN","IBCNEMS1",41,0)
 S MSG(1)="Tried to create an entry in the EIV EICD TRACKING file #365.18"
"RTN","IBCNEMS1",42,0)
 S MSG(2)="without success."
"RTN","IBCNEMS1",43,0)
 S MSG(3)=""
"RTN","IBCNEMS1",44,0)
 S MSG(4)="Error encountered: "_$G(ERRGB("DIERR",1,"TEXT",1))
"RTN","IBCNEMS1",45,0)
 S MSG(5)=""
"RTN","IBCNEMS1",46,0)
 S MSG(6)="The associated IIV Transmission Queue IEN: "_TQ
"RTN","IBCNEMS1",47,0)
 S MSG(7)=""
"RTN","IBCNEMS1",48,0)
 S MSG(8)="If you continue to receive this error message, you should contact"
"RTN","IBCNEMS1",49,0)
 S MSG(9)="your IRM and possibly call the Help Desk for assistance."
"RTN","IBCNEMS1",50,0)
 Q
"RTN","IBCNEMS1",51,0)
 ; 
"RTN","IBCNEPM")
0^12^B15435667^B15040845
"RTN","IBCNEPM",1,0)
IBCNEPM ;DAOU/ESG - PAYER MAINTENANCE PAYER LIST SCREEN ;22-JAN-2003
"RTN","IBCNEPM",2,0)
 ;;2.0;INTEGRATED BILLING;**184,601,621**;21-MAR-94;Build 8
"RTN","IBCNEPM",3,0)
 ;;Per VA Directive 6402, this routine should not be modified.
"RTN","IBCNEPM",4,0)
 ;
"RTN","IBCNEPM",5,0)
 Q
"RTN","IBCNEPM",6,0)
 ;
"RTN","IBCNEPM",7,0)
HDR ; -- header code
"RTN","IBCNEPM",8,0)
 S VALMHDR(1)="Payers with potential matches to active insurance companies."
"RTN","IBCNEPM",9,0)
 Q
"RTN","IBCNEPM",10,0)
 ;
"RTN","IBCNEPM",11,0)
INIT ; -- init variables and list array
"RTN","IBCNEPM",12,0)
 ;
"RTN","IBCNEPM",13,0)
 ;Create scratch global of payer w/ potential matches missing
"RTN","IBCNEPM",14,0)
 KILL ^TMP("IBCNEPM",$J)
"RTN","IBCNEPM",15,0)
 NEW INS,DATA,PROFID,INSTID,IEN,APP,ACTIVE,PAYER
"RTN","IBCNEPM",16,0)
 ;
"RTN","IBCNEPM",17,0)
 ; First build a scratch global cross reference with all existing
"RTN","IBCNEPM",18,0)
 ; professional and institutional EDI ID numbers in file 36.
"RTN","IBCNEPM",19,0)
 S INS=0
"RTN","IBCNEPM",20,0)
 F  S INS=$O(^DIC(36,INS)) Q:'INS  D
"RTN","IBCNEPM",21,0)
 . I '$$ACTIVE^IBCNEUT4(INS) Q          ; inactive ins co
"RTN","IBCNEPM",22,0)
 . S DATA=$G(^DIC(36,INS,3))
"RTN","IBCNEPM",23,0)
 . I $P(DATA,U,10)'="" Q                ; already linked to a payer
"RTN","IBCNEPM",24,0)
 . S PROFID=$P(DATA,U,2),INSTID=$P(DATA,U,4)
"RTN","IBCNEPM",25,0)
 . I PROFID'="" S ^TMP("IBCNEPM",$J,"P",PROFID,INS)=""
"RTN","IBCNEPM",26,0)
 . I INSTID'="" S ^TMP("IBCNEPM",$J,"I",INSTID,INS)=""
"RTN","IBCNEPM",27,0)
 . Q
"RTN","IBCNEPM",28,0)
 ;
"RTN","IBCNEPM",29,0)
 ; Next loop through all payers.  Count up the number of insurance 
"RTN","IBCNEPM",30,0)
 ; companies that have matching EDI ID numbers but no payer links.  
"RTN","IBCNEPM",31,0)
 ; These are possible payer-insurance company links that have not yet 
"RTN","IBCNEPM",32,0)
 ; been made.
"RTN","IBCNEPM",33,0)
 ;
"RTN","IBCNEPM",34,0)
 S IEN=0
"RTN","IBCNEPM",35,0)
 F  S IEN=$O(^IBE(365.12,IEN)) Q:'IEN  D
"RTN","IBCNEPM",36,0)
 . I IEN=$$GET1^DIQ(350.9,"1,","MBI PAYER","I") Q  ;IB*2*601/DM
"RTN","IBCNEPM",37,0)
 . I IEN=$$GET1^DIQ(350.9,"1,","EICD PAYER","I") Q  ;IB*2.0*621/DM
"RTN","IBCNEPM",38,0)
 . S DATA=$G(^IBE(365.12,IEN,0))
"RTN","IBCNEPM",39,0)
 . ;
"RTN","IBCNEPM",40,0)
 . I '$$ACTAPP^IBCNEUT5(IEN) Q  ; no active payer applications
"RTN","IBCNEPM",41,0)
 . ;
"RTN","IBCNEPM",42,0)
 . ; must have at least 1 nationally active payer application
"RTN","IBCNEPM",43,0)
 . S APP=0,ACTIVE=0
"RTN","IBCNEPM",44,0)
 . F  S APP=$O(^IBE(365.12,IEN,1,APP)) Q:'APP!(ACTIVE)  D
"RTN","IBCNEPM",45,0)
 .. I $P($G(^IBE(365.12,IEN,1,APP,0)),U,2)=1 S ACTIVE=1
"RTN","IBCNEPM",46,0)
 . Q:'ACTIVE    ; no nationally active payer application found
"RTN","IBCNEPM",47,0)
 . ;
"RTN","IBCNEPM",48,0)
 . S PAYER=$P(DATA,U),PROFID=$P(DATA,U,5),INSTID=$P(DATA,U,6)
"RTN","IBCNEPM",49,0)
 . ;
"RTN","IBCNEPM",50,0)
 . ; Look at the payer's professional ID and see how many unique
"RTN","IBCNEPM",51,0)
 . ; insurance companies also have this professional ID
"RTN","IBCNEPM",52,0)
 . I PROFID'="",$D(^TMP("IBCNEPM",$J,"P",PROFID)) D
"RTN","IBCNEPM",53,0)
 .. S INS="" F  S INS=$O(^TMP("IBCNEPM",$J,"P",PROFID,INS)) Q:'INS  D
"RTN","IBCNEPM",54,0)
 ... S ^TMP("IBCNEPM",$J,"INS",INS,IEN)=PAYER
"RTN","IBCNEPM",55,0)
 ... I $D(^TMP("IBCNEPM",$J,"PYR",PAYER,IEN,INS)) Q
"RTN","IBCNEPM",56,0)
 ... S ^TMP("IBCNEPM",$J,"PYR",PAYER,IEN,INS)=""
"RTN","IBCNEPM",57,0)
 ... S ^TMP("IBCNEPM",$J,"PYR",PAYER,IEN)=$G(^TMP("IBCNEPM",$J,"PYR",PAYER,IEN))+1  ; increment tot
"RTN","IBCNEPM",58,0)
 . ;
"RTN","IBCNEPM",59,0)
 . ; Look at the payer's institutional ID and see how many unique
"RTN","IBCNEPM",60,0)
 . ; insurance companies also have this institutional ID
"RTN","IBCNEPM",61,0)
 . I INSTID'="",$D(^TMP("IBCNEPM",$J,"I",INSTID)) D
"RTN","IBCNEPM",62,0)
 .. S INS="" F  S INS=$O(^TMP("IBCNEPM",$J,"I",INSTID,INS)) Q:'INS  D
"RTN","IBCNEPM",63,0)
 ... S ^TMP("IBCNEPM",$J,"INS",INS,IEN)=PAYER
"RTN","IBCNEPM",64,0)
 ... I $D(^TMP("IBCNEPM",$J,"PYR",PAYER,IEN,INS)) Q
"RTN","IBCNEPM",65,0)
 ... S ^TMP("IBCNEPM",$J,"PYR",PAYER,IEN,INS)=""
"RTN","IBCNEPM",66,0)
 ... S ^TMP("IBCNEPM",$J,"PYR",PAYER,IEN)=$G(^TMP("IBCNEPM",$J,"PYR",PAYER,IEN))+1  ; increment tot
"RTN","IBCNEPM",67,0)
 ;
"RTN","IBCNEPM",68,0)
 D BUILD
"RTN","IBCNEPM",69,0)
 ;
"RTN","IBCNEPM",70,0)
INITX ;
"RTN","IBCNEPM",71,0)
 Q
"RTN","IBCNEPM",72,0)
 ;
"RTN","IBCNEPM",73,0)
BUILD ; This procedure builds the ListMan display global based on the 
"RTN","IBCNEPM",74,0)
 ; "PYR" area of the scratch global.  
"RTN","IBCNEPM",75,0)
 ;
"RTN","IBCNEPM",76,0)
 NEW LINE,PAYER,IEN,STRING,LINKS
"RTN","IBCNEPM",77,0)
 KILL ^TMP("IBCNEPM",$J,1)
"RTN","IBCNEPM",78,0)
 S LINE=0,(PAYER,IEN)=""
"RTN","IBCNEPM",79,0)
 F  S PAYER=$O(^TMP("IBCNEPM",$J,"PYR",PAYER)) Q:PAYER=""  D
"RTN","IBCNEPM",80,0)
 . F  S IEN=$O(^TMP("IBCNEPM",$J,"PYR",PAYER,IEN)) Q:IEN=""  D
"RTN","IBCNEPM",81,0)
 .. S STRING="",LINE=LINE+1
"RTN","IBCNEPM",82,0)
 .. S ^TMP("IBCNEPM",$J,"IDX",LINE,IEN)=PAYER
"RTN","IBCNEPM",83,0)
 .. S LINKS=^TMP("IBCNEPM",$J,"PYR",PAYER,IEN)
"RTN","IBCNEPM",84,0)
 .. S STRING=$$SETFLD^VALM1(LINE,STRING,"LINE")
"RTN","IBCNEPM",85,0)
 .. S STRING=$$SETFLD^VALM1(PAYER,STRING,"PAYER")
"RTN","IBCNEPM",86,0)
 .. S STRING=$$SETFLD^VALM1(LINKS,STRING,"LINKS")
"RTN","IBCNEPM",87,0)
 .. D SET^VALM10(LINE,STRING)
"RTN","IBCNEPM",88,0)
 ;
"RTN","IBCNEPM",89,0)
 S VALMCNT=LINE
"RTN","IBCNEPM",90,0)
 I VALMCNT=0 S VALMSG=" No Active Payers with potential missing links."
"RTN","IBCNEPM",91,0)
BUILDX ;
"RTN","IBCNEPM",92,0)
 Q
"RTN","IBCNEPM",93,0)
 ;
"RTN","IBCNEPM",94,0)
 ;
"RTN","IBCNEPM",95,0)
HELP ; -- help code
"RTN","IBCNEPM",96,0)
 N X S X="?" D DISP^XQORM1 W !!
"RTN","IBCNEPM",97,0)
 Q
"RTN","IBCNEPM",98,0)
 ;
"RTN","IBCNEPM",99,0)
EXIT ; -- exit code
"RTN","IBCNEPM",100,0)
 Q
"RTN","IBCNEPM",101,0)
 ;
"RTN","IBCNEPM",102,0)
EXPND ; -- expand code
"RTN","IBCNEPM",103,0)
 Q
"RTN","IBCNEPM",104,0)
 ;
"RTN","IBCNERP0")
0^27^B5584263^B5707694
"RTN","IBCNERP0",1,0)
IBCNERP0 ;DAOU/BHS - IBCNE eIV STATISTICAL REPORT (cont'd) ;11-JUN-2002
"RTN","IBCNERP0",2,0)
 ;;2.0;INTEGRATED BILLING;**184,271,416,621**;21-MAR-94;Build 8
"RTN","IBCNERP0",3,0)
 ;;Per VA Directive 6402, this routine should not be modified.
"RTN","IBCNERP0",4,0)
 ;
"RTN","IBCNERP0",5,0)
 ; eIV - Insurance Verification Interface
"RTN","IBCNERP0",6,0)
 ;
"RTN","IBCNERP0",7,0)
 ; PYR tag called by IBCNERP8
"RTN","IBCNERP0",8,0)
 ;
"RTN","IBCNERP0",9,0)
 ; Cannot be called from top of routine
"RTN","IBCNERP0",10,0)
 Q
"RTN","IBCNERP0",11,0)
 ;
"RTN","IBCNERP0",12,0)
PYR(RTN,BDT,EDT,TOT) ; Determine Incoming Data
"RTN","IBCNERP0",13,0)
 ; Input params: RTN-routine name for ^TMP($J), BDT-start dt/time,
"RTN","IBCNERP0",14,0)
 ;  EDT-end dt/time, **TOT-total records searched - used only for status
"RTN","IBCNERP0",15,0)
 ;  checks when the process is queued (passed by reference)
"RTN","IBCNERP0",16,0)
 ; Output vars: Set ^TMP($J,RTN,"PYR",PAYER NAME,IEN of file 365.12)=""
"RTN","IBCNERP0",17,0)
 N PIEN,PYR,CREATEDT,APPIEN,APPDATA
"RTN","IBCNERP0",18,0)
 ;S BDT=$P(BDT,"."),EDT=$P(EDT,".")
"RTN","IBCNERP0",19,0)
 S PIEN=0 F  S PIEN=$O(^IBE(365.12,PIEN)) Q:'PIEN  D
"RTN","IBCNERP0",20,0)
 . S TOT=TOT+1
"RTN","IBCNERP0",21,0)
 . S CREATEDT=$P($G(^IBE(365.12,PIEN,0)),U,4)
"RTN","IBCNERP0",22,0)
 . I CREATEDT=""!(CREATEDT<BDT)!(CREATEDT>EDT) Q
"RTN","IBCNERP0",23,0)
 . S PYR=$P($G(^IBE(365.12,PIEN,0)),U)
"RTN","IBCNERP0",24,0)
 . Q:PYR="~NO PAYER"       ; used internally only - not a real eIV payer
"RTN","IBCNERP0",25,0)
 . ;
"RTN","IBCNERP0",26,0)
 . ; Get Payer app multiple IEN
"RTN","IBCNERP0",27,0)
 . S APPIEN=$$PYRAPP^IBCNEUT5("IIV",PIEN)
"RTN","IBCNERP0",28,0)
 . ; Must have eIV application
"RTN","IBCNERP0",29,0)
 . I 'APPIEN Q
"RTN","IBCNERP0",30,0)
 . S APPDATA=$G(^IBE(365.12,PIEN,1,APPIEN,0))
"RTN","IBCNERP0",31,0)
 . ; Must be Nationally Active
"RTN","IBCNERP0",32,0)
 . I '$P(APPDATA,U,2) Q
"RTN","IBCNERP0",33,0)
 . ;
"RTN","IBCNERP0",34,0)
 . S ^TMP($J,RTN,"PYR",PYR,PIEN)=""
"RTN","IBCNERP0",35,0)
 Q
"RTN","IBCNERP0",36,0)
 ;
"RTN","IBCNERP0",37,0)
HEADER(HDRDATA,PGC,PXT,MAX,CRT,SITE,DTMRNG,MM) ; Print header info for each pg
"RTN","IBCNERP0",38,0)
 ; Init vars
"RTN","IBCNERP0",39,0)
 N CT,HDRCT,LIN,HDR
"RTN","IBCNERP0",40,0)
 ;
"RTN","IBCNERP0",41,0)
 ; Prompt to print next page for reports to the screen
"RTN","IBCNERP0",42,0)
 I CRT,PGC>0,'$D(ZTQUEUED) D  I PXT G HEADERX
"RTN","IBCNERP0",43,0)
 . I MAX<51 F LIN=1:1:(MAX-$Y) W !
"RTN","IBCNERP0",44,0)
 . S DIR(0)="E" D ^DIR K DIR
"RTN","IBCNERP0",45,0)
 . I $D(DTOUT)!$D(DUOUT) S PXT=1 Q
"RTN","IBCNERP0",46,0)
 I $D(ZTQUEUED),$$S^%ZTLOAD() S ZTSTOP=1 G HEADERX
"RTN","IBCNERP0",47,0)
 ;
"RTN","IBCNERP0",48,0)
 ; Update page ct
"RTN","IBCNERP0",49,0)
 S PGC=PGC+1
"RTN","IBCNERP0",50,0)
 ;
"RTN","IBCNERP0",51,0)
 ; Update header based on MailMan message flag
"RTN","IBCNERP0",52,0)
 S HDRCT=0
"RTN","IBCNERP0",53,0)
 S HDRCT=HDRCT+1,HDRDATA(HDRCT)="eIV Statistical Report"_$$FO^IBCNEUT1($$FMTE^XLFDT($$NOW^XLFDT,1)_"  Page: "_PGC,56,"R")
"RTN","IBCNERP0",54,0)
 ;S HDRDATA(HDRCT)=$$FO^IBCNEUT1(SITE,(80-$L(SITE)\2)+$L(SITE),"R"),HDRCT=HDRCT+1
"RTN","IBCNERP0",55,0)
 S HDR="Report Timeframe: "_DTMRNG ; IB*2.0*621 
"RTN","IBCNERP0",56,0)
 S HDRCT=HDRCT+1,HDRDATA(HDRCT)=$$FO^IBCNEUT1(HDR,(80-$L(HDR)\2)+$L(HDR),"R") ; IB*2.0*621 
"RTN","IBCNERP0",57,0)
 S HDRCT=HDRCT+1,HDRDATA(HDRCT)="" ; IB*2.0*621 
"RTN","IBCNERP0",58,0)
 ;
"RTN","IBCNERP0",59,0)
 I MM S HDRCT=HDRCT+1,HDRDATA(HDRCT)=""
"RTN","IBCNERP0",60,0)
 ; Only write out Header for non-MailMan message output
"RTN","IBCNERP0",61,0)
 I MM="" W @IOF F CT=1:1:HDRCT W !,?1,HDRDATA(CT)
"RTN","IBCNERP0",62,0)
 ;
"RTN","IBCNERP0",63,0)
HEADERX ; HEADER exit pt
"RTN","IBCNERP0",64,0)
 Q
"RTN","IBCNERP0",65,0)
 ;
"RTN","IBCNERP7")
0^22^B35463903^B30436149
"RTN","IBCNERP7",1,0)
IBCNERP7 ;DAOU/BHS - eIV STATISTICAL REPORT ;10-JUN-2002
"RTN","IBCNERP7",2,0)
 ;;2.0;INTEGRATED BILLING;**184,416,528,621**;21-MAR-94;Build 8
"RTN","IBCNERP7",3,0)
 ;;Per VA Directive 6402, this routine should not be modified.
"RTN","IBCNERP7",4,0)
 ;
"RTN","IBCNERP7",5,0)
 ; eIV - Insurance Verification Interface
"RTN","IBCNERP7",6,0)
 ;
"RTN","IBCNERP7",7,0)
 ; Input parameter: N/A
"RTN","IBCNERP7",8,0)
 ; Other relevant variables:
"RTN","IBCNERP7",9,0)
 ;   IBCNERTN = "IBCNERP7" (current routine name for queueing the 
"RTN","IBCNERP7",10,0)
 ;                          COMPILE process)
"RTN","IBCNERP7",11,0)
 ;   IBCNESPC("BEGDTM") = start date/time for date/time range
"RTN","IBCNERP7",12,0)
 ;   IBCNESPC("ENDDTM") = end date/time for date/time range
"RTN","IBCNERP7",13,0)
 ;   IBCNESPC("SECTS") = list of sections to display on the report
"RTN","IBCNERP7",14,0)
 ;                       1 = All (Outgoing, Incoming and General),
"RTN","IBCNERP7",15,0)
 ;                       2 = Outgoing - Inquiry Response data,
"RTN","IBCNERP7",16,0)
 ;                       3 = Incoming - Inquiry Transmission data,
"RTN","IBCNERP7",17,0)
 ;                       4 = General - Ins Buffer data, Outstanding 
"RTN","IBCNERP7",18,0)
 ;                           Inquiries, Communication Failures, Retries
"RTN","IBCNERP7",19,0)
 ;                       may equal a list of values if '1' is not the
"RTN","IBCNERP7",20,0)
 ;                       the only value
"RTN","IBCNERP7",21,0)
 ;   IBCNESPC("MM") = "", not for MailMan message OR
"RTN","IBCNERP7",22,0)
 ;                    MAILGROUP, generate as MailMan message for this
"RTN","IBCNERP7",23,0)
 ;                               MAILGROUP as defined in IB site 
"RTN","IBCNERP7",24,0)
 ;                               parameters
"RTN","IBCNERP7",25,0)
 ;   IBOUT = "E" for Excel or "R" for report format
"RTN","IBCNERP7",26,0)
 ;
"RTN","IBCNERP7",27,0)
 ; Only enter routine from EN or MAILMSG tags
"RTN","IBCNERP7",28,0)
 Q
"RTN","IBCNERP7",29,0)
 ;
"RTN","IBCNERP7",30,0)
 ; Entry pt
"RTN","IBCNERP7",31,0)
EN ;
"RTN","IBCNERP7",32,0)
 ; Init vars 
"RTN","IBCNERP7",33,0)
 N STOP,IBCNERTN,POP,IBCNESPC,IBOUT
"RTN","IBCNERP7",34,0)
 ;
"RTN","IBCNERP7",35,0)
 S STOP=0
"RTN","IBCNERP7",36,0)
 S IBCNERTN="IBCNERP7"
"RTN","IBCNERP7",37,0)
 W @IOF
"RTN","IBCNERP7",38,0)
 W !,"eIV Statistical Report",!
"RTN","IBCNERP7",39,0)
 W !,"Please select the timeframe for which to view the Insurance"
"RTN","IBCNERP7",40,0)
 W !,"Verification statistics and current status."
"RTN","IBCNERP7",41,0)
 ;
"RTN","IBCNERP7",42,0)
 ; Default to MailMan flag to No from the EN tag
"RTN","IBCNERP7",43,0)
 S IBCNESPC("MM")=""
"RTN","IBCNERP7",44,0)
 ;
"RTN","IBCNERP7",45,0)
 ; Prompts for Payer Report
"RTN","IBCNERP7",46,0)
 ; Date Range parameters
"RTN","IBCNERP7",47,0)
S10 D DTMRNG I STOP G EXIT
"RTN","IBCNERP7",48,0)
 ; Sort by parameter - Payer or Total Inquiries (Payer Report)
"RTN","IBCNERP7",49,0)
S20 D SECTS I STOP G:$$STOP^IBCNERP1 EXIT G S10
"RTN","IBCNERP7",50,0)
 ; Select report type  528 - baa
"RTN","IBCNERP7",51,0)
S30 S IBOUT=$$OUT I STOP G:$$STOP^IBCNERP1 EXIT G S20
"RTN","IBCNERP7",52,0)
 ; Select the output device
"RTN","IBCNERP7",53,0)
S50 D DEVICE^IBCNERP1(IBCNERTN,.IBCNESPC,IBOUT) I STOP G:$$STOP^IBCNERP1 EXIT G S20
"RTN","IBCNERP7",54,0)
 ;
"RTN","IBCNERP7",55,0)
EXIT ; Quit this routine
"RTN","IBCNERP7",56,0)
 Q
"RTN","IBCNERP7",57,0)
 ;
"RTN","IBCNERP7",58,0)
 ;
"RTN","IBCNERP7",59,0)
DTMRNG ; Determine the start and end date/times for the report
"RTN","IBCNERP7",60,0)
 ; Init vars
"RTN","IBCNERP7",61,0)
 N DIR,X,Y,DIRUT
"RTN","IBCNERP7",62,0)
 ;
"RTN","IBCNERP7",63,0)
 W !
"RTN","IBCNERP7",64,0)
 ;
"RTN","IBCNERP7",65,0)
 S DIR(0)="DO^::ERX"
"RTN","IBCNERP7",66,0)
 S DIR("A")="Start DATE/TIME"
"RTN","IBCNERP7",67,0)
 S DIR("?",1)="    Enter Start DATE/TIME for report range."
"RTN","IBCNERP7",68,0)
 S DIR("?")="    The time element is required."
"RTN","IBCNERP7",69,0)
 D ^DIR K DIR
"RTN","IBCNERP7",70,0)
 I $D(DIRUT) S STOP=1 G DTMRNGX
"RTN","IBCNERP7",71,0)
 S IBCNESPC("BEGDTM")=Y
"RTN","IBCNERP7",72,0)
 ;
"RTN","IBCNERP7",73,0)
DTMRNG1 S DIR(0)="D^::ERX"
"RTN","IBCNERP7",74,0)
 S DIR("A")="  End DATE/TIME"
"RTN","IBCNERP7",75,0)
 S DIR("?",1)="    Enter End DATE/TIME for report range."
"RTN","IBCNERP7",76,0)
 S DIR("?")="    The time element is required."
"RTN","IBCNERP7",77,0)
 D ^DIR K DIR
"RTN","IBCNERP7",78,0)
 I $D(DIRUT) S STOP=1 G DTMRNGX
"RTN","IBCNERP7",79,0)
 I Y<IBCNESPC("BEGDTM") D  G DTMRNG1
"RTN","IBCNERP7",80,0)
 . W !,"    The End Date/Time must not precede the Start Date/Time."
"RTN","IBCNERP7",81,0)
 . W !,"    Please reenter."
"RTN","IBCNERP7",82,0)
 S IBCNESPC("ENDDTM")=Y
"RTN","IBCNERP7",83,0)
 ;
"RTN","IBCNERP7",84,0)
DTMRNGX ; DTMRNG exit pt
"RTN","IBCNERP7",85,0)
 Q
"RTN","IBCNERP7",86,0)
 ;
"RTN","IBCNERP7",87,0)
 ;
"RTN","IBCNERP7",88,0)
SECTS ; Prompt to allow users to include the available sections in the report
"RTN","IBCNERP7",89,0)
 ; Init vars
"RTN","IBCNERP7",90,0)
 N DIR,X,Y,DIRUT
"RTN","IBCNERP7",91,0)
 ;
"RTN","IBCNERP7",92,0)
 W !
"RTN","IBCNERP7",93,0)
 ; IB*2.0*621 - Updated Help Text for Entry 4
"RTN","IBCNERP7",94,0)
 S DIR(0)="L^1:4"
"RTN","IBCNERP7",95,0)
 S DIR("A",1)="Choose all sections to be reviewed"
"RTN","IBCNERP7",96,0)
 S DIR("A",2)="1  -  All                             = All report sections (Default)"
"RTN","IBCNERP7",97,0)
 S DIR("A",3)="2  -  Outgoing Data                   = Inquiry Transmission statistics"
"RTN","IBCNERP7",98,0)
 S DIR("A",4)="3  -  Incoming Data                   = Inquiry Response statistics"
"RTN","IBCNERP7",99,0)
 S DIR("A",5)="4  -  Current Status/Payer Activity   = Responses Pending, Queued Inquiries,"
"RTN","IBCNERP7",100,0)
 S DIR("A",6)="                                        Ins Buffer Entries, Payer Activity, etc."
"RTN","IBCNERP7",101,0)
 S DIR("A")="Select one or more sections: "
"RTN","IBCNERP7",102,0)
 S DIR("B")=1
"RTN","IBCNERP7",103,0)
 S DIR("?",1)="  Please select one or more sections of the report to view."
"RTN","IBCNERP7",104,0)
 S DIR("?",2)="  To select multiple sections, enter a comma-separated list"
"RTN","IBCNERP7",105,0)
 S DIR("?",3)="  (ex. 2,4)."
"RTN","IBCNERP7",106,0)
 S DIR("?",4)="  1  -  Include all sections in the report.  (Default)"
"RTN","IBCNERP7",107,0)
 S DIR("?",5)="  2  -  Include statistics on inquiries transmitted during the"
"RTN","IBCNERP7",108,0)
 S DIR("?",6)="        timeframe by extract type."
"RTN","IBCNERP7",109,0)
 S DIR("?",7)="  3  -  Include statistics on responses received during the"
"RTN","IBCNERP7",110,0)
 S DIR("?",8)="        timeframe by extract type."
"RTN","IBCNERP7",111,0)
 S DIR("?",9)="  4  -  Include statistics on the Current Status of the system and Payer"
"RTN","IBCNERP7",112,0)
 S DIR("?",10)="        Activity. The totals in the Current Status section--including responses"
"RTN","IBCNERP7",113,0)
 S DIR("?",11)="        pending, queued inquiries, deferred inquiries, insurance companies"
"RTN","IBCNERP7",114,0)
 S DIR("?",12)="        without national ID, eIV Payers disabled locally, and insurance buffer"
"RTN","IBCNERP7",115,0)
 S DIR("?",13)="        entries--are independent of the report date range. The totals in the"
"RTN","IBCNERP7",116,0)
 S DIR("?",14)="        Payer Activity section reflect activity during the report date range."
"RTN","IBCNERP7",117,0)
 S DIR("?")=" "
"RTN","IBCNERP7",118,0)
 D ^DIR K DIR
"RTN","IBCNERP7",119,0)
 I $D(DIRUT) S STOP=1 G SECTSX
"RTN","IBCNERP7",120,0)
 ; Default to all if 1 is included OR if 2,3 and 4 are included in any
"RTN","IBCNERP7",121,0)
 ; order
"RTN","IBCNERP7",122,0)
 S Y=","_Y
"RTN","IBCNERP7",123,0)
 I Y[(",1,") S IBCNESPC("SECTS")=1 G SECTSX
"RTN","IBCNERP7",124,0)
 I Y[(",2,"),Y[(",3,"),Y[(",4,") S IBCNESPC("SECTS")=1 G SECTSX
"RTN","IBCNERP7",125,0)
 S IBCNESPC("SECTS")=Y
"RTN","IBCNERP7",126,0)
 ;
"RTN","IBCNERP7",127,0)
SECTSX ; SECTS exit pt
"RTN","IBCNERP7",128,0)
 Q
"RTN","IBCNERP7",129,0)
 ;
"RTN","IBCNERP7",130,0)
 ;
"RTN","IBCNERP7",131,0)
MAILMSG ; Tag to be called by TaskMan to generate report with default values
"RTN","IBCNERP7",132,0)
 ; and send as MailMan message
"RTN","IBCNERP7",133,0)
 ; Init vars
"RTN","IBCNERP7",134,0)
 N IBCNERTN,IBCNESPC,EDT,BDT,TM,IBOUT
"RTN","IBCNERP7",135,0)
 ;
"RTN","IBCNERP7",136,0)
 ; -- set the mail message to display in a report format
"RTN","IBCNERP7",137,0)
 S IBOUT="R"
"RTN","IBCNERP7",138,0)
 ;
"RTN","IBCNERP7",139,0)
 ; Default report parameters
"RTN","IBCNERP7",140,0)
 ; Start Date/Time - End Date/Time range
"RTN","IBCNERP7",141,0)
 ;  Determine start time based on IB site parameter
"RTN","IBCNERP7",142,0)
 S TM=$$GET1^DIQ(350.9,"1,",51.03,"E")
"RTN","IBCNERP7",143,0)
 I TM=""!(+TM=0) S TM="2400"
"RTN","IBCNERP7",144,0)
 S EDT=$$DT^XLFDT
"RTN","IBCNERP7",145,0)
 S BDT=$$FMADD^XLFDT(EDT,-1)
"RTN","IBCNERP7",146,0)
 S IBCNESPC("BEGDTM")=+(BDT_"."_TM)
"RTN","IBCNERP7",147,0)
 S IBCNESPC("ENDDTM")=+(EDT_"."_TM)
"RTN","IBCNERP7",148,0)
 ; Display all sections
"RTN","IBCNERP7",149,0)
 S IBCNESPC("SECTS")=1
"RTN","IBCNERP7",150,0)
 ; Set MailMan flag to IB site parameter MAILGROUP
"RTN","IBCNERP7",151,0)
 S IBCNESPC("MM")=$$MGRP^IBCNEUT5
"RTN","IBCNERP7",152,0)
 ; If there is no MailGroup to send message - do not continue
"RTN","IBCNERP7",153,0)
 I IBCNESPC("MM")="" QUIT
"RTN","IBCNERP7",154,0)
 ; If the send MailMan message parameter is turned off, stop the process
"RTN","IBCNERP7",155,0)
 I '$P($G(^IBE(350.9,1,51)),U,2) QUIT
"RTN","IBCNERP7",156,0)
 ;
"RTN","IBCNERP7",157,0)
 ; Set routine parameter
"RTN","IBCNERP7",158,0)
 S IBCNERTN="IBCNERP7"
"RTN","IBCNERP7",159,0)
 ;
"RTN","IBCNERP7",160,0)
 ; Initialize scratch global
"RTN","IBCNERP7",161,0)
 KILL ^TMP($J,IBCNERTN)
"RTN","IBCNERP7",162,0)
 ; Compile the report data
"RTN","IBCNERP7",163,0)
 D EN^IBCNERP8(IBCNERTN,.IBCNESPC)
"RTN","IBCNERP7",164,0)
 ; Print the report - to MailMan
"RTN","IBCNERP7",165,0)
 I '$G(ZTSTOP) D EN^IBCNERP9(IBCNERTN,.IBCNESPC,IBOUT)
"RTN","IBCNERP7",166,0)
 ;
"RTN","IBCNERP7",167,0)
 ; Kill scratch global
"RTN","IBCNERP7",168,0)
 KILL ^TMP($J,IBCNERTN)
"RTN","IBCNERP7",169,0)
 ;
"RTN","IBCNERP7",170,0)
 ; Purge the task record
"RTN","IBCNERP7",171,0)
 I $D(ZTQUEUED) S ZTREQ="@"
"RTN","IBCNERP7",172,0)
 ;
"RTN","IBCNERP7",173,0)
 ; MAILMSG exit pt
"RTN","IBCNERP7",174,0)
 Q
"RTN","IBCNERP7",175,0)
 ;  528 - baa : Add option to ouput data in excel format
"RTN","IBCNERP7",176,0)
OUT() ; Prompt to allow users to select output format
"RTN","IBCNERP7",177,0)
 N DIR,DIROUT,DIRUT,DTOUT,DUOUT,X,Y
"RTN","IBCNERP7",178,0)
 W !
"RTN","IBCNERP7",179,0)
 S DIR(0)="SA^E:Excel;R:Report"
"RTN","IBCNERP7",180,0)
 S DIR("A")="(E)xcel Format or (R)eport Format: "
"RTN","IBCNERP7",181,0)
 S DIR("B")="Report"
"RTN","IBCNERP7",182,0)
 D ^DIR I $D(DIRUT) S STOP=1 Q ""
"RTN","IBCNERP7",183,0)
 Q Y
"RTN","IBCNERP7",184,0)
 ;
"RTN","IBCNERP8")
0^23^B110475563^B75472595
"RTN","IBCNERP8",1,0)
IBCNERP8 ;DAOU/BHS - IBCNE eIV STATISTICAL REPORT COMPILE ;11-JUN-2002
"RTN","IBCNERP8",2,0)
 ;;2.0;INTEGRATED BILLING;**184,271,345,416,506,621**;21-MAR-94;Build 8
"RTN","IBCNERP8",3,0)
  ;;Per VA Directive 6402, this routine should not be modified.
"RTN","IBCNERP8",4,0)
 ;
"RTN","IBCNERP8",5,0)
 ; eIV - Insurance Verification Interface
"RTN","IBCNERP8",6,0)
 ;
"RTN","IBCNERP8",7,0)
 ;Input vars from IBCNERP7:
"RTN","IBCNERP8",8,0)
 ; IBCNERTN = "IBCNERP7"
"RTN","IBCNERP8",9,0)
 ; **IBCNESPC array ONLY passed by reference **
"RTN","IBCNERP8",10,0)
 ; IBCNESPC("BEGDTM") = Start Dt/Tm for rpt range
"RTN","IBCNERP8",11,0)
 ; IBCNESPC("ENDDTM") = End Dt/Tm for rpt range
"RTN","IBCNERP8",12,0)
 ; IBCNESPC("SECTS")  = 1 - All sections OR ',' sep'd list of 1 or more
"RTN","IBCNERP8",13,0)
 ;  of the following (not all)
"RTN","IBCNERP8",14,0)
 ;  2 - Outgoing data, inq trans stats
"RTN","IBCNERP8",15,0)
 ;  3 - Incoming data, resps rec'd stats
"RTN","IBCNERP8",16,0)
 ;  4 - Current status, pending resps, queued inqs, deferred inqs, payer
"RTN","IBCNERP8",17,0)
 ;      stats, ins buf stats
"RTN","IBCNERP8",18,0)
 ; IBCNESPC("MM") = "" - do not generate MailMan message OR MAILGROUP to
"RTN","IBCNERP8",19,0)
 ;  send report to Mail Group as defined in the IB site parameters
"RTN","IBCNERP8",20,0)
 ;Output vars:
"RTN","IBCNERP8",21,0)
 ; Based on IBCNESPC("SECTS") parameter the following scratch globals
"RTN","IBCNERP8",22,0)
 ; may be built
"RTN","IBCNERP8",23,0)
 ; 1 OR contains 2 --> 
"RTN","IBCNERP8",24,0)
 ; ^TMP($J,RTN,"OUT")=TotInq^InsBufExtSubtotal^PreRegExtSubtotal^...
"RTN","IBCNERP8",25,0)
 ;  NonVerifInsExtSubtotal^NoActInsExtSubtotal
"RTN","IBCNERP8",26,0)
 ; 1 OR contains 3 --> 
"RTN","IBCNERP8",27,0)
 ; ^TMP($J,RTN,"IN")=TotResp^InsBufExtSubtotal^PreRegExtSubtotal^...
"RTN","IBCNERP8",28,0)
 ;  NonVerifInsExtSubtotal^NoActInsExtSubtotal
"RTN","IBCNERP8",29,0)
 ; 1 OR contains 4 --> 
"RTN","IBCNERP8",30,0)
 ; ^TMP($J,RTN,"CUR")=TotPendingResponses^TotQueuedInquiries^...
"RTN","IBCNERP8",31,0)
 ;  TotDeferredInquiries(Hold)^TotInsCosw/oNationalID^...
"RTN","IBCNERP8",32,0)
 ;  ToteIVPyrsDisabldLocally^TotUserActReq^TotInsBufVerified^TotalManVerified...
"RTN","IBCNERP8",33,0)
 ;  TotaleIVVerified^TotInsBufUnverified^! InsBufSubtotal^...
"RTN","IBCNERP8",34,0)
 ;  ? InsBufSubtotal^- InsBufSubtotal^Other InsBufSubtotal^...
"RTN","IBCNERP8",35,0)
 ;  $ EscolatedBufSubtotal
"RTN","IBCNERP8",36,0)
 ; 1 OR contains 4 -->
"RTN","IBCNERP8",37,0)
 ; ^TMP($J,RTN,"PYR",PAYER,IEN)=""  (list of new payers)
"RTN","IBCNERP8",38,0)
 ;
"RTN","IBCNERP8",39,0)
 ; Must call at EN
"RTN","IBCNERP8",40,0)
 Q
"RTN","IBCNERP8",41,0)
 ;
"RTN","IBCNERP8",42,0)
EN(IBCNERTN,IBCNESPC) ; Entry pt
"RTN","IBCNERP8",43,0)
 ; Init vars
"RTN","IBCNERP8",44,0)
 N IBBDT,IBEDT,IBSCT,IBTOT,PIECES,VALUE,CT
"RTN","IBCNERP8",45,0)
 ;
"RTN","IBCNERP8",46,0)
 I '$D(ZTQUEUED),$G(IOST)["C-" W !!,"Compiling report data ..."
"RTN","IBCNERP8",47,0)
 ;
"RTN","IBCNERP8",48,0)
 S IBTOT=0
"RTN","IBCNERP8",49,0)
 ;
"RTN","IBCNERP8",50,0)
 ; Kill scratch global
"RTN","IBCNERP8",51,0)
 K ^TMP($J,IBCNERTN)
"RTN","IBCNERP8",52,0)
 ;
"RTN","IBCNERP8",53,0)
 ; Init looping vars
"RTN","IBCNERP8",54,0)
 S IBBDT=$G(IBCNESPC("BEGDTM")),IBEDT=$G(IBCNESPC("ENDDTM"))
"RTN","IBCNERP8",55,0)
 S IBSCT=$G(IBCNESPC("SECTS"))
"RTN","IBCNERP8",56,0)
 ;
"RTN","IBCNERP8",57,0)
 I IBSCT=1!$F(IBSCT,",2,") D OUT(IBCNERTN,IBBDT,IBEDT,.IBTOT)
"RTN","IBCNERP8",58,0)
 I $G(ZTSTOP) G EXIT
"RTN","IBCNERP8",59,0)
 I IBSCT=1!$F(IBSCT,",3,") D IN(IBCNERTN,IBBDT,IBEDT,.IBTOT)
"RTN","IBCNERP8",60,0)
 I $G(ZTSTOP) G EXIT
"RTN","IBCNERP8",61,0)
 I IBSCT=1!$F(IBSCT,",4,") D CUR(IBCNERTN,IBBDT,IBEDT,.IBTOT),PYR^IBCNERP0(IBCNERTN,IBBDT,IBEDT,.IBTOT)
"RTN","IBCNERP8",62,0)
 ;
"RTN","IBCNERP8",63,0)
EXIT ; EN Exit pt
"RTN","IBCNERP8",64,0)
 Q
"RTN","IBCNERP8",65,0)
 ;
"RTN","IBCNERP8",66,0)
IN(RTN,BDT,EDT,TOT) ; Determine Incoming Data
"RTN","IBCNERP8",67,0)
 ; Input params: RTN-routine name for ^TMP($J), BDT-start dt/time,
"RTN","IBCNERP8",68,0)
 ;  EDT-end dt/time, **TOT-total records searched - used only for status
"RTN","IBCNERP8",69,0)
 ;  checks when the process is queued (passed by reference)
"RTN","IBCNERP8",70,0)
 ; Output vars: Set pcs of ^TMP($J,RTN,"IN") as follows:
"RTN","IBCNERP8",71,0)
 ;  1=total Resps rec'd for date/time range
"RTN","IBCNERP8",72,0)
 ;  2=Ins Buf extract subtotal
"RTN","IBCNERP8",73,0)
 ;  3=Pre-Reg extract subtotal
"RTN","IBCNERP8",74,0)
 ;  4=Non-ver extract subtotal
"RTN","IBCNERP8",75,0)
 ;  5=No Act Ins subtotal
"RTN","IBCNERP8",76,0)
 ;
"RTN","IBCNERP8",77,0)
 ; Init vars
"RTN","IBCNERP8",78,0)
 N IBDT,PYRIEN,PATIEN,IBPTR,IBTYP,RPTDATA,TRANSIEN
"RTN","IBCNERP8",79,0)
 ;
"RTN","IBCNERP8",80,0)
 ; Loop thru the eIV Resp File (#365) x-ref on Date/Time Resp Rec'd
"RTN","IBCNERP8",81,0)
 S IBDT=$O(^IBCN(365,"AD",BDT),-1)
"RTN","IBCNERP8",82,0)
 F  S IBDT=$O(^IBCN(365,"AD",IBDT)) Q:IBDT=""!(IBDT>EDT)  D  Q:$G(ZTSTOP)
"RTN","IBCNERP8",83,0)
 . S PYRIEN=0
"RTN","IBCNERP8",84,0)
 . F  S PYRIEN=$O(^IBCN(365,"AD",IBDT,PYRIEN)) Q:'PYRIEN  D  Q:$G(ZTSTOP)
"RTN","IBCNERP8",85,0)
 . . S PATIEN=0
"RTN","IBCNERP8",86,0)
 . . F  S PATIEN=$O(^IBCN(365,"AD",IBDT,PYRIEN,PATIEN)) Q:'PATIEN  D  Q:$G(ZTSTOP)
"RTN","IBCNERP8",87,0)
 . . . S IBPTR=0
"RTN","IBCNERP8",88,0)
 . . . F  S IBPTR=$O(^IBCN(365,"AD",IBDT,PYRIEN,PATIEN,IBPTR)) Q:'IBPTR  D  Q:$G(ZTSTOP)
"RTN","IBCNERP8",89,0)
 . . . . S TOT=TOT+1
"RTN","IBCNERP8",90,0)
 . . . . I $D(ZTQUEUED),TOT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 Q
"RTN","IBCNERP8",91,0)
 . . . . ; Update total 
"RTN","IBCNERP8",92,0)
 . . . . S $P(RPTDATA,U,1)=$P($G(RPTDATA),U,1)+1
"RTN","IBCNERP8",93,0)
 . . . . ; Update extract type total
"RTN","IBCNERP8",94,0)
 . . . . ; Get the data for the report - build RPTDATA
"RTN","IBCNERP8",95,0)
 . . . . S IBTYP=5,TRANSIEN=$P($G(^IBCN(365,IBPTR,0)),U,5)
"RTN","IBCNERP8",96,0)
 . . . . ; IB*2.0*621
"RTN","IBCNERP8",97,0)
 . . . . S TQIEN=$P($G(^IBCN(365,IBPTR,0)),U,5)
"RTN","IBCNERP8",98,0)
 . . . . I TQIEN="" Q
"RTN","IBCNERP8",99,0)
 . . . . S IBTYP=$$GET1^DIQ(365.1,TQIEN_",",.1,"I")
"RTN","IBCNERP8",100,0)
 . . . . S IBQUERY=$$GET1^DIQ(365.1,TQIEN_",",.11,"I")
"RTN","IBCNERP8",101,0)
 . . . . S IBMBI=$$GET1^DIQ(365.1,TQIEN_",",.16,"I")
"RTN","IBCNERP8",102,0)
 . . . . I IBTYP'="" D
"RTN","IBCNERP8",103,0)
 . . . . . I IBTYP=3 Q
"RTN","IBCNERP8",104,0)
 . . . . . I IBTYP=1 D  Q
"RTN","IBCNERP8",105,0)
 . . . . . . I IBMBI="MBIrequest" S $P(RPTDATA,U,6)=$P($G(RPTDATA),U,6)+1 ; MBI Request
"RTN","IBCNERP8",106,0)
 . . . . . . I IBMBI'="MBIrequest" S $P(RPTDATA,U,IBTYP+1)=$P($G(RPTDATA),U,IBTYP+1)+1
"RTN","IBCNERP8",107,0)
 . . . . . I IBTYP=4 D  Q
"RTN","IBCNERP8",108,0)
 . . . . . . I IBQUERY="I" S $P(RPTDATA,U,4)=$P($G(RPTDATA),U,4)+1 ; EICD Queries
"RTN","IBCNERP8",109,0)
 . . . . . . I IBQUERY="V" S $P(RPTDATA,U,5)=$P($G(RPTDATA),U,5)+1 ; EICD Verification
"RTN","IBCNERP8",110,0)
 . . . . . S:IBTYP=2 $P(RPTDATA,U,3)=$P($G(RPTDATA),U,3)+1
"RTN","IBCNERP8",111,0)
 . . . . ; IB*2.0*621 - End IN Group
"RTN","IBCNERP8",112,0)
 ;
"RTN","IBCNERP8",113,0)
 I $G(ZTSTOP) G INX
"RTN","IBCNERP8",114,0)
 ;
"RTN","IBCNERP8",115,0)
 ; Save data to global
"RTN","IBCNERP8",116,0)
 S ^TMP($J,RTN,"IN")=$G(RPTDATA)
"RTN","IBCNERP8",117,0)
 ;
"RTN","IBCNERP8",118,0)
INX ; IN exit pt
"RTN","IBCNERP8",119,0)
 Q
"RTN","IBCNERP8",120,0)
 ;
"RTN","IBCNERP8",121,0)
OUT(RTN,BDT,EDT,TOT) ; Outgoing Data
"RTN","IBCNERP8",122,0)
 ;Input params:  RTN-routine name used as subscript in ^TMP($J),
"RTN","IBCNERP8",123,0)
 ; BDT-start date/time, EDT-end date/time, **TOT-total recs searched-used
"RTN","IBCNERP8",124,0)
 ; only for status checks when process is queued (passed by reference)
"RTN","IBCNERP8",125,0)
 ;Output vars: Set pcs of ^TMP($J,RTN,"OUT") as follows:
"RTN","IBCNERP8",126,0)
 ; 1=total Inqs transmitted for timeframe
"RTN","IBCNERP8",127,0)
 ; 2=Ins Buffer extract subtotal
"RTN","IBCNERP8",128,0)
 ; 3=Pre-Reg extract subtotal
"RTN","IBCNERP8",129,0)
 ; 4=Non-Ver extract subtotal
"RTN","IBCNERP8",130,0)
 ; 5=No Act Ins subtotal
"RTN","IBCNERP8",131,0)
 ; 6=MBI subtotal
"RTN","IBCNERP8",132,0)
 ;
"RTN","IBCNERP8",133,0)
 ; Init vars
"RTN","IBCNERP8",134,0)
 N IBDT,IBPTR,IBTYP,RPTDATA,TQIEN
"RTN","IBCNERP8",135,0)
 ;
"RTN","IBCNERP8",136,0)
 ; Loop thru the eIV Resp File (#365) by x-ref on Date/Time Resp Created
"RTN","IBCNERP8",137,0)
 ;  Only count responses for unique HL7 message IDs - filter out
"RTN","IBCNERP8",138,0)
 ;  unsolicited responses as they artificially inflate the Outgoing Count
"RTN","IBCNERP8",139,0)
 S IBDT=$O(^IBCN(365,"AE",BDT),-1)
"RTN","IBCNERP8",140,0)
 F  S IBDT=$O(^IBCN(365,"AE",IBDT)) Q:IBDT=""!(IBDT>EDT)  D  Q:$G(ZTSTOP)
"RTN","IBCNERP8",141,0)
 . S IBPTR=0
"RTN","IBCNERP8",142,0)
 . F  S IBPTR=$O(^IBCN(365,"AE",IBDT,IBPTR)) Q:'IBPTR  D  Q:$G(ZTSTOP)
"RTN","IBCNERP8",143,0)
 . . S TOT=TOT+1
"RTN","IBCNERP8",144,0)
 . . I $D(ZTQUEUED),TOT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 Q
"RTN","IBCNERP8",145,0)
 . . ; Quit, if response was not O - original
"RTN","IBCNERP8",146,0)
 . . I $P($G(^IBCN(365,IBPTR,0)),U,10)'="O" Q
"RTN","IBCNERP8",147,0)
 . . ; Update total
"RTN","IBCNERP8",148,0)
 . . S $P(RPTDATA,U,1)=$P($G(RPTDATA),U,1)+1
"RTN","IBCNERP8",149,0)
 . . ; Update extract type total (1,2,3,4)
"RTN","IBCNERP8",150,0)
 . . S TQIEN=$P($G(^IBCN(365,IBPTR,0)),U,5)
"RTN","IBCNERP8",151,0)
 . . I TQIEN="" Q
"RTN","IBCNERP8",152,0)
 . . ; IB*2.0*621
"RTN","IBCNERP8",153,0)
 . . ;S IBTYP=$P($G(^IBCN(365.1,TQIEN,0)),U,10)
"RTN","IBCNERP8",154,0)
 . . S IBTYP=$$GET1^DIQ(365.1,TQIEN_",",.1,"I")
"RTN","IBCNERP8",155,0)
 . . S IBQUERY=$$GET1^DIQ(365.1,TQIEN_",",.11,"I")
"RTN","IBCNERP8",156,0)
 . . S IBMBI=$$GET1^DIQ(365.1,TQIEN_",",.16,"I")
"RTN","IBCNERP8",157,0)
 . . I IBTYP'="" D
"RTN","IBCNERP8",158,0)
 . . . I IBTYP=3 Q
"RTN","IBCNERP8",159,0)
 . . . I IBTYP=1 D  Q
"RTN","IBCNERP8",160,0)
 . . . . I IBMBI="MBIrequest" S $P(RPTDATA,U,6)=$P($G(RPTDATA),U,6)+1 ; MBI Request
"RTN","IBCNERP8",161,0)
 . . . . I IBMBI'="MBIrequest" S $P(RPTDATA,U,IBTYP+1)=$P($G(RPTDATA),U,IBTYP+1)+1
"RTN","IBCNERP8",162,0)
 . . . I IBTYP=4 D  Q
"RTN","IBCNERP8",163,0)
 . . . . I IBQUERY="I" S $P(RPTDATA,U,4)=$P($G(RPTDATA),U,4)+1 ; EICD Queries
"RTN","IBCNERP8",164,0)
 . . . . I IBQUERY="V" S $P(RPTDATA,U,5)=$P($G(RPTDATA),U,5)+1 ; EICD Verification
"RTN","IBCNERP8",165,0)
 . . . S:IBTYP=2 $P(RPTDATA,U,3)=$P($G(RPTDATA),U,3)+1
"RTN","IBCNERP8",166,0)
 ;
"RTN","IBCNERP8",167,0)
 I $G(ZTSTOP) G OUTX
"RTN","IBCNERP8",168,0)
 ;
"RTN","IBCNERP8",169,0)
 ; Save data to global array
"RTN","IBCNERP8",170,0)
 S ^TMP($J,RTN,"OUT")=$G(RPTDATA)
"RTN","IBCNERP8",171,0)
 ;
"RTN","IBCNERP8",172,0)
OUTX ; OUT exit pt
"RTN","IBCNERP8",173,0)
 Q
"RTN","IBCNERP8",174,0)
 ;
"RTN","IBCNERP8",175,0)
CUR(RTN,BDT,EDT,TOT) ; Current Status - stats - timeframe independent
"RTN","IBCNERP8",176,0)
 ; Input params: RTN-routine name as subs in ^TMP($J), **TOT-total recs
"RTN","IBCNERP8",177,0)
 ;  searched - used only for status checks when the process is queued
"RTN","IBCNERP8",178,0)
 ;  passed by reference
"RTN","IBCNERP8",179,0)
 ; Output vars: Set pcs of ^TMP($J,RTN,"CUR") as follows:
"RTN","IBCNERP8",180,0)
 ;  1=total Pending Resps (Transmitted-2)
"RTN","IBCNERP8",181,0)
 ;  2=total Queued Inqs (Ready to Transmit-1/Retry-6)
"RTN","IBCNERP8",182,0)
 ;  3=total Deferred Inqs (Hold-4)
"RTN","IBCNERP8",183,0)
 ;  4=Ins Cos w/o National ID
"RTN","IBCNERP8",184,0)
 ;  5=Payers w/eIV disabled locally
"RTN","IBCNERP8",185,0)
 ;  6=total user action required (symbol'='*' or '#' or '!' or '?' or '-')
"RTN","IBCNERP8",186,0)
 ;  7=total Man. Ver'd Ins Buf entries (symbol='*')
"RTN","IBCNERP8",187,0)
 ;  8=total eIV Processed Ver. (symbol='+')
"RTN","IBCNERP8",188,0)
 ;  9=total awaiting processing (symbol='?' or BLANK)
"RTN","IBCNERP8",189,0)
 ;  10=total Ins Buf entries w/symbol='#'
"RTN","IBCNERP8",190,0)
 ;  11=total Ins Buf entries w/symbol='!'
"RTN","IBCNERP8",191,0)
 ;  12=total Ins Buf entries w/symbol='?'
"RTN","IBCNERP8",192,0)
 ;  13=total Ins Buf entries w/symbol='-'
"RTN","IBCNERP8",193,0)
 ;  14=total Ins Buffer entries w/symbol not in ('*','#','!','?','-')
"RTN","IBCNERP8",194,0)
 ;  15=total Ins Buffer entries w/symbol='$'
"RTN","IBCNERP8",195,0)
 ;  16=total Ins Buffet entries w/symbol= % ; IB*2.0*621 - Added 16-21
"RTN","IBCNERP8",196,0)
 ;  17=total Insurance Buffer
"RTN","IBCNERP8",197,0)
 ;  18=Total Appointment 
"RTN","IBCNERP8",198,0)
 ;  19=total Ele Ins Cov Discovery (EICD)
"RTN","IBCNERP8",199,0)
 ;  20=total EICD Triggered Einsurance Verification
"RTN","IBCNERP8",200,0)
 ;  21=total MBI Inquiry
"RTN","IBCNERP8",201,0)
 ;  ^TMP($J,RTN,"CUR","FLAGS","A",Payer name,N) = active flag timestamp ^ active flag setting
"RTN","IBCNERP8",202,0)
 ;  ^TMP($J,RTN,"CUR","FLAGS","T",Payer name,N) = trusted flag timestamp ^ trusted flag setting
"RTN","IBCNERP8",203,0)
 ;
"RTN","IBCNERP8",204,0)
 ; Init vars
"RTN","IBCNERP8",205,0)
 N RIEN,TQIEN,ICIEN,IBIEN,RPTDATA,IEN,IBSYMBOL,PIECE,IBSTS,APPIEN
"RTN","IBCNERP8",206,0)
 N PIEN,TMP,APPDATA,XDT,PDATA
"RTN","IBCNERP8",207,0)
 ;
"RTN","IBCNERP8",208,0)
 S RPTDATA=""
"RTN","IBCNERP8",209,0)
 ;
"RTN","IBCNERP8",210,0)
 ; Responses pending (Transmitted - 2)
"RTN","IBCNERP8",211,0)
 S RIEN=0
"RTN","IBCNERP8",212,0)
 F  S RIEN=$O(^IBCN(365,"AC",2,RIEN)) Q:'RIEN  D  Q:$G(ZTSTOP)
"RTN","IBCNERP8",213,0)
 .  S TOT=TOT+1
"RTN","IBCNERP8",214,0)
 .  I $D(ZTQUEUED),TOT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 Q
"RTN","IBCNERP8",215,0)
 .  S $P(RPTDATA,U,1)=$P(RPTDATA,U,1)+1
"RTN","IBCNERP8",216,0)
 .  ; IB*2.0*621
"RTN","IBCNERP8",217,0)
 .  S TQIEN=$P($G(^IBCN(365,RIEN,0)),U,5)
"RTN","IBCNERP8",218,0)
 .  I TQIEN="" Q
"RTN","IBCNERP8",219,0)
 .  S IBTYP=$$GET1^DIQ(365.1,TQIEN_",",.1,"I")
"RTN","IBCNERP8",220,0)
 .  S IBQUERY=$$GET1^DIQ(365.1,TQIEN_",",.11,"I")
"RTN","IBCNERP8",221,0)
 .  S IBMBI=$$GET1^DIQ(365.1,TQIEN_",",.16,"I")
"RTN","IBCNERP8",222,0)
 .  I IBTYP'="" D
"RTN","IBCNERP8",223,0)
 .  . I IBTYP=3 Q
"RTN","IBCNERP8",224,0)
 .  . I IBTYP=1 D  Q
"RTN","IBCNERP8",225,0)
 .  . . I IBMBI="MBIrequest" S $P(RPTDATA,U,21)=$P($G(RPTDATA),U,21)+1 ; MBI Request
"RTN","IBCNERP8",226,0)
 .  . . I IBMBI'="MBIrequest" S $P(RPTDATA,U,17)=$P($G(RPTDATA),U,17)+1 ; Insurance Buffer
"RTN","IBCNERP8",227,0)
 .  S:IBTYP=2 $P(RPTDATA,U,18)=$P($G(RPTDATA),U,18)+1 ; Appointment
"RTN","IBCNERP8",228,0)
 .  I IBTYP=4 D  Q
"RTN","IBCNERP8",229,0)
 .  . I IBQUERY="I" S $P(RPTDATA,U,19)=$P($G(RPTDATA),U,19)+1 ; EICD Queries
"RTN","IBCNERP8",230,0)
 .  . I IBQUERY="V" S $P(RPTDATA,U,20)=$P($G(RPTDATA),U,20)+1 ; EICD Verification
"RTN","IBCNERP8",231,0)
 .  ; IB*2.0*621 - End IN Group
"RTN","IBCNERP8",232,0)
 ;
"RTN","IBCNERP8",233,0)
 I $G(ZTSTOP) G CURX
"RTN","IBCNERP8",234,0)
 ;
"RTN","IBCNERP8",235,0)
 ; Queued inquiries (Ready to Transmit - 1/Retry - 6) and 
"RTN","IBCNERP8",236,0)
 ; Deferred inquiries (Hold - 4)
"RTN","IBCNERP8",237,0)
 F IBSTS=1,6,4 D  Q:$G(ZTSTOP)
"RTN","IBCNERP8",238,0)
 . S TQIEN=0
"RTN","IBCNERP8",239,0)
 . F  S TQIEN=$O(^IBCN(365.1,"AC",IBSTS,TQIEN)) Q:'TQIEN  D  Q:$G(ZTSTOP)
"RTN","IBCNERP8",240,0)
 . .  S TOT=TOT+1
"RTN","IBCNERP8",241,0)
 . .  I $D(ZTQUEUED),TOT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 QUIT
"RTN","IBCNERP8",242,0)
 . .  I IBSTS'=4 S $P(RPTDATA,U,2)=$P(RPTDATA,U,2)+1 Q
"RTN","IBCNERP8",243,0)
 . .  S $P(RPTDATA,U,3)=$P(RPTDATA,U,3)+1
"RTN","IBCNERP8",244,0)
 ;
"RTN","IBCNERP8",245,0)
 I $G(ZTSTOP) G CURX
"RTN","IBCNERP8",246,0)
 ;
"RTN","IBCNERP8",247,0)
 ; Payer stats
"RTN","IBCNERP8",248,0)
 ; Ins cos w/o National ID
"RTN","IBCNERP8",249,0)
 S ICIEN=0,$P(RPTDATA,U,4)=0
"RTN","IBCNERP8",250,0)
 F  S ICIEN=$O(^DIC(36,ICIEN)) Q:'ICIEN  D  Q:$G(ZTSTOP)
"RTN","IBCNERP8",251,0)
 .  S TOT=TOT+1
"RTN","IBCNERP8",252,0)
 .  I $D(ZTQUEUED),TOT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 QUIT
"RTN","IBCNERP8",253,0)
 .  ; Exclude inactive
"RTN","IBCNERP8",254,0)
 .  S TMP=$$ACTIVE^IBCNEUT4(ICIEN) I 'TMP Q
"RTN","IBCNERP8",255,0)
 .  ; Exclude Medicaid, etc.
"RTN","IBCNERP8",256,0)
 .  I $$EXCLUDE^IBCNEUT4($P(TMP,U,2)) Q
"RTN","IBCNERP8",257,0)
 .  ; Does a NATIONAL ID exist?
"RTN","IBCNERP8",258,0)
 .  ; VA CBO defines 'No National ID' as lack of EDI IDs - fields (#36,3.02) & (#36,3.04) 3/4/14
"RTN","IBCNERP8",259,0)
 .  ; This is *NOT* a check for the 'VA NATIONAL ID' associated with the linked payer
"RTN","IBCNERP8",260,0)
 .  I ($$GET1^DIQ(36,ICIEN_",",3.02)="")&($$GET1^DIQ(36,ICIEN_",",3.04)="") S $P(RPTDATA,U,4)=$P(RPTDATA,U,4)+1 Q
"RTN","IBCNERP8",261,0)
 .  Q
"RTN","IBCNERP8",262,0)
 .  ; Determine assoc Payer
"RTN","IBCNERP8",263,0)
 .  ;S PIEN=$P($G(^DIC(36,ICIEN,3)),U,10)
"RTN","IBCNERP8",264,0)
 .  ; Missing payer link
"RTN","IBCNERP8",265,0)
 .  ;I 'PIEN S $P(RPTDATA,U,4)=$P(RPTDATA,U,4)+1 Q
"RTN","IBCNERP8",266,0)
 .  ; Does a VA NATIONAL ID exist?
"RTN","IBCNERP8",267,0)
 .  ;I $P($G(^IBE(365.12,PIEN,0)),U,2)'="" Q
"RTN","IBCNERP8",268,0)
 .  ;S $P(RPTDATA,U,4)=$P(RPTDATA,U,4)+1
"RTN","IBCNERP8",269,0)
 ;
"RTN","IBCNERP8",270,0)
 I $G(ZTSTOP) G CURX
"RTN","IBCNERP8",271,0)
 ;
"RTN","IBCNERP8",272,0)
 ; eIV Payers disabled locally
"RTN","IBCNERP8",273,0)
 S PIEN=0
"RTN","IBCNERP8",274,0)
 F  S PIEN=$O(^IBE(365.12,PIEN)) Q:'PIEN  D  Q:$G(ZTSTOP)
"RTN","IBCNERP8",275,0)
 .  S TOT=TOT+1
"RTN","IBCNERP8",276,0)
 .  I $D(ZTQUEUED),TOT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 Q
"RTN","IBCNERP8",277,0)
 .  S PDATA=$G(^IBE(365.12,PIEN,0))
"RTN","IBCNERP8",278,0)
 .  ; Must have National ID
"RTN","IBCNERP8",279,0)
 .  I $P(PDATA,U,2)="" Q
"RTN","IBCNERP8",280,0)
 .  ; Get Payer app multiple IEN
"RTN","IBCNERP8",281,0)
 .  S APPIEN=$$PYRAPP^IBCNEUT5("IIV",PIEN)
"RTN","IBCNERP8",282,0)
 .  ; Must have eIV application
"RTN","IBCNERP8",283,0)
 .  I 'APPIEN Q
"RTN","IBCNERP8",284,0)
 .  ; Get Active/Trusted flag logs
"RTN","IBCNERP8",285,0)
 .  D GETFLAGS(PIEN,APPIEN,PDATA,BDT,EDT,.RPTDATA)
"RTN","IBCNERP8",286,0)
 .  ;
"RTN","IBCNERP8",287,0)
 .  S APPDATA=$G(^IBE(365.12,PIEN,1,APPIEN,0))
"RTN","IBCNERP8",288,0)
 .  ; Must be Nationally Active
"RTN","IBCNERP8",289,0)
 .  I '$P(APPDATA,U,2) Q
"RTN","IBCNERP8",290,0)
 .  ; Must not be Locally Active
"RTN","IBCNERP8",291,0)
 .  I $P(APPDATA,U,3) Q
"RTN","IBCNERP8",292,0)
 .  S $P(RPTDATA,U,5)=$P(RPTDATA,U,5)+1
"RTN","IBCNERP8",293,0)
 ;
"RTN","IBCNERP8",294,0)
 I $G(ZTSTOP) G CURX
"RTN","IBCNERP8",295,0)
 ;
"RTN","IBCNERP8",296,0)
 ; Buffer stats
"RTN","IBCNERP8",297,0)
 ; Loop thru the Ins Buffer File (#355.33)
"RTN","IBCNERP8",298,0)
 S IBIEN=0,XDT=0
"RTN","IBCNERP8",299,0)
 F  S XDT=$O(^IBA(355.33,"AEST","E",XDT)) Q:XDT=""  D  Q:$G(ZTSTOP)
"RTN","IBCNERP8",300,0)
 . F  S IBIEN=$O(^IBA(355.33,"AEST","E",XDT,IBIEN)) Q:IBIEN=""  D  Q:$G(ZTSTOP)
"RTN","IBCNERP8",301,0)
 . . S TOT=TOT+1
"RTN","IBCNERP8",302,0)
 . . I $D(ZTQUEUED),TOT#100=0,$$S^%ZTLOAD() S ZTSTOP=1 Q
"RTN","IBCNERP8",303,0)
 . . S IBSYMBOL=$$SYMBOL^IBCNBLL(IBIEN)
"RTN","IBCNERP8",304,0)
 . . ; Determine piece to update based on symbol
"RTN","IBCNERP8",305,0)
 . . ; ('*') = Man. Verified,  ('#','!','-','?',blank/null) = eIV Processing
"RTN","IBCNERP8",306,0)
 . . ; ('+') = eIV Processed, ('$') = Escalated, Active policy
"RTN","IBCNERP8",307,0)
 . . ; IB*2.0*506/taz Node 15 added.
"RTN","IBCNERP8",308,0)
 . . ; IB*2.0*621/ Node 16 Added.
"RTN","IBCNERP8",309,0)
 . . S PIECE=$S(IBSYMBOL="*":7,IBSYMBOL="+":8,IBSYMBOL="#":10,IBSYMBOL="!":11,IBSYMBOL="-":13,IBSYMBOL="?":12,IBSYMBOL="$":15,IBSYMBOL="%":16,1:14)
"RTN","IBCNERP8",310,0)
 . . I PIECE=12!(PIECE=14) S $P(RPTDATA,U,9)=$P($G(RPTDATA),U,9)+1
"RTN","IBCNERP8",311,0)
 . . E  S $P(RPTDATA,U,6)=$P($G(RPTDATA),U,6)+1
"RTN","IBCNERP8",312,0)
 . . S $P(RPTDATA,U,PIECE)=$P($G(RPTDATA),U,PIECE)+1
"RTN","IBCNERP8",313,0)
 ;
"RTN","IBCNERP8",314,0)
 I $G(ZTSTOP) G CURX
"RTN","IBCNERP8",315,0)
 ;
"RTN","IBCNERP8",316,0)
 ; Save data to global
"RTN","IBCNERP8",317,0)
 M ^TMP($J,RTN,"CUR")=RPTDATA
"RTN","IBCNERP8",318,0)
 ;
"RTN","IBCNERP8",319,0)
CURX ; CUR exit point
"RTN","IBCNERP8",320,0)
 Q
"RTN","IBCNERP8",321,0)
 ;
"RTN","IBCNERP8",322,0)
GETFLAGS(PIEN,APPIEN,PDATA,BDT,EDT,RPTDATA) ; get Active/Trusted flag logs
"RTN","IBCNERP8",323,0)
 ; PIEN - Payer ien in file 365.12
"RTN","IBCNERP8",324,0)
 ; APPIEN - Application ien in subfile 365.121
"RTN","IBCNERP8",325,0)
 ; PDATA - 0 node of Payer file entry
"RTN","IBCNERP8",326,0)
 ; BDT - Start date/time
"RTN","IBCNERP8",327,0)
 ; EDT - End date/time
"RTN","IBCNERP8",328,0)
 ; RPTDATA - output array, passed by reference
"RTN","IBCNERP8",329,0)
 ; 
"RTN","IBCNERP8",330,0)
 N FLAGS,IEN,PNAME,TYP,TM,VAL,Z
"RTN","IBCNERP8",331,0)
 S PNAME=$P(PDATA,U)
"RTN","IBCNERP8",332,0)
 F TYP=2,3 S TM=EDT,Z=0 F  S TM=$O(^IBE(365.12,PIEN,1,APPIEN,TYP,"B",TM),-1) Q:TM=""!($$FMDIFF^XLFDT(TM,BDT,2)'>0)  D
"RTN","IBCNERP8",333,0)
 .S IEN=$O(^IBE(365.12,PIEN,1,APPIEN,TYP,"B",TM,""))
"RTN","IBCNERP8",334,0)
 .S VAL=$$EXTERNAL^DILFD("365.121"_TYP,.02,,$P(^IBE(365.12,PIEN,1,APPIEN,TYP,IEN,0),U,2))
"RTN","IBCNERP8",335,0)
 .S Z=Z+1,RPTDATA("FLAGS",$S(TYP=2:"A",1:"T"),PNAME,Z)=$$FMTE^XLFDT(TM,"5ZS")_"^"_VAL
"RTN","IBCNERP8",336,0)
 .Q
"RTN","IBCNERP8",337,0)
 Q
"RTN","IBCNERP9")
0^24^B183172218^B133982311
"RTN","IBCNERP9",1,0)
IBCNERP9 ;DAOU/BHS - eIV STATISTICAL REPORT PRINT ;12-JUN-2002
"RTN","IBCNERP9",2,0)
 ;;2.0;INTEGRATED BILLING;**184,271,416,506,528,621**;21-MAR-94;Build 8
"RTN","IBCNERP9",3,0)
 ;;Per VA Directive 6402, this routine should not be modified.
"RTN","IBCNERP9",4,0)
 ;
"RTN","IBCNERP9",5,0)
 ; eIV - Insurance Verification Interface
"RTN","IBCNERP9",6,0)
 ;
"RTN","IBCNERP9",7,0)
 ; Input variables from IBCNERP7:
"RTN","IBCNERP9",8,0)
 ;  IBCNERTN = "IBCNERP7"
"RTN","IBCNERP9",9,0)
 ; **IBCNESPC array ONLY passed by reference
"RTN","IBCNERP9",10,0)
 ;  IBCNESPC("BEGDTM") = Start Date/Time for date/time report range
"RTN","IBCNERP9",11,0)
 ;  IBCNESPC("ENDDTM") = End Date/Time for date/time report range
"RTN","IBCNERP9",12,0)
 ;  IBCNESPC("SECTS") = 1 - All, includes all sections OR
"RTN","IBCNERP9",13,0)
 ;   list of one or more of the following:
"RTN","IBCNERP9",14,0)
 ;   2 - Outgoing Data, Inquiry Transmission data,
"RTN","IBCNERP9",15,0)
 ;   3 - Incoming Data, Inquiry Response data,
"RTN","IBCNERP9",16,0)
 ;   4 - General Data, Insurance Buffer data,
"RTN","IBCNERP9",17,0)
 ;   Communication Failures, Outstanding Inquiries
"RTN","IBCNERP9",18,0)
 ;   IBCNESPC("MM") = "", do not generate MailMan message OR
"RTN","IBCNERP9",19,0)
 ;                    MAILGROUP, mailgroup to send MailMan message to
"RTN","IBCNERP9",20,0)
 ;                               based on IB site parameter
"RTN","IBCNERP9",21,0)
 ;   Assumes report data exists in ^TMP($J,IBCNERTN,...)
"RTN","IBCNERP9",22,0)
 ;   Based on IBCNESPC("SECTS") parameter the following scratch globals
"RTN","IBCNERP9",23,0)
 ;   will be built
"RTN","IBCNERP9",24,0)
 ;   1 OR contains 2 --> 
"RTN","IBCNERP9",25,0)
 ;    ^TMP($J,RTN,"OUT")=TotInq^InsBufExtSubtotal^PreRegExtSubtotal^...
"RTN","IBCNERP9",26,0)
 ;                       NonVerifInsExtSubtotal^NoActInsExtSubtotal
"RTN","IBCNERP9",27,0)
 ;   1 OR contains 3 --> 
"RTN","IBCNERP9",28,0)
 ;    ^TMP($J,RTN,"IN")=TotResp^InsBufExtSubtotal^PreRegExtSubtotal^...
"RTN","IBCNERP9",29,0)
 ;                       NonVerifInsExtSubtotal^NoActInsExtSubtotal
"RTN","IBCNERP9",30,0)
 ;   1 OR contains 4 --> 
"RTN","IBCNERP9",31,0)
 ;    ^TMP($J,RTN,"CUR")=TotOutstandingInq^TotInqRetries^...
"RTN","IBCNERP9",32,0)
 ;                       TotInqCommFailure^TotInsBufVerified^...
"RTN","IBCNERP9",33,0)
 ;                       ManVerifedSubtotal^eIVProcessedSubtotal...
"RTN","IBCNERP9",34,0)
 ;                       TotInsBufUnverified^! InsBufSubtotal^...
"RTN","IBCNERP9",35,0)
 ;                       ? InsBufSubtotal^- InsBufSubtotal^...
"RTN","IBCNERP9",36,0)
 ;                       Other InsBufSubtotal^TQReadyToTransmit^...
"RTN","IBCNERP9",37,0)
 ;                       TQHold^TQRetry
"RTN","IBCNERP9",38,0)
 ;    and ^TMP($J,RTN","PYR",PAYER NAME,IEN of file 365.12)=""
"RTN","IBCNERP9",39,0)
 ;    IBOUT = "E" for Excel or "R" for report format        
"RTN","IBCNERP9",40,0)
 ; Must call at EN
"RTN","IBCNERP9",41,0)
 Q
"RTN","IBCNERP9",42,0)
 ;
"RTN","IBCNERP9",43,0)
EN(IBCNERTN,IBCNESPC,IBOUT) ; Entry pt
"RTN","IBCNERP9",44,0)
 ;
"RTN","IBCNERP9",45,0)
 ; Init vars
"RTN","IBCNERP9",46,0)
 N CRT,MAXCNT,IBPXT,IBPGC,IBBDT,IBEDT,IBSCT,IBMM,RETRY,OUTINQ,ATTEMPT
"RTN","IBCNERP9",47,0)
 N X,Y,DIR,DTOUT,DUOUT,LIN,IBMBI,IBQUERY
"RTN","IBCNERP9",48,0)
 ;
"RTN","IBCNERP9",49,0)
 S IBBDT=$G(IBCNESPC("BEGDTM")),IBEDT=$G(IBCNESPC("ENDDTM"))
"RTN","IBCNERP9",50,0)
 S IBSCT=$G(IBCNESPC("SECTS")),IBMM=$G(IBCNESPC("MM"))
"RTN","IBCNERP9",51,0)
 ;
"RTN","IBCNERP9",52,0)
 S (IBPXT,IBPGC,CRT,MAXCNT)=0
"RTN","IBCNERP9",53,0)
 ;
"RTN","IBCNERP9",54,0)
 ; Determine IO parameters if output device is NOT MailMan message
"RTN","IBCNERP9",55,0)
 I IBMM="" D
"RTN","IBCNERP9",56,0)
 . I IOST["C-" S MAXCNT=IOSL-3,CRT=1 Q
"RTN","IBCNERP9",57,0)
 . S MAXCNT=IOSL-6,CRT=0
"RTN","IBCNERP9",58,0)
 ;
"RTN","IBCNERP9",59,0)
 D PRINT(IBCNERTN,IBBDT,IBEDT,IBSCT,IBMM,.IBPGC,.IBPXT,MAXCNT,CRT,IBOUT)
"RTN","IBCNERP9",60,0)
 I $G(ZTSTOP)!IBPXT G EXIT
"RTN","IBCNERP9",61,0)
 I CRT,IBPGC>0,'$D(ZTQUEUED) D  G EXIT
"RTN","IBCNERP9",62,0)
 . I MAXCNT<51 F LIN=1:1:(MAXCNT-$Y) W !
"RTN","IBCNERP9",63,0)
 . S DIR(0)="E" D ^DIR K DIR
"RTN","IBCNERP9",64,0)
 ;
"RTN","IBCNERP9",65,0)
EXIT ; Exit pt
"RTN","IBCNERP9",66,0)
 Q
"RTN","IBCNERP9",67,0)
 ;
"RTN","IBCNERP9",68,0)
 ;
"RTN","IBCNERP9",69,0)
PRINT(RTN,BDT,EDT,SCT,MM,PGC,PXT,MAX,CRT,IBOUT) ; Print data
"RTN","IBCNERP9",70,0)
 ; Init vars
"RTN","IBCNERP9",71,0)
 N EORMSG,NONEMSG,LINECT,DISPDATA,HDRDATA,OFFSET,TMP,DTMRNG,SITE
"RTN","IBCNERP9",72,0)
 ;
"RTN","IBCNERP9",73,0)
 S LINECT=0
"RTN","IBCNERP9",74,0)
 ;
"RTN","IBCNERP9",75,0)
 ; Build End-Of-Report Message for display
"RTN","IBCNERP9",76,0)
 S EORMSG="*** END OF REPORT ***"
"RTN","IBCNERP9",77,0)
 S OFFSET=80-$L(EORMSG)\2
"RTN","IBCNERP9",78,0)
 S EORMSG=$$FO^IBCNEUT1(EORMSG,OFFSET+$L(EORMSG),"R")
"RTN","IBCNERP9",79,0)
 ; Build No-Data-Found Message for display
"RTN","IBCNERP9",80,0)
 S NONEMSG="* * * N O  D A T A  F O U N D * * *"
"RTN","IBCNERP9",81,0)
 S OFFSET=80-$L(NONEMSG)\2
"RTN","IBCNERP9",82,0)
 S NONEMSG=$$FO^IBCNEUT1(NONEMSG,OFFSET+$L(NONEMSG),"R")
"RTN","IBCNERP9",83,0)
 ; Build Site for display
"RTN","IBCNERP9",84,0)
 S SITE=$P($$SITE^VASITE,U,2)
"RTN","IBCNERP9",85,0)
 ; Build Date/Time Range for display
"RTN","IBCNERP9",86,0)
 ;  Build Date/Time display for Starting date/time
"RTN","IBCNERP9",87,0)
 S TMP=$$FMTE^XLFDT(BDT,"5Z")
"RTN","IBCNERP9",88,0)
 S DTMRNG=$P(TMP,"@")_" "_$P(TMP,"@",2)
"RTN","IBCNERP9",89,0)
 ;  Calculate Date/Time display for Ending date/time
"RTN","IBCNERP9",90,0)
 S TMP=$$FMTE^XLFDT(EDT,"5Z")
"RTN","IBCNERP9",91,0)
 S DTMRNG=DTMRNG_" - "_$P(TMP,"@")_" "_$P(TMP,"@",2)
"RTN","IBCNERP9",92,0)
 ;
"RTN","IBCNERP9",93,0)
 ; Print header to DISPDATA for MailMan message ONLY
"RTN","IBCNERP9",94,0)
 I IBOUT="R" D HEADER^IBCNERP0(.HDRDATA,.PGC,.PXT,MAX,CRT,SITE,DTMRNG,MM)
"RTN","IBCNERP9",95,0)
 I MM'="" M DISPDATA=HDRDATA S LINECT=+$O(DISPDATA(""),-1)
"RTN","IBCNERP9",96,0)
 I MM="" KILL HDRDATA
"RTN","IBCNERP9",97,0)
 ;
"RTN","IBCNERP9",98,0)
 ; If global does not exist - display No Data message
"RTN","IBCNERP9",99,0)
 I '$D(^TMP($J,RTN)) S LINECT=LINECT+1,DISPDATA(LINECT)=NONEMSG G PRINT2
"RTN","IBCNERP9",100,0)
 ;
"RTN","IBCNERP9",101,0)
 ; Display Outgoing Data - if selected
"RTN","IBCNERP9",102,0)
 I SCT=1!(SCT[2) D  I PXT!$G(ZTSTOP) G PRINTX
"RTN","IBCNERP9",103,0)
 . ; Build lines of data to display
"RTN","IBCNERP9",104,0)
 . D DATA(.DISPDATA,.LINECT,RTN,"OUT",MM,IBOUT)
"RTN","IBCNERP9",105,0)
 ;
"RTN","IBCNERP9",106,0)
 ; Display Incoming Data - if selected
"RTN","IBCNERP9",107,0)
 I SCT=1!(SCT[3) D  I PXT!$G(ZTSTOP) G PRINTX
"RTN","IBCNERP9",108,0)
 . ; Build lines of data to display
"RTN","IBCNERP9",109,0)
 . D DATA(.DISPDATA,.LINECT,RTN,"IN",MM,IBOUT)
"RTN","IBCNERP9",110,0)
 ;
"RTN","IBCNERP9",111,0)
 ; Display General Data - if selected
"RTN","IBCNERP9",112,0)
 I SCT=1!(SCT[4) D  I PXT!$G(ZTSTOP) G PRINTX
"RTN","IBCNERP9",113,0)
 . ; Build lines of data to display
"RTN","IBCNERP9",114,0)
 . D DATA(.DISPDATA,.LINECT,RTN,"CUR",MM,IBOUT)
"RTN","IBCNERP9",115,0)
 . D DATA(.DISPDATA,.LINECT,RTN,"PYR",MM,IBOUT)
"RTN","IBCNERP9",116,0)
 . D DATA(.DISPDATA,.LINECT,RTN,"FLG",MM,IBOUT)
"RTN","IBCNERP9",117,0)
 ;
"RTN","IBCNERP9",118,0)
PRINT2 S LINECT=LINECT+1
"RTN","IBCNERP9",119,0)
 S DISPDATA(LINECT)=EORMSG
"RTN","IBCNERP9",120,0)
 ;
"RTN","IBCNERP9",121,0)
 I MM="" D LINE(.DISPDATA,.PGC,.PXT,MAX,CRT,SITE,DTMRNG,MM)
"RTN","IBCNERP9",122,0)
 ; Generate MailMan message, if flag is set
"RTN","IBCNERP9",123,0)
 I MM'="" D MSG^IBCNEUT5(MM,"** eIV Statistical Rpt **","DISPDATA(")
"RTN","IBCNERP9",124,0)
 ;
"RTN","IBCNERP9",125,0)
PRINTX ; PRINT exit pt
"RTN","IBCNERP9",126,0)
 Q
"RTN","IBCNERP9",127,0)
 ;
"RTN","IBCNERP9",128,0)
LINE(DISPDATA,PGC,PXT,MAX,CRT,SITE,DTMRNG,MM) ; Print line of data
"RTN","IBCNERP9",129,0)
 ; Init vars
"RTN","IBCNERP9",130,0)
 N CT,II,ARRAY,NWPG
"RTN","IBCNERP9",131,0)
 ;
"RTN","IBCNERP9",132,0)
 S NWPG=0
"RTN","IBCNERP9",133,0)
 S CT=+$O(DISPDATA(""),-1)
"RTN","IBCNERP9",134,0)
 I $Y+1+CT>MAX,PGC>1 D HEADER^IBCNERP0(.ARRAY,.PGC,.PXT,MAX,CRT,SITE,DTMRNG,MM) S NWPG=1 I PXT!$G(ZTSTOP) G LINEX
"RTN","IBCNERP9",135,0)
 F II=1:1:CT D  Q:PXT!$G(ZTSTOP)
"RTN","IBCNERP9",136,0)
 . I $Y+1>MAX!('PGC) D HEADER^IBCNERP0(.ARRAY,.PGC,.PXT,MAX,CRT,SITE,DTMRNG,MM) S NWPG=1 I PXT!$G(ZTSTOP) Q
"RTN","IBCNERP9",137,0)
 . I 'NWPG!(NWPG&($D(DISPDATA(II)))) I $G(DISPDATA(II))'="" W !,?1,DISPDATA(II)
"RTN","IBCNERP9",138,0)
 . I NWPG S NWPG=0
"RTN","IBCNERP9",139,0)
 ;
"RTN","IBCNERP9",140,0)
LINEX ; LINE exit pt
"RTN","IBCNERP9",141,0)
 Q
"RTN","IBCNERP9",142,0)
 ;
"RTN","IBCNERP9",143,0)
DATA(DISPDATA,LINECT,RTN,TYPE,MM,IBOUT) ; Format lines of data to be printed
"RTN","IBCNERP9",144,0)
 ; Init vars
"RTN","IBCNERP9",145,0)
 ; 528 - baa : added code to output to Excel 
"RTN","IBCNERP9",146,0)
 N DASHES,PEND,RPTDATA,CT,DEFINQ,INSCOS,PAYERS,QUEINQ,TXT,TYPE1
"RTN","IBCNERP9",147,0)
 ;
"RTN","IBCNERP9",148,0)
 S $P(DASHES,"=",14)="",TYPE1=TYPE ; IB*2.0*621
"RTN","IBCNERP9",149,0)
 I LINECT>0,MM="" S LINECT=LINECT+1,DISPDATA(LINECT)=""
"RTN","IBCNERP9",150,0)
 ;
"RTN","IBCNERP9",151,0)
 ; Copy report data to local variable
"RTN","IBCNERP9",152,0)
 S RPTDATA=$G(^TMP($J,RTN,TYPE))      ; does not work for "PYR"
"RTN","IBCNERP9",153,0)
 ; Outgoing and Incoming Totals
"RTN","IBCNERP9",154,0)
 I TYPE="OUT"!(TYPE="IN") D  S:IBOUT="R" LINECT=LINECT+1,DISPDATA(LINECT)=" " G DATAX  ; IB*2.0*621 
"RTN","IBCNERP9",155,0)
 . S LINECT=LINECT+1
"RTN","IBCNERP9",156,0)
 . I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1($S(TYPE="OUT":"Outgoing Data (Inquiries Sent)",1:"Incoming Data (Responses Received)"),46)_$$FO^IBCNEUT1(+$P(RPTDATA,U,1),14,"R") ; IB*2.0*621 
"RTN","IBCNERP9",157,0)
 . I IBOUT="E" S DISPDATA(LINECT)=$S(TYPE="OUT":"OUTGOING DATA",1:"INCOMING DATA")_U_+$P(RPTDATA,U,1)
"RTN","IBCNERP9",158,0)
 . S LINECT=LINECT+1
"RTN","IBCNERP9",159,0)
 . I IBOUT="R" S DISPDATA(LINECT)=DASHES ; IB*2.0*621
"RTN","IBCNERP9",160,0)
 . F CT=1:1:5 D  ; Updated for IB*2.0*621
"RTN","IBCNERP9",161,0)
 . . N TYPE ; 
"RTN","IBCNERP9",162,0)
 . . I TYPE1="IN" S TYPE=$S(CT=1:"Insurance Buffer",CT=2:"Appointment",CT=3:"Electronic Insurance Coverage Discovery (EICD)",CT=4:"EICD-Triggered eInsurance Verification",CT=5:"MBI Response")
"RTN","IBCNERP9",163,0)
 . . I TYPE1="OUT" S TYPE=$S(CT=1:"Insurance Buffer",CT=2:"Appointment",CT=3:"Electronic Insurance Coverage Discovery (EICD)",CT=4:"EICD-Triggered eInsurance Verification",CT=5:"MBI Inquiry")
"RTN","IBCNERP9",164,0)
 . . S LINECT=LINECT+1
"RTN","IBCNERP9",165,0)
 . . I IBOUT="E" S DISPDATA(LINECT)=TYPE_U_+$P(RPTDATA,U,CT+1)
"RTN","IBCNERP9",166,0)
 . . I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1("   "_TYPE,50)_$$FO^IBCNEUT1(+$P(RPTDATA,U,CT+1),25,"R")
"RTN","IBCNERP9",167,0)
 ;
"RTN","IBCNERP9",168,0)
 ; General Data
"RTN","IBCNERP9",169,0)
 I TYPE="CUR" D  G DATAX
"RTN","IBCNERP9",170,0)
 . S LINECT=LINECT+1 ; IB*2.0*621 - Added Status Label
"RTN","IBCNERP9",171,0)
 . I IBOUT="R" S DISPDATA(LINECT)="Current Status"
"RTN","IBCNERP9",172,0)
 . I IBOUT="E" S DISPDATA(LINECT)="CURRENT STATUS"
"RTN","IBCNERP9",173,0)
 . I IBOUT="R" S LINECT=LINECT+1
"RTN","IBCNERP9",174,0)
 . I IBOUT="R" S DISPDATA(LINECT)="=============="
"RTN","IBCNERP9",175,0)
 . ; Responses Pending
"RTN","IBCNERP9",176,0)
 . S PEND=+$P(RPTDATA,U,1)
"RTN","IBCNERP9",177,0)
 . S LINECT=LINECT+1
"RTN","IBCNERP9",178,0)
 . I IBOUT="E" S DISPDATA(LINECT)="Responses Pending"_U_PEND
"RTN","IBCNERP9",179,0)
 . I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1("Responses Pending:",46)_$$FO^IBCNEUT1(PEND,14,"R")
"RTN","IBCNERP9",180,0)
 . ; IB*2.0*621
"RTN","IBCNERP9",181,0)
 . ; Insurance Buffer
"RTN","IBCNERP9",182,0)
 . S PEND=+$P(RPTDATA,U,17)
"RTN","IBCNERP9",183,0)
 . S LINECT=LINECT+1
"RTN","IBCNERP9",184,0)
 . I IBOUT="E" S DISPDATA(LINECT)="Insurance Buffer"_U_PEND
"RTN","IBCNERP9",185,0)
 . I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1("   Insurance Buffer",60)_$$FO^IBCNEUT1(PEND,15,"R")
"RTN","IBCNERP9",186,0)
 . ; Appointment
"RTN","IBCNERP9",187,0)
 . S PEND=+$P(RPTDATA,U,18)
"RTN","IBCNERP9",188,0)
 . S LINECT=LINECT+1
"RTN","IBCNERP9",189,0)
 . I IBOUT="E" S DISPDATA(LINECT)="Appointment"_U_PEND
"RTN","IBCNERP9",190,0)
 . I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1("   Appointment",60)_$$FO^IBCNEUT1(PEND,15,"R")
"RTN","IBCNERP9",191,0)
 . ; Electronic Insurance Coverage Discovery (EICD)
"RTN","IBCNERP9",192,0)
 . S PEND=+$P(RPTDATA,U,19)
"RTN","IBCNERP9",193,0)
 . S LINECT=LINECT+1
"RTN","IBCNERP9",194,0)
 . I IBOUT="E" S DISPDATA(LINECT)="Electronic Insurance Coverage Discovery (EICD)"_U_PEND
"RTN","IBCNERP9",195,0)
 . I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1("   Electronic Insurance Coverage Discovery (EICD)",60)_$$FO^IBCNEUT1(PEND,15,"R")
"RTN","IBCNERP9",196,0)
 . ; EICD-Triggered eInsurance Verification
"RTN","IBCNERP9",197,0)
 . S PEND=+$P(RPTDATA,U,20)
"RTN","IBCNERP9",198,0)
 . S LINECT=LINECT+1
"RTN","IBCNERP9",199,0)
 . I IBOUT="E" S DISPDATA(LINECT)="EICD-Triggered eInsurance Verification"_U_PEND
"RTN","IBCNERP9",200,0)
 . I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1("   EICD-Triggered eInsurance Verification",60)_$$FO^IBCNEUT1(PEND,15,"R")
"RTN","IBCNERP9",201,0)
 . ; MBI Inquiry
"RTN","IBCNERP9",202,0)
 . S PEND=+$P(RPTDATA,U,21)
"RTN","IBCNERP9",203,0)
 . S LINECT=LINECT+1
"RTN","IBCNERP9",204,0)
 . I IBOUT="E" S DISPDATA(LINECT)="MBI Inquiry"_U_PEND
"RTN","IBCNERP9",205,0)
 . I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1("   MBI Inquiry",60)_$$FO^IBCNEUT1(PEND,15,"R")
"RTN","IBCNERP9",206,0)
 . ; IB*2.0*621 - End
"RTN","IBCNERP9",207,0)
 . ; Queued Inqs
"RTN","IBCNERP9",208,0)
 . S QUEINQ=+$P(RPTDATA,U,2)
"RTN","IBCNERP9",209,0)
 . S LINECT=LINECT+1
"RTN","IBCNERP9",210,0)
 . I IBOUT="E" S DISPDATA(LINECT)="Queued Inquiries"_U_QUEINQ
"RTN","IBCNERP9",211,0)
 . I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1("Queued Inquiries:",46)_$$FO^IBCNEUT1(QUEINQ,14,"R")
"RTN","IBCNERP9",212,0)
 . ; Deferred Inqs
"RTN","IBCNERP9",213,0)
 . S DEFINQ=+$P(RPTDATA,U,3)
"RTN","IBCNERP9",214,0)
 . S LINECT=LINECT+1
"RTN","IBCNERP9",215,0)
 . I IBOUT="E" S DISPDATA(LINECT)="Deferred Inquiries:"_U_DEFINQ
"RTN","IBCNERP9",216,0)
 . I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1("Deferred Inquiries:",46)_$$FO^IBCNEUT1(DEFINQ,14,"R")
"RTN","IBCNERP9",217,0)
 . ; Ins Cos w/o Nat ID
"RTN","IBCNERP9",218,0)
 . S INSCOS=+$P(RPTDATA,U,4)
"RTN","IBCNERP9",219,0)
 . S LINECT=LINECT+1
"RTN","IBCNERP9",220,0)
 . I IBOUT="E" S DISPDATA(LINECT)="Insurance Companies w/o National ID"_U_INSCOS
"RTN","IBCNERP9",221,0)
 . I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1("Insurance Companies w/o National ID:",46)_$$FO^IBCNEUT1(INSCOS,14,"R")
"RTN","IBCNERP9",222,0)
 . ; Payers disabled locally
"RTN","IBCNERP9",223,0)
 . S PAYERS=+$P(RPTDATA,U,5)
"RTN","IBCNERP9",224,0)
 . S LINECT=LINECT+1
"RTN","IBCNERP9",225,0)
 . I IBOUT="E" S DISPDATA(LINECT)="eIV Payers Disabled Locally"_U_PAYERS
"RTN","IBCNERP9",226,0)
 . I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1("eIV Payers Disabled Locally:",46)_$$FO^IBCNEUT1(PAYERS,14,"R")
"RTN","IBCNERP9",227,0)
 . I IBOUT="R" S LINECT=LINECT+1
"RTN","IBCNERP9",228,0)
 . I IBOUT="R" S DISPDATA(LINECT)=" "
"RTN","IBCNERP9",229,0)
 . ; Insurance Buffer statistics
"RTN","IBCNERP9",230,0)
 . S LINECT=LINECT+1
"RTN","IBCNERP9",231,0)
 . I IBOUT="E" S DISPDATA(LINECT)="Insurance Buffer Entries: "_U_($P(RPTDATA,U,6)+$P(RPTDATA,U,9))
"RTN","IBCNERP9",232,0)
 . I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1("Insurance Buffer Entries: ",46)_$$FO^IBCNEUT1(($P(RPTDATA,U,9)+$P(RPTDATA,U,9)),14,"R")
"RTN","IBCNERP9",233,0)
 . ; *,+,#,! or -  symbol entries - User action required
"RTN","IBCNERP9",234,0)
 . S LINECT=LINECT+1
"RTN","IBCNERP9",235,0)
 . I IBOUT="E" S DISPDATA(LINECT)="User Action Required"_U_+$P(RPTDATA,U,6)
"RTN","IBCNERP9",236,0)
 . I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1("  User Action Required: ",46)_$$FO^IBCNEUT1(+$P(RPTDATA,U,6),22,"R")
"RTN","IBCNERP9",237,0)
 . I IBOUT="R" F CT=8,15,16,13,10,11 D  ; IB*2.0*621
"RTN","IBCNERP9",238,0)
 . . S LINECT=LINECT+1
"RTN","IBCNERP9",239,0)
 . . ; Added # to report
"RTN","IBCNERP9",240,0)
 . . S TYPE="    # of "
"RTN","IBCNERP9",241,0)
 . . I CT=7 S TXT="* entries (User Verified policy)"
"RTN","IBCNERP9",242,0)
 . . I CT=8 S TXT="+ entries (Payer indicated Active policy)"
"RTN","IBCNERP9",243,0)
 . . I CT=10 S TXT="# entries (Policy status undetermined)"
"RTN","IBCNERP9",244,0)
 . . I CT=11 S TXT="! entries (eIV needs user assistance for entry)"
"RTN","IBCNERP9",245,0)
 . . I CT=13 S TXT="- entries (Payer indicated Inactive policy)"
"RTN","IBCNERP9",246,0)
 . . I CT=15 S TXT="$ entries (Escalated, Active policy)"
"RTN","IBCNERP9",247,0)
 . . I CT=16 S TXT="% entries (MBI value received)" ; IB*2.0*621
"RTN","IBCNERP9",248,0)
 . . S TYPE=TYPE_TXT
"RTN","IBCNERP9",249,0)
 . . S DISPDATA(LINECT)=$$FO^IBCNEUT1(TYPE,56)_$$FO^IBCNEUT1(+$P(RPTDATA,U,CT),19,"R")
"RTN","IBCNERP9",250,0)
 . ;
"RTN","IBCNERP9",251,0)
 . S LINECT=LINECT+1
"RTN","IBCNERP9",252,0)
 . I IBOUT="E" S DISPDATA(LINECT)="Entries Awaiting Processing"_U_+$P(RPTDATA,U,9)
"RTN","IBCNERP9",253,0)
 . I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1("  Entries Awaiting Processing: ",46)_$$FO^IBCNEUT1(+$P(RPTDATA,U,9),22,"R")
"RTN","IBCNERP9",254,0)
 . ; Subtotal of ? entries (eIV is waiting for a response)
"RTN","IBCNERP9",255,0)
 . S LINECT=LINECT+1
"RTN","IBCNERP9",256,0)
 . I IBOUT="E" S DISPDATA(LINECT)="# of ? entries (eIV is waiting for a response)"_U_+$P(RPTDATA,U,12)
"RTN","IBCNERP9",257,0)
 . I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1("    # of ? entries (eIV is waiting for a response)",56)_$$FO^IBCNEUT1(+$P(RPTDATA,U,12),19,"R")
"RTN","IBCNERP9",258,0)
 . ; Subtotal of blank entries (yet to be processed or accepted)
"RTN","IBCNERP9",259,0)
 . S LINECT=LINECT+1
"RTN","IBCNERP9",260,0)
 . I IBOUT="E" S DISPDATA(LINECT)="# of blank entries (yet to be processed or accepted)"_U_+$P(RPTDATA,U,14)
"RTN","IBCNERP9",261,0)
 . I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1("    # of blank entries (yet to be processed or accepted)",56)_$$FO^IBCNEUT1(+$P(RPTDATA,U,14),19,"R")
"RTN","IBCNERP9",262,0)
 ;
"RTN","IBCNERP9",263,0)
 ; Blank Line 
"RTN","IBCNERP9",264,0)
 S LINECT=LINECT+1 ; IB*2.0*621 
"RTN","IBCNERP9",265,0)
 I IBOUT="R" S DISPDATA(LINECT)=" " ; IB*2.0*621 
"RTN","IBCNERP9",266,0)
 ; New Payers added to File 365.12
"RTN","IBCNERP9",267,0)
 I TYPE="PYR" D  G DATAX
"RTN","IBCNERP9",268,0)
 . ; Payers added to file 365.12
"RTN","IBCNERP9",269,0)
 . D DATAX
"RTN","IBCNERP9",270,0)
 . S LINECT=LINECT+1 ; IB*2.0*621
"RTN","IBCNERP9",271,0)
 . I IBOUT="E" S DISPDATA(LINECT)="PAYER ACTIVITY (During Report Date Range)" ; IB*2.0*621
"RTN","IBCNERP9",272,0)
 . I IBOUT="R" S DISPDATA(LINECT)="Payer Activity (During Report Date Range)" ; IB*2.0*621
"RTN","IBCNERP9",273,0)
 . I IBOUT="R" S LINECT=LINECT+1
"RTN","IBCNERP9",274,0)
 . I IBOUT="R" S DISPDATA(LINECT)="=============="
"RTN","IBCNERP9",275,0)
 . S LINECT=LINECT+1
"RTN","IBCNERP9",276,0)
 . S DISPDATA(LINECT)="New eIV Payers received"
"RTN","IBCNERP9",277,0)
 . S LINECT=LINECT+1
"RTN","IBCNERP9",278,0)
 . I '$D(^TMP($J,RTN,TYPE)) S DISPDATA(LINECT)=" No new Payers added" Q
"RTN","IBCNERP9",279,0)
 . S DISPDATA(LINECT)="  Please link the associated active insurance companies to these payers at your"
"RTN","IBCNERP9",280,0)
 . S LINECT=LINECT+1,DISPDATA(LINECT)="  earliest convenience.  Locally activate the payers after you link insurance"
"RTN","IBCNERP9",281,0)
 . S LINECT=LINECT+1,DISPDATA(LINECT)="  companies to them.  For further details regarding this process, please refer"
"RTN","IBCNERP9",282,0)
 . S LINECT=LINECT+1,DISPDATA(LINECT)="  to the Integrated Billing eIV Interface User Guide."
"RTN","IBCNERP9",283,0)
 . N PYR,PIEN
"RTN","IBCNERP9",284,0)
 . S PYR="",PIEN="" F  S PYR=$O(^TMP($J,RTN,TYPE,PYR)) Q:PYR=""  D
"RTN","IBCNERP9",285,0)
 . . F  S PIEN=$O(^TMP($J,RTN,TYPE,PYR,PIEN)) Q:'PIEN  D
"RTN","IBCNERP9",286,0)
 . . . S LINECT=LINECT+1
"RTN","IBCNERP9",287,0)
 . . . I IBOUT="E" S DISPDATA(LINECT)=PYR Q
"RTN","IBCNERP9",288,0)
 . . . I IBOUT="R" S DISPDATA(LINECT)="    "_PYR
"RTN","IBCNERP9",289,0)
 ;
"RTN","IBCNERP9",290,0)
 ; Active/Trusted flag logs
"RTN","IBCNERP9",291,0)
 I TYPE="FLG" D  G DATAX ; IB*2.0*621 Added Payer Received
"RTN","IBCNERP9",292,0)
 .N DATA,PNAME,Z,FLG
"RTN","IBCNERP9",293,0)
 .F FLG="A","T" D
"RTN","IBCNERP9",294,0)
 ..I FLG="A" D
"RTN","IBCNERP9",295,0)
 ...I IBOUT="R" S DISPDATA(LINECT)=" "
"RTN","IBCNERP9",296,0)
 ...S LINECT=LINECT+1,DISPDATA(LINECT)="National Payers - ACTIVE flag changes at FSC:"
"RTN","IBCNERP9",297,0)
 ...Q
"RTN","IBCNERP9",298,0)
 ..I FLG="T" D
"RTN","IBCNERP9",299,0)
 ...I IBOUT="R" S LINECT=LINECT+1,DISPDATA(LINECT)=" "
"RTN","IBCNERP9",300,0)
 ...S LINECT=LINECT+1,DISPDATA(LINECT)="Nationally Active Payers - TRUSTED flag changes at FSC:"
"RTN","IBCNERP9",301,0)
 ...Q
"RTN","IBCNERP9",302,0)
 ..I '$D(^TMP($J,RTN,"CUR","FLAGS",FLG)) S LINECT=LINECT+1,DISPDATA(LINECT)=" No information available",LINECT=LINECT+1 Q
"RTN","IBCNERP9",303,0)
 ..S PNAME="" F  S PNAME=$O(^TMP($J,RTN,"CUR","FLAGS",FLG,PNAME)) Q:PNAME=""  D
"RTN","IBCNERP9",304,0)
 ...S Z="" F  S Z=$O(^TMP($J,RTN,"CUR","FLAGS",FLG,PNAME,Z)) Q:Z=""  D
"RTN","IBCNERP9",305,0)
 ....S DATA=$G(^TMP($J,RTN,"CUR","FLAGS",FLG,PNAME,Z))
"RTN","IBCNERP9",306,0)
 ....S LINECT=LINECT+1
"RTN","IBCNERP9",307,0)
 ....I IBOUT="E" S DISPDATA(LINECT)=PNAME_U_$P(DATA,U)_U_$P(DATA,U,2)
"RTN","IBCNERP9",308,0)
 ....I IBOUT="R" S DISPDATA(LINECT)=$$FO^IBCNEUT1(" "_PNAME,47)_$$FO^IBCNEUT1($P(DATA,U),19)_" Set: "_$P(DATA,U,2)
"RTN","IBCNERP9",309,0)
 ....Q
"RTN","IBCNERP9",310,0)
 ...Q
"RTN","IBCNERP9",311,0)
 .Q
"RTN","IBCNERP9",312,0)
DATAX ; DATA exit pt
"RTN","IBCNERP9",313,0)
 S LINECT=LINECT+1
"RTN","IBCNERP9",314,0)
 S DISPDATA(LINECT)=""
"RTN","IBCNERP9",315,0)
 Q
"RTN","IBCNERP9",316,0)
 ;
"RTN","IBCNEUT5")
0^25^B63252821^B57334702
"RTN","IBCNEUT5",1,0)
IBCNEUT5 ;DAOU/ALA - eIV MISC. UTILITIES ;20-JUN-2002
"RTN","IBCNEUT5",2,0)
 ;;2.0;INTEGRATED BILLING;**184,284,271,416,621**;21-MAR-94;Build 8
"RTN","IBCNEUT5",3,0)
 ;;Per VHA Directive 6402, this routine should not be modified.
"RTN","IBCNEUT5",4,0)
 ;
"RTN","IBCNEUT5",5,0)
 ;**Program Description**
"RTN","IBCNEUT5",6,0)
 ;  This program contains some general utilities or functions
"RTN","IBCNEUT5",7,0)
 ;
"RTN","IBCNEUT5",8,0)
 Q
"RTN","IBCNEUT5",9,0)
 ;
"RTN","IBCNEUT5",10,0)
MSG(MGRP,XMSUB,XMTEXT,FROMFLAG,XMY) ;  Send a MailMan Message
"RTN","IBCNEUT5",11,0)
 ;
"RTN","IBCNEUT5",12,0)
 ;  Input Parameters
"RTN","IBCNEUT5",13,0)
 ;   MGRP = Mailgroup Name (optional)
"RTN","IBCNEUT5",14,0)
 ;   XMSUB = Subject Line (required)
"RTN","IBCNEUT5",15,0)
 ;   XMTEXT = Message Text Array Name in open format:  "MSG(" (required)
"RTN","IBCNEUT5",16,0)
 ;   FROMFLAG = Flag indicating from whom the message is sent (optional)
"RTN","IBCNEUT5",17,0)
 ;         false/undefined:  from the specific, non-human eIV user
"RTN","IBCNEUT5",18,0)
 ;                    true:  from the actual user (DUZ)
"RTN","IBCNEUT5",19,0)
 ;   XMY = recipients array; pass by reference (optional)
"RTN","IBCNEUT5",20,0)
 ;         The possible recipients are the sender, the Mail Group in the
"RTN","IBCNEUT5",21,0)
 ;         first parameter, and anybody else already defined in the XMY 
"RTN","IBCNEUT5",22,0)
 ;         array when this parameter is used.
"RTN","IBCNEUT5",23,0)
 ;
"RTN","IBCNEUT5",24,0)
 ; New MailMan variables and also some FileMan variables.  The FileMan
"RTN","IBCNEUT5",25,0)
 ; variables are used and not cleaned up when sending to external
"RTN","IBCNEUT5",26,0)
 ; internet addresses.
"RTN","IBCNEUT5",27,0)
 NEW DIFROM,XMDUZ,XMDUN,XMZ,XMMG,XMSTRIP,XMROU,XMYBLOB
"RTN","IBCNEUT5",28,0)
 NEW D0,D1,D2,DG,DIC,DICR,DISYS,DIW
"RTN","IBCNEUT5",29,0)
 NEW TMPSUB,TMPTEXT,TMPY,XX
"RTN","IBCNEUT5",30,0)
 ;
"RTN","IBCNEUT5",31,0)
 I $G(FROMFLAG),$G(DUZ) S XMDUZ=DUZ
"RTN","IBCNEUT5",32,0)
 E  S XMDUZ="eIV INTERFACE (IB)"
"RTN","IBCNEUT5",33,0)
 I $G(MGRP)'="" S XMY("G."_MGRP)=""
"RTN","IBCNEUT5",34,0)
 ; If no recipients are defined, send to postmaster
"RTN","IBCNEUT5",35,0)
 I '$D(XMY) S XMY(.5)=""
"RTN","IBCNEUT5",36,0)
 I $G(DUZ) S XMY(DUZ)=""
"RTN","IBCNEUT5",37,0)
 ; Store off subject, array reference and array of recipients
"RTN","IBCNEUT5",38,0)
 S TMPSUB=XMSUB,TMPTEXT=XMTEXT
"RTN","IBCNEUT5",39,0)
 M TMPY=XMY
"RTN","IBCNEUT5",40,0)
 D ^XMD
"RTN","IBCNEUT5",41,0)
 ;
"RTN","IBCNEUT5",42,0)
 ; Error logic
"RTN","IBCNEUT5",43,0)
 ; If there's an error message and the message was not originally sent
"RTN","IBCNEUT5",44,0)
 ; to the postmaster, then send a message to the postmaster with this
"RTN","IBCNEUT5",45,0)
 ; error message.
"RTN","IBCNEUT5",46,0)
 ;
"RTN","IBCNEUT5",47,0)
 I $D(XMMG),'$D(TMPY(.5)) D
"RTN","IBCNEUT5",48,0)
 . S XMY(.5)=""
"RTN","IBCNEUT5",49,0)
 . S XMTEXT=TMPTEXT,XMSUB="MailMan Error"
"RTN","IBCNEUT5",50,0)
 . ; Add XMMG error message as the first line of the message
"RTN","IBCNEUT5",51,0)
 . S XX=999999
"RTN","IBCNEUT5",52,0)
 . F  S XX=$O(@(XMTEXT_"XX)"),-1) Q:'XX  S @(XMTEXT_"XX+3)")=@(XMTEXT_"XX)")
"RTN","IBCNEUT5",53,0)
 . S @(XMTEXT_"1)")="   MailMan Error:  "_XMMG
"RTN","IBCNEUT5",54,0)
 . S @(XMTEXT_"2)")="Original Subject:  "_TMPSUB
"RTN","IBCNEUT5",55,0)
 . S @(XMTEXT_"3)")="------Original Message------"
"RTN","IBCNEUT5",56,0)
 . D ^XMD
"RTN","IBCNEUT5",57,0)
 . Q
"RTN","IBCNEUT5",58,0)
 Q
"RTN","IBCNEUT5",59,0)
 ;
"RTN","IBCNEUT5",60,0)
 ;
"RTN","IBCNEUT5",61,0)
BFEXIST(DFN,INSNAME) ; Function returns 1 if an Entered Ins Buffer File 
"RTN","IBCNEUT5",62,0)
 ; entry exists with the same DFN and INSNAME, otherwise it returns a 0
"RTN","IBCNEUT5",63,0)
 ;
"RTN","IBCNEUT5",64,0)
 ; DFN - Patient DFN
"RTN","IBCNEUT5",65,0)
 ; INSNAME - Insurance Company Name File 36 - Field .01
"RTN","IBCNEUT5",66,0)
 ;
"RTN","IBCNEUT5",67,0)
 NEW EXIST,IEN
"RTN","IBCNEUT5",68,0)
 S EXIST=0
"RTN","IBCNEUT5",69,0)
 S INSNAME=$$TRIM^XLFSTR(INSNAME)  ; trimmed
"RTN","IBCNEUT5",70,0)
 I ('DFN)!(INSNAME="") G BFEXIT
"RTN","IBCNEUT5",71,0)
 ;
"RTN","IBCNEUT5",72,0)
 S IEN=0
"RTN","IBCNEUT5",73,0)
 F  S IEN=$O(^IBA(355.33,"C",DFN,IEN)) Q:'IEN!EXIST  D
"RTN","IBCNEUT5",74,0)
 .  ; Quit if status is NOT 'Entered'
"RTN","IBCNEUT5",75,0)
 .  I $P($G(^IBA(355.33,IEN,0)),U,4)'="E" Q
"RTN","IBCNEUT5",76,0)
 .  ; Quit if Ins Buffer Ins Co Name (trimmed) is NOT EQUAL to 
"RTN","IBCNEUT5",77,0)
 .  ;  the Ins Co Name parameter (trimmed)
"RTN","IBCNEUT5",78,0)
 .  I $$TRIM^XLFSTR($P($G(^IBA(355.33,IEN,20)),U))'=INSNAME Q
"RTN","IBCNEUT5",79,0)
 .  ; Match found
"RTN","IBCNEUT5",80,0)
 .  S EXIST=1
"RTN","IBCNEUT5",81,0)
 .  Q
"RTN","IBCNEUT5",82,0)
BFEXIT ;
"RTN","IBCNEUT5",83,0)
 Q EXIST
"RTN","IBCNEUT5",84,0)
 ;
"RTN","IBCNEUT5",85,0)
 ;
"RTN","IBCNEUT5",86,0)
MGRP() ; Get the Mail Group for the eIV Interface - IB Site Parameters (51.04)
"RTN","IBCNEUT5",87,0)
 Q $$GET1^DIQ(350.9,"1,",51.04,"E")
"RTN","IBCNEUT5",88,0)
 ;
"RTN","IBCNEUT5",89,0)
 ;
"RTN","IBCNEUT5",90,0)
PYRAPP(APP,PAYERIEN) ; Get the Payer Application multiple IEN
"RTN","IBCNEUT5",91,0)
 ; based on the payer application name and payer ien.
"RTN","IBCNEUT5",92,0)
 ;
"RTN","IBCNEUT5",93,0)
 NEW MIEN,APPIEN,DISYS
"RTN","IBCNEUT5",94,0)
 S MIEN=""
"RTN","IBCNEUT5",95,0)
 S APPIEN=$$FIND1^DIC(365.13,,"X",APP,"B")
"RTN","IBCNEUT5",96,0)
 I 'APPIEN G PYRAPPX
"RTN","IBCNEUT5",97,0)
 I '$G(PAYERIEN) G PYRAPPX
"RTN","IBCNEUT5",98,0)
 S MIEN=$O(^IBE(365.12,PAYERIEN,1,"B",APPIEN,""))
"RTN","IBCNEUT5",99,0)
PYRAPPX ;
"RTN","IBCNEUT5",100,0)
 Q MIEN
"RTN","IBCNEUT5",101,0)
 ;
"RTN","IBCNEUT5",102,0)
 ;
"RTN","IBCNEUT5",103,0)
ACTAPP(IEN) ; Active payer applications
"RTN","IBCNEUT5",104,0)
 ; This function will return 1 if any of the payer applications for 
"RTN","IBCNEUT5",105,0)
 ; this payer (being passed in by the payer IEN) are NOT deactivated.
"RTN","IBCNEUT5",106,0)
 ; This should not be confused with the other payer application fields
"RTN","IBCNEUT5",107,0)
 ; such as national active or local active.  The deactivated field is
"RTN","IBCNEUT5",108,0)
 ; the .11 field in the payer application multiple.
"RTN","IBCNEUT5",109,0)
 ;
"RTN","IBCNEUT5",110,0)
 ; This function is invoked by the FileMan data dictionary as a screen
"RTN","IBCNEUT5",111,0)
 ; for the Payer field (#3.1) in the Insurance company file (#36).
"RTN","IBCNEUT5",112,0)
 ;
"RTN","IBCNEUT5",113,0)
 NEW APPIEN,ACTAPP,APPDATA
"RTN","IBCNEUT5",114,0)
 S APPIEN=0,ACTAPP="",IEN=+$G(IEN)
"RTN","IBCNEUT5",115,0)
 F  S APPIEN=$O(^IBE(365.12,IEN,1,APPIEN)) Q:'APPIEN  D  Q:ACTAPP
"RTN","IBCNEUT5",116,0)
 . S APPDATA=$G(^IBE(365.12,IEN,1,APPIEN,0))
"RTN","IBCNEUT5",117,0)
 . I $P(APPDATA,U,11) Q
"RTN","IBCNEUT5",118,0)
 . I $P(APPDATA,U,12) Q
"RTN","IBCNEUT5",119,0)
 . S ACTAPP=1
"RTN","IBCNEUT5",120,0)
 . Q
"RTN","IBCNEUT5",121,0)
 Q ACTAPP
"RTN","IBCNEUT5",122,0)
 ;
"RTN","IBCNEUT5",123,0)
ADDTQ(DFN,PAYER,SRVDT,FDAYS,EICDEXT) ; Function  - Returns flag (0/1)
"RTN","IBCNEUT5",124,0)
 ; 1 - TQ File entry can be added as the service date for the patient 
"RTN","IBCNEUT5",125,0)
 ;     and payer >= MAX TQ service date + Freshness Days
"RTN","IBCNEUT5",126,0)
 ; 0 - otherwise
"RTN","IBCNEUT5",127,0)
 ;
"RTN","IBCNEUT5",128,0)
 ; Input:
"RTN","IBCNEUT5",129,0)
 ;  DFN   - Patient DFN (File #2)
"RTN","IBCNEUT5",130,0)
 ;  PAYER - Payer IEN (File #365.12)
"RTN","IBCNEUT5",131,0)
 ;  SRVDT - Service dt for potential TQ entry
"RTN","IBCNEUT5",132,0)
 ;  FDAYS - Freshness Days param (by extract type)
"RTN","IBCNEUT5",133,0)
 ;  EICDEXT - 1 OR 0 (Is this from the EICD extract?) ;IB*2.0*621 - Renamed parameter to EICD extract
"RTN","IBCNEUT5",134,0)
 ;
"RTN","IBCNEUT5",135,0)
 N ADDTQ,MAXDT
"RTN","IBCNEUT5",136,0)
 ; 
"RTN","IBCNEUT5",137,0)
 S ADDTQ=1
"RTN","IBCNEUT5",138,0)
 I ($G(DFN)="")!($G(SRVDT)="")!($G(FDAYS)="") S ADDTQ=0 G ADDTQX
"RTN","IBCNEUT5",139,0)
 I ($G(EICDEXT)="")!($G(PAYER)="") S ADDTQ=0 G ADDTQX
"RTN","IBCNEUT5",140,0)
 ;
"RTN","IBCNEUT5",141,0)
 ; MAX TQ Service Date
"RTN","IBCNEUT5",142,0)
 S MAXDT=$$TQMAXSV(DFN,$G(PAYER),$G(EICDEXT))
"RTN","IBCNEUT5",143,0)
 I MAXDT="" G ADDTQX
"RTN","IBCNEUT5",144,0)
 ; If Service Date < Max Service Date + Freshness Days, do not add
"RTN","IBCNEUT5",145,0)
 I SRVDT'>$$FMADD^XLFDT(MAXDT,FDAYS) S ADDTQ=0
"RTN","IBCNEUT5",146,0)
 ;
"RTN","IBCNEUT5",147,0)
ADDTQX ; ADDTQ exit pt
"RTN","IBCNEUT5",148,0)
 Q ADDTQ
"RTN","IBCNEUT5",149,0)
 ;
"RTN","IBCNEUT5",150,0)
TQUPDSV(DFN,PAYER,SRVDT) ; Update service dates & freshness dates for TQ
"RTN","IBCNEUT5",151,0)
 ; entries awaiting transmission
"RTN","IBCNEUT5",152,0)
 ;
"RTN","IBCNEUT5",153,0)
 N SVDT,STS,ERACT,CSRVDT,CSPAN,SPAN,DA,HL7IEN,RIEN
"RTN","IBCNEUT5",154,0)
 ;
"RTN","IBCNEUT5",155,0)
 I ($G(DFN)="")!($G(PAYER)="")!($G(SRVDT)="") G TQUPDSVX
"RTN","IBCNEUT5",156,0)
 ;
"RTN","IBCNEUT5",157,0)
 ; Loop thru all inquiries to be transmitted to update the service date
"RTN","IBCNEUT5",158,0)
 ; Statuses:  Ready to Transmit(1), Hold(4) and Retry(6)
"RTN","IBCNEUT5",159,0)
 S SVDT=""
"RTN","IBCNEUT5",160,0)
 F  S SVDT=$O(^IBCN(365.1,"AD",DFN,PAYER,SVDT)) Q:'SVDT  D
"RTN","IBCNEUT5",161,0)
 . S DA=0
"RTN","IBCNEUT5",162,0)
 . F  S DA=$O(^IBCN(365.1,"AD",DFN,PAYER,SVDT,DA)) Q:'DA  D
"RTN","IBCNEUT5",163,0)
 .. ; TQ Status
"RTN","IBCNEUT5",164,0)
 .. S STS=$P($G(^IBCN(365.1,DA,0)),U,4)
"RTN","IBCNEUT5",165,0)
 .. ; Check to see if record is still scheduled to be transmitted.
"RTN","IBCNEUT5",166,0)
 .. ; If so, update the service date if the new service date and current
"RTN","IBCNEUT5",167,0)
 .. ; service date are both in the past or future and the new service
"RTN","IBCNEUT5",168,0)
 .. ; date is closer to Today.  Also, if the current service date is in
"RTN","IBCNEUT5",169,0)
 .. ; the future and the new service date is in the past, update with the
"RTN","IBCNEUT5",170,0)
 .. ; new service date.
"RTN","IBCNEUT5",171,0)
 .. ; If not Ready to Transmit(1), Hold(4) and Retry(6), quit
"RTN","IBCNEUT5",172,0)
 .. I STS'=1,STS'=4,STS'=6 Q
"RTN","IBCNEUT5",173,0)
 .. ; If Hold and last Response returned Error Action - Please resubmit
"RTN","IBCNEUT5",174,0)
 .. ; Original Transaction (P) - do not update
"RTN","IBCNEUT5",175,0)
 .. I STS=4 S ERACT="" D  I ERACT="P" Q
"RTN","IBCNEUT5",176,0)
 .. . ; Last msg sent
"RTN","IBCNEUT5",177,0)
 .. . S HL7IEN=$O(^IBCN(365.1,DA,2," "),-1) Q:'HL7IEN
"RTN","IBCNEUT5",178,0)
 .. . ; Assoc eIV Response IEN
"RTN","IBCNEUT5",179,0)
 .. . S RIEN=$P($G(^IBCN(365.1,DA,2,HL7IEN,0)),U,3) Q:'RIEN
"RTN","IBCNEUT5",180,0)
 .. . ; Error Action IEN (365.018)
"RTN","IBCNEUT5",181,0)
 .. . S ERACT=$P($G(^IBCN(365,RIEN,1)),U,15) Q:'ERACT
"RTN","IBCNEUT5",182,0)
 .. . S ERACT=$P($G(^IBE(365.018,ERACT,0)),U,1)
"RTN","IBCNEUT5",183,0)
 .. ;
"RTN","IBCNEUT5",184,0)
 .. ; Current service date for TQ entry
"RTN","IBCNEUT5",185,0)
 .. S CSRVDT=$P($G(^IBCN(365.1,DA,0)),U,12)
"RTN","IBCNEUT5",186,0)
 .. ; If current service date is today (DT), do not update
"RTN","IBCNEUT5",187,0)
 .. I CSRVDT=DT Q
"RTN","IBCNEUT5",188,0)
 .. ; If new service date is in the future and current service date is in
"RTN","IBCNEUT5",189,0)
 .. ; the past, do not update
"RTN","IBCNEUT5",190,0)
 .. I SRVDT>DT,CSRVDT<DT Q
"RTN","IBCNEUT5",191,0)
 .. ; If new service date is today, update
"RTN","IBCNEUT5",192,0)
 .. I SRVDT=DT D SAVETQ^IBCNEUT2(DA,SRVDT),SAVFRSH(DA,+$$FMDIFF^XLFDT(SRVDT,CSRVDT,1)) Q
"RTN","IBCNEUT5",193,0)
 .. ; If both current and new service dates are in the past or future,
"RTN","IBCNEUT5",194,0)
 .. ; only update, when new service date is closer to today (DT).
"RTN","IBCNEUT5",195,0)
 .. I ((CSRVDT<DT)&(SRVDT<DT))!((CSRVDT>DT)&(SRVDT>DT)) D  Q
"RTN","IBCNEUT5",196,0)
 .. . S CSPAN=$$FMDIFF^XLFDT(CSRVDT,DT,1),SPAN=$$FMDIFF^XLFDT(SRVDT,DT,1)
"RTN","IBCNEUT5",197,0)
 .. . I CSPAN<0 S CSPAN=-CSPAN
"RTN","IBCNEUT5",198,0)
 .. . I SPAN<0 S SPAN=-SPAN
"RTN","IBCNEUT5",199,0)
 .. . I SPAN<CSPAN D SAVETQ^IBCNEUT2(DA,SRVDT),SAVFRSH(DA,+$$FMDIFF^XLFDT(SRVDT,CSRVDT,1))
"RTN","IBCNEUT5",200,0)
 .. ; If new service date is in the past and current service date is in
"RTN","IBCNEUT5",201,0)
 .. ; the future, update
"RTN","IBCNEUT5",202,0)
 .. I SRVDT<CSRVDT D SAVETQ^IBCNEUT2(DA,SRVDT),SAVFRSH(DA,+$$FMDIFF^XLFDT(SRVDT,CSRVDT,1)) Q
"RTN","IBCNEUT5",203,0)
 .. Q
"RTN","IBCNEUT5",204,0)
TQUPDSVX ; TQUPDSV exit pt
"RTN","IBCNEUT5",205,0)
 Q
"RTN","IBCNEUT5",206,0)
 ;
"RTN","IBCNEUT5",207,0)
TQMAXSV(DFN,PAYER,EICDEXT) ; Returns MAX(TQ Service Date) for Patient & Payer
"RTN","IBCNEUT5",208,0)
 ; Input: 
"RTN","IBCNEUT5",209,0)
 ;  DFN     - Patient DFN (2)
"RTN","IBCNEUT5",210,0)
 ;  PAYER   - Payer IEN (365.12) (If no PAYER passed in, check them all)
"RTN","IBCNEUT5",211,0)
 ;  EICDEXT - 1 OR 0 (Is this from the EICD extract?)
"RTN","IBCNEUT5",212,0)
 ;
"RTN","IBCNEUT5",213,0)
 ; Output:
"RTN","IBCNEUT5",214,0)
 ;  TQMAXSV - MAX (most recent) service date from TQ entry for Patient &
"RTN","IBCNEUT5",215,0)
 ;            Payer
"RTN","IBCNEUT5",216,0)
 ;
"RTN","IBCNEUT5",217,0)
 ; IB*621 reworked this function to ignore TQ entries with statuses of
"RTN","IBCNEUT5",218,0)
 ;  "Response Received" for EICD for which the Response indicated a "Clearinghouse Timeout"
"RTN","IBCNEUT5",219,0)
 N TQMAXSV
"RTN","IBCNEUT5",220,0)
 S TQMAXSV=""
"RTN","IBCNEUT5",221,0)
 I $G(DFN)="" G TQMAXSVX
"RTN","IBCNEUT5",222,0)
 ;
"RTN","IBCNEUT5",223,0)
 N ERTXT,IBSKIP,IBTQS,IENS,LASTBYP,STATLIST,TQIEN
"RTN","IBCNEUT5",224,0)
 ; This is the list of statuses that are to be ignored for EICD extract only
"RTN","IBCNEUT5",225,0)
 ;   3=Response Received
"RTN","IBCNEUT5",226,0)
 S STATLIST=",3,"
"RTN","IBCNEUT5",227,0)
 ;
"RTN","IBCNEUT5",228,0)
 S LASTBYP=""
"RTN","IBCNEUT5",229,0)
 F  S LASTBYP=$O(^IBCN(365.1,"AD",DFN,PAYER,LASTBYP)) Q:LASTBYP=""  D
"RTN","IBCNEUT5",230,0)
 . S TQIEN=""
"RTN","IBCNEUT5",231,0)
 . F  S TQIEN=$O(^IBCN(365.1,"AD",DFN,PAYER,LASTBYP,TQIEN)) Q:TQIEN=""  D
"RTN","IBCNEUT5",232,0)
 .. S IBSKIP=0
"RTN","IBCNEUT5",233,0)
 .. I EICDEXT D  Q:IBSKIP
"RTN","IBCNEUT5",234,0)
 .. . S IBTQS=+$$GET1^DIQ(365.1,TQIEN_",",.04,"I")    ; TQ Transmission Status 
"RTN","IBCNEUT5",235,0)
 .. . I IBTQS,'($F(STATLIST,","_IBTQS_",")) Q
"RTN","IBCNEUT5",236,0)
 .. . S IENS="1,"_TQIEN_",",RIEN=$$GET1^DIQ(365.16,IENS,.03,"I")
"RTN","IBCNEUT5",237,0)
 .. . S ERTXT=$$GET1^DIQ(365,RIEN_",",4.01) I $$UP^XLFSTR(ERTXT)["TIMEOUT" S IBSKIP=1 ; keep looking
"RTN","IBCNEUT5",238,0)
 .. I LASTBYP>TQMAXSV S TQMAXSV=LASTBYP
"RTN","IBCNEUT5",239,0)
 ;
"RTN","IBCNEUT5",240,0)
TQMAXSVX ; TQMAXSV exit pt
"RTN","IBCNEUT5",241,0)
 Q TQMAXSV
"RTN","IBCNEUT5",242,0)
 ;
"RTN","IBCNEUT5",243,0)
SAVFRSH(TQIEN,DTDIFF) ; Update TQ freshness date based on service date diff
"RTN","IBCNEUT5",244,0)
 ;
"RTN","IBCNEUT5",245,0)
 N DIE,DA,FDT,DR,D,D0,DI,DIC,DQ,X
"RTN","IBCNEUT5",246,0)
 I $G(TQIEN)="" Q
"RTN","IBCNEUT5",247,0)
 S FDT=$P($G(^IBCN(365.1,TQIEN,0)),U,17)
"RTN","IBCNEUT5",248,0)
 ; Note - will only update if FDT > 0.
"RTN","IBCNEUT5",249,0)
 S FDT=$$FMADD^XLFDT(FDT,+DTDIFF)
"RTN","IBCNEUT5",250,0)
 S DIE="^IBCN(365.1,",DA=TQIEN,DR=".17////"_FDT
"RTN","IBCNEUT5",251,0)
 D ^DIE
"RTN","IBCNEUT5",252,0)
 Q
"RTN","IBCNEUT5",253,0)
 ;
"RTN","IBJPI")
0^13^B54110191^B43418759
"RTN","IBJPI",1,0)
IBJPI ;DAOU/BHS - IBJP eIV SITE PARAMETERS SCREEN ;01-APR-2015
"RTN","IBJPI",2,0)
 ;;2.0;INTEGRATED BILLING;**184,271,316,416,438,479,506,528,549,601,621**;21-MAR-94;Build 8
"RTN","IBJPI",3,0)
 ;;Per VA Directive 6402, this routine should not be modified.
"RTN","IBJPI",4,0)
 ;
"RTN","IBJPI",5,0)
 ; eIV - Electronic Insurance Verification Interface parameters
"RTN","IBJPI",6,0)
 ;
"RTN","IBJPI",7,0)
EN ; main entry pt for IBJP IIV SITE PARAMS
"RTN","IBJPI",8,0)
 N CTRLCOL,POP,VALMCNT,VALMHDR,X,%DT
"RTN","IBJPI",9,0)
 D EN^VALM("IBJP IIV SITE PARAMETERS")
"RTN","IBJPI",10,0)
 Q
"RTN","IBJPI",11,0)
 ;
"RTN","IBJPI",12,0)
HDR ; header 
"RTN","IBJPI",13,0)
 S VALMHDR(1)="Only authorized persons may edit this data."
"RTN","IBJPI",14,0)
 Q
"RTN","IBJPI",15,0)
 ;
"RTN","IBJPI",16,0)
INIT ; init vars & list array
"RTN","IBJPI",17,0)
 K ^TMP($J,"IBJPI")
"RTN","IBJPI",18,0)
 ; Kills data and video control arrays with active list
"RTN","IBJPI",19,0)
 D CLEAN^VALM10
"RTN","IBJPI",20,0)
 D BLD
"RTN","IBJPI",21,0)
 Q
"RTN","IBJPI",22,0)
 ;
"RTN","IBJPI",23,0)
HELP ; help
"RTN","IBJPI",24,0)
 ; IB*2.0*601,IB*2.0*621/DM adjust help text
"RTN","IBJPI",25,0)
 D FULL^VALM1
"RTN","IBJPI",26,0)
 W @IOF
"RTN","IBJPI",27,0)
 W !,"This screen displays all of the eIV Site Parameters used to manage the"
"RTN","IBJPI",28,0)
 W !,"eIV application used for electronic Insurance Verification."
"RTN","IBJPI",29,0)
 W !!,"The General Parameters section concerns overall parameters for"
"RTN","IBJPI",30,0)
 W !,"monitoring the interface and controlling eIV communication between"
"RTN","IBJPI",31,0)
 W !,"VistA and the EC located in Austin."
"RTN","IBJPI",32,0)
 W !!,"The Batch Extracts section concerns extract-specific parameters"
"RTN","IBJPI",33,0)
 W !,"including active/inactive status and selection criteria. Parameters"
"RTN","IBJPI",34,0)
 W !,"associated with a specific extract may also be detailed here."
"RTN","IBJPI",35,0)
 D PAUSE^VALM1
"RTN","IBJPI",36,0)
 W @IOF
"RTN","IBJPI",37,0)
 S VALMBCK="R"
"RTN","IBJPI",38,0)
 Q
"RTN","IBJPI",39,0)
 ;
"RTN","IBJPI",40,0)
EXIT ; exit
"RTN","IBJPI",41,0)
 K ^TMP($J,"IBJPI")
"RTN","IBJPI",42,0)
 D CLEAN^VALM10
"RTN","IBJPI",43,0)
 Q
"RTN","IBJPI",44,0)
 ;
"RTN","IBJPI",45,0)
BLD ; Creates the body of the worklist
"RTN","IBJPI",46,0)
 ; IB*2.0*549 - rewrote this entire method and all methods called from it to
"RTN","IBJPI",47,0)
 ;              change to a totally new display of fields
"RTN","IBJPI",48,0)
 N ELINEL,ELINER,SLINE,STARTR
"RTN","IBJPI",49,0)
 S VALMCNT=0,SLINE=1
"RTN","IBJPI",50,0)
 D BLDGENE(SLINE,.ELINEL)                       ; Build Editable General Parameters
"RTN","IBJPI",51,0)
 D BLDGENNL(ELINEL,.STARTR,.ELINEL)             ; Build Non-Editable Gen Param left
"RTN","IBJPI",52,0)
 D BLDGENNR(STARTR,.ELINER)                     ; Build Non-Editable Gen Param Right
"RTN","IBJPI",53,0)
 S SLINE=$S(ELINEL>ELINER:ELINEL,1:ELINER)
"RTN","IBJPI",54,0)
 D BLDGENNB(SLINE,.ELINEL)                      ; Build Non-Editable Bottom Params
"RTN","IBJPI",55,0)
 D BLDBE(ELINEL,.ELINEL)                        ; Build Batch Extract Gen Parameters
"RTN","IBJPI",56,0)
 S VALMCNT=ELINEL-1
"RTN","IBJPI",57,0)
 Q
"RTN","IBJPI",58,0)
 ;
"RTN","IBJPI",59,0)
BLDGENE(SLINE,ELINE) ; Build the General Editable Parameters Section
"RTN","IBJPI",60,0)
 ; Input:   SLINE   - Starting Section Line Number
"RTN","IBJPI",61,0)
 ;          ELINE   - Current Ending Section Line Number
"RTN","IBJPI",62,0)
 ; Output:  ELINE   - Updated Ending Section Line Number
"RTN","IBJPI",63,0)
 ;
"RTN","IBJPI",64,0)
 ; IB*2.0*621/DM adjusted this area to get SSVI parameters on the same line 
"RTN","IBJPI",65,0)
 N XX
"RTN","IBJPI",66,0)
 S ELINE=$$SETN("General Parameters (editable)",SLINE,1,1)
"RTN","IBJPI",67,0)
 S ELINE=$$SET("          Medicare Payer: ",$$GET1^DIQ(350.9,"1,",51.25),ELINE,1)
"RTN","IBJPI",68,0)
 S ELINE=$$SET("           HMS Directory: ",$$GET1^DIQ(350.9,"1,",13.01),ELINE,1)
"RTN","IBJPI",69,0)
 S ELINE=$$SET("              EII Active: ",$$GET1^DIQ(350.9,"1,",13.02),ELINE,1)
"RTN","IBJPI",70,0)
 ;
"RTN","IBJPI",71,0)
 S XX=$$GET1^DIQ(350.9,"1,",100,"I"),XX=$S(XX:"YES",1:"NO")
"RTN","IBJPI",72,0)
 S ELINE=$$SET("            SSVI Enabled: ",XX,ELINE,1)    ; IB*2*528/baa
"RTN","IBJPI",73,0)
 S XX=$$GET1^DIQ(350.9,"1,",103,"I")
"RTN","IBJPI",74,0)
 S ELINE=$$SET("Days to retain SSVI data: ",XX,ELINE-1,38) ; IB*2*528/baa
"RTN","IBJPI",75,0)
 Q
"RTN","IBJPI",76,0)
 ;
"RTN","IBJPI",77,0)
BLDGENNL(SLINE,STARTR,ELINE) ; Build the Left portion of the General
"RTN","IBJPI",78,0)
 ; Non-Editable Parameters Section
"RTN","IBJPI",79,0)
 ; Input:   SLINE   - Starting Section Line Number
"RTN","IBJPI",80,0)
 ;          ELINE   - Current Ending Section Line Number
"RTN","IBJPI",81,0)
 ; Output:  STARTR  - Line to start displaying General Non-Editable Right
"RTN","IBJPI",82,0)
 ;                    Section
"RTN","IBJPI",83,0)
 ;          ELINE   - Updated Ending Section Line Number
"RTN","IBJPI",84,0)
 ;
"RTN","IBJPI",85,0)
 N XX
"RTN","IBJPI",86,0)
 S ELINE=$$SET("",$J("",40),SLINE,1)            ; Spacing Blank Line
"RTN","IBJPI",87,0)
 S ELINE=$$SETN("General Parameters (non-editable)",ELINE,1,1)
"RTN","IBJPI",88,0)
 S STARTR=ELINE                                 ; Start of Right Section
"RTN","IBJPI",89,0)
 S ELINE=$$SET("          Freshness Days: ",$$GET1^DIQ(350.9,"1,",51.01),ELINE,1)
"RTN","IBJPI",90,0)
 S ELINE=$$SET("            Timeout Days: ",$$GET1^DIQ(350.9,"1,",51.05),ELINE,1)
"RTN","IBJPI",91,0)
 S ELINE=$$SET("     Timeout Mailman Msg: ",$$GET1^DIQ(350.9,"1,",51.07),ELINE,1)
"RTN","IBJPI",92,0)
 S ELINE=$$SET("             Default STC: ",$$GET1^DIQ(350.9,"1,",60.01),ELINE,1)
"RTN","IBJPI",93,0)
 S ELINE=$$SET("  Master Switch Realtime: ",$$GET1^DIQ(350.9,"1,",51.27),ELINE,1)
"RTN","IBJPI",94,0)
 S ELINE=$$SET("           CMS MBI Payer: ",$$GET1^DIQ(350.9,"1,","MBI PAYER"),ELINE,1) ; IB*2.0*601/DM 
"RTN","IBJPI",95,0)
 S ELINE=$$SET("              EICD Payer: ",$$GET1^DIQ(350.9,"1,","EICD PAYER"),ELINE,1) ; IB*2.0*621/DM 
"RTN","IBJPI",96,0)
 Q
"RTN","IBJPI",97,0)
 ;
"RTN","IBJPI",98,0)
BLDGENNR(SLINE,ELINE) ; Build the Right portion of the General
"RTN","IBJPI",99,0)
 ; Non-Editable Parameters Section
"RTN","IBJPI",100,0)
 ; Input:   SLINE   - Starting Section Line Number
"RTN","IBJPI",101,0)
 ;          ELINE   - Current Ending Section Line Number
"RTN","IBJPI",102,0)
 ; Output:  ELINE   - Updated Ending Section Line Number
"RTN","IBJPI",103,0)
 ;
"RTN","IBJPI",104,0)
 S ELINE=SLINE
"RTN","IBJPI",105,0)
 S ELINE=$$SET("   HL7 Maximum Number: ",$$GET1^DIQ(350.9,"1,",51.15),ELINE,41)
"RTN","IBJPI",106,0)
 S ELINE=$$SET("           Retry Flag: ",$$GET1^DIQ(350.9,"1,",51.26),ELINE,41)
"RTN","IBJPI",107,0)
 S ELINE=$$SET("    Number of Retries: ",$$GET1^DIQ(350.9,"1,",51.06),ELINE,41)
"RTN","IBJPI",108,0)
 S ELINE=$$SET("           Mail Group: ",$$MGRP^IBCNEUT5,ELINE,41)
"RTN","IBJPI",109,0)
 S ELINE=$$SET("Master Switch Nightly: ",$$GET1^DIQ(350.9,"1,",51.28),ELINE,41)
"RTN","IBJPI",110,0)
 Q
"RTN","IBJPI",111,0)
 ;
"RTN","IBJPI",112,0)
BLDGENNB(SLINE,ELINE) ; Build the General Non-Editable Bottom Parameters Section
"RTN","IBJPI",113,0)
 ; Input:   SLINE   - Starting Section Line Number
"RTN","IBJPI",114,0)
 ;          ELINE   - Current Ending Section Line Number
"RTN","IBJPI",115,0)
 ; Output:  ELINE   - Updated Ending Section Line Number
"RTN","IBJPI",116,0)
 ;
"RTN","IBJPI",117,0)
 N XX
"RTN","IBJPI",118,0)
 S ELINE=$$SET("",$J("",40),SLINE,1)            ; Spacing Blank Line
"RTN","IBJPI",119,0)
 S XX=$$GET1^DIQ(350.9,"1,",51.2)
"RTN","IBJPI",120,0)
 S:XX="" XX="NO"
"RTN","IBJPI",121,0)
 S ELINE=$$SET("Send MailMan Message if Communication Problem: ",XX,ELINE,1)
"RTN","IBJPI",122,0)
 S XX=$$GET1^DIQ(350.9,"1,",51.02)
"RTN","IBJPI",123,0)
 S:XX="" XX="NO"
"RTN","IBJPI",124,0)
 S XX=$$GET1^DIQ(350.9,"1,",51.02)_" at "_$$GET1^DIQ(350.9,"1,",51.03)
"RTN","IBJPI",125,0)
 S ELINE=$$SET("   Receive MailMan Message, Daily Statistical: ",XX,ELINE,1)
"RTN","IBJPI",126,0)
 Q
"RTN","IBJPI",127,0)
 ;
"RTN","IBJPI",128,0)
BLDBE(SLINE,ELINE) ; Build the Batch Extract Parameters Section
"RTN","IBJPI",129,0)
 ; Input:   SLINE   - Starting Section Line Number
"RTN","IBJPI",130,0)
 ;          ELINE   - Current Ending Section Line Number
"RTN","IBJPI",131,0)
 ; Output:  ELINE   - Updated Ending Section Line Number
"RTN","IBJPI",132,0)
 ;
"RTN","IBJPI",133,0)
 N IBEX,IBEX1,IBEX2,IBEX3,IBIIVB,IBST,IEN
"RTN","IBJPI",134,0)
 S ELINE=$$SET("",$J("",40),ELINE,1)            ; Spacing Blank Line
"RTN","IBJPI",135,0)
 S ELINE=$$SETN("Batch Extracts",ELINE,1,1)
"RTN","IBJPI",136,0)
 S ELINE=$$SET(" Extract               Selection    Maximum # to","",ELINE,1)
"RTN","IBJPI",137,0)
 S ELINE=$$SETN("Name         On/Off   Criteria     Extract/Day",ELINE,1,"",1)
"RTN","IBJPI",138,0)
 ;
"RTN","IBJPI",139,0)
 ; Loop thru extracts
"RTN","IBJPI",140,0)
 S IEN=0
"RTN","IBJPI",141,0)
 F  D  Q:'IEN
"RTN","IBJPI",142,0)
 . S IEN=$O(^IBE(350.9,1,51.17,IEN))
"RTN","IBJPI",143,0)
 . Q:'IEN
"RTN","IBJPI",144,0)
 . S IBIIVB=$G(^IBE(350.9,1,51.17,IEN,0))       ; Batch Extract multiple line
"RTN","IBJPI",145,0)
 . S IBEX=+$P(IBIIVB,"^",1)                     ; Type
"RTN","IBJPI",146,0)
 . Q:'$F(".1.2.","."_IBEX_".")
"RTN","IBJPI",147,0)
 . S IBST=$$FO^IBCNEUT1($S($P(IBIIVB,"^",1)'="":$$GET1^DIQ(350.9002,IEN_",1,",.01,"E"),1:""),14)
"RTN","IBJPI",148,0)
 . S IBST=IBST_$$FO^IBCNEUT1($S(+$P(IBIIVB,"^",2):"ON",1:"OFF"),9)
"RTN","IBJPI",149,0)
 . S IBEX1=$S(+$P(IBIIVB,U,3)'=0:+$P(IBIIVB,"^",3),1:$P(IBIIVB,"^",3))
"RTN","IBJPI",150,0)
 . S IBEX2=$S(+$P(IBIIVB,U,4)'=0:+$P(IBIIVB,"^",4),1:$P(IBIIVB,"^",4))
"RTN","IBJPI",151,0)
 . S IBST=IBST_$$FO^IBCNEUT1($S(IBEX=1:"n/a",IBEX=2:IBEX1,IBEX=3:IBEX1_"/"_IBEX2,1:"ERROR"),13)
"RTN","IBJPI",152,0)
 . S IBST=IBST_$$FO^IBCNEUT1($S(+$P(IBIIVB,"^",5):+$P(IBIIVB,"^",5),1:$P(IBIIVB,"^",5)),14)
"RTN","IBJPI",153,0)
 . S ELINE=$$SET(IBST,"",ELINE,1)
"RTN","IBJPI",154,0)
 ; IB*2.0*621/DM display EICD extract (#4), eventually, other extracts will migrate to this structure 
"RTN","IBJPI",155,0)
 S ELINE=$$SET("",$J("",40),ELINE,1)  ; Spacing Blank Line 
"RTN","IBJPI",156,0)
 S ELINE=$$SET("",$J("",40),ELINE,1)  ; Spacing Blank Line
"RTN","IBJPI",157,0)
 S ELINE=$$SET(" Extract               Start Days   Days After           Maximum # to","",ELINE,1)
"RTN","IBJPI",158,0)
 S ELINE=$$SETN("Name         On/Off   From Today   Start        Freq.   Extract/Day",ELINE,1,"",1)
"RTN","IBJPI",159,0)
 I $$GET1^DIQ(350.9002,"4,1,",.01)="EICD" D 
"RTN","IBJPI",160,0)
 . S IBEX=$$SETTINGS^IBCNEDE7(4) ; collect EICD parameters 
"RTN","IBJPI",161,0)
 . S IBST=$$FO^IBCNEUT1("EICD",14)
"RTN","IBJPI",162,0)
 . S IBST=IBST_$$FO^IBCNEUT1($S(+IBEX:"ON",1:"OFF"),9)
"RTN","IBJPI",163,0)
 . S IBST=IBST_$$FO^IBCNEUT1(+$P(IBEX,"^",6),13) ; Start Days
"RTN","IBJPI",164,0)
 . S IBST=IBST_$$FO^IBCNEUT1(+$P(IBEX,"^",7),13) ; Days After 
"RTN","IBJPI",165,0)
 . S IBST=IBST_$$FO^IBCNEUT1(+$P(IBEX,"^",8),8) ; Frequency
"RTN","IBJPI",166,0)
 . S IBST=IBST_$$FO^IBCNEUT1(+$P(IBEX,"^",4),8) ; Max extract
"RTN","IBJPI",167,0)
 . S ELINE=$$SET(IBST,"",ELINE,1)
"RTN","IBJPI",168,0)
 Q
"RTN","IBJPI",169,0)
 ;
"RTN","IBJPI",170,0)
SET(LABEL,DATA,LINE,COL) ; Sets text into the body of the worklist
"RTN","IBJPI",171,0)
 ; Input:   LABEL   - Label text to set into the line
"RTN","IBJPI",172,0)
 ;          DATA    - Field Data to set into the line
"RTN","IBJPI",173,0)
 ;          LINE    - Line to set LABEL and DATA into
"RTN","IBJPI",174,0)
 ;          COL     - Starting column position in LINE to insert
"RTN","IBJPI",175,0)
 ;                    LABEL_DATA text
"RTN","IBJPI",176,0)
 ; Returns: LINE    - Updated Line by 1
"RTN","IBJPI",177,0)
 ;
"RTN","IBJPI",178,0)
 N IBY
"RTN","IBJPI",179,0)
 S IBY=LABEL_DATA
"RTN","IBJPI",180,0)
 D SET1(IBY,LINE,COL,$L(IBY))
"RTN","IBJPI",181,0)
 S LINE=LINE+1
"RTN","IBJPI",182,0)
 Q LINE
"RTN","IBJPI",183,0)
 ;
"RTN","IBJPI",184,0)
SETN(TITLE,LINE,COL,RV,ULINE) ; Sets a field Section title into the body of the worklist
"RTN","IBJPI",185,0)
 ; Input:   TITLE   - Text to be used for the field Section Title
"RTN","IBJPI",186,0)
 ;          LINE    - Line number in the body to insert the field section title
"RTN","IBJPI",187,0)
 ;          COL     - Starting Column position to set Section Title into
"RTN","IBJPI",188,0)
 ;          RV      - 1 - Set Reverse Video, 0 or null don't use Reverse Video
"RTN","IBJPI",189,0)
 ;                        Optional, defaults to ""
"RTN","IBJPI",190,0)
 ;          ULINE   - 1 - Set Underline, 0 or null don't use underline
"RTN","IBJPI",191,0)
 ;                        Optional, defaults to ""
"RTN","IBJPI",192,0)
 ; Returns: LINE    - Line number increased by 1
"RTN","IBJPI",193,0)
 ;
"RTN","IBJPI",194,0)
 N IBY
"RTN","IBJPI",195,0)
 S IBY=" "_TITLE_" "
"RTN","IBJPI",196,0)
 D SET1(IBY,LINE,COL,$L(IBY),$G(RV),$G(ULINE))
"RTN","IBJPI",197,0)
 S LINE=LINE+1
"RTN","IBJPI",198,0)
 Q LINE
"RTN","IBJPI",199,0)
 ;
"RTN","IBJPI",200,0)
SET1(TEXT,LINE,COL,WIDTH,RV,ULINE) ; Sets the TMP array with body data
"RTN","IBJPI",201,0)
 ; Input:   TEXT                - Text to be set into the specified line
"RTN","IBJPI",202,0)
 ;          LINE                - Line to set TEXT into
"RTN","IBJPI",203,0)
 ;          COL                 - Column of LINE to set TEXT into
"RTN","IBJPI",204,0)
 ;          WIDTH               - Width of the TEXT being set into line
"RTN","IBJPI",205,0)
 ;          RV                  - 1 - Set Reverse Video, 0 or null don't use
"RTN","IBJPI",206,0)
 ;                                    Reverse Video
"RTN","IBJPI",207,0)
 ;                                Optional, defaults to ""
"RTN","IBJPI",208,0)
 ;          ULINE               - 1 - Set Underline, 0 or null don't use
"RTN","IBJPI",209,0)
 ;                                    Underline
"RTN","IBJPI",210,0)
 ;                                Optional, defaults to ""
"RTN","IBJPI",211,0)
 ;          ^TMP($J,"IBJPI")   - Current ^TMP array
"RTN","IBJPI",212,0)
 ; Output:  ^TMP($J,"IBJPI")   - Updated ^TMP array
"RTN","IBJPI",213,0)
 ;
"RTN","IBJPI",214,0)
 N IBX
"RTN","IBJPI",215,0)
 S IBX=$G(^TMP($J,"IBJPI",LINE,0))
"RTN","IBJPI",216,0)
 S IBX=$$SETSTR^VALM1(TEXT,IBX,COL,WIDTH)
"RTN","IBJPI",217,0)
 D SET^VALM10(LINE,IBX)
"RTN","IBJPI",218,0)
 D:$G(RV)'="" CNTRL^VALM10(LINE,COL,WIDTH,IORVON,IORVOFF)
"RTN","IBJPI",219,0)
 D:$G(ULINE)'="" CNTRL^VALM10(LINE,COL,WIDTH,IOUON,IOUOFF)
"RTN","IBJPI",220,0)
 Q
"RTN","IBJPI",221,0)
 ; 
"RTN","IBY621PO")
0^14^B16847703^n/a
"RTN","IBY621PO",1,0)
IBY621PO ;AITC/DM - Post-Installation for IB patch 621; 22-MAY-2018
"RTN","IBY621PO",2,0)
 ;;2.0;INTEGRATED BILLING;**621**;21-MAR-94;Build 8
"RTN","IBY621PO",3,0)
 ;;Per VA Directive 6402, this routine should not be modified.
"RTN","IBY621PO",4,0)
 ;
"RTN","IBY621PO",5,0)
POST ; POST ROUTINE(S)
"RTN","IBY621PO",6,0)
 N IBXPD,XPDIDTOT
"RTN","IBY621PO",7,0)
 S XPDIDTOT=3
"RTN","IBY621PO",8,0)
 ;
"RTN","IBY621PO",9,0)
 ; Create/update the EICD extract  
"RTN","IBY621PO",10,0)
 D CHKEICD(1)
"RTN","IBY621PO",11,0)
 ;
"RTN","IBY621PO",12,0)
 ; Send site registration message to FSC
"RTN","IBY621PO",13,0)
 D REGMSG(2)
"RTN","IBY621PO",14,0)
 ;
"RTN","IBY621PO",15,0)
 ; Check/remove any link from an insurance to the National EICD Payer
"RTN","IBY621PO",16,0)
 D CHKLNK(3)
"RTN","IBY621PO",17,0)
 ;
"RTN","IBY621PO",18,0)
 ; Displays the 'Done' message and finishes the progress bar
"RTN","IBY621PO",19,0)
 D MES^XPDUTL("")
"RTN","IBY621PO",20,0)
 D MES^XPDUTL("POST-Install Completed.")
"RTN","IBY621PO",21,0)
 Q
"RTN","IBY621PO",22,0)
 ;
"RTN","IBY621PO",23,0)
REGMSG(IBXPD) ; send site registration message to FSC
"RTN","IBY621PO",24,0)
 D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
"RTN","IBY621PO",25,0)
 D MES^XPDUTL("-------------")
"RTN","IBY621PO",26,0)
 D MES^XPDUTL("Sending site registration message to FSC ... ")
"RTN","IBY621PO",27,0)
 ;
"RTN","IBY621PO",28,0)
 I '$$PROD^XUPROD(1) D MES^XPDUTL(" N/A - Not a production account - No site registration message sent") G REGMSGQ
"RTN","IBY621PO",29,0)
 D MES^XPDUTL("Sending site registration message to FSC ... ")
"RTN","IBY621PO",30,0)
 D ^IBCNEHLM
"RTN","IBY621PO",31,0)
 ;
"RTN","IBY621PO",32,0)
REGMSGQ ;
"RTN","IBY621PO",33,0)
 Q
"RTN","IBY621PO",34,0)
 ; 
"RTN","IBY621PO",35,0)
CHKLNK(IBXPD) ; Due to a timing issue with the National EICD Payer
"RTN","IBY621PO",36,0)
 ;It's possible that a client linked an insurance to the EICD payer
"RTN","IBY621PO",37,0)
 ;This is not allowed. Any such link will be removed
"RTN","IBY621PO",38,0)
 N IBEICDPY,IBIEN
"RTN","IBY621PO",39,0)
 D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
"RTN","IBY621PO",40,0)
 D MES^XPDUTL("-------------")
"RTN","IBY621PO",41,0)
 D MES^XPDUTL("Verifying Insurance links to payers...")
"RTN","IBY621PO",42,0)
 ;
"RTN","IBY621PO",43,0)
 S IBEICDPY=0
"RTN","IBY621PO",44,0)
 S IBEICDPY=$O(^IBE(365.12,"B","ELECTRONIC COVERAGE DISCOVERY",IBEICDPY))
"RTN","IBY621PO",45,0)
 I 'IBEICDPY D BMES^XPDUTL("The Electronic Insurance Coverage Discovery Payer has not been established") G CHKLNKQ
"RTN","IBY621PO",46,0)
 S IBIEN=0
"RTN","IBY621PO",47,0)
 F  S IBIEN=$O(^DIC(36,"AC",IBEICDPY,IBIEN)) Q:'IBIEN  D
"RTN","IBY621PO",48,0)
 . S DIE="^DIC(36,",DA=IBIEN,DR="3.1///@" D ^DIE ; remove the link
"RTN","IBY621PO",49,0)
 . W !,"Insurance:"_IBIEN_" "_$$GET1^DIQ(36,IBIEN_",","NAME")
"RTN","IBY621PO",50,0)
 . K DIE,DA,DR
"RTN","IBY621PO",51,0)
 ;
"RTN","IBY621PO",52,0)
CHKLNKQ ;
"RTN","IBY621PO",53,0)
 Q
"RTN","IBY621PO",54,0)
 ;
"RTN","IBY621PO",55,0)
CHKEICD(IBXPD) ; Create or update the EICD Extract
"RTN","IBY621PO",56,0)
 N IBFDA,IBSETIEN,IBERR,IBEXT4,IBEXTIEN
"RTN","IBY621PO",57,0)
 D BMES^XPDUTL(" STEP "_IBXPD_" of "_XPDIDTOT)
"RTN","IBY621PO",58,0)
 D MES^XPDUTL("-------------")
"RTN","IBY621PO",59,0)
 D MES^XPDUTL("Create/update the EICD Extract parameters... ")
"RTN","IBY621PO",60,0)
 ;
"RTN","IBY621PO",61,0)
 S IBEXT4=+$$FIND1^DIC(350.9002,",1,","BQX","4","B")
"RTN","IBY621PO",62,0)
 I 'IBEXT4 D  G CHKEICDQ
"RTN","IBY621PO",63,0)
 . W !," Creating a new EICD batch extract record..."
"RTN","IBY621PO",64,0)
 . S IBEXTIEN="+1,1,"
"RTN","IBY621PO",65,0)
 . S IBSETIEN(1)=4 ;for safety, force new IEN to 4
"RTN","IBY621PO",66,0)
 . S IBFDA(350.9002,IBEXTIEN,.01)="4"   ; BATCH EXTRACTS
"RTN","IBY621PO",67,0)
 . S IBFDA(350.9002,IBEXTIEN,.02)="1"   ; Active?
"RTN","IBY621PO",68,0)
 . S IBFDA(350.9002,IBEXTIEN,.03)=""    ; SELECTION CRITERIA #1
"RTN","IBY621PO",69,0)
 . S IBFDA(350.9002,IBEXTIEN,.04)=""    ; SELECTION CRITERIA #2
"RTN","IBY621PO",70,0)
 . S IBFDA(350.9002,IBEXTIEN,.05)=99999 ; MAXIMUM EXTRACT NUMBER
"RTN","IBY621PO",71,0)
 . S IBFDA(350.9002,IBEXTIEN,.06)="1"   ; SUPPRESS BUFFER CREATION
"RTN","IBY621PO",72,0)
 . S IBFDA(350.9002,IBEXTIEN,.07)=31    ; START DAYS
"RTN","IBY621PO",73,0)
 . S IBFDA(350.9002,IBEXTIEN,.08)=9     ; DAYS AFTER START
"RTN","IBY621PO",74,0)
 . S IBFDA(350.9002,IBEXTIEN,.09)=365   ; FREQUENCY
"RTN","IBY621PO",75,0)
 . ;
"RTN","IBY621PO",76,0)
 . D UPDATE^DIE(,"IBFDA","IBSETIEN","IBERR")
"RTN","IBY621PO",77,0)
 . I $G(IBERR("DIERR",1,"TEXT",1))'="" W !,"ISSUE CREATING EXTRACT: "_$G(IBERR("DIERR",1,"TEXT",1))
"RTN","IBY621PO",78,0)
 ;
"RTN","IBY621PO",79,0)
 I IBEXT4 D  G CHKEICDQ
"RTN","IBY621PO",80,0)
 . W !," Updating existing EICD batch extract record..."
"RTN","IBY621PO",81,0)
 . S IBEXTIEN=IBEXT4_",1,"
"RTN","IBY621PO",82,0)
 . S IBFDA(350.9002,IBEXTIEN,.02)="1"   ; Active?
"RTN","IBY621PO",83,0)
 . S IBFDA(350.9002,IBEXTIEN,.03)=""    ; SELECTION CRITERIA #1
"RTN","IBY621PO",84,0)
 . S IBFDA(350.9002,IBEXTIEN,.04)=""    ; SELECTION CRITERIA #2
"RTN","IBY621PO",85,0)
 . S IBFDA(350.9002,IBEXTIEN,.05)=99999 ; MAXIMUM EXTRACT NUMBER
"RTN","IBY621PO",86,0)
 . S IBFDA(350.9002,IBEXTIEN,.06)="1"   ; SUPPRESS BUFFER CREATION
"RTN","IBY621PO",87,0)
 . S IBFDA(350.9002,IBEXTIEN,.07)=31    ; START DAYS
"RTN","IBY621PO",88,0)
 . S IBFDA(350.9002,IBEXTIEN,.08)=9     ; DAYS AFTER START
"RTN","IBY621PO",89,0)
 . S IBFDA(350.9002,IBEXTIEN,.09)=365   ; FREQUENCY
"RTN","IBY621PO",90,0)
 . ;
"RTN","IBY621PO",91,0)
 . D FILE^DIE(,"IBFDA","IBERR")
"RTN","IBY621PO",92,0)
 . I $G(IBERR("DIERR",1,"TEXT",1))'="" W !,"ISSUE UPDATING EXTRACT: "_$G(IBERR("DIERR",1,"TEXT",1))
"RTN","IBY621PO",93,0)
 ;
"RTN","IBY621PO",94,0)
CHKEICDQ ; 
"RTN","IBY621PO",95,0)
 Q
"RTN","IBY621PO",96,0)
 ;
"UP",350.9,350.9002,-1)
350.9^51.17
"UP",350.9,350.9002,0)
350.9002
"VER")
8.0^22.2
"^DD",2,2,2001,0)
DATE LAST EICD RUN^D^^INS;1^S %DT="EX" D ^%DT S X=Y K:X<1 X
"^DD",2,2,2001,3)
Enter the date the last EICD Identification inquiry was run for this patient.
"^DD",2,2,2001,21,0)
^^2^2^3180607^
"^DD",2,2,2001,21,1,0)
This field contains the date that the last EICD Identification inquiry was
"^DD",2,2,2001,21,2,0)
transmitted to the Financial Services Center (FSC).
"^DD",2,2,2001,23,0)
^^2^2^3180607^
"^DD",2,2,2001,23,1,0)
When the Health Level 7 (HL7) message for an EICD Identification inquiry
"^DD",2,2,2001,23,2,0)
is actually transmitted, VistA will populate this date.
"^DD",2,2,2001,"DT")
3180607
"^DD",350.9,350.9,51.17,0)
BATCH EXTRACTS^350.9002S^^51.17;0
"^DD",350.9,350.9,51.17,21,0)
^.001^5^5^3180522^^
"^DD",350.9,350.9,51.17,21,1,0)
This field identifies each of the four data extracts that eIV uses
"^DD",350.9,350.9,51.17,21,2,0)
to find insurance data via verification inquiries.
"^DD",350.9,350.9,51.17,21,3,0)
 
"^DD",350.9,350.9,51.17,21,4,0)
Buffer, appointment, non-verified Insurance and 
"^DD",350.9,350.9,51.17,21,5,0)
EICD (formerly No Insurance ).
"^DD",350.9,350.9,51.31,0)
EICD PAYER^P365.12'^IBE(365.12,^51;31^Q
"^DD",350.9,350.9,51.31,3)
Select the EICD entry from the Payer file.
"^DD",350.9,350.9,51.31,21,0)
^^3^3^3180523^
"^DD",350.9,350.9,51.31,21,1,0)
This field identifies the National payer utilized when
"^DD",350.9,350.9,51.31,21,2,0)
performing an Electronic Insurance Coverage Discovery
"^DD",350.9,350.9,51.31,21,3,0)
(EICD) inquiry for a Veteran.
"^DD",350.9,350.9,51.31,23,0)
^^5^5^3180523^
"^DD",350.9,350.9,51.31,23,1,0)
This field is a pointer to the EICD payer
"^DD",350.9,350.9,51.31,23,2,0)
table (#365.12). It is set via a table update from FSC.  
"^DD",350.9,350.9,51.31,23,3,0)
It was introduced with IB*2.0*621 and should not 
"^DD",350.9,350.9,51.31,23,4,0)
have to change unless the EICD payer gets changed.
"^DD",350.9,350.9,51.31,23,5,0)
It is only editable via FileMan. Edit with extreme care.
"^DD",350.9,350.9,51.31,"DT")
3180523
"^DD",350.9,350.9002,0)
BATCH EXTRACTS SUB-FIELD^^.09^9
"^DD",350.9,350.9002,0,"NM","BATCH EXTRACTS")

"^DD",350.9,350.9002,.01,0)
BATCH EXTRACTS^MRS^1:Buffer;2:Appt;3:Non-verified;4:EICD;^0;1^Q
"^DD",350.9,350.9002,.01,1,0)
^.1
"^DD",350.9,350.9002,.01,1,1,0)
350.9002^B
"^DD",350.9,350.9002,.01,1,1,1)
S ^IBE(350.9,DA(1),51.17,"B",$E(X,1,30),DA)=""
"^DD",350.9,350.9002,.01,1,1,2)
K ^IBE(350.9,DA(1),51.17,"B",$E(X,1,30),DA)
"^DD",350.9,350.9002,.01,1,1,"%D",0)
^^1^1^3020612^
"^DD",350.9,350.9002,.01,1,1,"%D",1,0)
Standard "B" cross-reference
"^DD",350.9,350.9002,.01,3)
Enter a code from the list.
"^DD",350.9,350.9002,.01,21,0)
^^5^5^3180522^
"^DD",350.9,350.9002,.01,21,1,0)
This field identifies each of the four data extracts that eIV uses
"^DD",350.9,350.9002,.01,21,2,0)
to find data to request insurance verification.
"^DD",350.9,350.9002,.01,21,3,0)
 
"^DD",350.9,350.9002,.01,21,4,0)
Buffer, appointment, non-verified Insurance and 
"^DD",350.9,350.9002,.01,21,5,0)
EICD (formerly No Insurance ).
"^DD",350.9,350.9002,.01,"DT")
3180522
"^DD",350.9,350.9002,.05,0)
MAXIMUM EXTRACT NUMBER^RNJ5,0^^0;5^K:+X'=X!(X>99999)!(X<10)!(X?.E1"."1.N) X
"^DD",350.9,350.9002,.05,3)
Type a number between 10 and 99999, 0 Decimal Digits
"^DD",350.9,350.9002,.05,21,0)
^.001^2^2^3180522^^
"^DD",350.9,350.9002,.05,21,1,0)
This field allows a site to restrict the daily number of records
"^DD",350.9,350.9002,.05,21,2,0)
extracted and placed in the eIV Transmission Queue.
"^DD",350.9,350.9002,.05,"DT")
3180522
"^DD",350.9,350.9002,.07,0)
START DAYS^NJ2,0^^0;7^K:+X'=X!(X>31)!(X<7)!(X?.E1"."1.N) X
"^DD",350.9,350.9002,.07,3)
Type a number between 7 and 31, 0 decimal digits.
"^DD",350.9,350.9002,.07,21,0)
^^11^11^3180625^
"^DD",350.9,350.9002,.07,21,1,0)
This parameter is the number of days added to today to form the 
"^DD",350.9,350.9002,.07,21,2,0)
extract's start date used to determine whether a record 
"^DD",350.9,350.9002,.07,21,3,0)
should be extracted or not.
"^DD",350.9,350.9002,.07,21,4,0)
 
"^DD",350.9,350.9002,.07,21,5,0)
To date, this parameter is only used by the EICD extract (#4), formerly
"^DD",350.9,350.9002,.07,21,6,0)
"No Insurance". 
"^DD",350.9,350.9002,.07,21,7,0)
 
"^DD",350.9,350.9002,.07,21,8,0)
 For EICD, this indicates how far in the future a Patient can be scheduled
"^DD",350.9,350.9002,.07,21,9,0)
for an appointment and be eligible for extract. If the value is 21, then a
"^DD",350.9,350.9002,.07,21,10,0)
patient will be eligible for extract if their appointment is no earlier
"^DD",350.9,350.9002,.07,21,11,0)
than 21 days from the extract date (current date).
"^DD",350.9,350.9002,.07,"DT")
3180625
"^DD",350.9,350.9002,.08,0)
DAYS AFTER START^NJ2,0^^0;8^K:+X'=X!(X>20)!(X<0)!(X?.E1"."1.N) X
"^DD",350.9,350.9002,.08,3)
Type a number between 0 and 20, 0 decimal digits.
"^DD",350.9,350.9002,.08,21,0)
^^12^12^3180522^
"^DD",350.9,350.9002,.08,21,1,0)
This parameter is added to the start date, calculated using "START DAYS", 
"^DD",350.9,350.9002,.08,21,2,0)
to form the extract's end date used to determine whether a record should
"^DD",350.9,350.9002,.08,21,3,0)
be extracted or not.
"^DD",350.9,350.9002,.08,21,4,0)
 
"^DD",350.9,350.9002,.08,21,5,0)
To date, this parameter is only used by the EICD extract (#4), formerly 
"^DD",350.9,350.9002,.08,21,6,0)
"No Insurance".
"^DD",350.9,350.9002,.08,21,7,0)
 
"^DD",350.9,350.9002,.08,21,8,0)
For EICD, this indicates how far in the future a patient from the start 
"^DD",350.9,350.9002,.08,21,9,0)
date, calculated using "START DAYS", that a scheduled appointment must be 
"^DD",350.9,350.9002,.08,21,10,0)
within in order to be eligible for extract.  If the value is 9, then a 
"^DD",350.9,350.9002,.08,21,11,0)
patient will be eligible for extract if their appointment is no earlier 
"^DD",350.9,350.9002,.08,21,12,0)
than start date and is no further than start date + 9.
"^DD",350.9,350.9002,.08,"DT")
3180522
"^DD",350.9,350.9002,.09,0)
FREQUENCY^NJ3,0^^0;9^K:+X'=X!(X>365)!(X<90)!(X?.E1"."1.N) X
"^DD",350.9,350.9002,.09,3)
Type a number between 90 and 365, 0 decimal digits.
"^DD",350.9,350.9002,.09,21,0)
^^10^10^3180522^
"^DD",350.9,350.9002,.09,21,1,0)
This parameter is similar to the FRESHNESS DAYS parameter in that it 
"^DD",350.9,350.9002,.09,21,2,0)
represents how long the extract must wait before an attempt to re-verify 
"^DD",350.9,350.9002,.09,21,3,0)
the insurance for the patient. 
"^DD",350.9,350.9002,.09,21,4,0)
 
"^DD",350.9,350.9002,.09,21,5,0)
To date, this parameter is only used by the EICD extract (#4), formerly
"^DD",350.9,350.9002,.09,21,6,0)
"No Insurance". 
"^DD",350.9,350.9002,.09,21,7,0)
 
"^DD",350.9,350.9002,.09,21,8,0)
For EICD, If the value is 365, this means that eIV can attempt to
"^DD",350.9,350.9002,.09,21,9,0)
re-verify the lack of insurance for a patient 366 days after the last time
"^DD",350.9,350.9002,.09,21,10,0)
an EICD inquiry was run.
"^DD",350.9,350.9002,.09,"DT")
3180522
"^DD",365.1,365.1,.1,0)
WHICH EXTRACT^S^1:Buffer;2:Appt;3:Non-verified;4:EICD;^0;10^Q
"^DD",365.1,365.1,.1,3)
Enter a code from the list.
"^DD",365.1,365.1,.1,21,0)
^^2^2^3180515^
"^DD",365.1,365.1,.1,21,1,0)
This field identifies which data extract that the transmission
"^DD",365.1,365.1,.1,21,2,0)
record was generated from.
"^DD",365.1,365.1,.1,23,0)
^^2^2^3180515^
"^DD",365.1,365.1,.1,23,1,0)
Patch IB*2*621 renamed data extract (#4)
"^DD",365.1,365.1,.1,23,2,0)
from "No Insurance" to "EICD".
"^DD",365.1,365.1,.1,"DT")
3180515
"^DD",365.1,365.1,.21,0)
EICD INS-FND IEN^P365.18'^IBCN(365.18,^0;21^Q
"^DD",365.1,365.1,.21,3)
Select the EICD data record returned from an Identification response.
"^DD",365.1,365.1,.21,21,0)
^^3^3^3180606^
"^DD",365.1,365.1,.21,21,1,0)
This field points to discovered insurance returned from an EICD
"^DD",365.1,365.1,.21,21,2,0)
Identification response. The data will be used to track an EICD 
"^DD",365.1,365.1,.21,21,3,0)
Verification inquiry and response.  
"^DD",365.1,365.1,.21,23,0)
^^2^2^3180606^
"^DD",365.1,365.1,.21,23,1,0)
This field points to the "INS-FND" node multiple contained in EIV EICD
"^DD",365.1,365.1,.21,23,2,0)
TRACKING (#365.18) FILE.
"^DD",365.1,365.1,.21,"DT")
3180606
"^DD",365.18,365.18,0)
FIELD^^5^8
"^DD",365.18,365.18,0,"DT")
3180717
"^DD",365.18,365.18,0,"IX","B",365.18,.01)

"^DD",365.18,365.18,0,"IX","C",365.185,1.01)

"^DD",365.18,365.18,0,"IX","D",365.185,1.03)

"^DD",365.18,365.18,0,"IX","E",365.18,.04)

"^DD",365.18,365.18,0,"IX","F",365.18,.05)

"^DD",365.18,365.18,0,"NM","EIV EICD TRACKING")

"^DD",365.18,365.18,0,"PT",365.1,.21)

"^DD",365.18,365.18,.01,0)
EICD TRANSMISSION^RP365.1'^IBCN(365.1,^0;1^Q
"^DD",365.18,365.18,.01,1,0)
^.1
"^DD",365.18,365.18,.01,1,1,0)
365.18^B
"^DD",365.18,365.18,.01,1,1,1)
S ^IBCN(365.18,"B",$E(X,1,30),DA)=""
"^DD",365.18,365.18,.01,1,1,2)
K ^IBCN(365.18,"B",$E(X,1,30),DA)
"^DD",365.18,365.18,.01,3)
Select the IIV TRANSMISSION QUEUE record associated with this EICD Identification inquiry.
"^DD",365.18,365.18,.01,21,0)
^^2^2^3180612^
"^DD",365.18,365.18,.01,21,1,0)
This is the IIV TRANSMISSION QUEUE record associated with this EICD
"^DD",365.18,365.18,.01,21,2,0)
Identification inquiry.
"^DD",365.18,365.18,.01,23,0)
^^2^2^3180605^
"^DD",365.18,365.18,.01,23,1,0)
VistA populates this field with a pointer to the IIV TRANSMISSION QUEUE
"^DD",365.18,365.18,.01,23,2,0)
(#365.1). 
"^DD",365.18,365.18,.01,"DT")
3180612
"^DD",365.18,365.18,.02,0)
EICD DATE CREATED^D^^0;2^S %DT="EX" D ^%DT S X=Y K:X<1 X
"^DD",365.18,365.18,.02,3)
Enter the date that the associated IIV TRANSMISSION QUEUE entry was created.
"^DD",365.18,365.18,.02,21,0)
^^2^2^3180605^
"^DD",365.18,365.18,.02,21,1,0)
This is the date that the IIV TRANSMISSION QUEUE entry was created for an
"^DD",365.18,365.18,.02,21,2,0)
EICD Identification inquiry. 
"^DD",365.18,365.18,.02,23,0)
^^2^2^3180608^
"^DD",365.18,365.18,.02,23,1,0)
This is the date that the IIV TRANSMISSION QUEUE entry pointed to by 
"^DD",365.18,365.18,.02,23,2,0)
the EICD TRANSMISSION (#365.18,.01) field was created.
"^DD",365.18,365.18,.02,"DT")
3180612
"^DD",365.18,365.18,.03,0)
EICD PAYER^P365.12'^IBE(365.12,^0;3^Q
"^DD",365.18,365.18,.03,3)
Select the EICD Identification inquiry National PAYER. 
"^DD",365.18,365.18,.03,21,0)
^^2^2^3180612^
"^DD",365.18,365.18,.03,21,1,0)
This is the National EICD PAYER entry used when creating an EICD
"^DD",365.18,365.18,.03,21,2,0)
Identification inquiry.
"^DD",365.18,365.18,.03,23,0)
^^3^3^3180606^
"^DD",365.18,365.18,.03,23,1,0)
When an EICD Identification inquiry is created, this field is populated
"^DD",365.18,365.18,.03,23,2,0)
with The "EICD PAYER" from IB SITE PARAMETERS (#350.9,51.31) which
"^DD",365.18,365.18,.03,23,3,0)
is a pointer to the proper National PAYER (#365.12).
"^DD",365.18,365.18,.03,"DT")
3180612
"^DD",365.18,365.18,.04,0)
EICD TRACE NUMBER^FJ30^^0;4^K:$L(X)>30!($L(X)<3) X
"^DD",365.18,365.18,.04,1,0)
^.1
"^DD",365.18,365.18,.04,1,1,0)
365.18^E
"^DD",365.18,365.18,.04,1,1,1)
S ^IBCN(365.18,"E",$E(X,1,30),DA)=""
"^DD",365.18,365.18,.04,1,1,2)
K ^IBCN(365.18,"E",$E(X,1,30),DA)
"^DD",365.18,365.18,.04,1,1,3)
DO NOT DELETE
"^DD",365.18,365.18,.04,1,1,"%D",0)
^^2^2^3180712^
"^DD",365.18,365.18,.04,1,1,"%D",1,0)
This cross reference allows the enrtry to be looked up by the EICD TRACE
"^DD",365.18,365.18,.04,1,1,"%D",2,0)
NUMBER.
"^DD",365.18,365.18,.04,1,1,"DT")
3180712
"^DD",365.18,365.18,.04,3)
Enter the EICD Identification response Trace number, must be 3-30 characters in length.
"^DD",365.18,365.18,.04,21,0)
^^3^3^3180608^^
"^DD",365.18,365.18,.04,21,1,0)
This is the IIV RESPONSE TRACE NUMBER (#365,.09) associated with an EICD 
"^DD",365.18,365.18,.04,21,2,0)
Identification response that traces back to the EICD TRANSMISSION 
"^DD",365.18,365.18,.04,21,3,0)
(#365.18,.01) field.
"^DD",365.18,365.18,.04,"DT")
3180712
"^DD",365.18,365.18,.05,0)
EICD PATIENT^P2'^DPT(^0;5^Q
"^DD",365.18,365.18,.05,1,0)
^.1
"^DD",365.18,365.18,.05,1,1,0)
365.18^F
"^DD",365.18,365.18,.05,1,1,1)
S ^IBCN(365.18,"F",$E(X,1,30),DA)=""
"^DD",365.18,365.18,.05,1,1,2)
K ^IBCN(365.18,"F",$E(X,1,30),DA)
"^DD",365.18,365.18,.05,1,1,3)
DO NOT DELETE
"^DD",365.18,365.18,.05,1,1,"%D",0)
^^2^2^3180712^
"^DD",365.18,365.18,.05,1,1,"%D",1,0)
This cross reference allows the enrtry to be looked up by the EICD 
"^DD",365.18,365.18,.05,1,1,"%D",2,0)
PATIENT.
"^DD",365.18,365.18,.05,1,1,"DT")
3180712
"^DD",365.18,365.18,.05,3)
Enter the EICD Identification inquiry Patient. 
"^DD",365.18,365.18,.05,21,0)
^^1^1^3180612^
"^DD",365.18,365.18,.05,21,1,0)
This is the PATIENT record associated with an EICD Identification inquiry.
"^DD",365.18,365.18,.05,"DT")
3180712
"^DD",365.18,365.18,.06,0)
EICD RESPONSE^P365'^IBCN(365,^0;6^Q
"^DD",365.18,365.18,.06,3)
Select the IIV RESPONSE entry associated with an EICD Identification.
"^DD",365.18,365.18,.06,21,0)
^^2^2^3180612^
"^DD",365.18,365.18,.06,21,1,0)
This is the IIV RESPONSE file record associated with an EICD
"^DD",365.18,365.18,.06,21,2,0)
Identification response.
"^DD",365.18,365.18,.06,"DT")
3180612
"^DD",365.18,365.18,.07,0)
EICD RESPONSE RESULT^S^0:Error;1:Active Policies Found;2:No Active Policies Found;3:Clearinghouse Timeout;^0;7^Q
"^DD",365.18,365.18,.07,3)
Enter an EICD Identification response result code.
"^DD",365.18,365.18,.07,21,0)
^.001^2^2^3180717^^
"^DD",365.18,365.18,.07,21,1,0)
This field contains a result code based on response data returned 
"^DD",365.18,365.18,.07,21,2,0)
from an EICD Identification inquiry.
"^DD",365.18,365.18,.07,"DT")
3180717
"^DD",365.18,365.18,5,0)
INSURANCE DISCOVERED^365.185A^^INS-FND;0
"^DD",365.18,365.18,5,21,0)
^.001^3^3^3180703^^^^
"^DD",365.18,365.18,5,21,1,0)
When an EICD Identification response returns with one or more 
"^DD",365.18,365.18,5,21,2,0)
discovered policies, they are detailed in this sub-file to be used when
"^DD",365.18,365.18,5,21,3,0)
creating Verification inquiries.
"^DD",365.18,365.185,0)
INSURANCE DISCOVERED SUB-FIELD^^.15^19
"^DD",365.18,365.185,0,"DT")
3180712
"^DD",365.18,365.185,0,"IX","B",365.185,.01)

"^DD",365.18,365.185,0,"NM","INSURANCE DISCOVERED")

"^DD",365.18,365.185,0,"UP")
365.18
"^DD",365.18,365.185,.01,0)
PAYER VA ID^FJ10^^0;1^K:$L(X)>10!($L(X)<1) X
"^DD",365.18,365.185,.01,1,0)
^.1
"^DD",365.18,365.185,.01,1,1,0)
365.185^B
"^DD",365.18,365.185,.01,1,1,1)
S ^IBCN(365.18,DA(1),"INS-FND","B",$E(X,1,30),DA)=""
"^DD",365.18,365.185,.01,1,1,2)
K ^IBCN(365.18,DA(1),"INS-FND","B",$E(X,1,30),DA)
"^DD",365.18,365.185,.01,3)
Enter the EICD Identification response Payer VA ID, must be 1-10 characters in length.
"^DD",365.18,365.185,.01,21,0)
^^3^3^3180608^
"^DD",365.18,365.185,.01,21,1,0)
This is the PAYER VA NATIONAL ID returned from an EICD Identification
"^DD",365.18,365.185,.01,21,2,0)
response. The ID could be "UNKNOWN" and/or not available in the PAYER
"^DD",365.18,365.185,.01,21,3,0)
file. It may be used when creating a Verification inquiry.
"^DD",365.18,365.185,.01,23,0)
^^2^2^3180608^
"^DD",365.18,365.185,.01,23,1,0)
The returned PAYER VA NATIONAL ID may not be a valid entry in the PAYER
"^DD",365.18,365.185,.01,23,2,0)
(#365.12,.02) file. The ID could also be "UNKNOWN".
"^DD",365.18,365.185,.01,"DT")
3180608
"^DD",365.18,365.185,.02,0)
PAYER NAME^FJ80^^0;2^K:$L(X)>80!($L(X)<1) X
"^DD",365.18,365.185,.02,3)
Enter the EICD Identification response Payer Name, must be 1-80 characters in length.
"^DD",365.18,365.185,.02,21,0)
^^4^4^3180608^
"^DD",365.18,365.185,.02,21,1,0)
When the PAYER VA ID (#365.185,.01) is "UNKNOWN", or not found in the
"^DD",365.18,365.185,.02,21,2,0)
PAYER (#365.12) file, this PAYER NAME will be used to populate the
"^DD",365.18,365.185,.02,21,3,0)
INSURANCE COMPANY NAME when creating an INSURANCE VERIFICATION PROCESSOR
"^DD",365.18,365.185,.02,21,4,0)
(#355.33) entry for manual processing.
"^DD",365.18,365.185,.02,"DT")
3180608
"^DD",365.18,365.185,.03,0)
GROUP NUMBER^FJ17^^0;3^K:$L(X)>17!($L(X)<2) X
"^DD",365.18,365.185,.03,3)
Enter the EICD Identification response Group Number, must be 2-17 characters in length.
"^DD",365.18,365.185,.03,21,0)
^^2^2^3180605^
"^DD",365.18,365.185,.03,21,1,0)
This is the Group number returned in an EICD Identification response, it
"^DD",365.18,365.185,.03,21,2,0)
will be used when creating a Verification inquiry.
"^DD",365.18,365.185,.03,"DT")
3180608
"^DD",365.18,365.185,.04,0)
SUBSCRIBER ID^FJ80^^0;4^K:$L(X)>80!($L(X)<3) X
"^DD",365.18,365.185,.04,3)
Enter the EICD Identification response Subscriber ID, must be 3-80 characters in length.
"^DD",365.18,365.185,.04,21,0)
^^2^2^3180605^
"^DD",365.18,365.185,.04,21,1,0)
This is the Subscriber ID returned in an EICD Identification response, it
"^DD",365.18,365.185,.04,21,2,0)
will be used when creating a Verification inquiry.
"^DD",365.18,365.185,.04,"DT")
3180608
"^DD",365.18,365.185,.05,0)
MEMBER ID^FJ20^^0;5^K:$L(X)>20!($L(X)<1) X
"^DD",365.18,365.185,.05,3)
Enter the EICD Identification response Member ID, must be 1-20 characters in length.
"^DD",365.18,365.185,.05,21,0)
^^2^2^3180605^
"^DD",365.18,365.185,.05,21,1,0)
This is the Member ID returned in an EICD Identification response, it
"^DD",365.18,365.185,.05,21,2,0)
will be used when creating a Verification inquiry.
"^DD",365.18,365.185,.05,"DT")
3180608
"^DD",365.18,365.185,.06,0)
SUBSCRIBER SSN^FJ13^^0;6^K:$L(X)>13!($L(X)<9) X
"^DD",365.18,365.185,.06,3)
Enter the EICD Identification response Subscriber SSN, must be 9-13 characters in length.
"^DD",365.18,365.185,.06,21,0)
^^2^2^3180703^
"^DD",365.18,365.185,.06,21,1,0)
This is the Subscriber SSN returned in an EICD Identification response. It
"^DD",365.18,365.185,.06,21,2,0)
may be used to further research the response.
"^DD",365.18,365.185,.06,"DT")
3180703
"^DD",365.18,365.185,.07,0)
INSURED DOB^D^^0;7^S %DT="EX" D ^%DT S X=Y K:Y<1 X
"^DD",365.18,365.185,.07,3)
Enter the EICD Identification response Insured (Subscriber) Date of Birth.
"^DD",365.18,365.185,.07,21,0)
^^2^2^3180608^
"^DD",365.18,365.185,.07,21,1,0)
This is the Insured DOB (Subscriber) returned in an EICD Identification
"^DD",365.18,365.185,.07,21,2,0)
response, it will be used when creating a Verification inquiry.
"^DD",365.18,365.185,.07,"DT")
3180608
"^DD",365.18,365.185,.08,0)
INSURED SEX^S^F:FEMALE;M:MALE;^0;8^Q
"^DD",365.18,365.185,.08,3)
Enter the EICD Identification response Insured (Subscriber) sex, (M or F).
"^DD",365.18,365.185,.08,21,0)
^^2^2^3180608^
"^DD",365.18,365.185,.08,21,1,0)
This is the Insured sex (Subscriber) returned in an EICD Identification
"^DD",365.18,365.185,.08,21,2,0)
response, it will be used when creating a Verification inquiry.
"^DD",365.18,365.185,.08,"DT")
3180608
"^DD",365.18,365.185,.09,0)
NAME OF INSURED^FJ30^^0;9^K:$L(X)>30!($L(X)<2) X
"^DD",365.18,365.185,.09,3)
Enter the EICD Identification response Insured (Subscriber) name, must be 2-30 characters in length.
"^DD",365.18,365.185,.09,21,0)
^^2^2^3180608^
"^DD",365.18,365.185,.09,21,1,0)
This is the Insured name (Subscriber) returned in an EICD Identification
"^DD",365.18,365.185,.09,21,2,0)
response, it will be used when creating a Verification inquiry.
"^DD",365.18,365.185,.09,"DT")
3180608
"^DD",365.18,365.185,.1,0)
SUBSCRIBER ADDRESS LINE 1^FJ55^^0;10^K:$L(X)>55!($L(X)<1) X
"^DD",365.18,365.185,.1,3)
Enter the EICD Identification response Subscriber addr line 1, must be 1-55 characters in length.
"^DD",365.18,365.185,.1,21,0)
^^2^2^3180605^
"^DD",365.18,365.185,.1,21,1,0)
This is the Subscriber address line 1 returned in an EICD Identification
"^DD",365.18,365.185,.1,21,2,0)
response, it will be used when creating a Verification inquiry.
"^DD",365.18,365.185,.1,"DT")
3180608
"^DD",365.18,365.185,.11,0)
SUBSCRIBER ADDRESS LINE 2^FJ55^^0;11^K:$L(X)>55!($L(X)<1) X
"^DD",365.18,365.185,.11,3)
Enter the EICD Identification response Subscriber addr line 2, must be 1-55 characters in length.
"^DD",365.18,365.185,.11,21,0)
^^2^2^3180605^
"^DD",365.18,365.185,.11,21,1,0)
This is the Subscriber address line 2 returned in an EICD Identification
"^DD",365.18,365.185,.11,21,2,0)
response, it will be used when creating a Verification inquiry.
"^DD",365.18,365.185,.11,"DT")
3180608
"^DD",365.18,365.185,.12,0)
SUBSCRIBER ADDRESS CITY^FJ30^^0;12^K:$L(X)>30!($L(X)<1) X
"^DD",365.18,365.185,.12,3)
Enter the EICD Identification response Subscriber addr city, must be 1-30 characters in length.
"^DD",365.18,365.185,.12,21,0)
^^2^2^3180605^
"^DD",365.18,365.185,.12,21,1,0)
This is the Subscriber address city returned in an EICD Identification
"^DD",365.18,365.185,.12,21,2,0)
response, it will be used when creating a Verification inquiry.
"^DD",365.18,365.185,.12,"DT")
3180608
"^DD",365.18,365.185,.13,0)
SUBSCRIBER ADDRESS STATE^P5'^DIC(5,^0;13^Q
"^DD",365.18,365.185,.13,3)
Enter the EICD Identification response Subscriber addr state.
"^DD",365.18,365.185,.13,21,0)
^^2^2^3180605^
"^DD",365.18,365.185,.13,21,1,0)
This is the Subscriber address state returned in an EICD Identification
"^DD",365.18,365.185,.13,21,2,0)
response, it will be used when creating a Verification inquiry.
"^DD",365.18,365.185,.13,"DT")
3180608
"^DD",365.18,365.185,.14,0)
SUBSCRIBER ADDRESS ZIP^FJ15^^0;14^K:$L(X)>15!($L(X)<1) X
"^DD",365.18,365.185,.14,3)
Enter the EICD Identification response Subscriber addr zip, must be 1-15 characters in length.
"^DD",365.18,365.185,.14,21,0)
^^2^2^3180605^
"^DD",365.18,365.185,.14,21,1,0)
This is the Subscriber address zip returned in an EICD Identification
"^DD",365.18,365.185,.14,21,2,0)
response, it will be used when creating a Verification inquiry.
"^DD",365.18,365.185,.14,"DT")
3180608
"^DD",365.18,365.185,.15,0)
DEPENDENT POLICY (Y/N?)^S^0:N;1:Y;^0;15^Q
"^DD",365.18,365.185,.15,3)
Enter Y if this is a Dependent Policy, otherwise enter N.
"^DD",365.18,365.185,.15,21,0)
^^2^2^3180703^
"^DD",365.18,365.185,.15,21,1,0)
This field will be set to 1 any time there is a GT1 record associated with
"^DD",365.18,365.185,.15,21,2,0)
an EICD Identification response.
"^DD",365.18,365.185,.15,"DT")
3180703
"^DD",365.18,365.185,1.01,0)
EICD VER INQ TRANSMISSION^P365.1'^IBCN(365.1,^1;1^Q
"^DD",365.18,365.185,1.01,1,0)
^.1
"^DD",365.18,365.185,1.01,1,1,0)
365.18^C
"^DD",365.18,365.185,1.01,1,1,1)
S ^IBCN(365.18,"C",$E(X,1,30),DA(1),DA)=""
"^DD",365.18,365.185,1.01,1,1,2)
K ^IBCN(365.18,"C",$E(X,1,30),DA(1),DA)
"^DD",365.18,365.185,1.01,1,1,3)
DO NOT DELETE
"^DD",365.18,365.185,1.01,1,1,"%D",0)
^.101^2^2^3180712^^^^
"^DD",365.18,365.185,1.01,1,1,"%D",1,0)
The cross-reference allows quickly locating the EICD VER INQ TRANSMISSION 
"^DD",365.18,365.185,1.01,1,1,"%D",2,0)
record from an IIV TRANSMISSION QUEUE entry.
"^DD",365.18,365.185,1.01,1,1,"DT")
3180605
"^DD",365.18,365.185,1.01,3)
Select the IIV TRANSMISSION QUEUE record associated with this EICD Verification inquiry.
"^DD",365.18,365.185,1.01,21,0)
^^2^2^3180612^
"^DD",365.18,365.185,1.01,21,1,0)
This is the IIV TRANSMISSION QUEUE record associated with an EICD
"^DD",365.18,365.185,1.01,21,2,0)
Verification inquiry.
"^DD",365.18,365.185,1.01,23,0)
^^2^2^3180608^
"^DD",365.18,365.185,1.01,23,1,0)
VistA populates this field with a pointer to the IIV TRANSMISSION QUEUE
"^DD",365.18,365.185,1.01,23,2,0)
(#365.1) associated with an EICD Verification inquiry.
"^DD",365.18,365.185,1.01,"DT")
3180712
"^DD",365.18,365.185,1.02,0)
EICD VER INQ DATE CREATED^D^^1;2^S %DT="EX" D ^%DT S X=Y K:X<1 X
"^DD",365.18,365.185,1.02,3)
Enter the date that the associated IIV TRANSMISSION QUEUE entry was created.
"^DD",365.18,365.185,1.02,21,0)
^^2^2^3180608^^^^
"^DD",365.18,365.185,1.02,21,1,0)
This is the date that the IIV Transmission Queue entry was created for an 
"^DD",365.18,365.185,1.02,21,2,0)
EICD Verification inquiry.
"^DD",365.18,365.185,1.02,23,0)
^^2^2^3180608^^
"^DD",365.18,365.185,1.02,23,1,0)
This is the date that the IIV TRANSMISSION QUEUE entry pointed to by EICD 
"^DD",365.18,365.185,1.02,23,2,0)
VER INQ TRANSMISSION (365.185,1.01) field was created.
"^DD",365.18,365.185,1.02,"DT")
3180608
"^DD",365.18,365.185,1.03,0)
EICD VER RESPONSE^P365'^IBCN(365,^1;3^Q
"^DD",365.18,365.185,1.03,1,0)
^.1
"^DD",365.18,365.185,1.03,1,1,0)
365.18^D
"^DD",365.18,365.185,1.03,1,1,1)
S ^IBCN(365.18,"D",$E(X,1,30),DA(1),DA)=""
"^DD",365.18,365.185,1.03,1,1,2)
K ^IBCN(365.18,"D",$E(X,1,30),DA(1),DA)
"^DD",365.18,365.185,1.03,1,1,3)
DO NOT DELETE
"^DD",365.18,365.185,1.03,1,1,"%D",0)
^.101^2^2^3180712^^^
"^DD",365.18,365.185,1.03,1,1,"%D",1,0)
The cross-reference allows quickly locating the EICD VER RESPONSE record
"^DD",365.18,365.185,1.03,1,1,"%D",2,0)
from an IIV RESPONSE entry.
"^DD",365.18,365.185,1.03,1,1,"DT")
3180605
"^DD",365.18,365.185,1.03,3)
Select the IIV RESPONSE entry associated with an EICD Verification.
"^DD",365.18,365.185,1.03,21,0)
^^2^2^3180612^
"^DD",365.18,365.185,1.03,21,1,0)
This is the IIV RESPONSE file record associated with an EICD Verification
"^DD",365.18,365.185,1.03,21,2,0)
response.
"^DD",365.18,365.185,1.03,"DT")
3180712
"^DD",365.18,365.185,1.04,0)
EICD VER RESPONSE RESULT^S^0:ERROR;1:ACTIVE POLICY;2:INACTIVE POLICY;3:AMBIGUOUS;^1;4^Q
"^DD",365.18,365.185,1.04,3)
Enter the EICD Verification response result code.
"^DD",365.18,365.185,1.04,21,0)
^^2^2^3180605^
"^DD",365.18,365.185,1.04,21,1,0)
This field contains a result code based on response data returned from an
"^DD",365.18,365.185,1.04,21,2,0)
EICD Verification inquiry.
"^DD",365.18,365.185,1.04,"DT")
3180608
"^DIC",365.18,365.18,0)
EIV EICD TRACKING^365.18
"^DIC",365.18,365.18,0,"GL")
^IBCN(365.18,
"^DIC",365.18,365.18,"%D",0)
^1.001^4^4^3180612^^
"^DIC",365.18,365.18,"%D",1,0)
This file allows VistA to track data associated with the
"^DIC",365.18,365.18,"%D",2,0)
Electronic Insurance Coverage Discovery (EICD) extract process. 
"^DIC",365.18,365.18,"%D",3,0)
Both Identification and Verification EICD transactions (inquires and 
"^DIC",365.18,365.18,"%D",4,0)
responses) are detailed an tracked in this file.
"^DIC",365.18,"B","EIV EICD TRACKING",365.18)

"BLD",10972,6)
6^
$END KID IB*2.0*621
