IBCNERP3 ;DAOU/BHS - IBCNE eIV RESPONSE REPORT PRINT ; 03-JUN-2002
;;2.0;INTEGRATED BILLING;**184,271,416,528,602,702,737,752**;21-MAR-94;Build 20
;;Per VA Directive 6402, this routine should not be modified.
;
; eIV - Insurance Verification
;
; Called by IBCNERPA
; Input from IBCNERP1/2:
; IBCNERTN="IBCNERP1" - Driver rtn
; IBCNESPC("BEGDT")=Start Dt, IBCNESPC("ENDDT")=End Dt
; IBCNESPC("PYR")=Pyr IEN OR "" for all
; IBCNESPC("PAT")=Pat IEN OR "" for all
; IBCNESPC("TYPE")=A (All Responses) OR M (Most Recent Responses) for
; unique Pyr/Pt pair
; IBCNESPC("SORT")=1 (PyrNm) OR 2 (PatNm)
; IBCNESPC("TRCN")=Trace #^IEN, if non-null, all params null
; IBCNESPC("RFLAG")=Report Flag used to indicate which report is being
; run. Response Report (0), Inactive Report (1), or Ambiguous
; Report (2).
; IBCNESPC("DTEXP")=Expiration date used in the inactive policy report
; IBOUT="R" for Report format or "E" for Excel format
;
; Based on structure of eIV Response File (#365)
; ^TMP($J,IBCNERTN,S1,S2,CT,0) based on ^IBCN(365,DA,0)
; IBCNERTN="IBCNERP1", S1=PyrName(SORT=1) or PatNm(SORT=2),
; S2=PatName(SORT=1) or PyrName(SORT=2), CT=Seq ct
; ^TMP($J,IBCNERTN,S1,S2,CT,1) based on ^IBCN(365,DA,1)
; ^TMP($J,IBCNERTN,S1,S2,2,EBCT) based on ^IBCN(365,DA,2)
; EBCT=E/B IEN (365.02)
; ^TMP($J,IBCNERTN,S1,S2,2,EBCT,NTCT)=based on ^IBCN(365,DA,2,EB,NT)
; NTCT=Notes Ct, may not be Notes IEN, if line wrapped (365.021)
; ^TMP($J,IBCNERTN,S1,S2,2,CNCT) based on ^IBCN(365,DA,3)
; CNCT=Cont Pers IEN (365.03)
; ^TMP($J,IBCNERTN,S1,S2,4,CT)= err txt based on ^IBCN(365,DA,4)
; CT=1/2 if >60 ch long
; ^TMP($J,IBCNERTN,S1,S2,5,CT)= based on # lines of comments reqd
; CT=1 to display future retransmission date
; Must call at appropriate tag
Q
;
;IB*752/DTG added param IBFEED to input
PRINT(RTN,BDT,EDT,PYR,PAT,TYP,SRT,PGC,PXT,MAX,CRT,TRC,EXP,IPRF,IBRDT,IBOUT,IBFEED) ; Print data
; Input: RTN="IBCENRP1", BDT=start dt, EDT=end dt, PYR=pyr ien,
; PAT= pat ien, TYP=A/M, SRT=1/2, PGC=page ct, PXT=exit flg,
; MAX=max line ct/pg, CRT=1/0, TRC=trc#, EXP=earliest expiration date,IBRDT=today's date/time formatted
N EORMSG,NONEMSG,SORT1,SORT2,CNT,CNFLG,ERFLG,PRT1,PRT2,DISPDATA
N OPRT1,OPRT2 ; Original values for PRT1 and PRT2, respectively
N IBHDR,IBDTA ; IB*702/ new vars
S EORMSG="*** END OF REPORT ***"
S NONEMSG="* * * N O D A T A F O U N D * * *"
S (SORT1,SORT2)=""
S IBFEED=$G(IBFEED) S:IBFEED="" IBFEED=MAX ;IB*752/DTG if IBFEED is null set to MAX
;
; IB*702/DTG start no form feed between no data the header and end of report
;D PHDL:IBOUT="E" I $G(ZTSTOP)!PXT G PRINTX
S IBHDR=$S(IBOUT="E":"PHDL",1:"HEADER"),IBDTA=+$D(^TMP($J,RTN))
I IBDTA D PHDL:IBOUT="E" I $G(ZTSTOP)!PXT G PRINTX
;
; If global does not exist - display No Data message
; I '$D(^TMP($J,RTN)) D @IBHDR W !,?(80-$L(NONEMSG)\2),NONEMSG,!!
I 'IBDTA D @IBHDR W ! W:$G(IBOUT)="R" ?23 W NONEMSG W:$G(IBOUT)="R" !! G PRINTEOR
; IB*702/DTG end no form feed between no data the header and end of report
;
F S SORT1=$O(^TMP($J,RTN,SORT1)) Q:SORT1="" D Q:PXT!$G(ZTSTOP)
. S (OPRT1,PRT1)=SORT1
. S SORT2="" F S SORT2=$O(^TMP($J,RTN,SORT1,SORT2)) Q:SORT2="" D Q:PXT!$G(ZTSTOP)
. . S (OPRT2,PRT2)=SORT2
. . S CNT="" F S CNT=$O(^TMP($J,RTN,SORT1,SORT2,CNT)) Q:CNT="" D Q:PXT!$G(ZTSTOP)
. . . I IBOUT="E" D XLDATA Q
. . . D SSDB ; add SSN (from ^DPT) and DOB to patient header info
. . . D HEADER
. . . I $G(ZTSTOP)!PXT Q
. . . K DISPDATA ; Init disp
. . . D DATA^IBCNERPE(.DISPDATA),LINE(.DISPDATA) ; build/display data
;
I $G(ZTSTOP)!PXT G PRINTX
S (CNFLG,ERFLG)=0
I $Y+1>IBFEED!('PGC) D HEADER:IBOUT="R" I $G(ZTSTOP)!PXT G PRINTX
; IB*702/DTG start EOR message
PRINTEOR ; IB*702 come here for eor if no data
W ! W:$G(IBOUT)="R" ?30 W EORMSG W:$G(IBOUT)="R" !
; IB*702/DTG end EOR message
PRINTX ;
Q
;
XLDATA ; Excel output ; 528
N PYRNM,PTNM,DFN,PTSSN,PTDOB,REFQ,REFID,RFIDSC,PROCD,REFID2,PRIDC,MLIST,EMPST,GOVAFL,DTMP,SRVRNK,MDESC,RPTDATA
M RPTDATA=^TMP($J,RTN,SORT1,SORT2,CNT)
S PYRNM=$P(RPTDATA(0),U,3),PYRNM=$$GET1^DIQ(365.12,PYRNM,.01)
S DFN=$P(RPTDATA(0),U,2),PTNM=$$GET1^DIQ(2,DFN,.01)
S PTSSN=$E($$GETSSN^IBCNEDE5(DFN),6,9),PTDOB=$$GETDOB^IBCNEDEQ(DFN)
;IB*752/TAZ - Removed unnecessary columns from Excel report
;W !,$S(SRT=1:PYRNM,1:PTNM)_U_$S(SRT=1:PTNM,1:PYRNM)_U_PTSSN_U_PTDOB_U_$P(RPTDATA(13),U)_U_$P(RPTDATA(13),U,2)_U_$P(RPTDATA(1),U,2)_U_$P(RPTDATA(1),U,3)_U_$P(RPTDATA(1),U,4)_U_$P(RPTDATA(14),U)_U_$P(RPTDATA(14),U,2)_U_$P(RPTDATA(1),U,8)
;W U_RPTDATA(8)_U_$P(RPTDATA(1),U,18)_U_$P(RPTDATA(1),U,13)_U_$P(RPTDATA(1),U,10)_U_$P(RPTDATA(1),U,16)_U_$P(RPTDATA(1),U,11)_U_$P(RPTDATA(1),U,17)
;W U_$P(RPTDATA(1),U,12)_U_$P(RPTDATA(1),U,19)_U_$P(RPTDATA(0),U,7)_U_$P(RPTDATA(0),U,9)_U_$P(RPTDATA(1),U,20)_U
;D DATA^IBCNERPE(.DISPDATA) ; Build Elig. Ben. global
;D GTDT
;W $G(REFQ)_U_$G(REFID)_U_$G(RFIDSC)_U_$G(PROCD)_U_$G(REFID2)_U_$G(PRIDC)_U_$G(MLIST)_U_$G(EMPST)_U_$G(GOVAFL)_U_$G(DTMP)_U_$G(SRVRNK)_U_$G(MDESC)
W !,$S(SRT=1:PYRNM,1:PTNM)_U_$S(SRT=1:PTNM,1:PYRNM)_U_PTSSN_U_PTDOB_U_$P(RPTDATA(13),U)_U_$P(RPTDATA(13),U,2)_U_$P(RPTDATA(1),U,2)_U_$P(RPTDATA(1),U,4)_U_$P(RPTDATA(14),U)_U_$P(RPTDATA(14),U,2)
W U_RPTDATA(8)_U_$P(RPTDATA(1),U,18)_U_$P(RPTDATA(1),U,16)_U_$P(RPTDATA(1),U,11)
W U_$P(RPTDATA(1),U,12)_U_$P(RPTDATA(0),U,7)_U_$P(RPTDATA(0),U,9)_U_$P(RPTDATA(1),U,20)
Q
;
GTDT ; Get Eligibility/Group Plan Information
;^TMP("EIV RESP. EB DATA",$J,"DISP",1,0)
;S SEL=$$TRIM^XLFSTR($E(Y(0),1,30),"R")
N LN,OUT,DATA
S (REFID,REFQ,RFIDSC,PROCD,REFID2,PRIDC,EMPST,MLIST,DTMP,GOVAFL,SRVRNK,MDESC)=""
S LN=0
F S LN=$O(^TMP("EIV RESP. EB DATA",$J,"DISP",LN)) Q:LN="" D
. S OUT=$G(^TMP("EIV RESP. EB DATA",$J,"DISP",LN,0))
. ;
. I OUT["Reference ID Qualifier:" D
. . S DATA=$P(OUT,"Reference ID Qualifier:",2)
. . S REFID=$$TRIM^XLFSTR($P(DATA,"Reference ID:",2),"R")
. . S REFQ=$$TRIM^XLFSTR($P(DATA,"Reference ID:",1),"R")
. I OUT["Reference ID description:" D
. . S DATA=$P(OUT,"Reference ID description:",2)
. . S RFIDSC=$$TRIM^XLFSTR(DATA,"R")
. I OUT["Provider Code:" D
. . S DATA=$P(OUT,"Provider Code:",2)
. . S PROCD=$$TRIM^XLFSTR(DATA,"R")
. I OUT["Reference ID:" D
. . S DATA=$P(OUT,"Reference ID:",2)
. . S REFID2=$$TRIM^XLFSTR(DATA,"R")
. I OUT["Primary Diagnosis Code:" D
. . S DATA=$P(OUT,"Primary Diagnosis Code:",2)
. . S PRIDC=$$TRIM^XLFSTR(DATA,"R")
. I OUT["Military Info Status:" D
. . S DATA=$P(OUT,"Military Info Status:",2)
. . S EMPST=$$TRIM^XLFSTR($P(DATA,"Employment Status:",2),"R")
. . S MLIST=$$TRIM^XLFSTR($P(DATA,"Employment Status:",1),"R")
. I OUT["Government Affiliation:" D
. . S DATA=$P(OUT,"Government Affiliation:",2)
. . S DTMP=$$TRIM^XLFSTR($P(DATA,"Date Time Period:",2),"R")
. . S GOVAFL=$$TRIM^XLFSTR($P(DATA,"Date Time Period:",1),"R")
. I OUT["Service Rank:" D
. . S DATA=$P(OUT,"Service Rank:",2)
. . S SRVRNK=$$TRIM^XLFSTR(DATA,"R")
. I OUT["Desc:" D
. . S DATA=$P(OUT,"Desc:",2)
. . S MDESC=$$TRIM^XLFSTR(DATA,"R")
Q
;
N X,Y,DIR,DTOUT,DUOUT,OFFSET,HDR,LIN,HDR
I CRT,PGC>0,'$D(ZTQUEUED) D I PXT G HEADERX
. I MAX<51 F LIN=1:1:(IBFEED-$Y) W ! ;IB*752/DTG change MAX to IBFEED
. S DIR(0)="E" D ^DIR K DIR
. I $D(DTOUT)!($D(DUOUT)) S PXT=1 Q
I $D(ZTQUEUED),$$S^%ZTLOAD() S ZTSTOP=1 G HEADERX
;
S PGC=PGC+1
W @IOF,!,?1,$S($G(IPRF)=1:"eIV Inactive Policy Report",$G(IPRF)=2:"eIV Ambiguous Policy Report",1:"eIV Response Report") I TRC'="" W " by Trace #"
;
S HDR=IBRDT_" Page: "_PGC,OFFSET=79-$L(HDR)
W ?OFFSET,HDR
;
I TRC'="" S HDR="Trace #: "_TRC,OFFSET=80-$L(HDR)\2 W !,?OFFSET,HDR
I TRC="" D
. W !,?1,"Sorted by: "_$S(SRT=1:"Payer",1:"Patient")_" Name"
. S HDR="Responses Displayed: "_$S(TYP="M":"Most Recent",1:"All")
. S OFFSET=79-$L(HDR)
. W ?OFFSET,HDR
. ; IB*702/DTG start remove policy exp date
. ;I $G(IPRF)=1 W !,?1,"Earliest Policy Expiration Date: ",$$FMTE^XLFDT(EXP,"5Z"),!
. ; IB*702/DTG end remove policy exp date
. S HDR=$$FMTE^XLFDT(BDT,"5Z")_" - "_$$FMTE^XLFDT(EDT,"5Z")
. S OFFSET=80-$L(HDR)\2
. W !,?OFFSET,HDR
. ; Disp SORT1 rng
. S HDR=""
. I SRT=1,PYR="" S HDR="All Payers"
. I SRT=2,PAT="" S HDR="All Patients"
. I HDR="" D
.. I SRT=1 S HDR=$P($G(^IBE(365.12,PYR,0)),U,1) Q
.. S HDR=$P($G(^DPT(PAT,0)),U,1)
. S OFFSET=80-$L(HDR)\2
. W !,?OFFSET,HDR
. ; Disp SORT2 rng
. S HDR=""
. I SRT=1,PAT="" S HDR="All Patients"
. I SRT=2,PYR="" S HDR="All Payers"
. I HDR="" D
.. I SRT=1 S HDR=$P($G(^DPT(PAT,0)),U,1) Q
.. S HDR=$P($G(^IBE(365.12,PYR,0)),U,1)
. S OFFSET=80-$L(HDR)\2
. W !,?OFFSET,HDR
W !
; Build disp
I SORT1'="",SORT2'="" D
. W !,?1,$$FO^IBCNEUT1($S(TRC'=""!(SRT=1):" Payer: ",1:"Patient: "),9)_$E(PRT1,1,69)
. W !,?1,$$FO^IBCNEUT1($S(TRC'=""!(SRT=1):"Patient: ",1:" Payer: "),9)_$E(PRT2,1,69)
. W !
Q
;
LINE(DISPDATA) ; Print data
N LNCT,LNTOT,NWPG
S LNTOT=+$O(DISPDATA(""),-1)
S (CNFLG,ERFLG,NWPG)=0
F LNCT=1:1:LNTOT D Q:$G(ZTSTOP)!PXT
. I $Y+1>MAX!('PGC) D HEADER S NWPG=1 I $G(ZTSTOP)!PXT Q
. I DISPDATA(LNCT)="Contact Information:"!(DISPDATA(LNCT)="Error Information:"),$Y+3>MAX S (CNFLG,ERFLG)=0 D HEADER S NWPG=1 I $G(ZTSTOP)!PXT Q
. I CNFLG,DISPDATA(LNCT)="",$G(DISPDATA(LNCT+1))="Error Information:" S CNFLG=0
. I NWPG,CNFLG W !,?1,"Contact Information: (cont'd)",!
. I NWPG,ERFLG W !,?1,"Error Information: (cont'd)",!
. I 'NWPG!(NWPG&(DISPDATA(LNCT)'="")) W !,?1,DISPDATA(LNCT)
. I NWPG S NWPG=0
. I DISPDATA(LNCT)["Contact Information:" S ERFLG=0,CNFLG=1
. I DISPDATA(LNCT)["Error Information:" S CNFLG=0,ERFLG=1
. Q
S (CNFLG,ERFLG)=0
LINEX ;
Q
;
SSDB ; Display last 4 digits of SSN and DOB to facilitate pt. identification
; $$SSN^IBCNEDEQ(DFN) returns SSN followed by DOB
;
N DFN
S DFN=$P($G(^TMP($J,RTN,SORT1,SORT2,CNT,0)),U,2)
I DFN D
. I SRT=1!TRC S PRT2=OPRT2_$$SSN^IBCNEDEQ(DFN) Q
. S PRT1=OPRT1_$$SSN^IBCNEDEQ(DFN)
Q
;
PHDL ; - Print the header line for the Excel spreadsheet ; 528
N X
; IB*602/HN ; Add report headers to Excel Spreadsheets
S EHDR=$S($G(IPRF)=1:"eIV Inactive Policy Report",$G(IPRF)=2:"eIV Ambiguous Policy Report",1:"eIV Response Report") I TRC'="" S EHDR=EHDR_"^by Trace #"
W !,EHDR_"^"_$$FMTE^XLFDT($$NOW^XLFDT,1)
;
I TRC'="" S HDR="Trace #: "_TRC W !,HDR
I TRC="" D
. S EHDR="Sorted by: "_$S(SRT=1:"Payer",1:"Patient")_" Name"
. S EHDR=EHDR_"^Responses Displayed: "_$S(TYP="M":"Most Recent",1:"All")
. W !,EHDR S EHDR=""
. ; IB*702/DTG start remove policy exp date
. ;I $G(IPRF)=1 W !,"Earliest Policy Expiration Date: ",$$FMTE^XLFDT(EXP,"5Z")
. ; IB*702/DTG end remove policy exp date
. S EHDR=$$FMTE^XLFDT(BDT,"5Z")_" - "_$$FMTE^XLFDT(EDT,"5Z")
. W !,EHDR
. ; Disp SORT1 rng
. S EHDR=""
. I SRT=1,PYR="" S EHDR="All Payers"
. I SRT=2,PAT="" S EHDR="All Patients"
. I EHDR="" D
.. I SRT=1 S EHDR=$P($G(^IBE(365.12,PYR,0)),U,1) Q
.. S EHDR=$P($G(^DPT(PAT,0)),U,1)
. W !,EHDR
. ; Disp SORT2 rng
. S EHDR=""
. I SRT=1,PAT="" S EHDR="All Patients"
. I SRT=2,PYR="" S EHDR="All Payers"
. I EHDR="" D
.. I SRT=1 S EHDR=$P($G(^DPT(PAT,0)),U,1) Q
.. S EHDR=$P($G(^IBE(365.12,PYR,0)),U,1)
. W !,EHDR
W !
; Build disp
I SORT1'="",SORT2'="" D
. W !,$$FO^IBCNEUT1($S(TRC'=""!(SRT=1):" Payer: ",1:"Patient: "),9)_$E(PRT1,1,69)
. W !,$$FO^IBCNEUT1($S(TRC'=""!(SRT=1):"Patient: ",1:" Payer: "),9)_$E(PRT2,1,69)
. W !
K EHDR
; IB*602/HN end
S PGC=1
;IB*752/TAZ - Removed unnecessary column headers from Excel report
;S X=$S(SRT=1:"Payer",1:"Patient")_U_$S(SRT=1:"Patient",1:"Payer")_"^Patient SSN^Patient DOB^Subscriber^Subscriber ID^Subscriber DOB^Subscriber SSN^Subscriber Sex^Group Name^Group ID"
;S X=X_"^Whose Insurance^Pt Relationship to Subscriber^Member ID^COB^Service Date^Date of Death^Effective Date^Certification Date^Expiration Date^Payer Updated Policy"
;S X=X_"^Response Date^Trace #^Policy Number^Reference ID Qualifier^Reference ID^Reference ID Description^Provider Code^Reference ID^Primary Diagnosis Code^Military Info Status"
;W X
;S X="^Employment Status^Government Affiliation^Date Time Period^Service Rank^Desc"
;W X
S X=$S(SRT=1:"Payer",1:"Patient")_U_$S(SRT=1:"Patient",1:"Payer")_"^Patient SSN^Patient DOB^Subscriber^Subscriber ID^Subscriber DOB^Subscriber Sex^Group Name^Group ID"
S X=X_"^Pt Relationship to Subscriber^Member ID^Date of Death^Effective Date^Expiration Date"
S X=X_"^Response Date^Trace #^Policy Number"
W X
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNERP3 12684 printed Dec 13, 2024@02:15 Page 2
IBCNERP3 ;DAOU/BHS - IBCNE eIV RESPONSE REPORT PRINT ; 03-JUN-2002
+1 ;;2.0;INTEGRATED BILLING;**184,271,416,528,602,702,737,752**;21-MAR-94;Build 20
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; eIV - Insurance Verification
+5 ;
+6 ; Called by IBCNERPA
+7 ; Input from IBCNERP1/2:
+8 ; IBCNERTN="IBCNERP1" - Driver rtn
+9 ; IBCNESPC("BEGDT")=Start Dt, IBCNESPC("ENDDT")=End Dt
+10 ; IBCNESPC("PYR")=Pyr IEN OR "" for all
+11 ; IBCNESPC("PAT")=Pat IEN OR "" for all
+12 ; IBCNESPC("TYPE")=A (All Responses) OR M (Most Recent Responses) for
+13 ; unique Pyr/Pt pair
+14 ; IBCNESPC("SORT")=1 (PyrNm) OR 2 (PatNm)
+15 ; IBCNESPC("TRCN")=Trace #^IEN, if non-null, all params null
+16 ; IBCNESPC("RFLAG")=Report Flag used to indicate which report is being
+17 ; run. Response Report (0), Inactive Report (1), or Ambiguous
+18 ; Report (2).
+19 ; IBCNESPC("DTEXP")=Expiration date used in the inactive policy report
+20 ; IBOUT="R" for Report format or "E" for Excel format
+21 ;
+22 ; Based on structure of eIV Response File (#365)
+23 ; ^TMP($J,IBCNERTN,S1,S2,CT,0) based on ^IBCN(365,DA,0)
+24 ; IBCNERTN="IBCNERP1", S1=PyrName(SORT=1) or PatNm(SORT=2),
+25 ; S2=PatName(SORT=1) or PyrName(SORT=2), CT=Seq ct
+26 ; ^TMP($J,IBCNERTN,S1,S2,CT,1) based on ^IBCN(365,DA,1)
+27 ; ^TMP($J,IBCNERTN,S1,S2,2,EBCT) based on ^IBCN(365,DA,2)
+28 ; EBCT=E/B IEN (365.02)
+29 ; ^TMP($J,IBCNERTN,S1,S2,2,EBCT,NTCT)=based on ^IBCN(365,DA,2,EB,NT)
+30 ; NTCT=Notes Ct, may not be Notes IEN, if line wrapped (365.021)
+31 ; ^TMP($J,IBCNERTN,S1,S2,2,CNCT) based on ^IBCN(365,DA,3)
+32 ; CNCT=Cont Pers IEN (365.03)
+33 ; ^TMP($J,IBCNERTN,S1,S2,4,CT)= err txt based on ^IBCN(365,DA,4)
+34 ; CT=1/2 if >60 ch long
+35 ; ^TMP($J,IBCNERTN,S1,S2,5,CT)= based on # lines of comments reqd
+36 ; CT=1 to display future retransmission date
+37 ; Must call at appropriate tag
+38 QUIT
+39 ;
+40 ;IB*752/DTG added param IBFEED to input
PRINT(RTN,BDT,EDT,PYR,PAT,TYP,SRT,PGC,PXT,MAX,CRT,TRC,EXP,IPRF,IBRDT,IBOUT,IBFEED) ; Print data
+1 ; Input: RTN="IBCENRP1", BDT=start dt, EDT=end dt, PYR=pyr ien,
+2 ; PAT= pat ien, TYP=A/M, SRT=1/2, PGC=page ct, PXT=exit flg,
+3 ; MAX=max line ct/pg, CRT=1/0, TRC=trc#, EXP=earliest expiration date,IBRDT=today's date/time formatted
+4 NEW EORMSG,NONEMSG,SORT1,SORT2,CNT,CNFLG,ERFLG,PRT1,PRT2,DISPDATA
+5 ; Original values for PRT1 and PRT2, respectively
NEW OPRT1,OPRT2
+6 ; IB*702/ new vars
NEW IBHDR,IBDTA
+7 SET EORMSG="*** END OF REPORT ***"
+8 SET NONEMSG="* * * N O D A T A F O U N D * * *"
+9 SET (SORT1,SORT2)=""
+10 ;IB*752/DTG if IBFEED is null set to MAX
SET IBFEED=$GET(IBFEED)
if IBFEED=""
SET IBFEED=MAX
+11 ;
+12 ; IB*702/DTG start no form feed between no data the header and end of report
+13 ;D PHDL:IBOUT="E" I $G(ZTSTOP)!PXT G PRINTX
+14 SET IBHDR=$SELECT(IBOUT="E":"PHDL",1:"HEADER")
SET IBDTA=+$DATA(^TMP($JOB,RTN))
+15 IF IBDTA
if IBOUT="E"
DO PHDL
IF $GET(ZTSTOP)!PXT
GOTO PRINTX
+16 ;
+17 ; If global does not exist - display No Data message
+18 ; I '$D(^TMP($J,RTN)) D @IBHDR W !,?(80-$L(NONEMSG)\2),NONEMSG,!!
+19 IF 'IBDTA
DO @IBHDR
WRITE !
if $GET(IBOUT)="R"
WRITE ?23
WRITE NONEMSG
if $GET(IBOUT)="R"
WRITE !!
GOTO PRINTEOR
+20 ; IB*702/DTG end no form feed between no data the header and end of report
+21 ;
+22 FOR
SET SORT1=$ORDER(^TMP($JOB,RTN,SORT1))
if SORT1=""
QUIT
Begin DoDot:1
+23 SET (OPRT1,PRT1)=SORT1
+24 SET SORT2=""
FOR
SET SORT2=$ORDER(^TMP($JOB,RTN,SORT1,SORT2))
if SORT2=""
QUIT
Begin DoDot:2
+25 SET (OPRT2,PRT2)=SORT2
+26 SET CNT=""
FOR
SET CNT=$ORDER(^TMP($JOB,RTN,SORT1,SORT2,CNT))
if CNT=""
QUIT
Begin DoDot:3
+27 IF IBOUT="E"
DO XLDATA
QUIT
+28 ; add SSN (from ^DPT) and DOB to patient header info
DO SSDB
+29 DO HEADER
+30 IF $GET(ZTSTOP)!PXT
QUIT
+31 ; Init disp
KILL DISPDATA
+32 ; build/display data
DO DATA^IBCNERPE(.DISPDATA)
DO LINE(.DISPDATA)
End DoDot:3
if PXT!$GET(ZTSTOP)
QUIT
End DoDot:2
if PXT!$GET(ZTSTOP)
QUIT
End DoDot:1
if PXT!$GET(ZTSTOP)
QUIT
+33 ;
+34 IF $GET(ZTSTOP)!PXT
GOTO PRINTX
+35 SET (CNFLG,ERFLG)=0
+36 IF $Y+1>IBFEED!('PGC)
if IBOUT="R"
DO HEADER
IF $GET(ZTSTOP)!PXT
GOTO PRINTX
+37 ; IB*702/DTG start EOR message
PRINTEOR ; IB*702 come here for eor if no data
+1 WRITE !
if $GET(IBOUT)="R"
WRITE ?30
WRITE EORMSG
if $GET(IBOUT)="R"
WRITE !
+2 ; IB*702/DTG end EOR message
PRINTX ;
+1 QUIT
+2 ;
XLDATA ; Excel output ; 528
+1 NEW PYRNM,PTNM,DFN,PTSSN,PTDOB,REFQ,REFID,RFIDSC,PROCD,REFID2,PRIDC,MLIST,EMPST,GOVAFL,DTMP,SRVRNK,MDESC,RPTDATA
+2 MERGE RPTDATA=^TMP($JOB,RTN,SORT1,SORT2,CNT)
+3 SET PYRNM=$PIECE(RPTDATA(0),U,3)
SET PYRNM=$$GET1^DIQ(365.12,PYRNM,.01)
+4 SET DFN=$PIECE(RPTDATA(0),U,2)
SET PTNM=$$GET1^DIQ(2,DFN,.01)
+5 SET PTSSN=$EXTRACT($$GETSSN^IBCNEDE5(DFN),6,9)
SET PTDOB=$$GETDOB^IBCNEDEQ(DFN)
+6 ;IB*752/TAZ - Removed unnecessary columns from Excel report
+7 ;W !,$S(SRT=1:PYRNM,1:PTNM)_U_$S(SRT=1:PTNM,1:PYRNM)_U_PTSSN_U_PTDOB_U_$P(RPTDATA(13),U)_U_$P(RPTDATA(13),U,2)_U_$P(RPTDATA(1),U,2)_U_$P(RPTDATA(1),U,3)_U_$P(RPTDATA(1),U,4)_U_$P(RPTDATA(14),U)_U_$P(RPTDATA(14),U,2)_U_$P(RPTDATA(1),U,8)
+8 ;W U_RPTDATA(8)_U_$P(RPTDATA(1),U,18)_U_$P(RPTDATA(1),U,13)_U_$P(RPTDATA(1),U,10)_U_$P(RPTDATA(1),U,16)_U_$P(RPTDATA(1),U,11)_U_$P(RPTDATA(1),U,17)
+9 ;W U_$P(RPTDATA(1),U,12)_U_$P(RPTDATA(1),U,19)_U_$P(RPTDATA(0),U,7)_U_$P(RPTDATA(0),U,9)_U_$P(RPTDATA(1),U,20)_U
+10 ;D DATA^IBCNERPE(.DISPDATA) ; Build Elig. Ben. global
+11 ;D GTDT
+12 ;W $G(REFQ)_U_$G(REFID)_U_$G(RFIDSC)_U_$G(PROCD)_U_$G(REFID2)_U_$G(PRIDC)_U_$G(MLIST)_U_$G(EMPST)_U_$G(GOVAFL)_U_$G(DTMP)_U_$G(SRVRNK)_U_$G(MDESC)
+13 WRITE !,$SELECT(SRT=1:PYRNM,1:PTNM)_U_$SELECT(SRT=1:PTNM,1:PYRNM)_U_PTSSN_U_PTDOB_U_$PIECE(RPTDATA(13),U)_U_$PIECE(RPTDATA(13),U,2)_U_$PIECE(RPTDATA(1),U,2)_U_$PIECE(RPTDATA(1),U,4)_U_$PIECE(RPTDATA(14),U)_U_$PIECE(RPTDATA(14),U,2)
+14 WRITE U_RPTDATA(8)_U_$PIECE(RPTDATA(1),U,18)_U_$PIECE(RPTDATA(1),U,16)_U_$PIECE(RPTDATA(1),U,11)
+15 WRITE U_$PIECE(RPTDATA(1),U,12)_U_$PIECE(RPTDATA(0),U,7)_U_$PIECE(RPTDATA(0),U,9)_U_$PIECE(RPTDATA(1),U,20)
+16 QUIT
+17 ;
GTDT ; Get Eligibility/Group Plan Information
+1 ;^TMP("EIV RESP. EB DATA",$J,"DISP",1,0)
+2 ;S SEL=$$TRIM^XLFSTR($E(Y(0),1,30),"R")
+3 NEW LN,OUT,DATA
+4 SET (REFID,REFQ,RFIDSC,PROCD,REFID2,PRIDC,EMPST,MLIST,DTMP,GOVAFL,SRVRNK,MDESC)=""
+5 SET LN=0
+6 FOR
SET LN=$ORDER(^TMP("EIV RESP. EB DATA",$JOB,"DISP",LN))
if LN=""
QUIT
Begin DoDot:1
+7 SET OUT=$GET(^TMP("EIV RESP. EB DATA",$JOB,"DISP",LN,0))
+8 ;
+9 IF OUT["Reference ID Qualifier:"
Begin DoDot:2
+10 SET DATA=$PIECE(OUT,"Reference ID Qualifier:",2)
+11 SET REFID=$$TRIM^XLFSTR($PIECE(DATA,"Reference ID:",2),"R")
+12 SET REFQ=$$TRIM^XLFSTR($PIECE(DATA,"Reference ID:",1),"R")
End DoDot:2
+13 IF OUT["Reference ID description:"
Begin DoDot:2
+14 SET DATA=$PIECE(OUT,"Reference ID description:",2)
+15 SET RFIDSC=$$TRIM^XLFSTR(DATA,"R")
End DoDot:2
+16 IF OUT["Provider Code:"
Begin DoDot:2
+17 SET DATA=$PIECE(OUT,"Provider Code:",2)
+18 SET PROCD=$$TRIM^XLFSTR(DATA,"R")
End DoDot:2
+19 IF OUT["Reference ID:"
Begin DoDot:2
+20 SET DATA=$PIECE(OUT,"Reference ID:",2)
+21 SET REFID2=$$TRIM^XLFSTR(DATA,"R")
End DoDot:2
+22 IF OUT["Primary Diagnosis Code:"
Begin DoDot:2
+23 SET DATA=$PIECE(OUT,"Primary Diagnosis Code:",2)
+24 SET PRIDC=$$TRIM^XLFSTR(DATA,"R")
End DoDot:2
+25 IF OUT["Military Info Status:"
Begin DoDot:2
+26 SET DATA=$PIECE(OUT,"Military Info Status:",2)
+27 SET EMPST=$$TRIM^XLFSTR($PIECE(DATA,"Employment Status:",2),"R")
+28 SET MLIST=$$TRIM^XLFSTR($PIECE(DATA,"Employment Status:",1),"R")
End DoDot:2
+29 IF OUT["Government Affiliation:"
Begin DoDot:2
+30 SET DATA=$PIECE(OUT,"Government Affiliation:",2)
+31 SET DTMP=$$TRIM^XLFSTR($PIECE(DATA,"Date Time Period:",2),"R")
+32 SET GOVAFL=$$TRIM^XLFSTR($PIECE(DATA,"Date Time Period:",1),"R")
End DoDot:2
+33 IF OUT["Service Rank:"
Begin DoDot:2
+34 SET DATA=$PIECE(OUT,"Service Rank:",2)
+35 SET SRVRNK=$$TRIM^XLFSTR(DATA,"R")
End DoDot:2
+36 IF OUT["Desc:"
Begin DoDot:2
+37 SET DATA=$PIECE(OUT,"Desc:",2)
+38 SET MDESC=$$TRIM^XLFSTR(DATA,"R")
End DoDot:2
End DoDot:1
+39 QUIT
+40 ;
+1 NEW X,Y,DIR,DTOUT,DUOUT,OFFSET,HDR,LIN,HDR
+2 IF CRT
IF PGC>0
IF '$DATA(ZTQUEUED)
Begin DoDot:1
+3 ;IB*752/DTG change MAX to IBFEED
IF MAX<51
FOR LIN=1:1:(IBFEED-$Y)
WRITE !
+4 SET DIR(0)="E"
DO ^DIR
KILL DIR
+5 IF $DATA(DTOUT)!($DATA(DUOUT))
SET PXT=1
QUIT
End DoDot:1
IF PXT
GOTO HEADERX
+6 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD()
SET ZTSTOP=1
GOTO HEADERX
+7 ;
+8 SET PGC=PGC+1
+9 WRITE @IOF,!,?1,$SELECT($GET(IPRF)=1:"eIV Inactive Policy Report",$GET(IPRF)=2:"eIV Ambiguous Policy Report",1:"eIV Response Report")
IF TRC'=""
WRITE " by Trace #"
+10 ;
+11 SET HDR=IBRDT_" Page: "_PGC
SET OFFSET=79-$LENGTH(HDR)
+12 WRITE ?OFFSET,HDR
+13 ;
+14 IF TRC'=""
SET HDR="Trace #: "_TRC
SET OFFSET=80-$LENGTH(HDR)\2
WRITE !,?OFFSET,HDR
+15 IF TRC=""
Begin DoDot:1
+16 WRITE !,?1,"Sorted by: "_$SELECT(SRT=1:"Payer",1:"Patient")_" Name"
+17 SET HDR="Responses Displayed: "_$SELECT(TYP="M":"Most Recent",1:"All")
+18 SET OFFSET=79-$LENGTH(HDR)
+19 WRITE ?OFFSET,HDR
+20 ; IB*702/DTG start remove policy exp date
+21 ;I $G(IPRF)=1 W !,?1,"Earliest Policy Expiration Date: ",$$FMTE^XLFDT(EXP,"5Z"),!
+22 ; IB*702/DTG end remove policy exp date
+23 SET HDR=$$FMTE^XLFDT(BDT,"5Z")_" - "_$$FMTE^XLFDT(EDT,"5Z")
+24 SET OFFSET=80-$LENGTH(HDR)\2
+25 WRITE !,?OFFSET,HDR
+26 ; Disp SORT1 rng
+27 SET HDR=""
+28 IF SRT=1
IF PYR=""
SET HDR="All Payers"
+29 IF SRT=2
IF PAT=""
SET HDR="All Patients"
+30 IF HDR=""
Begin DoDot:2
+31 IF SRT=1
SET HDR=$PIECE($GET(^IBE(365.12,PYR,0)),U,1)
QUIT
+32 SET HDR=$PIECE($GET(^DPT(PAT,0)),U,1)
End DoDot:2
+33 SET OFFSET=80-$LENGTH(HDR)\2
+34 WRITE !,?OFFSET,HDR
+35 ; Disp SORT2 rng
+36 SET HDR=""
+37 IF SRT=1
IF PAT=""
SET HDR="All Patients"
+38 IF SRT=2
IF PYR=""
SET HDR="All Payers"
+39 IF HDR=""
Begin DoDot:2
+40 IF SRT=1
SET HDR=$PIECE($GET(^DPT(PAT,0)),U,1)
QUIT
+41 SET HDR=$PIECE($GET(^IBE(365.12,PYR,0)),U,1)
End DoDot:2
+42 SET OFFSET=80-$LENGTH(HDR)\2
+43 WRITE !,?OFFSET,HDR
End DoDot:1
+44 WRITE !
+45 ; Build disp
+46 IF SORT1'=""
IF SORT2'=""
Begin DoDot:1
+47 WRITE !,?1,$$FO^IBCNEUT1($SELECT(TRC'=""!(SRT=1):" Payer: ",1:"Patient: "),9)_$EXTRACT(PRT1,1,69)
+48 WRITE !,?1,$$FO^IBCNEUT1($SELECT(TRC'=""!(SRT=1):"Patient: ",1:" Payer: "),9)_$EXTRACT(PRT2,1,69)
+49 WRITE !
End DoDot:1
+1 QUIT
+2 ;
LINE(DISPDATA) ; Print data
+1 NEW LNCT,LNTOT,NWPG
+2 SET LNTOT=+$ORDER(DISPDATA(""),-1)
+3 SET (CNFLG,ERFLG,NWPG)=0
+4 FOR LNCT=1:1:LNTOT
Begin DoDot:1
+5 IF $Y+1>MAX!('PGC)
DO HEADER
SET NWPG=1
IF $GET(ZTSTOP)!PXT
QUIT
+6 IF DISPDATA(LNCT)="Contact Information:"!(DISPDATA(LNCT)="Error Information:")
IF $Y+3>MAX
SET (CNFLG,ERFLG)=0
DO HEADER
SET NWPG=1
IF $GET(ZTSTOP)!PXT
QUIT
+7 IF CNFLG
IF DISPDATA(LNCT)=""
IF $GET(DISPDATA(LNCT+1))="Error Information:"
SET CNFLG=0
+8 IF NWPG
IF CNFLG
WRITE !,?1,"Contact Information: (cont'd)",!
+9 IF NWPG
IF ERFLG
WRITE !,?1,"Error Information: (cont'd)",!
+10 IF 'NWPG!(NWPG&(DISPDATA(LNCT)'=""))
WRITE !,?1,DISPDATA(LNCT)
+11 IF NWPG
SET NWPG=0
+12 IF DISPDATA(LNCT)["Contact Information:"
SET ERFLG=0
SET CNFLG=1
+13 IF DISPDATA(LNCT)["Error Information:"
SET CNFLG=0
SET ERFLG=1
+14 QUIT
End DoDot:1
if $GET(ZTSTOP)!PXT
QUIT
+15 SET (CNFLG,ERFLG)=0
LINEX ;
+1 QUIT
+2 ;
SSDB ; Display last 4 digits of SSN and DOB to facilitate pt. identification
+1 ; $$SSN^IBCNEDEQ(DFN) returns SSN followed by DOB
+2 ;
+3 NEW DFN
+4 SET DFN=$PIECE($GET(^TMP($JOB,RTN,SORT1,SORT2,CNT,0)),U,2)
+5 IF DFN
Begin DoDot:1
+6 IF SRT=1!TRC
SET PRT2=OPRT2_$$SSN^IBCNEDEQ(DFN)
QUIT
+7 SET PRT1=OPRT1_$$SSN^IBCNEDEQ(DFN)
End DoDot:1
+8 QUIT
+9 ;
PHDL ; - Print the header line for the Excel spreadsheet ; 528
+1 NEW X
+2 ; IB*602/HN ; Add report headers to Excel Spreadsheets
+3 SET EHDR=$SELECT($GET(IPRF)=1:"eIV Inactive Policy Report",$GET(IPRF)=2:"eIV Ambiguous Policy Report",1:"eIV Response Report")
IF TRC'=""
SET EHDR=EHDR_"^by Trace #"
+4 WRITE !,EHDR_"^"_$$FMTE^XLFDT($$NOW^XLFDT,1)
+5 ;
+6 IF TRC'=""
SET HDR="Trace #: "_TRC
WRITE !,HDR
+7 IF TRC=""
Begin DoDot:1
+8 SET EHDR="Sorted by: "_$SELECT(SRT=1:"Payer",1:"Patient")_" Name"
+9 SET EHDR=EHDR_"^Responses Displayed: "_$SELECT(TYP="M":"Most Recent",1:"All")
+10 WRITE !,EHDR
SET EHDR=""
+11 ; IB*702/DTG start remove policy exp date
+12 ;I $G(IPRF)=1 W !,"Earliest Policy Expiration Date: ",$$FMTE^XLFDT(EXP,"5Z")
+13 ; IB*702/DTG end remove policy exp date
+14 SET EHDR=$$FMTE^XLFDT(BDT,"5Z")_" - "_$$FMTE^XLFDT(EDT,"5Z")
+15 WRITE !,EHDR
+16 ; Disp SORT1 rng
+17 SET EHDR=""
+18 IF SRT=1
IF PYR=""
SET EHDR="All Payers"
+19 IF SRT=2
IF PAT=""
SET EHDR="All Patients"
+20 IF EHDR=""
Begin DoDot:2
+21 IF SRT=1
SET EHDR=$PIECE($GET(^IBE(365.12,PYR,0)),U,1)
QUIT
+22 SET EHDR=$PIECE($GET(^DPT(PAT,0)),U,1)
End DoDot:2
+23 WRITE !,EHDR
+24 ; Disp SORT2 rng
+25 SET EHDR=""
+26 IF SRT=1
IF PAT=""
SET EHDR="All Patients"
+27 IF SRT=2
IF PYR=""
SET EHDR="All Payers"
+28 IF EHDR=""
Begin DoDot:2
+29 IF SRT=1
SET EHDR=$PIECE($GET(^DPT(PAT,0)),U,1)
QUIT
+30 SET EHDR=$PIECE($GET(^IBE(365.12,PYR,0)),U,1)
End DoDot:2
+31 WRITE !,EHDR
End DoDot:1
+32 WRITE !
+33 ; Build disp
+34 IF SORT1'=""
IF SORT2'=""
Begin DoDot:1
+35 WRITE !,$$FO^IBCNEUT1($SELECT(TRC'=""!(SRT=1):" Payer: ",1:"Patient: "),9)_$EXTRACT(PRT1,1,69)
+36 WRITE !,$$FO^IBCNEUT1($SELECT(TRC'=""!(SRT=1):"Patient: ",1:" Payer: "),9)_$EXTRACT(PRT2,1,69)
+37 WRITE !
End DoDot:1
+38 KILL EHDR
+39 ; IB*602/HN end
+40 SET PGC=1
+41 ;IB*752/TAZ - Removed unnecessary column headers from Excel report
+42 ;S X=$S(SRT=1:"Payer",1:"Patient")_U_$S(SRT=1:"Patient",1:"Payer")_"^Patient SSN^Patient DOB^Subscriber^Subscriber ID^Subscriber DOB^Subscriber SSN^Subscriber Sex^Group Name^Group ID"
+43 ;S X=X_"^Whose Insurance^Pt Relationship to Subscriber^Member ID^COB^Service Date^Date of Death^Effective Date^Certification Date^Expiration Date^Payer Updated Policy"
+44 ;S X=X_"^Response Date^Trace #^Policy Number^Reference ID Qualifier^Reference ID^Reference ID Description^Provider Code^Reference ID^Primary Diagnosis Code^Military Info Status"
+45 ;W X
+46 ;S X="^Employment Status^Government Affiliation^Date Time Period^Service Rank^Desc"
+47 ;W X
+48 SET X=$SELECT(SRT=1:"Payer",1:"Patient")_U_$SELECT(SRT=1:"Patient",1:"Payer")_"^Patient SSN^Patient DOB^Subscriber^Subscriber ID^Subscriber DOB^Subscriber Sex^Group Name^Group ID"
+49 SET X=X_"^Pt Relationship to Subscriber^Member ID^Date of Death^Effective Date^Expiration Date"
+50 SET X=X_"^Response Date^Trace #^Policy Number"
+51 WRITE X
+52 QUIT
