- 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 Feb 18, 2025@23:41:24 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