IBCNERPE ;DAOU/BHS - IBCNE IIV RESPONSE REPORT (cont'd);03-JUN-2002
 ;;2.0;INTEGRATED BILLING;**271,300**;21-MAR-94
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
 ;
 ; Must call at tag
 Q
 ;
 ; This tag is only called from IBCNERP2
 ;
GETDATA(IEN,RPTDATA) ; Retrieve response data
 ; Init
 N EBCT,NOTECT,EBPTR,PC,CNCT,CNPTR,NWNTCT,IBNOTES,IBERR
 N %,DIW,DIWI,DIWT,DIWTC,DIWX,DN,I,Z,ERRTEXT,II,FUTDT,TQIEN
 N FRST,IIVSTR,IIVSTAT
 ;
 ; Insured Info from IIV Response #365
 S RPTDATA(0)=$G(^IBCN(365,IEN,0)),TQIEN=$P(RPTDATA(0),U,5)
 ; Trans dates to ext format
 S $P(RPTDATA(0),U,7)=$$FMTE^XLFDT($P(RPTDATA(0),U,7)\1,"5Z")
 S RPTDATA(1)=$G(^IBCN(365,IEN,1))
 ; Trans ext values for SET of CODES values
 S $P(RPTDATA(1),U,8)=$$GET1^DIQ(365,IEN_",",1.08,"E")   ; Whose Ins
 S $P(RPTDATA(1),U,9)=$$GET1^DIQ(365,IEN_",",1.09,"E")   ; Pt Rel to Sub
 S $P(RPTDATA(1),U,13)=$$GET1^DIQ(365,IEN_",",1.13,"E")  ; COB
 ; Trans err actions/codes to ext
 S $P(RPTDATA(1),U,14)=$$X12^IBCNERP2(365.017,$P(RPTDATA(1),U,14))
 S $P(RPTDATA(1),U,15)=$$X12^IBCNERP2(365.018,$P(RPTDATA(1),U,15))
 ; Trans dates to ext format - check format
 F PC=2,9:1:12,16,17,19 S $P(RPTDATA(1),U,PC)=$$FMTE^XLFDT($P(RPTDATA(1),U,PC),"5Z")
 ;
 ; Loop thru mult Elig/Ben segs
 S EBCT=0,IIVSTAT=""
 ; Check to see if the IIV STATUS flag was passed
 ; If so, set IIVSTAT to its value and update RPTDATA
 S FRST=$O(^IBCN(365,IEN,2,0))
 I FRST D
 . S IIVSTR=$G(^IBCN(365,IEN,2,FRST,0))
 . I $P(IIVSTR,U,6)="IIV Eligibility Determination" D
 ..  S EBCT=FRST,IIVSTAT=$P(IIVSTR,U)
 ..  ; Convert IEN to X12 code
 ..  S IIVSTAT=$$GET1^DIQ(365.02,EBCT_","_IEN_",","ELIGIBILITY/BENEFIT INFO:CODE")
 ..  S IIVSTAT=$S(IIVSTAT=1:"Active",IIVSTAT=6:"Inactive",1:"U")
 ..  S RPTDATA(2,0)=IIVSTAT,RPTDATA(2,EBCT)=""
 ; Error action/condition shd be flagged as Undetermined - no EC flg sent
 I IIVSTAT="",$P(RPTDATA(1),U,14)]""!($P(RPTDATA(1),U,15)]"") S (IIVSTAT,RPTDATA(2,0))="U"
 F  S EBCT=$O(^IBCN(365,IEN,2,EBCT)) Q:'EBCT  D
 .  S RPTDATA(2,EBCT)=$G(^IBCN(365,IEN,2,EBCT,0))
 .  ; Elig/Ben Info (ptr to EB01 table)
 .  S $P(RPTDATA(2,EBCT),U,2)=$$X12^IBCNERP2(365.011,$P(RPTDATA(2,EBCT),U,2))
 .  ; Cov Lvl Code (ptr to EB02 table)
 .  S $P(RPTDATA(2,EBCT),U,3)=$$X12^IBCNERP2(365.012,$P(RPTDATA(2,EBCT),U,3))
 .  ; Svc Type Code (ptr to EB03 table)
 .  S $P(RPTDATA(2,EBCT),U,4)=$$X12^IBCNERP2(365.013,$P(RPTDATA(2,EBCT),U,4))
 .  ; Ins Type Code (ptr to EB04 table)
 .  S $P(RPTDATA(2,EBCT),U,5)=$$X12^IBCNERP2(365.014,$P(RPTDATA(2,EBCT),U,5))
 .  ; Plan Cov Desc - free text
 .  ; Time Pd Qual (ptr to EB06 table)
 .  S $P(RPTDATA(2,EBCT),U,7)=$$X12^IBCNERP2(365.015,$P(RPTDATA(2,EBCT),U,7))
 .  ; Monetary Amt
 .  I $P(RPTDATA(2,EBCT),U,8)'="" S $P(RPTDATA(2,EBCT),U,8)="$"_$FN(+$P(RPTDATA(2,EBCT),U,8),",",2)
 .  ; Percent
 .  I $P(RPTDATA(2,EBCT),U,9)'="" S $P(RPTDATA(2,EBCT),U,9)=$S($P(RPTDATA(2,EBCT),U,9)<1:$P(RPTDATA(2,EBCT),U,9)*100,1:$P(RPTDATA(2,EBCT),U,9))_"%"
 .  ; Qty Qual (ptr to EB09)
 .  S $P(RPTDATA(2,EBCT),U,10)=$$X12^IBCNERP2(365.016,$P(RPTDATA(2,EBCT),U,10))
 .  ; Qty
 .  I $P(RPTDATA(2,EBCT),U,11)'="" S $P(RPTDATA(2,EBCT),U,10)=$P(RPTDATA(2,EBCT),U,11)_" "_$P(RPTDATA(2,EBCT),U,10),$P(RPTDATA(2,EBCT),U,11)=""
 .  ; Auth/Cert Ind (Y/N/U)
 .  I $P(RPTDATA(2,EBCT),U,12)'="" S $P(RPTDATA(2,EBCT),U,12)=$$GET1^DIQ(365.02,EBCT_","_IEN_",",.12,"E")
 .  ; In-Plan Network Ind (Y/N/U)
 .  I $P(RPTDATA(2,EBCT),U,13)'="" S $P(RPTDATA(2,EBCT),U,13)=$$GET1^DIQ(365.02,EBCT_","_IEN_",",.13,"E")
 .  ; Loop thru Notes (wp) - format to 70 chars
 .  S (NOTECT,NWNTCT)=0
 .  F  S NOTECT=$O(^IBCN(365,IEN,2,EBCT,2,NOTECT)) Q:'NOTECT  D
 .  .  D FSTRNG^IBJU1($G(^IBCN(365,IEN,2,EBCT,2,NOTECT,0)),70,.IBNOTES)
 .  .  ; Loop thru text (70 chars wide)
 .  .  S II=0
 .  .  F  S II=$O(IBNOTES(II)) Q:'II  I $G(IBNOTES(II))'="" D
 .  .  .  S NWNTCT=NWNTCT+1
 .  .  .  S RPTDATA(2,EBCT,NWNTCT)=$G(IBNOTES(II))
 ;
 ; Loop thru mult Contact segs
 S CNCT=0
 F  S CNCT=$O(^IBCN(365,IEN,3,CNCT)) Q:'CNCT  D
 .  S RPTDATA(3,CNCT)=$G(^IBCN(365,IEN,3,CNCT,0))
 .  ; Disp. blank if NOT SPECIFIED
 .  I $P(RPTDATA(3,CNCT),U)="NOT SPECIFIED" S $P(RPTDATA(3,CNCT),U)=""
 .  ; Comm Qual #1-3
 .  F II=1:1:3 D
 .  . S CNPTR=$$X12^IBCNERP2(365.021,$P(RPTDATA(3,CNCT),U,II*2))
 .  . I CNPTR'="" S $P(RPTDATA(3,CNCT),U,II*2)=CNPTR_": "_$P(RPTDATA(3,CNCT),U,II*2+1),$P(RPTDATA(3,CNCT),U,II*2+1)=""
 ;
 ; Error Txt
 S ERRTEXT=$G(^IBCN(365,IEN,4))
 ; Error text shd be flagged as Undetermined - no EC flg sent
 I IIVSTAT="" S (IIVSTAT,RPTDATA(2,0))="U"
 I ERRTEXT="" G FUTDT
 D FSTRNG^IBJU1(ERRTEXT,60,.IBERR)
 ; Loop thru text (60 chars)
 S II=0
 F  S II=$O(IBERR(II)) Q:'II  I $G(IBERR(II))'="" D
 .  S RPTDATA(4,II)=$G(IBERR(II))
