IBCNRRP3 ;BHAM ISC/CMW - GROUP PLAN WORKSHEET REPORT PRINT ;03-MAR-2004
;;2.0;INTEGRATED BILLING;**251,276,516,550,591**;21-MAR-94;Build 45
;;Per VA Directive 6402, this routine should not be modified.
;
; ePHARM GROUP PLAN WORKSHEET REPORT
;
; Called by IBCNRRP1
;
; Input variables from IBCNRRP1 and IBCNRRP2:
; IBCNRRTN = "IBCNRRP1"
; IBCNRSPC("BEGDT") = Start Date for dt range
; IBCNRSPC("ENDDT") = End Date for dt range
; IBCNRSPC("SORT") = 1 - By Insurance/Group; 2 - Total Claims;
; 3 - Total Charges; 4 - Exceptions
; IBCNRSPC("MATCH") = 1 - Matched Only; 0 - All;
;
; ^TMP(IBCNRRTN,1); ^TMP(IBCNRRTN,2); ^TMP(IBCNRRTN,3)
; Must call at appropriate tag
Q
;
;
EN(IBCNRRTN,IBCNRSPC) ; Entry pt.
;
; Init vars
N CRT,MAXCNT,IBPGC,IBBDT,IBEDT,IBMAT,IBPY,IBPXT,IBSRT,IBDTL
N X,Y,DIR,DTOUT,DUOUT,LIN,TOTALS
;
S IBBDT=$G(IBCNRSPC("BEGDT"))
S IBEDT=$G(IBCNRSPC("ENDDT"))
S IBSRT=$G(IBCNRSPC("SORT"))
S IBMAT=$G(IBCNRSPC("MATCH"))
S (IBPXT,IBPGC)=0
;
; Determine IO parameters
I IOST["C-" S MAXCNT=IOSL-3,CRT=1
E S MAXCNT=IOSL-6,CRT=0
;
D PRINT(IBCNRRTN,IBBDT,IBEDT,IBSRT,MAXCNT,IBPGC,IBMAT)
I $G(ZTSTOP)!IBPXT G EXIT3
I CRT,IBPGC>0,'$D(ZTQUEUED) D
. I MAXCNT<51 F LIN=1:1:(MAXCNT-$Y) W !
. S DIR(0)="E" D ^DIR K DIR
;
EXIT3 ; Exit pt
Q
;
PRINT(RTN,BDT,EDT,SRT,MAX,PGC,MAT) ; Print data
; Input params: RNT = "IBCNRRP1" - routine, BDT = starting dt,
; EDT = ending dt
; SRT = 1/2/3
; MAT = 1/0
;
; Init vars
N EORMSG,NONEMSG,TOTDASHS,DISPDATA,SORT,CT,PRT1,PRT2
;
S EORMSG="*** END OF REPORT ***"
S NONEMSG="* * * N O D A T A F O U N D * * *"
S $P(TOTDASHS,"=",89)=""
S CT=0
;
I '$D(^XTMP(RTN)) D HEADER W !,?(132-$L(NONEMSG)\2),NONEMSG,!! G PRINT2
;
; Build lines of data to display
K ^TMP("IBCNR",$J,"RPTDATA")
D DATA
K ^TMP("IBCNR",$J,"DSPDATA")
D DISP
; Display lines of response
D LINE
K ^TMP("IBCNR",$J,"DSPDATA"),^TMP("IBCNR",$J,"RPTDATA")
Q
;
PRINT2 I $G(ZTSTOP)!IBPXT G PRINTX
I $Y+1>MAX!('PGC) D HEADER I $G(ZTSTOP)!$G(IBPXT) G PRINTX
W !,?(132-$L(EORMSG)\2),EORMSG
;
PRINTX ; PRINT exit point
Q
;
; Assumes vars from PRINT: CRT,PGC,IBPXT,MAX,SRT,BDT,EDT,PYR,RDTL,MAR
; Init vars
N DIR,X,Y,DTOUT,DUOUT,OFFSET,HDR,DASHES,DASHES2,LIN
;
I CRT,PGC>0,'$D(ZTQUEUED) D I IBPXT G HEADERX
. I MAX<51 F LIN=1:1:(MAX-$Y) W !
. S DIR(0)="E" D ^DIR K DIR
. I $D(DTOUT)!$D(DUOUT) S IBPXT=1 Q
I $D(ZTQUEUED),$$S^%ZTLOAD() S (ZTSTOP,IBPXT)=1 G HEADERX
S PGC=PGC+1
W @IOF,!,?1,"ePHARM GROUP PLAN WORKSHEET REPORT"
S HDR=$$FMTE^XLFDT($$NOW^XLFDT,1)_" Page: "_PGC
S OFFSET=80-$L(HDR)
W ?OFFSET,HDR
W !,?1,"Claims with Pharmacy Coverage Sorted by: "_$S(SRT=1:"Insurance/Group",SRT=2:"Max. Total Claims",1:"Max. Total Charges")
S HDR=$$FMTE^XLFDT(BDT,"5Z")_" - "_$$FMTE^XLFDT(EDT,"5Z")
S OFFSET=80-$L(HDR)\2
W !,?OFFSET,HDR
; Display column headings
W !,?1,"Insurance Company Name",?40,"Insurance Company Address"
W !,?3,"Group Name/Number",?43,"VA PLAN ID",?60," BIN",?70,"PCN"
S $P(DASHES,"=",80)=""
W !,?1,DASHES
;
Q
;
LINE ; Print line of data
; Assumes vars from PRINT: PGC,IBPXT,MAX
; Init vars
N CT,II
;
S CT=+$O(^TMP("IBCNR",$J,"DSPDATA",""),-1)
I $Y+1+CT>MAX D HEADER I $G(ZTSTOP)!IBPXT G LINEX
F II=1:1:CT D Q:$G(ZTSTOP)!IBPXT
. I $Y+1>MAX!('PGC) D HEADER I $G(ZTSTOP)!IBPXT Q
. W !,?1,^TMP("IBCNR",$J,"DSPDATA",II)
. Q
;
LINEX ; LINE exit pt
Q
;
DATA ; Gather and format lines of data to be printed
; Assumes vars from PRINT: RTN,SRT,SRT,RDTL,CT,PRT1,PRT2
; Init vars
;
;Loop through and sort TMP file
N CNT,IBINS,IBINSNM,IBGRP,IBGRPNM,IBGRPNB,RPDT,RPTOT,RPTCNT,RPTCHG
;Get new HIPAA fields, IBGRP0 no longer needed - IB*2*516
;N IBGRP0,IBGRP6,IBGRPNM,IBPLBIN,IBPLNNM,IBPLPCN,IBPPIEN
N IBGRP6,IBGRPNM,IBPLBIN,IBPLNID,IBPLPCN,IBPPIEN
S IBINS=0,CNT=0
F S IBINS=$O(^XTMP(RTN,IBINS)) Q:IBINS="" D
. ;get insurance company name
. S IBINSNM=$P($G(^DIC(36,IBINS,0)),U)
. I IBINSNM="" S IBINSNM="NO NAME EXISTS"
. S IBGRP=0
. F S IBGRP=$O(^XTMP(RTN,IBINS,IBGRP)) Q:IBGRP="" D
.. ;get group info
.. ;S IBGRP0=$G(^IBA(355.3,IBGRP,0))
.. ;get pharmacy plan info
.. S IBGRP6=$G(^IBA(355.3,IBGRP,6))
.. I 'IBGRP6,$G(MAT) Q ; Matched only
.. ;I IBGRP0 D
.. I $$GET1^DIQ(355.3,IBGRP,2.01)]"" D
... S (IBGRPNM,IBGRPNB)=""
... ;S IBGRPNM=$P($G(IBGRP0),U,3) I $G(IBGRPNM)="" S IBGRPNM="<blank>"
... ;S IBGRPNB=$P($G(IBGRP0),U,4) I $G(IBGRPNB)="" S IBGRPNB="<blank>"
... S IBGRPNM=$$GET1^DIQ(355.3,IBGRP,2.01) I $G(IBGRPNM)="" S IBGRPNM="<blank>"
... S IBGRPNB=$$GET1^DIQ(355.3,IBGRP,2.02) I $G(IBGRPNB)="" S IBGRPNB="<blank>"
... S RPDT=IBGRPNB
.. I IBGRP6 D
... S (IBPPIEN,IBPLNID,IBPLPCN)=""
... S IBPPIEN=$P($G(IBGRP6),U)
... S IBPLNID=$P($G(^IBCNR(366.03,IBPPIEN,0)),U,1)
... S IBPLBIN=$P($G(^IBCNR(366.03,IBPPIEN,10)),U,2)
... S IBPLPCN=$P($G(^IBCNR(366.03,IBPPIEN,10)),U,3)
... S RPDT=$G(RPDT)_U_$G(IBPLNID)_U_$G(IBPLBIN)_U_$G(IBPLPCN)
.. E S RPDT=$G(RPDT)_U_U_U
.. S RPDT=$G(RPDT)_U_$P($G(IBGRP6),U,2,3)
.. S RPTOT=^XTMP(RTN,IBINS,IBGRP)
.. S RPTCNT=$P(RPTOT,U),RPTCHG=$P(RPTOT,U,2)
.. I SRT=1 D Q
... S ^TMP("IBCNR",$J,"RPTDATA",SRT,IBINSNM,IBINS,IBGRPNM,IBGRP)=$G(RPDT)
.. I SRT=2 D Q
... S ^TMP("IBCNR",$J,"RPTDATA",-$G(RPTCNT),IBINSNM,IBINS,IBGRPNM,IBGRP)=$G(RPDT)
.. I SRT=3 D Q
... S ^TMP("IBCNR",$J,"RPTDATA",-$G(RPTCHG),IBINSNM,IBINS,IBGRPNM,IBGRP)=$G(RPDT)
.. I SRT=4 D Q
... I '$G(IBGRP6) Q
... N OK S OK=1
... I $G(IBPLBIN)'="",$P(IBGRP6,U,2)'="",IBPLBIN'=$P(IBGRP6,U,2) S OK=0
... I $G(IBPLPCN)'="",$P(IBGRP6,U,3)'="",IBPLPCN'=$P(IBGRP6,U,3) S OK=0
... I 'OK S ^TMP("IBCNR",$J,"RPTDATA",SRT,IBINSNM,IBINS,IBGRPNM,IBGRP)=$G(RPDT)
Q
;
DISP ;set up display data
N CNT,DISP1,DISP2,DISP3,DISP4,DISP5,DISPD,DASHES2
N IBCNADR,IBCIN11,IBCINST,I
S DISP1="",CNT=0,$P(DASHES2,"-",80)=""
F S DISP1=$O(^TMP("IBCNR",$J,"RPTDATA",DISP1)) Q:DISP1="" D
. S DISP2=""
. F S DISP2=$O(^TMP("IBCNR",$J,"RPTDATA",DISP1,DISP2)) Q:DISP2="" D
.. S DISP3=0
.. F S DISP3=$O(^TMP("IBCNR",$J,"RPTDATA",DISP1,DISP2,DISP3)) Q:DISP3="" D
... S DISP4=""
... F S DISP4=$O(^TMP("IBCNR",$J,"RPTDATA",DISP1,DISP2,DISP3,DISP4)) Q:DISP4="" D
.... S DISP5=0
.... F S DISP5=$O(^TMP("IBCNR",$J,"RPTDATA",DISP1,DISP2,DISP3,DISP4,DISP5)) Q:DISP5="" D
..... S DISPD=$G(^TMP("IBCNR",$J,"RPTDATA",DISP1,DISP2,DISP3,DISP4,DISP5))
..... ;get insurance addr
..... S IBCIN11=$G(^DIC(36,DISP3,.11))
..... S IBCINST=$S($P(IBCIN11,U,5)="":"--",1:$P($G(^DIC(5,$P(IBCIN11,U,5),0)),U,2))
..... S IBCNADR=$E($P(IBCIN11,U),1,15)_","_$E($P(IBCIN11,U,4),1,10)_","_IBCINST_" "_$E($P(IBCIN11,U,6),1,5)
..... S CNT=CNT+1
..... ;insurance co and group/plan
..... S ^TMP("IBCNR",$J,"DSPDATA",CNT)=$$FO^IBCNEUT1(DISP2,40)_$$FO^IBCNEUT1(IBCNADR,35,"L")
..... ;bin; pcn; and pharmacy plan ID
..... S CNT=CNT+1
..... S ^TMP("IBCNR",$J,"DSPDATA",CNT)=$$FO^IBCNEUT1(($E(DISP4,1,24)_"/"_$E($P(DISPD,U),1,15)),42,"L")_$$FO^IBCNEUT1($P(DISPD,U,2),18,"L")_$$FO^IBCNEUT1($P(DISPD,U,3),9,"L")_$$FO^IBCNEUT1($P(DISPD,U,4),10,"L")
..... S I=$$FO^IBCNEUT1("",60)_$$FO^IBCNEUT1($P(DISPD,U,5),10,"L")_$$FO^IBCNEUT1($P(DISPD,U,6),10,"L")
..... I $TR(I," ")'="" S CNT=CNT+1,^TMP("IBCNR",$J,"DSPDATA",CNT)=I
..... S CNT=CNT+1
..... S ^TMP("IBCNR",$J,"DSPDATA",CNT)=$$FO^IBCNEUT1(DASHES2,79,"L")
;
DATAX ; DATA exit pt
K RPTDATA
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNRRP3 7582 printed Apr 09, 2024@21:33:50 Page 2
IBCNRRP3 ;BHAM ISC/CMW - GROUP PLAN WORKSHEET REPORT PRINT ;03-MAR-2004
+1 ;;2.0;INTEGRATED BILLING;**251,276,516,550,591**;21-MAR-94;Build 45
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; ePHARM GROUP PLAN WORKSHEET REPORT
+5 ;
+6 ; Called by IBCNRRP1
+7 ;
+8 ; Input variables from IBCNRRP1 and IBCNRRP2:
+9 ; IBCNRRTN = "IBCNRRP1"
+10 ; IBCNRSPC("BEGDT") = Start Date for dt range
+11 ; IBCNRSPC("ENDDT") = End Date for dt range
+12 ; IBCNRSPC("SORT") = 1 - By Insurance/Group; 2 - Total Claims;
+13 ; 3 - Total Charges; 4 - Exceptions
+14 ; IBCNRSPC("MATCH") = 1 - Matched Only; 0 - All;
+15 ;
+16 ; ^TMP(IBCNRRTN,1); ^TMP(IBCNRRTN,2); ^TMP(IBCNRRTN,3)
+17 ; Must call at appropriate tag
+18 QUIT
+19 ;
+20 ;
EN(IBCNRRTN,IBCNRSPC) ; Entry pt.
+1 ;
+2 ; Init vars
+3 NEW CRT,MAXCNT,IBPGC,IBBDT,IBEDT,IBMAT,IBPY,IBPXT,IBSRT,IBDTL
+4 NEW X,Y,DIR,DTOUT,DUOUT,LIN,TOTALS
+5 ;
+6 SET IBBDT=$GET(IBCNRSPC("BEGDT"))
+7 SET IBEDT=$GET(IBCNRSPC("ENDDT"))
+8 SET IBSRT=$GET(IBCNRSPC("SORT"))
+9 SET IBMAT=$GET(IBCNRSPC("MATCH"))
+10 SET (IBPXT,IBPGC)=0
+11 ;
+12 ; Determine IO parameters
+13 IF IOST["C-"
SET MAXCNT=IOSL-3
SET CRT=1
+14 IF '$TEST
SET MAXCNT=IOSL-6
SET CRT=0
+15 ;
+16 DO PRINT(IBCNRRTN,IBBDT,IBEDT,IBSRT,MAXCNT,IBPGC,IBMAT)
+17 IF $GET(ZTSTOP)!IBPXT
GOTO EXIT3
+18 IF CRT
IF IBPGC>0
IF '$DATA(ZTQUEUED)
Begin DoDot:1
+19 IF MAXCNT<51
FOR LIN=1:1:(MAXCNT-$Y)
WRITE !
+20 SET DIR(0)="E"
DO ^DIR
KILL DIR
End DoDot:1
+21 ;
EXIT3 ; Exit pt
+1 QUIT
+2 ;
PRINT(RTN,BDT,EDT,SRT,MAX,PGC,MAT) ; Print data
+1 ; Input params: RNT = "IBCNRRP1" - routine, BDT = starting dt,
+2 ; EDT = ending dt
+3 ; SRT = 1/2/3
+4 ; MAT = 1/0
+5 ;
+6 ; Init vars
+7 NEW EORMSG,NONEMSG,TOTDASHS,DISPDATA,SORT,CT,PRT1,PRT2
+8 ;
+9 SET EORMSG="*** END OF REPORT ***"
+10 SET NONEMSG="* * * N O D A T A F O U N D * * *"
+11 SET $PIECE(TOTDASHS,"=",89)=""
+12 SET CT=0
+13 ;
+14 IF '$DATA(^XTMP(RTN))
DO HEADER
WRITE !,?(132-$LENGTH(NONEMSG)\2),NONEMSG,!!
GOTO PRINT2
+15 ;
+16 ; Build lines of data to display
+17 KILL ^TMP("IBCNR",$JOB,"RPTDATA")
+18 DO DATA
+19 KILL ^TMP("IBCNR",$JOB,"DSPDATA")
+20 DO DISP
+21 ; Display lines of response
+22 DO LINE
+23 KILL ^TMP("IBCNR",$JOB,"DSPDATA"),^TMP("IBCNR",$JOB,"RPTDATA")
+24 QUIT
+25 ;
PRINT2 IF $GET(ZTSTOP)!IBPXT
GOTO PRINTX
+1 IF $Y+1>MAX!('PGC)
DO HEADER
IF $GET(ZTSTOP)!$GET(IBPXT)
GOTO PRINTX
+2 WRITE !,?(132-$LENGTH(EORMSG)\2),EORMSG
+3 ;
PRINTX ; PRINT exit point
+1 QUIT
+2 ;
+1 ; Assumes vars from PRINT: CRT,PGC,IBPXT,MAX,SRT,BDT,EDT,PYR,RDTL,MAR
+2 ; Init vars
+3 NEW DIR,X,Y,DTOUT,DUOUT,OFFSET,HDR,DASHES,DASHES2,LIN
+4 ;
+5 IF CRT
IF PGC>0
IF '$DATA(ZTQUEUED)
Begin DoDot:1
+6 IF MAX<51
FOR LIN=1:1:(MAX-$Y)
WRITE !
+7 SET DIR(0)="E"
DO ^DIR
KILL DIR
+8 IF $DATA(DTOUT)!$DATA(DUOUT)
SET IBPXT=1
QUIT
End DoDot:1
IF IBPXT
GOTO HEADERX
+9 IF $DATA(ZTQUEUED)
IF $$S^%ZTLOAD()
SET (ZTSTOP,IBPXT)=1
GOTO HEADERX
+10 SET PGC=PGC+1
+11 WRITE @IOF,!,?1,"ePHARM GROUP PLAN WORKSHEET REPORT"
+12 SET HDR=$$FMTE^XLFDT($$NOW^XLFDT,1)_" Page: "_PGC
+13 SET OFFSET=80-$LENGTH(HDR)
+14 WRITE ?OFFSET,HDR
+15 WRITE !,?1,"Claims with Pharmacy Coverage Sorted by: "_$SELECT(SRT=1:"Insurance/Group",SRT=2:"Max. Total Claims",1:"Max. Total Charges")
+16 SET HDR=$$FMTE^XLFDT(BDT,"5Z")_" - "_$$FMTE^XLFDT(EDT,"5Z")
+17 SET OFFSET=80-$LENGTH(HDR)\2
+18 WRITE !,?OFFSET,HDR
+19 ; Display column headings
+20 WRITE !,?1,"Insurance Company Name",?40,"Insurance Company Address"
+21 WRITE !,?3,"Group Name/Number",?43,"VA PLAN ID",?60," BIN",?70,"PCN"
+22 SET $PIECE(DASHES,"=",80)=""
+23 WRITE !,?1,DASHES
+24 ;
+1 QUIT
+2 ;
LINE ; Print line of data
+1 ; Assumes vars from PRINT: PGC,IBPXT,MAX
+2 ; Init vars
+3 NEW CT,II
+4 ;
+5 SET CT=+$ORDER(^TMP("IBCNR",$JOB,"DSPDATA",""),-1)
+6 IF $Y+1+CT>MAX
DO HEADER
IF $GET(ZTSTOP)!IBPXT
GOTO LINEX
+7 FOR II=1:1:CT
Begin DoDot:1
+8 IF $Y+1>MAX!('PGC)
DO HEADER
IF $GET(ZTSTOP)!IBPXT
QUIT
+9 WRITE !,?1,^TMP("IBCNR",$JOB,"DSPDATA",II)
+10 QUIT
End DoDot:1
if $GET(ZTSTOP)!IBPXT
QUIT
+11 ;
LINEX ; LINE exit pt
+1 QUIT
+2 ;
DATA ; Gather and format lines of data to be printed
+1 ; Assumes vars from PRINT: RTN,SRT,SRT,RDTL,CT,PRT1,PRT2
+2 ; Init vars
+3 ;
+4 ;Loop through and sort TMP file
+5 NEW CNT,IBINS,IBINSNM,IBGRP,IBGRPNM,IBGRPNB,RPDT,RPTOT,RPTCNT,RPTCHG
+6 ;Get new HIPAA fields, IBGRP0 no longer needed - IB*2*516
+7 ;N IBGRP0,IBGRP6,IBGRPNM,IBPLBIN,IBPLNNM,IBPLPCN,IBPPIEN
+8 NEW IBGRP6,IBGRPNM,IBPLBIN,IBPLNID,IBPLPCN,IBPPIEN
+9 SET IBINS=0
SET CNT=0
+10 FOR
SET IBINS=$ORDER(^XTMP(RTN,IBINS))
if IBINS=""
QUIT
Begin DoDot:1
+11 ;get insurance company name
+12 SET IBINSNM=$PIECE($GET(^DIC(36,IBINS,0)),U)
+13 IF IBINSNM=""
SET IBINSNM="NO NAME EXISTS"
+14 SET IBGRP=0
+15 FOR
SET IBGRP=$ORDER(^XTMP(RTN,IBINS,IBGRP))
if IBGRP=""
QUIT
Begin DoDot:2
+16 ;get group info
+17 ;S IBGRP0=$G(^IBA(355.3,IBGRP,0))
+18 ;get pharmacy plan info
+19 SET IBGRP6=$GET(^IBA(355.3,IBGRP,6))
+20 ; Matched only
IF 'IBGRP6
IF $GET(MAT)
QUIT
+21 ;I IBGRP0 D
+22 IF $$GET1^DIQ(355.3,IBGRP,2.01)]""
Begin DoDot:3
+23 SET (IBGRPNM,IBGRPNB)=""
+24 ;S IBGRPNM=$P($G(IBGRP0),U,3) I $G(IBGRPNM)="" S IBGRPNM="<blank>"
+25 ;S IBGRPNB=$P($G(IBGRP0),U,4) I $G(IBGRPNB)="" S IBGRPNB="<blank>"
+26 SET IBGRPNM=$$GET1^DIQ(355.3,IBGRP,2.01)
IF $GET(IBGRPNM)=""
SET IBGRPNM="<blank>"
+27 SET IBGRPNB=$$GET1^DIQ(355.3,IBGRP,2.02)
IF $GET(IBGRPNB)=""
SET IBGRPNB="<blank>"
+28 SET RPDT=IBGRPNB
End DoDot:3
+29 IF IBGRP6
Begin DoDot:3
+30 SET (IBPPIEN,IBPLNID,IBPLPCN)=""
+31 SET IBPPIEN=$PIECE($GET(IBGRP6),U)
+32 SET IBPLNID=$PIECE($GET(^IBCNR(366.03,IBPPIEN,0)),U,1)
+33 SET IBPLBIN=$PIECE($GET(^IBCNR(366.03,IBPPIEN,10)),U,2)
+34 SET IBPLPCN=$PIECE($GET(^IBCNR(366.03,IBPPIEN,10)),U,3)
+35 SET RPDT=$GET(RPDT)_U_$GET(IBPLNID)_U_$GET(IBPLBIN)_U_$GET(IBPLPCN)
End DoDot:3
+36 IF '$TEST
SET RPDT=$GET(RPDT)_U_U_U
+37 SET RPDT=$GET(RPDT)_U_$PIECE($GET(IBGRP6),U,2,3)
+38 SET RPTOT=^XTMP(RTN,IBINS,IBGRP)
+39 SET RPTCNT=$PIECE(RPTOT,U)
SET RPTCHG=$PIECE(RPTOT,U,2)
+40 IF SRT=1
Begin DoDot:3
+41 SET ^TMP("IBCNR",$JOB,"RPTDATA",SRT,IBINSNM,IBINS,IBGRPNM,IBGRP)=$GET(RPDT)
End DoDot:3
QUIT
+42 IF SRT=2
Begin DoDot:3
+43 SET ^TMP("IBCNR",$JOB,"RPTDATA",-$GET(RPTCNT),IBINSNM,IBINS,IBGRPNM,IBGRP)=$GET(RPDT)
End DoDot:3
QUIT
+44 IF SRT=3
Begin DoDot:3
+45 SET ^TMP("IBCNR",$JOB,"RPTDATA",-$GET(RPTCHG),IBINSNM,IBINS,IBGRPNM,IBGRP)=$GET(RPDT)
End DoDot:3
QUIT
+46 IF SRT=4
Begin DoDot:3
+47 IF '$GET(IBGRP6)
QUIT
+48 NEW OK
SET OK=1
+49 IF $GET(IBPLBIN)'=""
IF $PIECE(IBGRP6,U,2)'=""
IF IBPLBIN'=$PIECE(IBGRP6,U,2)
SET OK=0
+50 IF $GET(IBPLPCN)'=""
IF $PIECE(IBGRP6,U,3)'=""
IF IBPLPCN'=$PIECE(IBGRP6,U,3)
SET OK=0
+51 IF 'OK
SET ^TMP("IBCNR",$JOB,"RPTDATA",SRT,IBINSNM,IBINS,IBGRPNM,IBGRP)=$GET(RPDT)
End DoDot:3
QUIT
End DoDot:2
End DoDot:1
+52 QUIT
+53 ;
DISP ;set up display data
+1 NEW CNT,DISP1,DISP2,DISP3,DISP4,DISP5,DISPD,DASHES2
+2 NEW IBCNADR,IBCIN11,IBCINST,I
+3 SET DISP1=""
SET CNT=0
SET $PIECE(DASHES2,"-",80)=""
+4 FOR
SET DISP1=$ORDER(^TMP("IBCNR",$JOB,"RPTDATA",DISP1))
if DISP1=""
QUIT
Begin DoDot:1
+5 SET DISP2=""
+6 FOR
SET DISP2=$ORDER(^TMP("IBCNR",$JOB,"RPTDATA",DISP1,DISP2))
if DISP2=""
QUIT
Begin DoDot:2
+7 SET DISP3=0
+8 FOR
SET DISP3=$ORDER(^TMP("IBCNR",$JOB,"RPTDATA",DISP1,DISP2,DISP3))
if DISP3=""
QUIT
Begin DoDot:3
+9 SET DISP4=""
+10 FOR
SET DISP4=$ORDER(^TMP("IBCNR",$JOB,"RPTDATA",DISP1,DISP2,DISP3,DISP4))
if DISP4=""
QUIT
Begin DoDot:4
+11 SET DISP5=0
+12 FOR
SET DISP5=$ORDER(^TMP("IBCNR",$JOB,"RPTDATA",DISP1,DISP2,DISP3,DISP4,DISP5))
if DISP5=""
QUIT
Begin DoDot:5
+13 SET DISPD=$GET(^TMP("IBCNR",$JOB,"RPTDATA",DISP1,DISP2,DISP3,DISP4,DISP5))
+14 ;get insurance addr
+15 SET IBCIN11=$GET(^DIC(36,DISP3,.11))
+16 SET IBCINST=$SELECT($PIECE(IBCIN11,U,5)="":"--",1:$PIECE($GET(^DIC(5,$PIECE(IBCIN11,U,5),0)),U,2))
+17 SET IBCNADR=$EXTRACT($PIECE(IBCIN11,U),1,15)_","_$EXTRACT($PIECE(IBCIN11,U,4),1,10)_","_IBCINST_" "_$EXTRACT($PIECE(IBCIN11,U,6),1,5)
+18 SET CNT=CNT+1
+19 ;insurance co and group/plan
+20 SET ^TMP("IBCNR",$JOB,"DSPDATA",CNT)=$$FO^IBCNEUT1(DISP2,40)_$$FO^IBCNEUT1(IBCNADR,35,"L")
+21 ;bin; pcn; and pharmacy plan ID
+22 SET CNT=CNT+1
+23 SET ^TMP("IBCNR",$JOB,"DSPDATA",CNT)=$$FO^IBCNEUT1(($EXTRACT(DISP4,1,24)_"/"_$EXTRACT($PIECE(DISPD,U),1,15)),42,"L")_$$FO^IBCNEUT1($PIECE(DISPD,U,2),18,"L")_$$FO^IBCNEUT1($PIECE(DISPD,U,3),9,"L")_$$FO^IBC
NEUT1($PIECE(DISPD,U,4),10,"L")
+24 SET I=$$FO^IBCNEUT1("",60)_$$FO^IBCNEUT1($PIECE(DISPD,U,5),10,"L")_$$FO^IBCNEUT1($PIECE(DISPD,U,6),10,"L")
+25 IF $TRANSLATE(I," ")'=""
SET CNT=CNT+1
SET ^TMP("IBCNR",$JOB,"DSPDATA",CNT)=I
+26 SET CNT=CNT+1
+27 SET ^TMP("IBCNR",$JOB,"DSPDATA",CNT)=$$FO^IBCNEUT1(DASHES2,79,"L")
End DoDot:5
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+28 ;
DATAX ; DATA exit pt
+1 KILL RPTDATA
+2 QUIT
+3 ;
