178 lines
8.8 KiB
Mathematica
178 lines
8.8 KiB
Mathematica
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
|