IBCNERPO1 ;AITC/CKB - PATIENT POLICY AUTOLOAD REPORT COMPILE ; 20-JAN-2026
;;2.0;INTEGRATED BILLING;**836**;21-MAR-94;Build 12
;;Per VA Directive 6402, this routine should not be modified.
;
; Variable array from IBCNERPO:
; IBCNERPO("BEGDT") = Start with DATE - start date range
; IBCNERPO("ENDDT") = Go to DATE - end date range
; IBCNERPO("IBOUT") = "R" for Report format or "E" for Excel format
; IBCNERPO("TYPE") = report type: "S" - summary, "D" - detailed
; IBCNERPO("SORT") = (1)Patient Name - (2)Date Autoloaded
;
; Data global created for PRINT:
; Summary report:
; ^TMP($J,"IBCNERPO")=Total Count
; ^TMP($J,"IBCNERPO",PTYPE)=Count / PTYPE = "A+B" or "A only" or "B only"
;
; Detailed report:
; ^TMP($J,"IBCNERPO")=Count
; ^TMP($J,"IBCNERPO",SORT1)=Patient Name ^ DOB ^ SSN ^ Group Name ^ Group Number ^
; Effective Date ^ Autoload Date
;
Q
;
EN(IBCNERPO) ; Entry point
N DATE,BDATE,EDATE,PTYPE,RPCTR,RTYPE,SOI,SOIBA,SORT,TOTMES
;
S BDATE=$G(IBCNERPO("BEGDT"))
S EDATE=$G(IBCNERPO("ENDDT"))
I EDATE'="",$P(EDATE,".",2)="" S EDATE=$$FMADD^XLFDT(EDATE,0,23,59,59)
S RTYPE=$G(IBCNERPO("TYPE"))
I '$D(ZTQUEUED),$G(IOST)["C-",IBOUT="R" W !!,"Compiling report data ..."
; Kill scratch global
K ^TMP($J,"IBCNERPO")
K RPDATA
;Initialize variables
I RTYPE="S" N I F I="A+B","A Only","B Only" S RPDATA(I)=0
;
;Initialize variables
S (RPCTR,TOTMES)=0
S DATE=$O(^IBCN(365,"AD",BDATE),-1)
F S DATE=$O(^IBCN(365,"AD",DATE)) Q:'DATE!(DATE>EDATE) D I $G(ZTSTOP) G ENX
. N PAT,PYR
. ; Loop through Payers
. S PYR="" F S PYR=$O(^IBCN(365,"AD",DATE,PYR)) Q:'PYR D
.. ; Loop through Patients
.. S PAT="" F S PAT=$O(^IBCN(365,"AD",DATE,PYR,PAT)) Q:'PAT D Q:$G(ZTSTOP)
... D GETRESP(DATE,PYR,PAT,RTYPE)
; Move report data from RPDATA to scratch global
M ^TMP($J,"IBCNERPO")=RPDATA
ENX ; Exit
Q
;
GETRESP(DATE,PYR,PAT,RTYPE) ; loop through the responses and compile report
N AUTOLOAD,ACTIVE,DOB,EFFDT,ELIG,FOUND,GRP,GRPNAME,GRPNUM,ELIG,IBOUT,IENS2,IENS312,IENS3651
N IIEN,INS,PATNAME,POL,POLCT,POLICY,RIEN,SOI,SORT1,SORT2,TYPE
;
S RIEN="" F S RIEN=$O(^IBCN(365,"AD",DATE,PYR,PAT,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 not a EIV AUTO-LOAD response Quit
. I $$GET1^DIQ(365,RIEN_",",.16)'="YES" Q
. ;
. S IIEN=$$GET1^DIQ(365,RIEN_",",.12) ; Insurance Record IEN
. S IENS3651=$$GET1^DIQ(365,RIEN_",",.05) ; Transmission Queue IEN
. S SOI=$$GET1^DIQ(365.1,IENS3651,3.02,"I")
. ;
. ;Get list of insurance identified file #365 IIV RESPONSE file - 271 payer response
. D EBSUMMARY^IBCNEUT2(PAT,RIEN,SOI,.POLICY)
. I '$O(POLICY(0)) Q ; if none was returned on payer response (safety valve)
. I $D(POLICY(1,"Unknown")) Q ; if none was returned on payer response (safety valve)
. I $G(POLICY("OHI"))=1 Q ; indicates Other potential insurance indicated on payer response
. ;If the Medicare Policy in the Response is missing the Effective Date, policy did not auto-load
. I $G(POLICY("MISSING_EFFDT"))=1 Q
. ;Loop through POLICY and gather the Active policy(s)
. D GETACTIVE
. ;
. ;Summary Report
. I $D(ACTIVE("Medicare Part A")) S PTYPE="A Only"
. I $D(ACTIVE("Medicare Part B")) S PTYPE="B Only"
. I ($D(ACTIVE("Medicare Part A")))&($D(ACTIVE("Medicare Part B"))) S PTYPE="A+B"
. I RTYPE="S" D Q
.. S RPDATA=$G(RPDATA)+1
.. S RPDATA(PTYPE)=$G(RPDATA(PTYPE))+1
. ;
. ;Compile Report
. ;Loop through ACTIVE for the Detail Report info
. S POL="" F S POL=$O(ACTIVE(POL)) Q:POL="" D
.. S GRP=$S(POL="Medicare Part A":"PART A",1:"PART B",1:"")
.. ;Loop thru the patient policy's to get the Insurance IEN for the Active policy
.. S FOUND=0
.. S IIEN=0 F S IIEN=$O(^DPT(PAT,.312,IIEN)) Q:(IIEN="")!(FOUND=1) D COMPILE
Q
;
COMPILE ; Compile Detail Report
N REC
S IENS2=PAT_","
S IENS312=IIEN_","_IENS2
S AUTOLOAD=$P($$GET1^DIQ(2.312,IENS312,1.01,"I"),".")
S GRPNAME=$$GET1^DIQ(2.312,IENS312,20,"E")
;Check to see if this is the policy in ACTIVE array
I AUTOLOAD'=$P(DATE,".")!(GRP'=GRPNAME) Q
;Found the policy in the patient's insurance
S FOUND=1
S GRPNUM=$$GET1^DIQ(2.312,IENS312,21,"E")
S PATNAME=$$GET1^DIQ(2,IENS2,.01)
S DOB=$$GET1^DIQ(2,IENS2,.03,"I")
S SSN=$$GET1^DIQ(2,IENS2,.09)
S EFFDT=$$GET1^DIQ(2.312,IENS312,8,"I")
;Detail Report 1=Patient Name / 2=Date Autoloaded
S RPCTR=$G(RPCTR)+1
S SORT1=PATNAME
I IBCNERPO("IBOUT")="R" S SORT1=$S(IBCNERPO("SORT")=2:AUTOLOAD,1:PATNAME)
S REC=PATNAME_U_$$FMTE^XLFDT(DOB,"5Z")_U_SSN_U_GRPNAME_U_GRPNUM_U_$$FMTE^XLFDT(EFFDT,"5Z")_U_$$FMTE^XLFDT(AUTOLOAD,"5Z")
S RPDATA(SORT1,RPCTR)=REC
Q
;
PRINT(IBCNERPO) ; Entry point
N CRT,DDATA,DLINE,EORMSG,IBPGC,IBPXT,ICT,MAXCNT,NONEMSG,NPROC,SSN,SSNLEN,SRT1,TSTAMP,WIDTH,X,Y
;
S (IBPGC,IBPXT)=0
S NONEMSG="*** NO DATA FOUND ***"
S EORMSG="*** END OF REPORT ***"
S TSTAMP=$$FMTE^XLFDT($$NOW^XLFDT,1) ; time of report
S TYPE=$G(IBCNERPO("TYPE")) ; Report type
S IBOUT=$G(IBCNERPO("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",EHEADER:IBOUT="E"
; If global does not exist - display No Data message for the Detail Report
I TYPE="D" I '$D(^TMP($J,"IBCNERPO")) D LINE(NONEMSG,IBOUT) W:IBOUT="E" ! G PRINTX
;
; Summary Report
I TYPE="S" D G PRINTX
. N COUNT,SLINE,TLINE,TOTAL
. W ! F SRT1="A+B","A Only","B Only" D
.. S COUNT=$G(^TMP($J,"IBCNERPO",SRT1)) I COUNT="" S COUNT=0
.. S SLINE=$$FO^IBCNEUT1(" Patients ("_SRT1_")",38,"L")
.. S SLINE=SLINE_$$FO^IBCNEUT1(COUNT,20,"R")
.. D LINE(SLINE,IBOUT)
. W !
. S TOTAL=$G(^TMP($J,"IBCNERPO")) I TOTAL="" S TOTAL=0
. S TLINE=" Patients Autoloaded Medicare (Total) "
. S TLINE=TLINE_$$FO^IBCNEUT1(TOTAL,20,"R")
. D LINE(TLINE,IBOUT)
. W !!
;
; Detail Report
S SRT1="" F S SRT1=$O(^TMP($J,"IBCNERPO",SRT1)) Q:SRT1="" D Q:$G(ZTSTOP)!IBPXT
. S ICT="" F S ICT=$O(^TMP($J,"IBCNERPO",SRT1,ICT)) Q:ICT="" D
.. S DDATA=$G(^TMP($J,"IBCNERPO",SRT1,ICT))
.. S SSN=$P(DDATA,U,3)
.. I IBOUT="E" W !,$P(DDATA,U,1,2)_U_$E(SSN,$L(SSN)-3,$L(SSN))_U_$P(DDATA,U,4,7) Q
.. S DLINE=""
.. S $E(DLINE,1,35)=$E($P(DDATA,U),1,35) ; Patient Name
.. S $E(DLINE,38,48)=$E($P(DDATA,U,2),1,10) ; DOB
.. S SSNLEN=$L(SSN),$E(DLINE,51,54)=$E(SSN,SSNLEN-3,SSNLEN) ; SSN (last 4)
.. S $E(DLINE,58,78)=$E($P(DDATA,U,4),1,20) ; Group Name
.. S $E(DLINE,81,100)=$E($P(DDATA,U,5),1,17) ; Group Number
.. S $E(DLINE,102,112)=$E($P(DDATA,U,6),1,10) ; Effective Date
.. S $E(DLINE,115,125)=$E($P(DDATA,U,7),1,10) ; Autoload Date
.. D LINE(DLINE,IBOUT)
PRINTX ;
I 'IBPXT D
. W !
. I IBOUT="E" W EORMSG D PAUSE Q
. D LINE($$FO^IBCNEUT1(EORMSG,$L(EORMSG),"L"),IBOUT)
. I CRT,IBPGC>0,'$D(ZTQUEUED) D EOL
Q
;
GETACTIVE ; Get the Active policies from the POLICY array
; ACTIVE(GRPNUM)=DFN_U_GRPNUM_U_EFFDT_U_SOI_U_ELIG
; Loop through list of insurance (.POLICY) and keep only ACTIVE policies
; Only add 'Active' policies to the ACTIVE array
S POLCT="" F S POLCT=$O(POLICY(POLCT)) Q:POLCT="" D
. S GRPNUM="" F S GRPNUM=$O(POLICY(POLCT,GRPNUM)) Q:GRPNUM="" D
.. I $TR(GRPNUM,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")'["MEDICARE" Q
.. S ELIG=$P(POLICY(POLCT,GRPNUM),U,5) ; ELIG='Inactive' or 'Active Coverage'
.. I $TR(ELIG,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")["INACTIVE" Q
.. S ACTIVE(GRPNUM)=POLICY(POLCT,GRPNUM)
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 !
D PAUSE
Q
;
N DASHES,DELTA,HDR,HDRDATE,HDRDTR,HDRPG,OFFSET,SPACES
;
I CRT,IBPGC>0,'$D(ZTQUEUED) D EOL I IBPXT Q
I $D(ZTQUEUED),$$S^%ZTLOAD() S (ZTSTOP,IBPXT)=1 Q
W @IOF,!
S IBPGC=IBPGC+1
S DASHES="" F I=1:1:132 S DASHES=DASHES_"-"
S SPACES="" F I=1:1:25 S SPACES=SPACES_" "
D NOW^%DTC
S HDRDATE=$$DAT2^IBOUTL($E(%,1,12))
S HDRDTR=$$FMTE^XLFDT($G(IBCNERPO("BEGDT")),"5Z")_" - "_$$FMTE^XLFDT($G(IBCNERPO("ENDDT")),"5Z")
;Summary Report Header
I TYPE="S" D
. S HDR="Patient Policy Autoload Report (Summary) "_HDRDATE
. W !,HDR,?70,"Page: "_IBPGC
. W !,"Date Range: ",HDRDTR,!
;Detail Report Header
I TYPE="D" D
. S HDR="Patient Policy Autoload Report"_SPACES_HDRDATE
. W !,HDR,?112,"Page: "_IBPGC
. W !,"Date Range: ",HDRDTR
. W !,"Sort By: ",$S(IBCNERPO("SORT")=2:"Date Autoloaded",1:"Patient Name")
. W !!,"Patient Name",?38,"DOB",?51,"SSN",?58,"Group Name",?81,"Group Number",?102,"Eff Date",?115,"Autoload Date"
. W !,$E(DASHES,1,35),?38,$E(DASHES,1,10),?51,$E(DASHES,1,4),?58,$E(DASHES,1,10),?81,$E(DASHES,1,12)
. W ?102,$E(DASHES,1,10),?115,$E(DASHES,1,13)
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
;
N %,HDR,IBHDT
D NOW^%DTC
S IBHDT=$$DAT2^IBOUTL($E(%,1,12))
W !,"Patient Policy Autoload Report^",IBHDT
S HDR=$$FMTE^XLFDT($G(IBCNERPO("BEGDT")),"5Z")_" - "_$$FMTE^XLFDT($G(IBCNERPO("ENDDT")),"5Z")
W !,"Date Range: ",HDR
W !,"Patient Name^DOB^SSN^Group Name^Group Number^Effective Date^Autoload Date"
Q
;
PAUSE ; Pause for screen output.
N DIR,DIRUT,DTOUT,DUOUT
Q:$E(IOST,1,2)'["C-"
S DIR(0)="E" D ^DIR K DIR I $D(DIRUT)!($D(DUOUT)) S IBPXT=1 K DIR,DIRUT,DTOUT,DUOUT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNERPO1 9805 printed Sep 17, 2026@21:01:42 Page 2
IBCNERPO1 ;AITC/CKB - PATIENT POLICY AUTOLOAD REPORT COMPILE ; 20-JAN-2026
+1 ;;2.0;INTEGRATED BILLING;**836**;21-MAR-94;Build 12
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; Variable array from IBCNERPO:
+5 ; IBCNERPO("BEGDT") = Start with DATE - start date range
+6 ; IBCNERPO("ENDDT") = Go to DATE - end date range
+7 ; IBCNERPO("IBOUT") = "R" for Report format or "E" for Excel format
+8 ; IBCNERPO("TYPE") = report type: "S" - summary, "D" - detailed
+9 ; IBCNERPO("SORT") = (1)Patient Name - (2)Date Autoloaded
+10 ;
+11 ; Data global created for PRINT:
+12 ; Summary report:
+13 ; ^TMP($J,"IBCNERPO")=Total Count
+14 ; ^TMP($J,"IBCNERPO",PTYPE)=Count / PTYPE = "A+B" or "A only" or "B only"
+15 ;
+16 ; Detailed report:
+17 ; ^TMP($J,"IBCNERPO")=Count
+18 ; ^TMP($J,"IBCNERPO",SORT1)=Patient Name ^ DOB ^ SSN ^ Group Name ^ Group Number ^
+19 ; Effective Date ^ Autoload Date
+20 ;
+21 QUIT
+22 ;
EN(IBCNERPO) ; Entry point
+1 NEW DATE,BDATE,EDATE,PTYPE,RPCTR,RTYPE,SOI,SOIBA,SORT,TOTMES
+2 ;
+3 SET BDATE=$GET(IBCNERPO("BEGDT"))
+4 SET EDATE=$GET(IBCNERPO("ENDDT"))
+5 IF EDATE'=""
IF $PIECE(EDATE,".",2)=""
SET EDATE=$$FMADD^XLFDT(EDATE,0,23,59,59)
+6 SET RTYPE=$GET(IBCNERPO("TYPE"))
+7 IF '$DATA(ZTQUEUED)
IF $GET(IOST)["C-"
IF IBOUT="R"
WRITE !!,"Compiling report data ..."
+8 ; Kill scratch global
+9 KILL ^TMP($JOB,"IBCNERPO")
+10 KILL RPDATA
+11 ;Initialize variables
+12 IF RTYPE="S"
NEW I
FOR I="A+B","A Only","B Only"
SET RPDATA(I)=0
+13 ;
+14 ;Initialize variables
+15 SET (RPCTR,TOTMES)=0
+16 SET DATE=$ORDER(^IBCN(365,"AD",BDATE),-1)
+17 FOR
SET DATE=$ORDER(^IBCN(365,"AD",DATE))
if 'DATE!(DATE>EDATE)
QUIT
Begin DoDot:1
+18 NEW PAT,PYR
+19 ; Loop through Payers
+20 SET PYR=""
FOR
SET PYR=$ORDER(^IBCN(365,"AD",DATE,PYR))
if 'PYR
QUIT
Begin DoDot:2
+21 ; Loop through Patients
+22 SET PAT=""
FOR
SET PAT=$ORDER(^IBCN(365,"AD",DATE,PYR,PAT))
if 'PAT
QUIT
Begin DoDot:3
+23 DO GETRESP(DATE,PYR,PAT,RTYPE)
End DoDot:3
if $GET(ZTSTOP)
QUIT
End DoDot:2
End DoDot:1
IF $GET(ZTSTOP)
GOTO ENX
+24 ; Move report data from RPDATA to scratch global
+25 MERGE ^TMP($JOB,"IBCNERPO")=RPDATA
ENX ; Exit
+1 QUIT
+2 ;
GETRESP(DATE,PYR,PAT,RTYPE) ; loop through the responses and compile report
+1 NEW AUTOLOAD,ACTIVE,DOB,EFFDT,ELIG,FOUND,GRP,GRPNAME,GRPNUM,ELIG,IBOUT,IENS2,IENS312,IENS3651
+2 NEW IIEN,INS,PATNAME,POL,POLCT,POLICY,RIEN,SOI,SORT1,SORT2,TYPE
+3 ;
+4 SET RIEN=""
FOR
SET RIEN=$ORDER(^IBCN(365,"AD",DATE,PYR,PAT,RIEN))
if 'RIEN
QUIT
Begin DoDot:1
+5 SET TOTMES=TOTMES+1
+6 IF '$DATA(ZTQUEUED)
IF (TOTMES#100=0)
WRITE "."
+7 IF $DATA(ZTQUEUED)
IF TOTMES#100=0
IF $$S^%ZTLOAD()
SET ZTSTOP=1
QUIT
+8 ;If not a EIV AUTO-LOAD response Quit
+9 IF $$GET1^DIQ(365,RIEN_",",.16)'="YES"
QUIT
+10 ;
+11 ; Insurance Record IEN
SET IIEN=$$GET1^DIQ(365,RIEN_",",.12)
+12 ; Transmission Queue IEN
SET IENS3651=$$GET1^DIQ(365,RIEN_",",.05)
+13 SET SOI=$$GET1^DIQ(365.1,IENS3651,3.02,"I")
+14 ;
+15 ;Get list of insurance identified file #365 IIV RESPONSE file - 271 payer response
+16 DO EBSUMMARY^IBCNEUT2(PAT,RIEN,SOI,.POLICY)
+17 ; if none was returned on payer response (safety valve)
IF '$ORDER(POLICY(0))
QUIT
+18 ; if none was returned on payer response (safety valve)
IF $DATA(POLICY(1,"Unknown"))
QUIT
+19 ; indicates Other potential insurance indicated on payer response
IF $GET(POLICY("OHI"))=1
QUIT
+20 ;If the Medicare Policy in the Response is missing the Effective Date, policy did not auto-load
+21 IF $GET(POLICY("MISSING_EFFDT"))=1
QUIT
+22 ;Loop through POLICY and gather the Active policy(s)
+23 DO GETACTIVE
+24 ;
+25 ;Summary Report
+26 IF $DATA(ACTIVE("Medicare Part A"))
SET PTYPE="A Only"
+27 IF $DATA(ACTIVE("Medicare Part B"))
SET PTYPE="B Only"
+28 IF ($DATA(ACTIVE("Medicare Part A")))&($DATA(ACTIVE("Medicare Part B")))
SET PTYPE="A+B"
+29 IF RTYPE="S"
Begin DoDot:2
+30 SET RPDATA=$GET(RPDATA)+1
+31 SET RPDATA(PTYPE)=$GET(RPDATA(PTYPE))+1
End DoDot:2
QUIT
+32 ;
+33 ;Compile Report
+34 ;Loop through ACTIVE for the Detail Report info
+35 SET POL=""
FOR
SET POL=$ORDER(ACTIVE(POL))
if POL=""
QUIT
Begin DoDot:2
+36 SET GRP=$SELECT(POL="Medicare Part A":"PART A",1:"PART B",1:"")
+37 ;Loop thru the patient policy's to get the Insurance IEN for the Active policy
+38 SET FOUND=0
+39 SET IIEN=0
FOR
SET IIEN=$ORDER(^DPT(PAT,.312,IIEN))
if (IIEN="")!(FOUND=1)
QUIT
DO COMPILE
End DoDot:2
End DoDot:1
if $GET(ZTSTOP)
QUIT
+40 QUIT
+41 ;
COMPILE ; Compile Detail Report
+1 NEW REC
+2 SET IENS2=PAT_","
+3 SET IENS312=IIEN_","_IENS2
+4 SET AUTOLOAD=$PIECE($$GET1^DIQ(2.312,IENS312,1.01,"I"),".")
+5 SET GRPNAME=$$GET1^DIQ(2.312,IENS312,20,"E")
+6 ;Check to see if this is the policy in ACTIVE array
+7 IF AUTOLOAD'=$PIECE(DATE,".")!(GRP'=GRPNAME)
QUIT
+8 ;Found the policy in the patient's insurance
+9 SET FOUND=1
+10 SET GRPNUM=$$GET1^DIQ(2.312,IENS312,21,"E")
+11 SET PATNAME=$$GET1^DIQ(2,IENS2,.01)
+12 SET DOB=$$GET1^DIQ(2,IENS2,.03,"I")
+13 SET SSN=$$GET1^DIQ(2,IENS2,.09)
+14 SET EFFDT=$$GET1^DIQ(2.312,IENS312,8,"I")
+15 ;Detail Report 1=Patient Name / 2=Date Autoloaded
+16 SET RPCTR=$GET(RPCTR)+1
+17 SET SORT1=PATNAME
+18 IF IBCNERPO("IBOUT")="R"
SET SORT1=$SELECT(IBCNERPO("SORT")=2:AUTOLOAD,1:PATNAME)
+19 SET REC=PATNAME_U_$$FMTE^XLFDT(DOB,"5Z")_U_SSN_U_GRPNAME_U_GRPNUM_U_$$FMTE^XLFDT(EFFDT,"5Z")_U_$$FMTE^XLFDT(AUTOLOAD,"5Z")
+20 SET RPDATA(SORT1,RPCTR)=REC
+21 QUIT
+22 ;
PRINT(IBCNERPO) ; Entry point
+1 NEW CRT,DDATA,DLINE,EORMSG,IBPGC,IBPXT,ICT,MAXCNT,NONEMSG,NPROC,SSN,SSNLEN,SRT1,TSTAMP,WIDTH,X,Y
+2 ;
+3 SET (IBPGC,IBPXT)=0
+4 SET NONEMSG="*** NO DATA FOUND ***"
+5 SET EORMSG="*** END OF REPORT ***"
+6 ; time of report
SET TSTAMP=$$FMTE^XLFDT($$NOW^XLFDT,1)
+7 ; Report type
SET TYPE=$GET(IBCNERPO("TYPE"))
+8 ; Output type
SET IBOUT=$GET(IBCNERPO("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 EHEADER
+17 ; If global does not exist - display No Data message for the Detail Report
+18 IF TYPE="D"
IF '$DATA(^TMP($JOB,"IBCNERPO"))
DO LINE(NONEMSG,IBOUT)
if IBOUT="E"
WRITE !
GOTO PRINTX
+19 ;
+20 ; Summary Report
+21 IF TYPE="S"
Begin DoDot:1
+22 NEW COUNT,SLINE,TLINE,TOTAL
+23 WRITE !
FOR SRT1="A+B","A Only","B Only"
Begin DoDot:2
+24 SET COUNT=$GET(^TMP($JOB,"IBCNERPO",SRT1))
IF COUNT=""
SET COUNT=0
+25 SET SLINE=$$FO^IBCNEUT1(" Patients ("_SRT1_")",38,"L")
+26 SET SLINE=SLINE_$$FO^IBCNEUT1(COUNT,20,"R")
+27 DO LINE(SLINE,IBOUT)
End DoDot:2
+28 WRITE !
+29 SET TOTAL=$GET(^TMP($JOB,"IBCNERPO"))
IF TOTAL=""
SET TOTAL=0
+30 SET TLINE=" Patients Autoloaded Medicare (Total) "
+31 SET TLINE=TLINE_$$FO^IBCNEUT1(TOTAL,20,"R")
+32 DO LINE(TLINE,IBOUT)
+33 WRITE !!
End DoDot:1
GOTO PRINTX
+34 ;
+35 ; Detail Report
+36 SET SRT1=""
FOR
SET SRT1=$ORDER(^TMP($JOB,"IBCNERPO",SRT1))
if SRT1=""
QUIT
Begin DoDot:1
+37 SET ICT=""
FOR
SET ICT=$ORDER(^TMP($JOB,"IBCNERPO",SRT1,ICT))
if ICT=""
QUIT
Begin DoDot:2
+38 SET DDATA=$GET(^TMP($JOB,"IBCNERPO",SRT1,ICT))
+39 SET SSN=$PIECE(DDATA,U,3)
+40 IF IBOUT="E"
WRITE !,$PIECE(DDATA,U,1,2)_U_$EXTRACT(SSN,$LENGTH(SSN)-3,$LENGTH(SSN))_U_$PIECE(DDATA,U,4,7)
QUIT
+41 SET DLINE=""
+42 ; Patient Name
SET $EXTRACT(DLINE,1,35)=$EXTRACT($PIECE(DDATA,U),1,35)
+43 ; DOB
SET $EXTRACT(DLINE,38,48)=$EXTRACT($PIECE(DDATA,U,2),1,10)
+44 ; SSN (last 4)
SET SSNLEN=$LENGTH(SSN)
SET $EXTRACT(DLINE,51,54)=$EXTRACT(SSN,SSNLEN-3,SSNLEN)
+45 ; Group Name
SET $EXTRACT(DLINE,58,78)=$EXTRACT($PIECE(DDATA,U,4),1,20)
+46 ; Group Number
SET $EXTRACT(DLINE,81,100)=$EXTRACT($PIECE(DDATA,U,5),1,17)
+47 ; Effective Date
SET $EXTRACT(DLINE,102,112)=$EXTRACT($PIECE(DDATA,U,6),1,10)
+48 ; Autoload Date
SET $EXTRACT(DLINE,115,125)=$EXTRACT($PIECE(DDATA,U,7),1,10)
+49 DO LINE(DLINE,IBOUT)
End DoDot:2
End DoDot:1
if $GET(ZTSTOP)!IBPXT
QUIT
PRINTX ;
+1 IF 'IBPXT
Begin DoDot:1
+2 WRITE !
+3 IF IBOUT="E"
WRITE EORMSG
DO PAUSE
QUIT
+4 DO LINE($$FO^IBCNEUT1(EORMSG,$LENGTH(EORMSG),"L"),IBOUT)
+5 IF CRT
IF IBPGC>0
IF '$DATA(ZTQUEUED)
DO EOL
End DoDot:1
+6 QUIT
+7 ;
GETACTIVE ; Get the Active policies from the POLICY array
+1 ; ACTIVE(GRPNUM)=DFN_U_GRPNUM_U_EFFDT_U_SOI_U_ELIG
+2 ; Loop through list of insurance (.POLICY) and keep only ACTIVE policies
+3 ; Only add 'Active' policies to the ACTIVE array
+4 SET POLCT=""
FOR
SET POLCT=$ORDER(POLICY(POLCT))
if POLCT=""
QUIT
Begin DoDot:1
+5 SET GRPNUM=""
FOR
SET GRPNUM=$ORDER(POLICY(POLCT,GRPNUM))
if GRPNUM=""
QUIT
Begin DoDot:2
+6 IF $TRANSLATE(GRPNUM,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")'["MEDICARE"
QUIT
+7 ; ELIG='Inactive' or 'Active Coverage'
SET ELIG=$PIECE(POLICY(POLCT,GRPNUM),U,5)
+8 IF $TRANSLATE(ELIG,"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")["INACTIVE"
QUIT
+9 SET ACTIVE(GRPNUM)=POLICY(POLCT,GRPNUM)
End DoDot:2
End DoDot:1
+10 QUIT
+11 ;
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 DO PAUSE
+4 QUIT
+5 ;
+1 NEW DASHES,DELTA,HDR,HDRDATE,HDRDTR,HDRPG,OFFSET,SPACES
+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 WRITE @IOF,!
+6 SET IBPGC=IBPGC+1
+7 SET DASHES=""
FOR I=1:1:132
SET DASHES=DASHES_"-"
+8 SET SPACES=""
FOR I=1:1:25
SET SPACES=SPACES_" "
+9 DO NOW^%DTC
+10 SET HDRDATE=$$DAT2^IBOUTL($EXTRACT(%,1,12))
+11 SET HDRDTR=$$FMTE^XLFDT($GET(IBCNERPO("BEGDT")),"5Z")_" - "_$$FMTE^XLFDT($GET(IBCNERPO("ENDDT")),"5Z")
+12 ;Summary Report Header
+13 IF TYPE="S"
Begin DoDot:1
+14 SET HDR="Patient Policy Autoload Report (Summary) "_HDRDATE
+15 WRITE !,HDR,?70,"Page: "_IBPGC
+16 WRITE !,"Date Range: ",HDRDTR,!
End DoDot:1
+17 ;Detail Report Header
+18 IF TYPE="D"
Begin DoDot:1
+19 SET HDR="Patient Policy Autoload Report"_SPACES_HDRDATE
+20 WRITE !,HDR,?112,"Page: "_IBPGC
+21 WRITE !,"Date Range: ",HDRDTR
+22 WRITE !,"Sort By: ",$SELECT(IBCNERPO("SORT")=2:"Date Autoloaded",1:"Patient Name")
+23 WRITE !!,"Patient Name",?38,"DOB",?51,"SSN",?58,"Group Name",?81,"Group Number",?102,"Eff Date",?115,"Autoload Date"
+24 WRITE !,$EXTRACT(DASHES,1,35),?38,$EXTRACT(DASHES,1,10),?51,$EXTRACT(DASHES,1,4),?58,$EXTRACT(DASHES,1,10),?81,$EXTRACT(DASHES,1,12)
+25 WRITE ?102,$EXTRACT(DASHES,1,10),?115,$EXTRACT(DASHES,1,13)
End DoDot:1
+26 QUIT
+27 ;
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 ;
+1 NEW %,HDR,IBHDT
+2 DO NOW^%DTC
+3 SET IBHDT=$$DAT2^IBOUTL($EXTRACT(%,1,12))
+4 WRITE !,"Patient Policy Autoload Report^",IBHDT
+5 SET HDR=$$FMTE^XLFDT($GET(IBCNERPO("BEGDT")),"5Z")_" - "_$$FMTE^XLFDT($GET(IBCNERPO("ENDDT")),"5Z")
+6 WRITE !,"Date Range: ",HDR
+7 WRITE !,"Patient Name^DOB^SSN^Group Name^Group Number^Effective Date^Autoload Date"
+1 QUIT
+2 ;
PAUSE ; Pause for screen output.
+1 NEW DIR,DIRUT,DTOUT,DUOUT
+2 if $EXTRACT(IOST,1,2)'["C-"
QUIT
+3 SET DIR(0)="E"
DO ^DIR
KILL DIR
IF $DATA(DIRUT)!($DATA(DUOUT))
SET IBPXT=1
KILL DIR,DIRUT,DTOUT,DUOUT
+4 QUIT