FUTDT I TQIEN D  ; If there is a future date, display it
 . S FUTDT=$P($G(^IBCN(365.1,TQIEN,0)),U,9) Q:FUTDT=""
 . S II=$O(RPTDATA(5,""),-1)+1
 . S RPTDATA(5,II)=" ",II=II+1
 . S RPTDATA(5,II)="Inquiry will be automatically resubmitted on "_$$FMTE^XLFDT(FUTDT,"5Z")_"."
 ; 
GETDATX ; GETDATA exit point
 Q
 ;
 ; This tag is only called from IBCNERP3
 ;
DATA(DISPDATA)  ;  Build disp lines
 N LCT,EBCT,CT,SEGCT,ITEM,CT2,NTCT,CNCT,ERCT,RPTDATA
 ; Merge into local array
 ;M RPTDATA=^TMP($J,RTN,SORT1,SORT2,CNT)
 N %X,%Y
 S %X="^TMP($J,RTN,SORT1,SORT2,CNT,"
 S %Y="RPTDATA("
 I $D(^TMP($J,RTN,SORT1,SORT2,CNT))#10=1 S RPTDATA=^TMP($J,RTN,SORT1,SORT2,CNT)
 D %XY^%RCR K %X,%Y
 ; Build
 S LCT=1,DISPDATA(LCT)=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.01),17,"R")_$P(RPTDATA(1),U,1)
 S LCT=LCT+1,DISPDATA(LCT)=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.05),17,"R")_$$FO^IBCNEUT1($P(RPTDATA(1),U,5),20)_$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.02),22,"R")_$P(RPTDATA(1),U,2)
 S LCT=LCT+1,DISPDATA(LCT)=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.03),17,"R")_$$FO^IBCNEUT1($P(RPTDATA(1),U,3),20)_$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.04),22,"R")_$P(RPTDATA(1),U,4)
 S LCT=LCT+1,DISPDATA(LCT)=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.06),17,"R")_$$FO^IBCNEUT1($P(RPTDATA(1),U,6),20)_$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.07),22,"R")_$P(RPTDATA(1),U,7)
 S LCT=LCT+1,DISPDATA(LCT)=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.08),17,"R")_$$FO^IBCNEUT1($P(RPTDATA(1),U,8),20)_$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.09),22,"R")_$P(RPTDATA(1),U,9)
 S LCT=LCT+1,DISPDATA(LCT)=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.18),17,"R")_$$FO^IBCNEUT1($P(RPTDATA(1),U,18),20)_$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.13),22,"R")_$P(RPTDATA(1),U,13)
 S LCT=LCT+1,DISPDATA(LCT)=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.1),17,"R")_$$FO^IBCNEUT1($P(RPTDATA(1),U,10),20)_$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.16),22,"R")_$P(RPTDATA(1),U,16)
 S LCT=LCT+1,DISPDATA(LCT)=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.11),17,"R")_$$FO^IBCNEUT1($P(RPTDATA(1),U,11),20)_$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.17),22,"R")_$P(RPTDATA(1),U,17)
 S LCT=LCT+1,DISPDATA(LCT)=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.12),17,"R")_$$FO^IBCNEUT1($P(RPTDATA(1),U,12),20)_$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.19),22,"R")_$P(RPTDATA(1),U,19)
 S LCT=LCT+1,DISPDATA(LCT)=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,.07),17,"R")_$$FO^IBCNEUT1($P(RPTDATA(0),U,7),20)_$$FO^IBCNEUT1($$LBL^IBCNERP2(365,.09),22,"R")_$P(RPTDATA(0),U,9)
 S LCT=LCT+1,DISPDATA(LCT)=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.2),17,"R")_$$FO^IBCNEUT1($P(RPTDATA(1),U,20),20)
 S LCT=LCT+1
 ; Elig/Ben - added sorted EB notes to DISPDATA and update LCT (line ct)
 D EBDISP^IBCNERPA(.RPTDATA,.DISPDATA,.LCT)
 ;
 ; Contacts
