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

IBCNERPG.m

Go to the documentation of this file.
  1. IBCNERPG ;BP/YMG - IBCNE EIV INSURANCE UPDATE REPORT COMPILE;16-SEP-2009
  1. ;;2.0;INTEGRATED BILLING;**416,528,549,595,737,763**;16-SEP-09;Build 29
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ; NOTE:
  1. ; IB*2.0*763 is a major re-write of this report. The comments from the previous patches
  1. ; have either been removed or modified to remove the patch number if the comment is relevant.
  1. ;
  1. ; Variable array from IBCNERPF:
  1. ; IBCNESPC("BEGDT") = start date for date range
  1. ; IBCNESPC("ENDDT") = end date for date range
  1. ; IBCNESPC("IBOUT") = "R" for Report format or "E" for Excel format
  1. ; IBCNESPC("ICODETL") = 1 for displaying Ins Co Detail
  1. ; IBCNESPC("INSCO") = "A" (All ins. cos.) OR "S" (Selected ins. cos.)
  1. ; IBCNESPC("PYR",ien) - payer iens for report, if IBCNESPC("PYR")="A", then include all
  1. ; = (1) ^ (2)
  1. ; (1) Display insurance company detail - 0 = No / 1 = Yes
  1. ; (2) Display all or some insurance companies - A = All companies/
  1. ; S = Specified companies
  1. ; IBCNESPC("PYR",ien,coien) - payer iens and company ien for report
  1. ; = Count for insurance company
  1. ; IBCNESPC("PAT",ien) = patient iens for report, if IBCNESPC("PAT")="A", then include all
  1. ; IBCNESPC("TYPE") = report type: "S" - summary, "D" - detailed
  1. ;
  1. ; Data global created for PRINT:
  1. ; Summary report:
  1. ; ^TMP($J,"IBCNERPF")=Total Count
  1. ; ^TMP($J,"IBCNERPF",SORT1)=Payer Count
  1. ; ^TMP($J,"IBCNERPF",SORT1,SORT2)=Company Count
  1. ; SORT1 - Payer Name or SOI, SORT2 - Company Name
  1. ;
  1. ; Detailed report:
  1. ; ^TMP($J,"IBCNERPF",SORT1)=Count
  1. ; ^TMP($J,"IBCNERPF",SORT1,SORT2)=Count
  1. ; ^TMP($J,"IBCNERPF",SORT1,SORT2,SORT3)=Payer Name ^ Insurance Company Name ^ Pat. Name ^ SSN ^
  1. ; Date Inquiry Sent ^ Date Policy Auto Updated ^ Days old ^
  1. ; Trace Number
  1. ; Date Inquiry Sent ^ Date Policy Auto Updated@time ^ Trace Number
  1. ;
  1. ; SORT1 - Payer Name, SORT2 - Date received, SORT3 - Count
  1. ;
  1. Q
  1. ;
  1. EN(IBCNESPC) ; Entry point
  1. N DATE,BDATE,EDATE,RPDATA,RTYPE,SOI,SOIBA,SORT
  1. S ALLPYR=$G(IBCNESPC("PYR"))="A"
  1. S ALLPAT=$G(IBCNESPC("PAT"))="A"
  1. S BDATE=$G(IBCNESPC("BEGDT"))
  1. S EDATE=$G(IBCNESPC("ENDDT"))
  1. I EDATE'="",$P(EDATE,".",2)="" S EDATE=$$FMADD^XLFDT(EDATE,0,23,59,59)
  1. S RTYPE=$G(IBCNESPC("TYPE"))
  1. I '$D(ZTQUEUED),$G(IOST)["C-",IBOUT="R" W !!,"Compiling report data ..."
  1. ; Kill scratch global
  1. K ^TMP($J,"IBCNERPF")
  1. S DATE=$O(^IBCN(365,"AUTO",BDATE),-1)
  1. F S DATE=$O(^IBCN(365,"AUTO",DATE)) Q:'DATE!(DATE>EDATE) D I $G(ZTSTOP) G ENX
  1. . N PYR
  1. . S PYR=""
  1. . ; Loop through Payers
  1. . S PYR=$O(^IBCN(365,"AUTO",DATE,PYR)) Q:'PYR D
  1. .. N PAT
  1. .. S PAT=""
  1. .. F S PAT=$O(^IBCN(365,"AUTO",DATE,PYR,PAT)) Q:'PAT D Q:$G(ZTSTOP)
  1. ... D GETDATA(DATE,PYR,ALLPYR,PAT,RTYPE)
  1. ; Collect Selected Payers with no data
  1. I RTYPE="S" D
  1. . N PYR,PYRNAME,IIEN,INSCOMNM
  1. . S PYR=""
  1. . F S PYR=$O(IBCNESPC("PYR",PYR)) Q:'PYR D
  1. .. S PYRNAME=$$GET1^DIQ(365.12,PYR,".01","I")
  1. .. S:'$D(RPDATA(PYRNAME)) RPDATA(PYRNAME)=0
  1. .. I $P(IBCNESPC("PYR",PYR),U,2)="A" Q ;Only report selected insurance companies.
  1. .. S IIEN=""
  1. .. F S IIEN=$O(IBCNESPC("PYR",PYR,IIEN)) Q:IIEN="" D
  1. ... S INSCOMNM=$$GET1^DIQ(36,IIEN,".01","I")
  1. ... S:'$D(RPDATA(PYRNAME,INSCOMNM)) RPDATA(PYRNAME,INSCOMNM)=0
  1. M ^TMP($J,"IBCNERPF")=RPDATA
  1. ENX ; Exit
  1. Q
  1. ;
  1. GETDATA(DATE,PYR,ALLPYR,PAT,RTYPE) ; loop through responses and compile report
  1. N AUTOUPD,CLNAME,DTINQSNT,DTPOLUPD,FLG,IENS2,IENS312,IENS3651,IIEN,INS,INSCOMNM,NOW
  1. N PATNAME,PYRNAME,RIEN,SORT1,SORT2,SORT3,SSN,TOTMES,TQ,TRACENUM,TYPE,VDATE
  1. ;
  1. S (TOTMES,INS)=0
  1. F S INS=$O(^IBCN(365,"AUTO",DATE,PYR,PAT,INS)) Q:'INS D Q:$G(ZTSTOP)
  1. . S RIEN="" F S RIEN=$O(^IBCN(365,"AUTO",DATE,PYR,PAT,INS,1,RIEN)) Q:'RIEN D Q:$G(ZTSTOP)
  1. .. S TOTMES=TOTMES+1
  1. .. I '$D(ZTQUEUED),(TOTMES#100=0) W "."
  1. .. I $D(ZTQUEUED),TOTMES#100=0,$$S^%ZTLOAD() S ZTSTOP=1 Q
  1. .. ; If summary version of report & selected ins co were chosen, do not consider others
  1. .. ; If summary version of report & selected ins co were chosen, count for payer only includes
  1. .. ; counts for selected ins co
  1. .. S IENS2=PAT_",",IENS312=INS_","_IENS2
  1. .. S PYRNAME=$$GET1^DIQ(365.12,PYR_",",.01),PATNAME=$$GET1^DIQ(2,IENS2,.01)
  1. .. S IIEN=$$GET1^DIQ(2.312,IENS312,.01,"I")
  1. .. I 'IIEN Q ; policy no longer on pt
  1. .. S INSCOMNM=$$GET1^DIQ(36,IIEN,.01)
  1. .. S IENS3651=$$GET1^DIQ(365,RIEN_",",.05,"I")
  1. .. S SOI=$$GET1^DIQ(365.1,IENS3651,3.02,"I")
  1. .. S SOIE=$$GET1^DIQ(365.1,IENS3651,3.02)
  1. .. ; For summary version of report, include count for insurance company
  1. .. ; Do not display insurance company detail if user selected to not display such
  1. .. S TYPE=$G(IBCNESPC("PYR",PYR))
  1. .. ;
  1. .. ; Summary Report compile
  1. .. I RTYPE="S" D Q
  1. ... S RPDATA=$G(RPDATA)+1
  1. ... ; Sort by Source of Information
  1. ... I IBCNESPC("PS")="S" D Q
  1. .... I SOI="" Q
  1. .... S RPDATA(SOIE)=$G(RPDATA(SOIE))+1,RPDATA(SOIE,PYRNAME)=$G(RPDATA(SOIE,PYRNAME))+1
  1. ... ; Sort by Payer
  1. ... I 'ALLPYR,'$D(IBCNESPC("PYR",PYR)) Q ;Not a selected payer
  1. ... S RPDATA(PYRNAME)=$G(RPDATA(PYRNAME))+1
  1. ... ; Compile data for insurance company detail if selected.
  1. ... I '$G(IBCNESPC("ICODETL")) Q
  1. ... I (TYPE="S"),'$D(IBCNESPC("PYR",PYR,IIEN)) Q ; Not a selected insurance company
  1. ... S RPDATA(PYRNAME,INSCOMNM)=$G(RPDATA(PYRNAME,INSCOMNM))+1
  1. ... ;
  1. .. ; Detail Report
  1. .. S SORT1=PYRNAME
  1. .. S SSN=$$GET1^DIQ(2,IENS2,.09,"E")
  1. .. S DTINQSNT=$$FMTE^XLFDT($$GET1^DIQ(365,RIEN_",",".08","I"),"2DZ")
  1. .. S DTPOLUPD=$$FMTE^XLFDT(DATE,"2SZ")
  1. .. S SOIBA=$$GET1^DIQ(355.12,SOI_",",.03)
  1. .. I $L(DTPOLUPD)=8 S DTPOLUPD=DTPOLUPD_"@00:00:00" ; handles 0 seconds
  1. .. S TRACENUM=$$GET1^DIQ(365,RIEN_",",".09","I")
  1. .. S SORT2=DATE
  1. .. I 'ALLPYR,'$D(IBCNESPC("PYR",PYR)) Q ;Not a selected payer
  1. .. I 'ALLPAT,'$D(IBCNESPC("PAT",PAT)) Q ;Not a selected patient
  1. .. I IBCNESPC("ICODETL"),(TYPE="S"),'$D(IBCNESPC("PYR",PYR,IIEN)) Q ; If user chose selected co option, and company was not selected
  1. .. ; don't print company info
  1. .. S RPDATA=$G(RPDATA)+1
  1. .. S RPDATA(SORT1)=$G(RPDATA(SORT1))+1
  1. .. S (RPDATA(SORT1,SORT2),SORT3)=$G(RPDATA(SORT1,SORT2))+1
  1. .. S RPDATA(SORT1,SORT2,SORT3)=PYRNAME_U_INSCOMNM_U_PATNAME_U_SSN_U_DTINQSNT_U_DTPOLUPD_U_SOIBA_U_TRACENUM
  1. Q
  1. ;
  1. PRINT(IBCNESPC) ; Entry point
  1. N CRT,DDATA,DLINE,EORMSG,IBPGC,IBOUT,IBPXT,MAXCNT,NONEMSG,NPROC,SSN,SSNLEN,SRT1,SRT2,SRT3,TSTAMP,TYPE,WIDTH,X,Y
  1. S (IBPGC,IBPXT)=0,IBOUT=IBCNESPC("IBOUT")
  1. S NONEMSG="* * * N O D A T A F O U N D * * *"
  1. S EORMSG="*****END OF REPORT*****"
  1. S NPROC="Not Processed"
  1. S TSTAMP=$$FMTE^XLFDT($$NOW^XLFDT,1) ; time of report
  1. S TYPE=$G(IBCNESPC("TYPE")) ; report type
  1. S IBOUT=$G(IBCNESPC("IBOUT")) ; Output type
  1. S WIDTH=$S(TYPE="S":79,1:131)
  1. ; Determine IO parameters
  1. I "^R^E^"'[(U_$G(IBOUT)_U) S IBOUT="R"
  1. S MAXCNT=IOSL-6,CRT=0
  1. S:IOST["C-" MAXCNT=IOSL-3,CRT=1
  1. ; print data
  1. S SRT1=""
  1. D HEADER:IBOUT="R",PHDL:IBOUT="E" I $G(ZTSTOP)!IBPXT Q
  1. ; If global does not exist - display No Data message
  1. I '$D(^TMP($J,"IBCNERPF")) D LINE($$FO^IBCNEUT1(NONEMSG,$L(NONEMSG),"L"),IBOUT) G PRINTX
  1. ; Summary Report
  1. I TYPE="S" D G PRINTX
  1. . D LINE("TOTAL AUTO UPDATED = "_+$G(^TMP($J,"IBCNERPF")),IBOUT)
  1. . W !
  1. . F S SRT1=$O(^TMP($J,"IBCNERPF",SRT1)) Q:SRT1=""!$G(ZTSTOP)!IBPXT D
  1. .. I IBOUT="R" D LINE(SRT1_" = "_+$G(^TMP($J,"IBCNERPF",SRT1)),IBOUT)
  1. .. I IBOUT="E",'$G(IBCNESPC("ICODETL")) D LINE(SRT1_"^"_+$G(^TMP($J,"IBCNERPF",SRT1)),IBOUT)
  1. .. S SRT2="" F S SRT2=$O(^TMP($J,"IBCNERPF",SRT1,SRT2)) Q:SRT2=""!$G(ZTSTOP)!IBPXT D
  1. ... I '$G(IBCNESPC("ICODETL")) Q ;No ins co detail
  1. ... I IBOUT="E" D LINE(SRT1_U_$S(SRT2=0:NPROC,1:SRT2)_U_^TMP($J,"IBCNERPF",SRT1,SRT2),IBOUT) Q
  1. ... D LINE(" "_SRT2_" = "_+$G(^TMP($J,"IBCNERPF",SRT1,SRT2)),IBOUT)
  1. . W !
  1. ;
  1. ; detailed report
  1. F S SRT1=$O(^TMP($J,"IBCNERPF",SRT1)) Q:SRT1="" D Q:$G(ZTSTOP)!IBPXT
  1. . S SRT2="" F S SRT2=$O(^TMP($J,"IBCNERPF",SRT1,SRT2)) Q:SRT2=""!$G(ZTSTOP)!IBPXT D
  1. .. S SRT3="" F S SRT3=$O(^TMP($J,"IBCNERPF",SRT1,SRT2,SRT3)) Q:SRT3=""!$G(ZTSTOP)!IBPXT D
  1. ... S DDATA=$G(^TMP($J,"IBCNERPF",SRT1,SRT2,SRT3)),DLINE="",SSN=$P(DDATA,U,4)
  1. ... I IBOUT="E" W !,$P(DDATA,U,1,3)_U_$E(SSN,$L(SSN)-3,$L(SSN))_U_$P(DDATA,U,5,8) Q
  1. ... S $E(DLINE,1,24)=$E($P(DDATA,U),1,24) ; Payer name
  1. ... S $E(DLINE,28,43)=$E($P(DDATA,U,2),1,16) ; Insurance company name
  1. ... S $E(DLINE,46,60)=$E($P(DDATA,U,3),1,15) ; Patient name
  1. ... S SSNLEN=$L(SSN),$E(DLINE,63,66)=$E(SSN,SSNLEN-3,SSNLEN)
  1. ... S $E(DLINE,69,76)=$E($P(DDATA,U,5),1,8) ; Date sent
  1. ... S $E(DLINE,79,86)=$E($P(DDATA,U,6),1,17) ; Date auto updated
  1. ... S $E(DLINE,98,104)=$P(DDATA,U,7)
  1. ... S $E(DLINE,105,114)=$E($P(DDATA,U,8),1,10) ; eIV trace number
  1. ... D LINE(DLINE,IBOUT)
  1. . I IBOUT="R" W !
  1. ;
  1. PRINTX ;
  1. I 'IBPXT D
  1. . D LINE($$FO^IBCNEUT1(EORMSG,$L(EORMSG),"L"),IBOUT)
  1. . I CRT,IBPGC>0,'$D(ZTQUEUED) D EOL
  1. Q
  1. ;
  1. EOL ; display "end of page" message and set exit flag
  1. N DIR,DIROUT,DIRUT,DTOUT,DUOUT,LIN
  1. I MAXCNT<51 F LIN=1:1:(MAXCNT-$Y) W !
  1. S DIR(0)="E" D ^DIR K DIR
  1. I $D(DTOUT)!$D(DUOUT) S IBPXT=1
  1. Q
  1. ;
  1. N DASHES,DELTA,HDR,LEN,OFFSET,POS,STRING
  1. ;
  1. I CRT,IBPGC>0,'$D(ZTQUEUED) D EOL I IBPXT Q
  1. I $D(ZTQUEUED),$$S^%ZTLOAD() S (ZTSTOP,IBPXT)=1 Q
  1. S IBPGC=IBPGC+1
  1. W @IOF,!
  1. S HDR=$J("",WIDTH)
  1. S STRING=" Auto Update Report",$E(HDR,1,$L(STRING))=STRING
  1. S STRING=" Page: "_IBPGC,$E(HDR,WIDTH-$L(STRING)+1,WIDTH)=STRING
  1. S LEN=$L(TSTAMP)
  1. S DELTA=(WIDTH#2),POS=(WIDTH\2+DELTA)-(LEN\2)+1
  1. S $E(HDR,POS,POS+$L(TSTAMP)-1)=TSTAMP
  1. W HDR W:TYPE="S" !
  1. S HDR=$$FMTE^XLFDT($G(IBCNESPC("BEGDT")),"5Z")_" - "_$$FMTE^XLFDT($G(IBCNESPC("ENDDT")),"5Z")
  1. W !?1,"Response Received: ",HDR
  1. W !?1,$S(TYPE="D":"Detailed",1:"Summary")_" Report: "
  1. W $S($G(IBCNESPC("PS"))="S":" Source of Information",1:$S(ALLPYR:"All",1:"Selected")_" Payers")
  1. I TYPE="D" D
  1. . W "; ",$S($G(IBCNESPC("INSCO"))="S":"Selected",1:"All")
  1. . W " Insurance Companies; "
  1. . W $S(ALLPAT:"All",1:"Selected")_" Patients"
  1. . S STRING="Payer",$E(STRING,28,45)="Insurance Co",$E(STRING,46,62)="Patient Name"
  1. . S $E(STRING,63,68)="SSN",$E(STRING,69,78)="Dt Sent",$E(STRING,79,88)="Auto Dt"
  1. . S $E(STRING,98,104)="SOI"
  1. . S $E(STRING,105,138)="eIV Trace#"
  1. . W !!,?1,STRING
  1. S $P(DASHES,"-",WIDTH-2)="" W !,?1,DASHES
  1. Q
  1. ;
  1. LINE(LINE,IBOUT) ; Print line of data
  1. I $Y+1>MAXCNT,IBOUT="R" D HEADER I $G(ZTSTOP)!IBPXT Q
  1. W ! W:IBOUT="R" ?1 W LINE
  1. Q
  1. ;
  1. PHDL ; - Print the header line for the Excel spreadsheet
  1. ; IB*2.0*549 - Add report header
  1. N %,HDR,IBHDT,X
  1. D NOW^%DTC
  1. S IBHDT=$$DAT2^IBOUTL($E(%,1,12))
  1. W !!,"Auto Update Report",?53,"Run On: ",IBHDT
  1. S HDR=$$FMTE^XLFDT($G(IBCNESPC("BEGDT")),"5Z")_" - "_$$FMTE^XLFDT($G(IBCNESPC("ENDDT")),"5Z")
  1. W !?1,"Response Received: ",HDR
  1. W !?2,$S(TYPE="D":"Detailed",1:"Summary")_" Report: "
  1. W $S($G(IBCNESPC("PS"))="S":" Source of Information",1:$S(ALLPYR:"All",1:"Selected")_" Payers")
  1. S IBPGC=1
  1. I TYPE="S" D G PHDLX
  1. . I IBCNESPC("PS")="S" W !!,"SOI^Payer Name^Count" Q
  1. . W !!,"Payer Name",$S(IBCNESPC("ICODETL"):"^Insurance Co",1:""),"^Count"
  1. W "; ",$S($G(IBCNESPC("INSCO"))="S":"Selected",1:"All")," Insurance Companies; "
  1. W $S(ALLPAT:"All",1:"Selected")_" Patients"
  1. W !!,"Payer^Insurance Co^Patient Name^SSN^Dt Sent^Auto Dt^SOI^eIV Trace#"
  1. PHDLX ;
  1. Q