Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCNERP3

IBCNERP3.m

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