CONT S CNCT=+$O(RPTDATA(3,""),-1) I 'CNCT G ERR
 S DISPDATA(LCT)="",LCT=LCT+1,DISPDATA(LCT)="Contact Information:",LCT=LCT+1
 ; Build
 F CT=1:1:CNCT D
 . S DISPDATA(LCT)="",LCT=LCT+1,DISPDATA(LCT)=" "
 . S SEGCT=$L(RPTDATA(3,CT),U)
 . F CT2=1:1:SEGCT S ITEM=$P(RPTDATA(3,CT),U,CT2) I $L(ITEM)>0 D
 . . I $L(ITEM)+$L(DISPDATA(LCT))>74 S LCT=LCT+1,DISPDATA(LCT)=" "_ITEM Q
 . . I DISPDATA(LCT)'=" " S DISPDATA(LCT)=DISPDATA(LCT)_",  "_ITEM Q
 . . S DISPDATA(LCT)=" "_ITEM
 . S LCT=LCT+1
 ; Err Info
ERR I $P(RPTDATA(1),U,14)="",$P(RPTDATA(1),U,15)="",'$O(RPTDATA(4,""),-1) G DATAX
 S DISPDATA(LCT)="",LCT=LCT+1
 S DISPDATA(LCT)="Error Information:",LCT=LCT+1
 S DISPDATA(LCT)="",LCT=LCT+1
 I $P(RPTDATA(1),U,14)'="" D
 . ; Split text, if necessary
 . N IBERR,IBTOT,IBCT
 . D FSTRNG^IBJU1($P(RPTDATA(1),U,14),60,.IBERR)
 . S IBTOT=$O(IBERR(""),-1)
 . F IBCT=1:1:IBTOT S DISPDATA(LCT)=" "_$$FO^IBCNEUT1($S(IBCT=1:$$LBL^IBCNERP2(365,1.14),1:" "),17,"R")_$G(IBERR(IBCT)),LCT=LCT+1
 I $P(RPTDATA(1),U,15)'="" D
 . ; Split text, if necessary
 . N IBERR,IBTOT,IBCT
 . D FSTRNG^IBJU1($P(RPTDATA(1),U,15),60,.IBERR)
 . S IBTOT=$O(IBERR(""),-1)
 . F IBCT=1:1:IBTOT S DISPDATA(LCT)=" "_$$FO^IBCNEUT1($S(IBCT=1:$$LBL^IBCNERP2(365,1.15),1:" "),17,"R")_$G(IBERR(IBCT)),LCT=LCT+1
 ; Disp Err Txt
 F CT=1:1:+$O(RPTDATA(4,""),-1) D
 . I CT=1 S DISPDATA(LCT)=" "_$$FO^IBCNEUT1($$LBL^IBCNERP2(365,4.01),17,"R")_$G(RPTDATA(4,CT)),LCT=LCT+1 Q
 . S DISPDATA(LCT)=" "_$$FO^IBCNEUT1("",17,"R")_$G(RPTDATA(4,CT)),LCT=LCT+1
DATAX ;
 ; Disp Future Date and Misc. Comments
 I $O(RPTDATA(5,0))'="" D
 . F CT=1:1:+$O(RPTDATA(5,""),-1) D
 .. S DISPDATA(LCT)=" "_$$FO^IBCNEUT1("",7,"R")_$G(RPTDATA(5,CT)),LCT=LCT+1
 ;
 Q