IBCNERPE ;DAOU/BHS - IBCNE eIV RESPONSE REPORT (cont'd); 03-JUN-2002
;;2.0;INTEGRATED BILLING;**271,300,416,438,497,506,519,521,659,702,806**;21-MAR-94;Build 19
;;Per VA Directive 6402, this routine should not be modified.
;
; Must call at tag
Q
;
; This tag is only called from IBCNERP2
;
GETDATA(IEN,RPTDATA) ; Retrieve response data
; Init
N %,CNPTR,CT,DIW,DIWI,DIWT,DIWTC,DIWX,DN,EACT,ELOC,ESRC,ETXT,DQUAL,DTYPE,FUTDT,IENS,II,LOOP,NODE0,PC,TQIEN,Z
;
N IBI,IBTD1,IBTD2,IBTDT S (IBI,IBTD1,IBTD2,IBTDT)="" ;IB*806/DTG for hl7 date change
N IBSA,IBSADDR,IBSCTY,IBSUBER,IBSUBGET ;IB*806/DTG for adding subscriber address
; Insured Info from eIV Response #365
S RPTDATA(0)=$G(^IBCN(365,IEN,0)),TQIEN=$P(RPTDATA(0),U,5)
; Trans dates to ext format
S $P(RPTDATA(0),U,7)=$$FMTE^XLFDT($P(RPTDATA(0),U,7)\1,"5Z")
S RPTDATA(1)=$G(^IBCN(365,IEN,1))
; Trans ext values for SET of CODES values
S IENS=IEN_","
S $P(RPTDATA(1),U,8)=$$GET1^DIQ(365,IENS,1.08,"E") ; Whose Ins
S $P(RPTDATA(1),U,13)=$$GET1^DIQ(365,IENS,1.13,"E") ; COB
;
;IB*2*702/ckb - Convert Pt Rel code to English
; Pt Rel to Sub
;S RPTDATA(8)=$$GET1^DIQ(365,IENS,8.01,"E") ; Pt Rel to Sub
N PTREL,PTRIEN
S PTRIEN=$$GET1^DIQ(365,IENS,8.01,"I") ;Pt. Rel to Sub - HIPAA
S PTREL=$$GET1^DIQ(365.037,PTRIEN_",",.02,"E")
S RPTDATA(8)=PTREL
;IB*2*702/ckb - end
;
;IB*806/DTG adding in the subscriber address (365,5), error text (365,4)
; if there is data, other wise null
;RPTDATA(50,1)=subscriber address line 1 sp subscriber address line 2 sp subscriber city sp subscriber state subscriber zip
;RPTDATA(50,2)=subsriber address country ^ subscriber address subdivision
;RPTDATA(50,3)-error text
D GETS^DIQ(365,IENS,"4.01;5.01:5.07","IEN","IBSUBGET","IBSUBER")
S IBSADDR=$G(IBSUBGET(365,IENS,5.01,"E"))
S IBSA=$G(IBSUBGET(365,IENS,5.02,"E")) I IBSA'="" S IBSADDR=IBSADDR_" "_IBSA
S IBSCTY=$G(IBSUBGET(365,IENS,5.03,"E"))
S IBSA=$G(IBSUBGET(365,IENS,5.04,"I")),IBSA=$S(IBSA:$P($G(^DIC(5,IBSA,0)),U,2),1:"")
; IB*806/DTG correct address display setup
I IBSCTY'=""!(IBSA'="")!($G(IBSUBGET(365,IENS,5.05,"E"))'="") D
. S IBSCTY=IBSCTY_" "_IBSA_" "_$G(IBSUBGET(365,IENS,5.05,"E"))
S RPTDATA(50,1)="" I IBSADDR'=""!(IBSCTY'="") S RPTDATA(50,1)=IBSADDR_U_IBSCTY
S RPTDATA(50,2)="" I $G(IBSUBGET(365,IENS,5.06,"E"))'=""!($G(IBSUBGET(365,IENS,5.07,"E"))'="") D
. S RPTDATA(50,2)=$G(IBSUBGET(365,IENS,5.06,"E"))_U_$G(IBSUBGET(365,IENS,5.07,"E"))
S RPTDATA(50,3)=$G(IBSUBGET(365,IENS,4.01,"E"))
; IB*806/DTG end add of subscriber address, Error Text
;
; Trans err actions/codes to ext
S $P(RPTDATA(1),U,14)=$$X12^IBCNERP2(365.017,$P(RPTDATA(1),U,14))
S $P(RPTDATA(1),U,15)=$$X12^IBCNERP2(365.018,$P(RPTDATA(1),U,15))
; Trans dates to ext format - check format
F PC=2,9:1:12,16,17,19 S $P(RPTDATA(1),U,PC)=$$FMTE^XLFDT($P(RPTDATA(1),U,PC),"5Z")
;
; Loop thru mult Contact segs
S CT=0
F S CT=$O(^IBCN(365,IEN,3,CT)) Q:'CT D
.S RPTDATA(3,CT)=$G(^IBCN(365,IEN,3,CT,0))
.; Obtain the various Communication Text fields
.F II=1:1:3 S RPTDATA(3,CT,II)=$G(^IBCN(365,IEN,3,CT,II))
.; Disp. blank if NOT SPECIFIED
. I $P(RPTDATA(3,CT),U)="NOT SPECIFIED" S $P(RPTDATA(3,CT),U)=""
.; Comm Qual #1-3
.F II=1:1:3 D
..S CNPTR=$$X12^IBCNERP2(365.021,$P(RPTDATA(3,CT),U,II*2))
..I CNPTR'="" S RPTDATA(3,CT,II)=CNPTR_": "_$G(RPTDATA(3,CT,II))
;
; Subscriber level dates (ZTP segments)
S CT=0 F S CT=$O(^IBCN(365,IEN,7,CT)) Q:'CT D
.S NODE0=$G(^IBCN(365,IEN,7,CT,0))
.S DQUAL=$P(NODE0,U,3) I 'DQUAL Q
.S LOOP=$$GET1^DIQ(365.027,$P(NODE0,U,4)_",",.01)
.S DTYPE=$S(LOOP["C":"S",LOOP["D":"P",1:"O")
.;IB*806/DTG Change hl7 date to external date
.;S RPTDATA(7,DTYPE,CT)=$$X12^IBCNERP2(365.026,DQUAL)_U_$P(NODE0,U,2)
. S RPTDATA(7,DTYPE,CT)=$$X12^IBCNERP2(365.026,DQUAL) D S RPTDATA(7,DTYPE,CT)=RPTDATA(7,DTYPE,CT)_U_IBTDT
.. S IBTDT="",IBTD1=$P(NODE0,U,2) I IBTD1="" Q
.. S IBTD1=$TR(IBTD1," ","")
.. S IBTD2=$$FMTE^XLFDT($$HL7TFM^XLFDT($P(IBTD1,"-",1)),"5Z")
.. S IBTD3=$$FMTE^XLFDT($$HL7TFM^XLFDT($P(IBTD1,"-",2)),"5Z")
.. I IBTD3="-1" S IBTD3="" ;IB*806/dtg Payers sometimes send bad dates ie:99991231
.. I IBTD2="-1" S IBTD2=""
.. S IBTDT=IBTD2 I IBTD1["-" S IBTDT=IBTDT_" - "_IBTD3
;
; Reject reasons
S CT=0 F S CT=$O(^IBCN(365,IEN,6,CT)) Q:'CT D
.S NODE0=$G(^IBCN(365,IEN,6,CT,0)) I '$P(NODE0,U,3) Q
.S ETXT=$$X12^IBCNERP2(365.017,$P(NODE0,U,3))
.S ELOC=$P(NODE0,U,2) S:ELOC="" ELOC="N/A"
.S EACT=$$X12^IBCNERP2(365.018,$P(NODE0,U,4)) S:EACT="" EACT="N/A"
.S LOOP=$$X12^IBCNERP2(365.027,$P(NODE0,U,5)) S:LOOP="" LOOP="N/A"
.S ESRC=$P(NODE0,U,6) S:ESRC="" ESRC="N/A"
.;IB*2*497 modify existing line below to retrieve external value of ERROR CODE and ACTION CODE
. ;and build as part of the composite string at RPTDATA(6,CT).
.S RPTDATA(6,CT)=ELOC_U_$$GET1^DIQ(365.017,$P(NODE0,U,3)_",",.01)_U_ETXT_U_$$GET1^DIQ(365.018,$P(NODE0,U,4)_",",.01)_U_EACT_U_LOOP_U_ESRC
.; IB*2*497 retrieve additional messages
.S Z=0 F S Z=$O(^IBCN(365,IEN,6,CT,1,Z)) Q:'Z S RPTDATA(6,CT,"AMSG",Z)=$P($G(^IBCN(365,IEN,6,CT,1,Z,0)),U)
.Q
;
; Subscriber Data
S RPTDATA(13)=$G(^IBCN(365,IEN,13))
;
; Group Data
S RPTDATA(14)=$G(^IBCN(365,IEN,14))
;
FUTDT I TQIEN D ; If there is a future date, display it
. S FUTDT=$P($G(^IBCN(365.1,TQIEN,0)),U,9) Q:FUTDT=""
. S II=$O(RPTDATA(5,""),-1)+1
. S RPTDATA(5,II)=" ",II=II+1
. S RPTDATA(5,II)="Inquiry will be automatically resubmitted on "_$$FMTE^XLFDT(FUTDT,"5Z")_"."
;
GETDATX ; GETDATA exit point
Q
;
; This tag is only called from IBCNERP3
;
DATA(DISPDATA) ; Build disp lines
; IB*806/DJW Restructured this tag for readability and maintenance; Dropped SSN
N LCT,CT,SEGCT,ITEM,CT2,NTCT,CNCT,ERCT,RPTDATA,DCT,DTYPE
; Merge into local array
M RPTDATA=^TMP($J,RTN,SORT1,SORT2,CNT)
; Build
S LCT=1,ITEM=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,13.01),17,"R")_$P(RPTDATA(13),U,1) D WRAPIT(ITEM,.LCT,.DISPDATA,74,17) ;Insured/Subscriber's Name
S LCT=LCT+1,ITEM=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,13.02),17,"R")_$P(RPTDATA(13),U,2) D WRAPIT(ITEM,.LCT,.DISPDATA,74,17) ;Subscriber ID
S LCT=LCT+1,DISPDATA(LCT)=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.02),17,"R")_$P(RPTDATA(1),U,2) ;Insured/Subscriber DOB
;S LCT=LCT+1,DISPDATA(LCT)=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.03),17,"R")_$$FO^IBCNEUT1($P(RPTDATA(1),U,3),20) ; SSN
S DISPDATA(LCT)=DISPDATA(LCT)_$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.04),32,"R")_$P(RPTDATA(1),U,4) ;Insured/Subscriber Sex
;
S LCT=LCT+1,ITEM=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,14.01),17,"R")_$P(RPTDATA(14),U,1) D WRAPIT(ITEM,.LCT,.DISPDATA,74,17) ;Group Name
S LCT=LCT+1,ITEM=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,14.02),17,"R")_$P(RPTDATA(14),U,2) D WRAPIT(ITEM,.LCT,.DISPDATA,74,17) ;Group Number
S LCT=LCT+1,DISPDATA(LCT)=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.08),17,"R")_$$FO^IBCNEUT1($P(RPTDATA(1),U,8),14) ;Whose Insurance
S DISPDATA(LCT)=DISPDATA(LCT)_$$FO^IBCNEUT1("HIPAA Relationship to Sub: ",28,"R")_RPTDATA(8) ;PT. Relationship HIPAA
S LCT=LCT+1,DISPDATA(LCT)=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.18),17,"R")_$$FO^IBCNEUT1($P(RPTDATA(1),U,18),20) ;Member ID
S DISPDATA(LCT)=DISPDATA(LCT)_$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.13),22,"R")_$P(RPTDATA(1),U,13) ;COB
S LCT=LCT+1,DISPDATA(LCT)=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.1),17,"R")_$$FO^IBCNEUT1($P(RPTDATA(1),U,10),20) ;Service Dt
S DISPDATA(LCT)=DISPDATA(LCT)_$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.16),22,"R")_$P(RPTDATA(1),U,16) ;Dt of Death
S LCT=LCT+1,DISPDATA(LCT)=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.11),17,"R")_$$FO^IBCNEUT1($P(RPTDATA(1),U,11),20) ; Effective Dt
S DISPDATA(LCT)=DISPDATA(LCT)_$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.17),22,"R")_$P(RPTDATA(1),U,17) ;Certification Dt
S LCT=LCT+1,DISPDATA(LCT)=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.12),17,"R")_$$FO^IBCNEUT1($P(RPTDATA(1),U,12),20) ;Expiration Dt
S DISPDATA(LCT)=DISPDATA(LCT)_$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.19),22,"R")_$P(RPTDATA(1),U,19) ;Payer Updated Policy
S LCT=LCT+1,DISPDATA(LCT)=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,.07),17,"R")_$$FO^IBCNEUT1($P(RPTDATA(0),U,7),20) ;Response Dt/ Dt/Time Received
S DISPDATA(LCT)=DISPDATA(LCT)_$$FO^IBCNEUT1($$LBL^IBCNERP2(365,.09),22,"R")_$P(RPTDATA(0),U,9) ;Trace #
;IB*806/DTG display subscriber address 5.01,5.02,5.03,5.04,5.05,5.06,5.07
I $P($G(RPTDATA(50,1)),U,1)'=""!($P($G(RPTDATA(50,1)),U,2)'="") D
. S LCT=LCT+1,DISPDATA(LCT)=$$FO^IBCNEUT1("Sub Address: ",17,"R")_$P($G(RPTDATA(50,1)),U,1) ; Subscriber Address
. S LCT=LCT+1,DISPDATA(LCT)=$$FO^IBCNEUT1("",17,"R")_$P($G(RPTDATA(50,1)),U,2) ; Subscriber Address city/state/zip
I $P($G(RPTDATA(50,2)),U,1)'="" S LCT=LCT+1,DISPDATA(LCT)=$$FO^IBCNEUT1("Country: ",17,"R")_$P($G(RPTDATA(50,2)),U,1) ;subscriber country
I $P($G(RPTDATA(50,2)),U,2)'="" S LCT=LCT+1,DISPDATA(LCT)=$$FO^IBCNEUT1("Subdivision: ",17,"R")_$P($G(RPTDATA(50,2)),U,2) ;subscriber subdivision
;
I $G(RPTDATA(50,3))'="" D
. S LCT=LCT+1,DISPDATA(LCT)=""
. S LCT=LCT+1,DISPDATA(LCT)=$$FO^IBCNEUT1("Error Text: ",17,"R")_$G(RPTDATA(50,3)) ; IB*806/DTG error text
;
;IB*806/DTG removed policy number
;S LCT=LCT+1,DISPDATA(LCT)=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.2),17,"R")_$$FO^IBCNEUT1($P(RPTDATA(1),U,20),20) ;Policy #
;
; Dates
F DTYPE="S","P","O" D
.I '$D(RPTDATA(7,DTYPE)) Q
.S LCT=LCT+1,DISPDATA(LCT)=""
.S LCT=LCT+1,DISPDATA(LCT)=$S(DTYPE="S":"Subscriber",DTYPE="P":"Patient",1:"Other")_" Dates:"
.S LCT=LCT+1,DISPDATA(LCT)=$S(DTYPE="S":"----------",DTYPE="P":"-------",1:"-----")_"------"
.S DCT="" F S DCT=$O(RPTDATA(7,DTYPE,DCT)) Q:DCT="" D
..;S LCT=LCT+1,DISPDATA(LCT)=$$FO^IBCNEUT1($P(RPTDATA(7,DTYPE,DCT),U)_": ",40)_$P(RPTDATA(7,DTYPE,DCT),U,2)
..S LCT=LCT+1,DISPDATA(LCT)=$E($P(RPTDATA(7,DTYPE,DCT),U),1,60)_": "_$P(RPTDATA(7,DTYPE,DCT),U,2)
;
; Contacts
CONT ;
; IB*806 Restructured this tag
N TEXT
S CNCT=+$O(RPTDATA(3,""),-1) I 'CNCT G ERR
S LCT=LCT+1,DISPDATA(LCT)=""
S LCT=LCT+1,DISPDATA(LCT)="CONTACT INFORMATION:"
S LCT=LCT+1,DISPDATA(LCT)="--------------------"
; Build
F CT=1:1:CNCT D
. S SEGCT=$O(RPTDATA(3,CT,""),-1)
. S TEXT=""
. I $L($P(RPTDATA(3,CT),U,1)) S TEXT=$P(RPTDATA(3,CT),U,1)
. I $L(TEXT) S LCT=LCT+1,DISPDATA(LCT)="Contact Person: "_TEXT,TEXT="" ;IB*806/DTG separate the contact person from the communication
. F CT2=1:1:SEGCT S ITEM=$G(RPTDATA(3,CT,CT2)) D
. . Q:'$L(ITEM)
. . S TEXT=$S($L(TEXT):" "_TEXT_", ",1:" ")_ITEM
. . F D Q:'$L(TEXT)
. . . S LCT=LCT+1,DISPDATA(LCT)=$E(TEXT,1,74)
. . . I $L(TEXT)>74 S TEXT=$E(TEXT,75,$L(TEXT)) Q
. . . S TEXT=""
;
; Err Info
ERR S ERCT=+$O(RPTDATA(6,""),-1) I 'ERCT G DATAX
S LCT=LCT+1,DISPDATA(LCT)=""
S LCT=LCT+1,DISPDATA(LCT)="ERROR INFORMATION:"
S LCT=LCT+1,DISPDATA(LCT)=""
F CT=1:1:ERCT D
. ; IB*497 changed setting DISPDATA(LCT) below
.S LCT=LCT+1,DISPDATA(LCT)="Reject Reason Code: "_$P(RPTDATA(6,CT),U,2)
.S LCT=LCT+1,DISPDATA(LCT)="Reject Reason Text: "_$P(RPTDATA(6,CT),U,3)
.S LCT=LCT+1,DISPDATA(LCT)="Action Code: "_$P(RPTDATA(6,CT),U,4)
.S LCT=LCT+1,DISPDATA(LCT)="Action Code Text: "_$P(RPTDATA(6,CT),U,5)
.S LCT=LCT+1,DISPDATA(LCT)="HIPAA Loop: "_$P(RPTDATA(6,CT),U,6)
.S LCT=LCT+1,DISPDATA(LCT)="HL7 Location: "_$P(RPTDATA(6,CT),U)
.S LCT=LCT+1,DISPDATA(LCT)="Error Source: "_$P(RPTDATA(6,CT),U,7)
.I $D(RPTDATA(6,CT,"AMSG")) D
..I ERCT>0 S LCT=LCT+1,DISPDATA(LCT)="" ; IB*506
..S LCT=LCT+1,DISPDATA(LCT)="Additional Messages:"
..S LCT=LCT+1,DISPDATA(LCT)=""
..S Z=0 F S Z=$O(RPTDATA(6,CT,"AMSG",Z)) Q:'Z S LCT=LCT+1,DISPDATA(LCT)=RPTDATA(6,CT,"AMSG",Z)
..Q
.S LCT=LCT+1,DISPDATA(LCT)=""
;
DATAX ;
;IB*2.0*659/TAZ - Restuctured to get Response IEN that was used previously
;N RIBVDA,RSPIENS
;S RIBVDA=$P(RPTDATA(0),U,4)
;S RSPIENS=$O(^IBCN(365,"AF",+$G(RIBVDA),""),-1)
N RSPIENS
S RSPIENS=RPTDATA("RSPIENS")
;
; Disp Future Date and Misc. Comments
I $O(RPTDATA(5,0))'="" D
. F CT=1:1:+$O(RPTDATA(5,""),-1) D
.. S LCT=LCT+1,DISPDATA(LCT)=" "_$$FO^IBCNEUT1("",7,"R")_$G(RPTDATA(5,CT))
;
; /IB*2.0*506 Beginning
; Added the Elig. Ben. info to print at the end of the patient's display on the e-IV Response Report.
S LCT=LCT+1,DISPDATA(LCT)=" "
K ^TMP("EIV RESP. EB DATA",$J)
N VALMEVL ; Important as the INIT^IBCNES kills an array we need to keep if VALMEVL is defined (IB*519)
; save off certain VALM variables because call to IBCNES changes them and throws off page counter when returning to EE screen (IB*519)
; IB*2.0*521/ZEB use $G to prevent crash when report is run from outside of a ListMan context
I $G(VALMCNT) N IBVLSV S IBVLSV=VALMCNT_U_$G(VALM("LINES"))_U_$G(^TMP("IBCNBLE",$J,VALMCNT,0))
D INIT^IBCNES(365.02,RSPIENS_",","A",1,"EIV RESP. EB DATA")
N TCTR
S TCTR=""
F S TCTR=$O(^TMP("EIV RESP. EB DATA",$J,"DISP",TCTR)) Q:TCTR="" D
. S LCT=LCT+1,DISPDATA(LCT)=$$FO^IBCNEUT1($G(^TMP("EIV RESP. EB DATA",$J,"DISP",TCTR,0)),76)
; restore VALM page-counter values to pre-IBCNES values (IB*519)
; IB*2.0*521/ZEB use $G to prevent crash when report is run from outside of a ListMan context
I $G(IBVLSV) S VALM("LINES")=$P(IBVLSV,U,2),VALMCNT=$P(IBVLSV,U),^TMP("IBCNBLE",$J,VALMCNT,0)=$P(IBVLSV,U,3) K IBVLSV
; /IB*2.0*506 End
;
Q
;
WRAPIT(ITEM,RCTR,DARRAY,MAX,INDENT) ; Module to wrap text into a display array.
; ITEM = Text to be wrapped.
; RCTR = Current Record counter.
; DARRAY = Current Display Array.
; MAX = Maximum number of characters for one line before wrapping.
; INDENT = Character position to indent extra text when wrapping.
;
N TXT,I,SPACE
S TXT=ITEM,$P(SPACE," ",INDENT)=" "
F D Q:'$L(TXT)
.S DARRAY(RCTR)=$E(TXT,1,MAX)
.S TXT=$E(TXT,MAX+1,$L(TXT)) Q:'$L(TXT)
.S RCTR=RCTR+1
.S TXT=SPACE_TXT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNERPE 13929 printed Jan 29, 2026@15:14:05 Page 2
IBCNERPE ;DAOU/BHS - IBCNE eIV RESPONSE REPORT (cont'd); 03-JUN-2002
+1 ;;2.0;INTEGRATED BILLING;**271,300,416,438,497,506,519,521,659,702,806**;21-MAR-94;Build 19
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 ; Must call at tag
+5 QUIT
+6 ;
+7 ; This tag is only called from IBCNERP2
+8 ;
GETDATA(IEN,RPTDATA) ; Retrieve response data
+1 ; Init
+2 NEW %,CNPTR,CT,DIW,DIWI,DIWT,DIWTC,DIWX,DN,EACT,ELOC,ESRC,ETXT,DQUAL,DTYPE,FUTDT,IENS,II,LOOP,NODE0,PC,TQIEN,Z
+3 ;
+4 ;IB*806/DTG for hl7 date change
NEW IBI,IBTD1,IBTD2,IBTDT
SET (IBI,IBTD1,IBTD2,IBTDT)=""
+5 ;IB*806/DTG for adding subscriber address
NEW IBSA,IBSADDR,IBSCTY,IBSUBER,IBSUBGET
+6 ; Insured Info from eIV Response #365
+7 SET RPTDATA(0)=$GET(^IBCN(365,IEN,0))
SET TQIEN=$PIECE(RPTDATA(0),U,5)
+8 ; Trans dates to ext format
+9 SET $PIECE(RPTDATA(0),U,7)=$$FMTE^XLFDT($PIECE(RPTDATA(0),U,7)\1,"5Z")
+10 SET RPTDATA(1)=$GET(^IBCN(365,IEN,1))
+11 ; Trans ext values for SET of CODES values
+12 SET IENS=IEN_","
+13 ; Whose Ins
SET $PIECE(RPTDATA(1),U,8)=$$GET1^DIQ(365,IENS,1.08,"E")
+14 ; COB
SET $PIECE(RPTDATA(1),U,13)=$$GET1^DIQ(365,IENS,1.13,"E")
+15 ;
+16 ;IB*2*702/ckb - Convert Pt Rel code to English
+17 ; Pt Rel to Sub
+18 ;S RPTDATA(8)=$$GET1^DIQ(365,IENS,8.01,"E") ; Pt Rel to Sub
+19 NEW PTREL,PTRIEN
+20 ;Pt. Rel to Sub - HIPAA
SET PTRIEN=$$GET1^DIQ(365,IENS,8.01,"I")
+21 SET PTREL=$$GET1^DIQ(365.037,PTRIEN_",",.02,"E")
+22 SET RPTDATA(8)=PTREL
+23 ;IB*2*702/ckb - end
+24 ;
+25 ;IB*806/DTG adding in the subscriber address (365,5), error text (365,4)
+26 ; if there is data, other wise null
+27 ;RPTDATA(50,1)=subscriber address line 1 sp subscriber address line 2 sp subscriber city sp subscriber state subscriber zip
+28 ;RPTDATA(50,2)=subsriber address country ^ subscriber address subdivision
+29 ;RPTDATA(50,3)-error text
+30 DO GETS^DIQ(365,IENS,"4.01;5.01:5.07","IEN","IBSUBGET","IBSUBER")
+31 SET IBSADDR=$GET(IBSUBGET(365,IENS,5.01,"E"))
+32 SET IBSA=$GET(IBSUBGET(365,IENS,5.02,"E"))
IF IBSA'=""
SET IBSADDR=IBSADDR_" "_IBSA
+33 SET IBSCTY=$GET(IBSUBGET(365,IENS,5.03,"E"))
+34 SET IBSA=$GET(IBSUBGET(365,IENS,5.04,"I"))
SET IBSA=$SELECT(IBSA:$PIECE($GET(^DIC(5,IBSA,0)),U,2),1:"")
+35 ; IB*806/DTG correct address display setup
+36 IF IBSCTY'=""!(IBSA'="")!($GET(IBSUBGET(365,IENS,5.05,"E"))'="")
Begin DoDot:1
+37 SET IBSCTY=IBSCTY_" "_IBSA_" "_$GET(IBSUBGET(365,IENS,5.05,"E"))
End DoDot:1
+38 SET RPTDATA(50,1)=""
IF IBSADDR'=""!(IBSCTY'="")
SET RPTDATA(50,1)=IBSADDR_U_IBSCTY
+39 SET RPTDATA(50,2)=""
IF $GET(IBSUBGET(365,IENS,5.06,"E"))'=""!($GET(IBSUBGET(365,IENS,5.07,"E"))'="")
Begin DoDot:1
+40 SET RPTDATA(50,2)=$GET(IBSUBGET(365,IENS,5.06,"E"))_U_$GET(IBSUBGET(365,IENS,5.07,"E"))
End DoDot:1
+41 SET RPTDATA(50,3)=$GET(IBSUBGET(365,IENS,4.01,"E"))
+42 ; IB*806/DTG end add of subscriber address, Error Text
+43 ;
+44 ; Trans err actions/codes to ext
+45 SET $PIECE(RPTDATA(1),U,14)=$$X12^IBCNERP2(365.017,$PIECE(RPTDATA(1),U,14))
+46 SET $PIECE(RPTDATA(1),U,15)=$$X12^IBCNERP2(365.018,$PIECE(RPTDATA(1),U,15))
+47 ; Trans dates to ext format - check format
+48 FOR PC=2,9:1:12,16,17,19
SET $PIECE(RPTDATA(1),U,PC)=$$FMTE^XLFDT($PIECE(RPTDATA(1),U,PC),"5Z")
+49 ;
+50 ; Loop thru mult Contact segs
+51 SET CT=0
+52 FOR
SET CT=$ORDER(^IBCN(365,IEN,3,CT))
if 'CT
QUIT
Begin DoDot:1
+53 SET RPTDATA(3,CT)=$GET(^IBCN(365,IEN,3,CT,0))
+54 ; Obtain the various Communication Text fields
+55 FOR II=1:1:3
SET RPTDATA(3,CT,II)=$GET(^IBCN(365,IEN,3,CT,II))
+56 ; Disp. blank if NOT SPECIFIED
+57 IF $PIECE(RPTDATA(3,CT),U)="NOT SPECIFIED"
SET $PIECE(RPTDATA(3,CT),U)=""
+58 ; Comm Qual #1-3
+59 FOR II=1:1:3
Begin DoDot:2
+60 SET CNPTR=$$X12^IBCNERP2(365.021,$PIECE(RPTDATA(3,CT),U,II*2))
+61 IF CNPTR'=""
SET RPTDATA(3,CT,II)=CNPTR_": "_$GET(RPTDATA(3,CT,II))
End DoDot:2
End DoDot:1
+62 ;
+63 ; Subscriber level dates (ZTP segments)
+64 SET CT=0
FOR
SET CT=$ORDER(^IBCN(365,IEN,7,CT))
if 'CT
QUIT
Begin DoDot:1
+65 SET NODE0=$GET(^IBCN(365,IEN,7,CT,0))
+66 SET DQUAL=$PIECE(NODE0,U,3)
IF 'DQUAL
QUIT
+67 SET LOOP=$$GET1^DIQ(365.027,$PIECE(NODE0,U,4)_",",.01)
+68 SET DTYPE=$SELECT(LOOP["C":"S",LOOP["D":"P",1:"O")
+69 ;IB*806/DTG Change hl7 date to external date
+70 ;S RPTDATA(7,DTYPE,CT)=$$X12^IBCNERP2(365.026,DQUAL)_U_$P(NODE0,U,2)
+71 SET RPTDATA(7,DTYPE,CT)=$$X12^IBCNERP2(365.026,DQUAL)
Begin DoDot:2
+72 SET IBTDT=""
SET IBTD1=$PIECE(NODE0,U,2)
IF IBTD1=""
QUIT
+73 SET IBTD1=$TRANSLATE(IBTD1," ","")
+74 SET IBTD2=$$FMTE^XLFDT($$HL7TFM^XLFDT($PIECE(IBTD1,"-",1)),"5Z")
+75 SET IBTD3=$$FMTE^XLFDT($$HL7TFM^XLFDT($PIECE(IBTD1,"-",2)),"5Z")
+76 ;IB*806/dtg Payers sometimes send bad dates ie:99991231
IF IBTD3="-1"
SET IBTD3=""
+77 IF IBTD2="-1"
SET IBTD2=""
+78 SET IBTDT=IBTD2
IF IBTD1["-"
SET IBTDT=IBTDT_" - "_IBTD3
End DoDot:2
SET RPTDATA(7,DTYPE,CT)=RPTDATA(7,DTYPE,CT)_U_IBTDT
End DoDot:1
+79 ;
+80 ; Reject reasons
+81 SET CT=0
FOR
SET CT=$ORDER(^IBCN(365,IEN,6,CT))
if 'CT
QUIT
Begin DoDot:1
+82 SET NODE0=$GET(^IBCN(365,IEN,6,CT,0))
IF '$PIECE(NODE0,U,3)
QUIT
+83 SET ETXT=$$X12^IBCNERP2(365.017,$PIECE(NODE0,U,3))
+84 SET ELOC=$PIECE(NODE0,U,2)
if ELOC=""
SET ELOC="N/A"
+85 SET EACT=$$X12^IBCNERP2(365.018,$PIECE(NODE0,U,4))
if EACT=""
SET EACT="N/A"
+86 SET LOOP=$$X12^IBCNERP2(365.027,$PIECE(NODE0,U,5))
if LOOP=""
SET LOOP="N/A"
+87 SET ESRC=$PIECE(NODE0,U,6)
if ESRC=""
SET ESRC="N/A"
+88 ;IB*2*497 modify existing line below to retrieve external value of ERROR CODE and ACTION CODE
+89 ;and build as part of the composite string at RPTDATA(6,CT).
+90 SET RPTDATA(6,CT)=ELOC_U_$$GET1^DIQ(365.017,$PIECE(NODE0,U,3)_",",.01)_U_ETXT_U_$$GET1^DIQ(365.018,$PIECE(NODE0,U,4)_",",.01)_U_EACT_U_LOOP_U_ESRC
+91 ; IB*2*497 retrieve additional messages
+92 SET Z=0
FOR
SET Z=$ORDER(^IBCN(365,IEN,6,CT,1,Z))
if 'Z
QUIT
SET RPTDATA(6,CT,"AMSG",Z)=$PIECE($GET(^IBCN(365,IEN,6,CT,1,Z,0)),U)
+93 QUIT
End DoDot:1
+94 ;
+95 ; Subscriber Data
+96 SET RPTDATA(13)=$GET(^IBCN(365,IEN,13))
+97 ;
+98 ; Group Data
+99 SET RPTDATA(14)=$GET(^IBCN(365,IEN,14))
+100 ;
FUTDT ; If there is a future date, display it
IF TQIEN
Begin DoDot:1
+1 SET FUTDT=$PIECE($GET(^IBCN(365.1,TQIEN,0)),U,9)
if FUTDT=""
QUIT
+2 SET II=$ORDER(RPTDATA(5,""),-1)+1
+3 SET RPTDATA(5,II)=" "
SET II=II+1
+4 SET RPTDATA(5,II)="Inquiry will be automatically resubmitted on "_$$FMTE^XLFDT(FUTDT,"5Z")_"."
End DoDot:1
+5 ;
GETDATX ; GETDATA exit point
+1 QUIT
+2 ;
+3 ; This tag is only called from IBCNERP3
+4 ;
DATA(DISPDATA) ; Build disp lines
+1 ; IB*806/DJW Restructured this tag for readability and maintenance; Dropped SSN
+2 NEW LCT,CT,SEGCT,ITEM,CT2,NTCT,CNCT,ERCT,RPTDATA,DCT,DTYPE
+3 ; Merge into local array
+4 MERGE RPTDATA=^TMP($JOB,RTN,SORT1,SORT2,CNT)
+5 ; Build
+6 ;Insured/Subscriber's Name
SET LCT=1
SET ITEM=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,13.01),17,"R")_$PIECE(RPTDATA(13),U,1)
DO WRAPIT(ITEM,.LCT,.DISPDATA,74,17)
+7 ;Subscriber ID
SET LCT=LCT+1
SET ITEM=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,13.02),17,"R")_$PIECE(RPTDATA(13),U,2)
DO WRAPIT(ITEM,.LCT,.DISPDATA,74,17)
+8 ;Insured/Subscriber DOB
SET LCT=LCT+1
SET DISPDATA(LCT)=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.02),17,"R")_$PIECE(RPTDATA(1),U,2)
+9 ;S LCT=LCT+1,DISPDATA(LCT)=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.03),17,"R")_$$FO^IBCNEUT1($P(RPTDATA(1),U,3),20) ; SSN
+10 ;Insured/Subscriber Sex
SET DISPDATA(LCT)=DISPDATA(LCT)_$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.04),32,"R")_$PIECE(RPTDATA(1),U,4)
+11 ;
+12 ;Group Name
SET LCT=LCT+1
SET ITEM=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,14.01),17,"R")_$PIECE(RPTDATA(14),U,1)
DO WRAPIT(ITEM,.LCT,.DISPDATA,74,17)
+13 ;Group Number
SET LCT=LCT+1
SET ITEM=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,14.02),17,"R")_$PIECE(RPTDATA(14),U,2)
DO WRAPIT(ITEM,.LCT,.DISPDATA,74,17)
+14 ;Whose Insurance
SET LCT=LCT+1
SET DISPDATA(LCT)=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.08),17,"R")_$$FO^IBCNEUT1($PIECE(RPTDATA(1),U,8),14)
+15 ;PT. Relationship HIPAA
SET DISPDATA(LCT)=DISPDATA(LCT)_$$FO^IBCNEUT1("HIPAA Relationship to Sub: ",28,"R")_RPTDATA(8)
+16 ;Member ID
SET LCT=LCT+1
SET DISPDATA(LCT)=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.18),17,"R")_$$FO^IBCNEUT1($PIECE(RPTDATA(1),U,18),20)
+17 ;COB
SET DISPDATA(LCT)=DISPDATA(LCT)_$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.13),22,"R")_$PIECE(RPTDATA(1),U,13)
+18 ;Service Dt
SET LCT=LCT+1
SET DISPDATA(LCT)=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.1),17,"R")_$$FO^IBCNEUT1($PIECE(RPTDATA(1),U,10),20)
+19 ;Dt of Death
SET DISPDATA(LCT)=DISPDATA(LCT)_$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.16),22,"R")_$PIECE(RPTDATA(1),U,16)
+20 ; Effective Dt
SET LCT=LCT+1
SET DISPDATA(LCT)=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.11),17,"R")_$$FO^IBCNEUT1($PIECE(RPTDATA(1),U,11),20)
+21 ;Certification Dt
SET DISPDATA(LCT)=DISPDATA(LCT)_$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.17),22,"R")_$PIECE(RPTDATA(1),U,17)
+22 ;Expiration Dt
SET LCT=LCT+1
SET DISPDATA(LCT)=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.12),17,"R")_$$FO^IBCNEUT1($PIECE(RPTDATA(1),U,12),20)
+23 ;Payer Updated Policy
SET DISPDATA(LCT)=DISPDATA(LCT)_$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.19),22,"R")_$PIECE(RPTDATA(1),U,19)
+24 ;Response Dt/ Dt/Time Received
SET LCT=LCT+1
SET DISPDATA(LCT)=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,.07),17,"R")_$$FO^IBCNEUT1($PIECE(RPTDATA(0),U,7),20)
+25 ;Trace #
SET DISPDATA(LCT)=DISPDATA(LCT)_$$FO^IBCNEUT1($$LBL^IBCNERP2(365,.09),22,"R")_$PIECE(RPTDATA(0),U,9)
+26 ;IB*806/DTG display subscriber address 5.01,5.02,5.03,5.04,5.05,5.06,5.07
+27 IF $PIECE($GET(RPTDATA(50,1)),U,1)'=""!($PIECE($GET(RPTDATA(50,1)),U,2)'="")
Begin DoDot:1
+28 ; Subscriber Address
SET LCT=LCT+1
SET DISPDATA(LCT)=$$FO^IBCNEUT1("Sub Address: ",17,"R")_$PIECE($GET(RPTDATA(50,1)),U,1)
+29 ; Subscriber Address city/state/zip
SET LCT=LCT+1
SET DISPDATA(LCT)=$$FO^IBCNEUT1("",17,"R")_$PIECE($GET(RPTDATA(50,1)),U,2)
End DoDot:1
+30 ;subscriber country
IF $PIECE($GET(RPTDATA(50,2)),U,1)'=""
SET LCT=LCT+1
SET DISPDATA(LCT)=$$FO^IBCNEUT1("Country: ",17,"R")_$PIECE($GET(RPTDATA(50,2)),U,1)
+31 ;subscriber subdivision
IF $PIECE($GET(RPTDATA(50,2)),U,2)'=""
SET LCT=LCT+1
SET DISPDATA(LCT)=$$FO^IBCNEUT1("Subdivision: ",17,"R")_$PIECE($GET(RPTDATA(50,2)),U,2)
+32 ;
+33 IF $GET(RPTDATA(50,3))'=""
Begin DoDot:1
+34 SET LCT=LCT+1
SET DISPDATA(LCT)=""
+35 ; IB*806/DTG error text
SET LCT=LCT+1
SET DISPDATA(LCT)=$$FO^IBCNEUT1("Error Text: ",17,"R")_$GET(RPTDATA(50,3))
End DoDot:1
+36 ;
+37 ;IB*806/DTG removed policy number
+38 ;S LCT=LCT+1,DISPDATA(LCT)=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.2),17,"R")_$$FO^IBCNEUT1($P(RPTDATA(1),U,20),20) ;Policy #
+39 ;
+40 ; Dates
+41 FOR DTYPE="S","P","O"
Begin DoDot:1
+42 IF '$DATA(RPTDATA(7,DTYPE))
QUIT
+43 SET LCT=LCT+1
SET DISPDATA(LCT)=""
+44 SET LCT=LCT+1
SET DISPDATA(LCT)=$SELECT(DTYPE="S":"Subscriber",DTYPE="P":"Patient",1:"Other")_" Dates:"
+45 SET LCT=LCT+1
SET DISPDATA(LCT)=$SELECT(DTYPE="S":"----------",DTYPE="P":"-------",1:"-----")_"------"
+46 SET DCT=""
FOR
SET DCT=$ORDER(RPTDATA(7,DTYPE,DCT))
if DCT=""
QUIT
Begin DoDot:2
+47 ;S LCT=LCT+1,DISPDATA(LCT)=$$FO^IBCNEUT1($P(RPTDATA(7,DTYPE,DCT),U)_": ",40)_$P(RPTDATA(7,DTYPE,DCT),U,2)
+48 SET LCT=LCT+1
SET DISPDATA(LCT)=$EXTRACT($PIECE(RPTDATA(7,DTYPE,DCT),U),1,60)_": "_$PIECE(RPTDATA(7,DTYPE,DCT),U,2)
End DoDot:2
End DoDot:1
+49 ;
+50 ; Contacts
CONT ;
+1 ; IB*806 Restructured this tag
+2 NEW TEXT
+3 SET CNCT=+$ORDER(RPTDATA(3,""),-1)
IF 'CNCT
GOTO ERR
+4 SET LCT=LCT+1
SET DISPDATA(LCT)=""
+5 SET LCT=LCT+1
SET DISPDATA(LCT)="CONTACT INFORMATION:"
+6 SET LCT=LCT+1
SET DISPDATA(LCT)="--------------------"
+7 ; Build
+8 FOR CT=1:1:CNCT
Begin DoDot:1
+9 SET SEGCT=$ORDER(RPTDATA(3,CT,""),-1)
+10 SET TEXT=""
+11 IF $LENGTH($PIECE(RPTDATA(3,CT),U,1))
SET TEXT=$PIECE(RPTDATA(3,CT),U,1)
+12 ;IB*806/DTG separate the contact person from the communication
IF $LENGTH(TEXT)
SET LCT=LCT+1
SET DISPDATA(LCT)="Contact Person: "_TEXT
SET TEXT=""
+13 FOR CT2=1:1:SEGCT
SET ITEM=$GET(RPTDATA(3,CT,CT2))
Begin DoDot:2
+14 if '$LENGTH(ITEM)
QUIT
+15 SET TEXT=$SELECT($LENGTH(TEXT):" "_TEXT_", ",1:" ")_ITEM
+16 FOR
Begin DoDot:3
+17 SET LCT=LCT+1
SET DISPDATA(LCT)=$EXTRACT(TEXT,1,74)
+18 IF $LENGTH(TEXT)>74
SET TEXT=$EXTRACT(TEXT,75,$LENGTH(TEXT))
QUIT
+19 SET TEXT=""
End DoDot:3
if '$LENGTH(TEXT)
QUIT
End DoDot:2
End DoDot:1
+20 ;
+21 ; Err Info
ERR SET ERCT=+$ORDER(RPTDATA(6,""),-1)
IF 'ERCT
GOTO DATAX
+1 SET LCT=LCT+1
SET DISPDATA(LCT)=""
+2 SET LCT=LCT+1
SET DISPDATA(LCT)="ERROR INFORMATION:"
+3 SET LCT=LCT+1
SET DISPDATA(LCT)=""
+4 FOR CT=1:1:ERCT
Begin DoDot:1
+5 ; IB*497 changed setting DISPDATA(LCT) below
+6 SET LCT=LCT+1
SET DISPDATA(LCT)="Reject Reason Code: "_$PIECE(RPTDATA(6,CT),U,2)
+7 SET LCT=LCT+1
SET DISPDATA(LCT)="Reject Reason Text: "_$PIECE(RPTDATA(6,CT),U,3)
+8 SET LCT=LCT+1
SET DISPDATA(LCT)="Action Code: "_$PIECE(RPTDATA(6,CT),U,4)
+9 SET LCT=LCT+1
SET DISPDATA(LCT)="Action Code Text: "_$PIECE(RPTDATA(6,CT),U,5)
+10 SET LCT=LCT+1
SET DISPDATA(LCT)="HIPAA Loop: "_$PIECE(RPTDATA(6,CT),U,6)
+11 SET LCT=LCT+1
SET DISPDATA(LCT)="HL7 Location: "_$PIECE(RPTDATA(6,CT),U)
+12 SET LCT=LCT+1
SET DISPDATA(LCT)="Error Source: "_$PIECE(RPTDATA(6,CT),U,7)
+13 IF $DATA(RPTDATA(6,CT,"AMSG"))
Begin DoDot:2
+14 ; IB*506
IF ERCT>0
SET LCT=LCT+1
SET DISPDATA(LCT)=""
+15 SET LCT=LCT+1
SET DISPDATA(LCT)="Additional Messages:"
+16 SET LCT=LCT+1
SET DISPDATA(LCT)=""
+17 SET Z=0
FOR
SET Z=$ORDER(RPTDATA(6,CT,"AMSG",Z))
if 'Z
QUIT
SET LCT=LCT+1
SET DISPDATA(LCT)=RPTDATA(6,CT,"AMSG",Z)
+18 QUIT
End DoDot:2
+19 SET LCT=LCT+1
SET DISPDATA(LCT)=""
End DoDot:1
+20 ;
DATAX ;
+1 ;IB*2.0*659/TAZ - Restuctured to get Response IEN that was used previously
+2 ;N RIBVDA,RSPIENS
+3 ;S RIBVDA=$P(RPTDATA(0),U,4)
+4 ;S RSPIENS=$O(^IBCN(365,"AF",+$G(RIBVDA),""),-1)
+5 NEW RSPIENS
+6 SET RSPIENS=RPTDATA("RSPIENS")
+7 ;
+8 ; Disp Future Date and Misc. Comments
+9 IF $ORDER(RPTDATA(5,0))'=""
Begin DoDot:1
+10 FOR CT=1:1:+$ORDER(RPTDATA(5,""),-1)
Begin DoDot:2
+11 SET LCT=LCT+1
SET DISPDATA(LCT)=" "_$$FO^IBCNEUT1("",7,"R")_$GET(RPTDATA(5,CT))
End DoDot:2
End DoDot:1
+12 ;
+13 ; /IB*2.0*506 Beginning
+14 ; Added the Elig. Ben. info to print at the end of the patient's display on the e-IV Response Report.
+15 SET LCT=LCT+1
SET DISPDATA(LCT)=" "
+16 KILL ^TMP("EIV RESP. EB DATA",$JOB)
+17 ; Important as the INIT^IBCNES kills an array we need to keep if VALMEVL is defined (IB*519)
NEW VALMEVL
+18 ; save off certain VALM variables because call to IBCNES changes them and throws off page counter when returning to EE screen (IB*519)
+19 ; IB*2.0*521/ZEB use $G to prevent crash when report is run from outside of a ListMan context
+20 IF $GET(VALMCNT)
NEW IBVLSV
SET IBVLSV=VALMCNT_U_$GET(VALM("LINES"))_U_$GET(^TMP("IBCNBLE",$JOB,VALMCNT,0))
+21 DO INIT^IBCNES(365.02,RSPIENS_",","A",1,"EIV RESP. EB DATA")
+22 NEW TCTR
+23 SET TCTR=""
+24 FOR
SET TCTR=$ORDER(^TMP("EIV RESP. EB DATA",$JOB,"DISP",TCTR))
if TCTR=""
QUIT
Begin DoDot:1
+25 SET LCT=LCT+1
SET DISPDATA(LCT)=$$FO^IBCNEUT1($GET(^TMP("EIV RESP. EB DATA",$JOB,"DISP",TCTR,0)),76)
End DoDot:1
+26 ; restore VALM page-counter values to pre-IBCNES values (IB*519)
+27 ; IB*2.0*521/ZEB use $G to prevent crash when report is run from outside of a ListMan context
+28 IF $GET(IBVLSV)
SET VALM("LINES")=$PIECE(IBVLSV,U,2)
SET VALMCNT=$PIECE(IBVLSV,U)
SET ^TMP("IBCNBLE",$JOB,VALMCNT,0)=$PIECE(IBVLSV,U,3)
KILL IBVLSV
+29 ; /IB*2.0*506 End
+30 ;
+31 QUIT
+32 ;
WRAPIT(ITEM,RCTR,DARRAY,MAX,INDENT) ; Module to wrap text into a display array.
+1 ; ITEM = Text to be wrapped.
+2 ; RCTR = Current Record counter.
+3 ; DARRAY = Current Display Array.
+4 ; MAX = Maximum number of characters for one line before wrapping.
+5 ; INDENT = Character position to indent extra text when wrapping.
+6 ;
+7 NEW TXT,I,SPACE
+8 SET TXT=ITEM
SET $PIECE(SPACE," ",INDENT)=" "
+9 FOR
Begin DoDot:1
+10 SET DARRAY(RCTR)=$EXTRACT(TXT,1,MAX)
+11 SET TXT=$EXTRACT(TXT,MAX+1,$LENGTH(TXT))
if '$LENGTH(TXT)
QUIT
+12 SET RCTR=RCTR+1
+13 SET TXT=SPACE_TXT
End DoDot:1
if '$LENGTH(TXT)
QUIT
+14 QUIT
