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