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**;21-MAR-94;Build 53
;;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
;
; 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")
S PTREL=$$GET1^DIQ(365.037,PTRIEN_",",.02,"E")
S RPTDATA(8)=PTREL
;IB*2*702/ckb - end
; if pt. rel is empty, try to get value from the old field 365/1.09
I RPTDATA(8)="" S RPTDATA(8)=$$GET1^DIQ(365,IENS,1.09,"E")
; 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 $P(RPTDATA(3,CT),U,II*2)=CNPTR_": "_$P(RPTDATA(3,CT),U,II*2+1),$P(RPTDATA(3,CT),U,II*2+1)=""
..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")
.S RPTDATA(7,DTYPE,CT)=$$X12^IBCNERP2(365.026,DQUAL)_U_$P(NODE0,U,2)
.Q
;
; 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
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)
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)
S LCT=LCT+1,DISPDATA(LCT)=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.02),17,"R")_$P(RPTDATA(1),U,2)
S LCT=LCT+1,DISPDATA(LCT)=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.03),17,"R")_$$FO^IBCNEUT1($P(RPTDATA(1),U,3),20)_$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.04),22,"R")_$P(RPTDATA(1),U,4)
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)
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)
S LCT=LCT+1,DISPDATA(LCT)=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.08),17,"R")_$$FO^IBCNEUT1($P(RPTDATA(1),U,8),20)_$$FO^IBCNEUT1($$LBL^IBCNERP2(365,8.01),22,"R")_RPTDATA(8)
S LCT=LCT+1,DISPDATA(LCT)=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.18),17,"R")_$$FO^IBCNEUT1($P(RPTDATA(1),U,18),20)_$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.13),22,"R")_$P(RPTDATA(1),U,13)
S LCT=LCT+1,DISPDATA(LCT)=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.1),17,"R")_$$FO^IBCNEUT1($P(RPTDATA(1),U,10),20)_$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.16),22,"R")_$P(RPTDATA(1),U,16)
S LCT=LCT+1,DISPDATA(LCT)=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.11),17,"R")_$$FO^IBCNEUT1($P(RPTDATA(1),U,11),20)_$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.17),22,"R")_$P(RPTDATA(1),U,17)
S LCT=LCT+1,DISPDATA(LCT)=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.12),17,"R")_$$FO^IBCNEUT1($P(RPTDATA(1),U,12),20)_$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.19),22,"R")_$P(RPTDATA(1),U,19)
S LCT=LCT+1,DISPDATA(LCT)=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,.07),17,"R")_$$FO^IBCNEUT1($P(RPTDATA(0),U,7),20)_$$FO^IBCNEUT1($$LBL^IBCNERP2(365,.09),22,"R")_$P(RPTDATA(0),U,9)
S LCT=LCT+1,DISPDATA(LCT)=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.2),17,"R")_$$FO^IBCNEUT1($P(RPTDATA(1),U,20),20)
;
; 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 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)
..Q
.Q
;
; Contacts
CONT ;
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:"
; Build
F CT=1:1:CNCT D
. S LCT=LCT+1,DISPDATA(LCT)=""
. S LCT=LCT+1,DISPDATA(LCT)=" "
. 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)
. 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=""
. . . Q
. . Q
; 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
.S LCT=LCT+1,DISPDATA(LCT)="Reject Reason Code: "_$P(RPTDATA(6,CT),U,2) ; ib*2*497
.S LCT=LCT+1,DISPDATA(LCT)="Reject Reason Text: "_$P(RPTDATA(6,CT),U,3) ; ib*2*497
.S LCT=LCT+1,DISPDATA(LCT)="Action Code: "_$P(RPTDATA(6,CT),U,4) ; ib*2*497
.S LCT=LCT+1,DISPDATA(LCT)="Action Code Text: "_$P(RPTDATA(6,CT),U,5) ;IB*2*497
.S LCT=LCT+1,DISPDATA(LCT)="HIPAA Loop: "_$P(RPTDATA(6,CT),U,6) ; ib*2*497
.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) ; ib*2*497
.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)=""
.Q
;
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 10305 printed Sep 23, 2025@19:51:25 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**;21-MAR-94;Build 53
+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 ; Insured Info from eIV Response #365
+5 SET RPTDATA(0)=$GET(^IBCN(365,IEN,0))
SET TQIEN=$PIECE(RPTDATA(0),U,5)
+6 ; Trans dates to ext format
+7 SET $PIECE(RPTDATA(0),U,7)=$$FMTE^XLFDT($PIECE(RPTDATA(0),U,7)\1,"5Z")
+8 SET RPTDATA(1)=$GET(^IBCN(365,IEN,1))
+9 ; Trans ext values for SET of CODES values
+10 SET IENS=IEN_","
+11 ; Whose Ins
SET $PIECE(RPTDATA(1),U,8)=$$GET1^DIQ(365,IENS,1.08,"E")
+12 ; COB
SET $PIECE(RPTDATA(1),U,13)=$$GET1^DIQ(365,IENS,1.13,"E")
+13 ;IB*2*702/ckb - Convert Pt Rel code to English
+14 ; Pt Rel to Sub
+15 ;S RPTDATA(8)=$$GET1^DIQ(365,IENS,8.01,"E") ; Pt Rel to Sub
+16 NEW PTREL,PTRIEN
+17 SET PTRIEN=$$GET1^DIQ(365,IENS,8.01,"I")
+18 SET PTREL=$$GET1^DIQ(365.037,PTRIEN_",",.02,"E")
+19 SET RPTDATA(8)=PTREL
+20 ;IB*2*702/ckb - end
+21 ; if pt. rel is empty, try to get value from the old field 365/1.09
+22 IF RPTDATA(8)=""
SET RPTDATA(8)=$$GET1^DIQ(365,IENS,1.09,"E")
+23 ; Trans err actions/codes to ext
+24 SET $PIECE(RPTDATA(1),U,14)=$$X12^IBCNERP2(365.017,$PIECE(RPTDATA(1),U,14))
+25 SET $PIECE(RPTDATA(1),U,15)=$$X12^IBCNERP2(365.018,$PIECE(RPTDATA(1),U,15))
+26 ; Trans dates to ext format - check format
+27 FOR PC=2,9:1:12,16,17,19
SET $PIECE(RPTDATA(1),U,PC)=$$FMTE^XLFDT($PIECE(RPTDATA(1),U,PC),"5Z")
+28 ;
+29 ; Loop thru mult Contact segs
+30 SET CT=0
+31 FOR
SET CT=$ORDER(^IBCN(365,IEN,3,CT))
if 'CT
QUIT
Begin DoDot:1
+32 SET RPTDATA(3,CT)=$GET(^IBCN(365,IEN,3,CT,0))
+33 ; Obtain the various Communication Text fields
+34 FOR II=1:1:3
SET RPTDATA(3,CT,II)=$GET(^IBCN(365,IEN,3,CT,II))
+35 ; Disp. blank if NOT SPECIFIED
+36 IF $PIECE(RPTDATA(3,CT),U)="NOT SPECIFIED"
SET $PIECE(RPTDATA(3,CT),U)=""
+37 ; Comm Qual #1-3
+38 FOR II=1:1:3
Begin DoDot:2
+39 SET CNPTR=$$X12^IBCNERP2(365.021,$PIECE(RPTDATA(3,CT),U,II*2))
+40 ;;;I CNPTR'="" S $P(RPTDATA(3,CT),U,II*2)=CNPTR_": "_$P(RPTDATA(3,CT),U,II*2+1),$P(RPTDATA(3,CT),U,II*2+1)=""
+41 IF CNPTR'=""
SET RPTDATA(3,CT,II)=CNPTR_": "_$GET(RPTDATA(3,CT,II))
End DoDot:2
End DoDot:1
+42 ;
+43 ; Subscriber level dates (ZTP segments)
+44 SET CT=0
FOR
SET CT=$ORDER(^IBCN(365,IEN,7,CT))
if 'CT
QUIT
Begin DoDot:1
+45 SET NODE0=$GET(^IBCN(365,IEN,7,CT,0))
+46 SET DQUAL=$PIECE(NODE0,U,3)
IF 'DQUAL
QUIT
+47 SET LOOP=$$GET1^DIQ(365.027,$PIECE(NODE0,U,4)_",",.01)
+48 SET DTYPE=$SELECT(LOOP["C":"S",LOOP["D":"P",1:"O")
+49 SET RPTDATA(7,DTYPE,CT)=$$X12^IBCNERP2(365.026,DQUAL)_U_$PIECE(NODE0,U,2)
+50 QUIT
End DoDot:1
+51 ;
+52 ; Reject reasons
+53 SET CT=0
FOR
SET CT=$ORDER(^IBCN(365,IEN,6,CT))
if 'CT
QUIT
Begin DoDot:1
+54 SET NODE0=$GET(^IBCN(365,IEN,6,CT,0))
IF '$PIECE(NODE0,U,3)
QUIT
+55 SET ETXT=$$X12^IBCNERP2(365.017,$PIECE(NODE0,U,3))
+56 SET ELOC=$PIECE(NODE0,U,2)
if ELOC=""
SET ELOC="N/A"
+57 SET EACT=$$X12^IBCNERP2(365.018,$PIECE(NODE0,U,4))
if EACT=""
SET EACT="N/A"
+58 SET LOOP=$$X12^IBCNERP2(365.027,$PIECE(NODE0,U,5))
if LOOP=""
SET LOOP="N/A"
+59 SET ESRC=$PIECE(NODE0,U,6)
if ESRC=""
SET ESRC="N/A"
+60 ;IB*2*497 modify existing line below to retrieve external value of ERROR CODE and ACTION CODE
+61 ;and build as part of the composite string at RPTDATA(6,CT).
+62 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
+63 ; IB*2*497 retrieve additional messages
+64 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)
+65 QUIT
End DoDot:1
+66 ;
+67 ; Subscriber Data
+68 SET RPTDATA(13)=$GET(^IBCN(365,IEN,13))
+69 ;
+70 ; Group Data
+71 SET RPTDATA(14)=$GET(^IBCN(365,IEN,14))
+72 ;
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 NEW LCT,CT,SEGCT,ITEM,CT2,NTCT,CNCT,ERCT,RPTDATA,DCT,DTYPE
+2 ; Merge into local array
+3 MERGE RPTDATA=^TMP($JOB,RTN,SORT1,SORT2,CNT)
+4 ; Build
+5 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)
+6 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)
+7 SET LCT=LCT+1
SET DISPDATA(LCT)=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.02),17,"R")_$PIECE(RPTDATA(1),U,2)
+8 SET LCT=LCT+1
SET DISPDATA(LCT)=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.03),17,"R")_$$FO^IBCNEUT1($PIECE(RPTDATA(1),U,3),20)_$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.04),22,"R")_$PIECE(RPTDATA(1),U,4)
+9 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)
+10 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)
+11 SET LCT=LCT+1
SET DISPDATA(LCT)=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.08),17,"R")_$$FO^IBCNEUT1($PIECE(RPTDATA(1),U,8),20)_$$FO^IBCNEUT1($$LBL^IBCNERP2(365,8.01),22,"R")_RPTDATA(8)
+12 SET LCT=LCT+1
SET DISPDATA(LCT)=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.18),17,"R")_$$FO^IBCNEUT1($PIECE(RPTDATA(1),U,18),20)_$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.13),22,"R")_$PIECE(RPTDATA(1),U,13)
+13 SET LCT=LCT+1
SET DISPDATA(LCT)=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.1),17,"R")_$$FO^IBCNEUT1($PIECE(RPTDATA(1),U,10),20)_$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.16),22,"R")_$PIECE(RPTDATA(1),U,16)
+14 SET LCT=LCT+1
SET DISPDATA(LCT)=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.11),17,"R")_$$FO^IBCNEUT1($PIECE(RPTDATA(1),U,11),20)_$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.17),22,"R")_$PIECE(RPTDATA(1),U,17)
+15 SET LCT=LCT+1
SET DISPDATA(LCT)=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.12),17,"R")_$$FO^IBCNEUT1($PIECE(RPTDATA(1),U,12),20)_$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.19),22,"R")_$PIECE(RPTDATA(1),U,19)
+16 SET LCT=LCT+1
SET DISPDATA(LCT)=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,.07),17,"R")_$$FO^IBCNEUT1($PIECE(RPTDATA(0),U,7),20)_$$FO^IBCNEUT1($$LBL^IBCNERP2(365,.09),22,"R")_$PIECE(RPTDATA(0),U,9)
+17 SET LCT=LCT+1
SET DISPDATA(LCT)=$$FO^IBCNEUT1($$LBL^IBCNERP2(365,1.2),17,"R")_$$FO^IBCNEUT1($PIECE(RPTDATA(1),U,20),20)
+18 ;
+19 ; Dates
+20 FOR DTYPE="S","P","O"
Begin DoDot:1
+21 IF '$DATA(RPTDATA(7,DTYPE))
QUIT
+22 SET LCT=LCT+1
SET DISPDATA(LCT)=""
+23 SET LCT=LCT+1
SET DISPDATA(LCT)=$SELECT(DTYPE="S":"Subscriber",DTYPE="P":"Patient",1:"Other")_" Dates:"
+24 SET LCT=LCT+1
SET DISPDATA(LCT)=""
+25 SET DCT=""
FOR
SET DCT=$ORDER(RPTDATA(7,DTYPE,DCT))
if DCT=""
QUIT
Begin DoDot:2
+26 SET LCT=LCT+1
SET DISPDATA(LCT)=$$FO^IBCNEUT1($PIECE(RPTDATA(7,DTYPE,DCT),U)_": ",40)_$PIECE(RPTDATA(7,DTYPE,DCT),U,2)
+27 QUIT
End DoDot:2
+28 QUIT
End DoDot:1
+29 ;
+30 ; Contacts
CONT ;
+1 NEW TEXT
+2 SET CNCT=+$ORDER(RPTDATA(3,""),-1)
IF 'CNCT
GOTO ERR
+3 SET LCT=LCT+1
SET DISPDATA(LCT)=""
+4 SET LCT=LCT+1
SET DISPDATA(LCT)="CONTACT INFORMATION:"
+5 ; Build
+6 FOR CT=1:1:CNCT
Begin DoDot:1
+7 SET LCT=LCT+1
SET DISPDATA(LCT)=""
+8 SET LCT=LCT+1
SET DISPDATA(LCT)=" "
+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 FOR CT2=1:1:SEGCT
SET ITEM=$GET(RPTDATA(3,CT,CT2))
Begin DoDot:2
+13 if '$LENGTH(ITEM)
QUIT
+14 SET TEXT=$SELECT($LENGTH(TEXT):" "_TEXT_", ",1:" ")_ITEM
+15 FOR
Begin DoDot:3
+16 SET LCT=LCT+1
SET DISPDATA(LCT)=$EXTRACT(TEXT,1,74)
+17 IF $LENGTH(TEXT)>74
SET TEXT=$EXTRACT(TEXT,75,$LENGTH(TEXT))
QUIT
+18 SET TEXT=""
+19 QUIT
End DoDot:3
if '$LENGTH(TEXT)
QUIT
+20 QUIT
End DoDot:2
End DoDot:1
+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*2*497
SET LCT=LCT+1
SET DISPDATA(LCT)="Reject Reason Code: "_$PIECE(RPTDATA(6,CT),U,2)
+6 ; ib*2*497
SET LCT=LCT+1
SET DISPDATA(LCT)="Reject Reason Text: "_$PIECE(RPTDATA(6,CT),U,3)
+7 ; ib*2*497
SET LCT=LCT+1
SET DISPDATA(LCT)="Action Code: "_$PIECE(RPTDATA(6,CT),U,4)
+8 ;IB*2*497
SET LCT=LCT+1
SET DISPDATA(LCT)="Action Code Text: "_$PIECE(RPTDATA(6,CT),U,5)
+9 ; ib*2*497
SET LCT=LCT+1
SET DISPDATA(LCT)="HIPAA Loop: "_$PIECE(RPTDATA(6,CT),U,6)
+10 SET LCT=LCT+1
SET DISPDATA(LCT)="HL7 Location: "_$PIECE(RPTDATA(6,CT),U)
+11 ; ib*2*497
SET LCT=LCT+1
SET DISPDATA(LCT)="Error Source: "_$PIECE(RPTDATA(6,CT),U,7)
+12 IF $DATA(RPTDATA(6,CT,"AMSG"))
Begin DoDot:2
+13 ; IB*506
IF ERCT>0
SET LCT=LCT+1
SET DISPDATA(LCT)=""
+14 SET LCT=LCT+1
SET DISPDATA(LCT)="Additional Messages:"
+15 SET LCT=LCT+1
SET DISPDATA(LCT)=""
+16 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)
+17 QUIT
End DoDot:2
+18 SET LCT=LCT+1
SET DISPDATA(LCT)=""
+19 QUIT
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
