IBCNBLE ;ALB/ARH - Ins Buffer: LM buffer entry screen ;1-Jun-97
;;2.0;INTEGRATED BILLING;**82,231,184,251,371,416,435,452,497,519,516,528,687,737,743**;21-MAR-94;Build 18
;;Per VA Directive 6402, this routine should not be modified.
;
EN ; - main entry point for list manager display
N DFN
D EN^VALM("IBCNB INSURANCE BUFFER ENTRY")
Q
;
HDR ; - header code for list manager display
N IBX,IB0,VADM,VA,VAERR S IBX=""
I +$G(DFN) D DEM^VADPT S IBX=$E(VADM(1),1,28),IBX=IBX_$J("",35-$L(IBX))_$P(VADM(2),U,2)_" DOB: "_$P(VADM(3),U,2)_" AGE: "_VADM(4)
S VALMHDR(1)=IBX
S IB0=$G(^IBA(355.33,+$G(IBBUFDA),0))
S IBX=$E($P($G(^VA(200,+$P(IB0,U,2),0)),U,1),1,27)_" ("_$E($$EXPAND^IBTRE(355.33,.03,$P(IB0,U,3)),1,11)_")"
S IBX="Buffer entry created on "_$$DATE(+IB0)_" by "_IBX,IBX=$J("",40-($L(IBX)\2))_IBX
S VALMHDR(2)=IBX
S IBX="" I +$P(IB0,U,10) S IBX="Buffer entry verified on "_$$DATE(+$P(IB0,U,10))_" by "_$E($P($G(^VA(200,+$P(IB0,U,11),0)),U,1),1,27),IBX=$J("",40-($L(IBX)\2))_IBX
S VALMHDR(3)=IBX
Q
;
INIT ; - initialization of list manager screen, ien of record to display required IBBUFDA
K ^TMP("IBCNBLE",$J)
I '$G(IBBUFDA) S VALMQUIT="" Q
S DFN=+$G(^IBA(355.33,IBBUFDA,60))
D BLD
Q
;
HELP ; - help text for list manager screen
D FULL^VALM1
W !!,"This screen displays all data in a Buffer File entry."
W !!,"The actions allow editing of all data and verification of coverage."
; IB*2.0*737/DTG remove verify action reference
; W !!,"It is not necessary to use the Verify Entry action, this action is optional."
; W !,"If the Verify Entry action is not used, the policy will be automatically flagged"
; W !,"as verified when it is Accepted and stored in the main Insurance files."
;
D PAUSE^VALM1 S VALMBCK="R"
Q
;
EXIT ; - exit list manager screen
K ^TMP("IBCNBLE",$J)
D CLEAR^VALM1
Q
;
BLD ; display buffer entry
N DFN,CLIEN,CLDT,IB0,IB20,IB40,IB60,IB61,IB62,IB90,IB91,IBL,IBLINE,ADDR,IBI,IBY,SRVARRAY
S VALMCNT=0
S IB0=$G(^IBA(355.33,IBBUFDA,0)),IB20=$G(^IBA(355.33,IBBUFDA,20)),IB40=$G(^IBA(355.33,IBBUFDA,40))
S IB60=$G(^IBA(355.33,IBBUFDA,60)),IB61=$G(^IBA(355.33,IBBUFDA,61)),IB62=$G(^IBA(355.33,IBBUFDA,62))
S IB90=$G(^IBA(355.33,IBBUFDA,90)),IB91=$G(^IBA(355.33,IBBUFDA,91))
; check if we are coming from appointments view
I $G(AVIEW) D
.D SET(" ") S IBY=$J("",26)_"Appointment Information" D SET(IBY,"B") S IBLINE=""
.S DFN=+IB60
.S CLIEN="" F S CLIEN=$O(^TMP($J,"IBCNAPPTS",DFN,CLIEN)) Q:CLIEN="" D
..S CLDT="" F S CLDT=$O(^TMP($J,"IBCNAPPTS",DFN,CLIEN,CLDT)) Q:CLDT="" D
...S IBL="Clinic: ",IBY=$P($P(^TMP($J,"IBCNAPPTS",DFN,CLIEN,CLDT),U,2),";",2)
...S IBLINE=$$SETL(IBLINE,IBY,IBL,10,30)
...S IBL="Appt. D/T: ",IBY=$$FMTE^XLFDT(CLDT)
...S IBLINE=$$SETL(IBLINE,IBY,IBL,50,22)
...D SET(IBLINE) S IBLINE=""
...Q
..Q
.Q
;
I +$P(IB0,U,17) D EN^IBCNBLE2 ; IB*2*435 - Display e-Pharmacy ELIG response data
;
D SET(" ") S IBY=$J("",26)_"Insurance Company Information" D SET(IBY,"B") S IBLINE=""
S IBL="Name: ",IBY=$P(IB20,U,1) S IBLINE=$$SETL("",IBY,IBL,10,30)
S IBL="Reimburse?: ",IBY=$$EXPAND^IBTRE(355.33,20.05,$P(IB20,U,5)) S IBLINE=$$SETL(IBLINE,IBY,IBL,57,20)
D SET(IBLINE) S IBLINE=""
S IBL="Phone: ",IBY=$P(IB20,U,2) S IBLINE=$$SETL(IBLINE,IBY,IBL,10,20)
S IBL="Billing Phone: ",IBY=$P(IB20,U,3) S IBLINE=$$SETL(IBLINE,IBY,IBL,57,20)
D SET(IBLINE) S IBLINE=""
S IBL="Precert Phone: ",IBY=$P(IB20,U,4) S IBLINE=$$SETL(IBLINE,IBY,IBL,57,20)
D SET(IBLINE) S IBLINE=""
;IB*687/ckb Changed "Remote Query From" to "Received From"
S IBL="Received From: ",IBY=$$EXTERNAL^DILFD(355.33,.14,"",$P(IB0,"^",14)) S IBLINE=$$SETL(IBLINE,IBY,IBL,57,20)
D SET(IBLINE) S IBLINE="" D ADDR(21,1)
S IBL="Address: ",IBY=ADDR(1) S IBLINE=$$SETL(IBLINE,IBY,IBL,10,69)
D SET(IBLINE) S IBLINE=""
F IBI=2:1:9 S IBL="",IBY=$G(ADDR(IBI)) Q:IBY="" S IBLINE=$$SETL(IBLINE,IBY,IBL,10,69) D SET(IBLINE) S IBLINE=""
D SET(" ") S IBY=$J("",29)_"Group/Plan Information" D SET(IBY,"B") S IBLINE=""
S IBL="Group Plan?: ",IBY=$$YN($P(IB40,U,1)) S IBLINE=$$SETL("",IBY,IBL,16,3)
D SET(IBLINE) S IBLINE=""
S IBL="Group Name: ",IBY=$P(IB90,U,1) S IBLINE=$$SETL("",IBY,IBL,16,58) D SET(IBLINE) S IBLINE=""
I $TR($E(IBY,59,80)," ","")'="" S IBLINE=$$SETL("",$E(IBY,59,80),"",16,22) D SET(IBLINE) S IBLINE=""
;
S IBL="Group Number: ",IBY=$P(IB90,U,2) S IBLINE=$$SETL("",IBY,IBL,16,55)
;;Daou/EEN - Adding BIN and PCN
D SET(IBLINE) S IBLINE=""
S IBL="BIN: ",IBY=$P(IB40,U,10) S IBLINE=$$SETL("",IBY,IBL,16,10)
S IBL="Require UR: ",IBY=$$YN($P(IB40,U,4)) S IBLINE=$$SETL(IBLINE,IBY,IBL,63,3)
D SET(IBLINE) S IBLINE=""
S IBL="PCN: ",IBY=$P(IB40,U,11) S IBLINE=$$SETL("",IBY,IBL,16,20)
S IBL="Require Amb Cert: ",IBY=$$YN($P(IB40,U,6)) S IBLINE=$$SETL(IBLINE,IBY,IBL,63,3)
D SET(IBLINE) S IBLINE=""
S IBL="Require Pre-Cert: ",IBY=$$YN($P(IB40,U,5)) S IBLINE=$$SETL(IBLINE,IBY,IBL,63,3)
D SET(IBLINE) S IBLINE=""
;
S IBL="Type of Plan: ",IBY=$P($G(^IBE(355.1,+$P(IB40,U,9),0)),U,1) S IBLINE=$$SETL("",IBY,IBL,16,25)
S IBL="Exclude Pre-Cond: ",IBY=$$YN($P(IB40,U,7)) S IBLINE=$$SETL(IBLINE,IBY,IBL,63,3)
D SET(IBLINE) S IBLINE=""
S IBL="Benefits Assignable: ",IBY=$$YN($P(IB40,U,8)) S IBLINE=$$SETL(IBLINE,IBY,IBL,63,3)
D SET(IBLINE) S IBLINE=""
;
D SET(" ") S IBY=$J("",26)_"Policy/Subscriber Information" D SET(IBY,"B") S IBLINE=""
S IBL="Whose Insurance: ",IBY=$$EXPAND^IBTRE(355.33,60.05,$P(IB60,U,5)) S IBLINE=$$SETL("",IBY,IBL,18,7)
S IBL="Effective: ",IBY=$$DATE($P(IB60,U,2)) S IBLINE=$$SETL(IBLINE,IBY,IBL,62,8)
D SET(IBLINE) S IBLINE=""
S IBL="Expiration: ",IBY=$$DATE($P(IB60,U,3)) S IBLINE=$$SETL(IBLINE,IBY,IBL,62,13)
D SET(IBLINE) S IBLINE=""
S IBL="Subscriber Name: ",IBY=$P(IB91,U,1) S IBLINE=$$SETL("",IBY,IBL,18,56) D SET(IBLINE) S IBLINE=""
I $TR($E(IBY,57,130)," ","")'="" S IBLINE=$$SETL("",$E(IBY,57,130),"",18,56) D SET(IBLINE) S IBLINE=""
I $TR($E(IBY,113,130)," ","")'="" S IBLINE=$$SETL("",$E(IBY,113,130),"",18,18) D SET(IBLINE) S IBLINE=""
S IBL="Subscriber Id: ",IBY=$P(IB90,U,3) S IBLINE=$$SETL("",IBY,IBL,18,56) D SET(IBLINE) S IBLINE=""
I $TR($E(IBY,57,80)," ","")'="" S IBLINE=$$SETL("",$E(IBY,57,80),"",18,24) D SET(IBLINE) S IBLINE=""
;
S IBL="Relationship: ",IBY=$$EXPAND^IBTRE(355.33,60.06,$P(IB60,U,6)) S IBLINE=$$SETL("",IBY,IBL,18,16)
S IBL="Primary Provider: ",IBY=$P(IB60,U,10) S IBLINE=$$SETL(IBLINE,IBY,IBL,62,17)
D SET(IBLINE) S IBLINE=""
S IBL="Provider Phone: ",IBY=$P(IB60,U,11) S IBLINE=$$SETL(IBLINE,IBY,IBL,62,16)
D SET(IBLINE) S IBLINE=""
I $P(IB60,U,6)'="01"!($P(IB60,U,8)'="") S IBL="Insured's DOB: ",IBY=$$DATE($P(IB60,U,8)) S IBLINE=$$SETL("",IBY,IBL,18,8)
S IBL="Coord of Benefits: ",IBY=$$EXPAND^IBTRE(355.33,60.12,$P(IB60,U,12)) S IBLINE=$$SETL(IBLINE,IBY,IBL,62,16)
D SET(IBLINE) S IBLINE=""
;
I $P(IB60,U,15)'=""!($P(IB60,U,16)'="") D ; IB*2*452 - esg - display Pharmacy fields if they exist
. S IBL="Rx Relationship: ",IBY=""
. N G S G=+$P(IB60,U,15)
. I G S IBY=$$GET1^DIQ(9002313.19,G_",",.01)_" - "_$$GET1^DIQ(9002313.19,G_",",.02)
. S IBLINE=$$SETL("",IBY,IBL,18,20)
. S IBL="Rx Person Code: ",IBY=$P(IB60,U,16),IBLINE=$$SETL(IBLINE,IBY,IBL,62,10)
. D SET(IBLINE) S IBLINE=""
. Q
;
I $P(IB62,U,1)'="" S IBL="Patient Id: ",IBY=$P(IB62,U,1) S IBLINE=$$SETL(IBLINE,IBY,IBL,62,13)
I IBLINE'="" D SET(IBLINE) S IBLINE=""
;
I '$P(IB61,U,1) D SET(" ") S IBL="Employer Sponsored Group Health Plan?: ",IBY=$$YN($P(IB61,U,1)) S IBLINE=$$SETL("",IBY,IBL,40,3) D SET(IBLINE) S IBLINE="" G NXT
;
D ADDR(61,6)
D SET(" ") S IBY=$J("",24)_"Subscriber's Employer Information" D SET(IBY,"B") S IBLINE=""
S IBL="Employer Sponsored?: ",IBY=$$YN($P(IB61,U,1)) S IBLINE=$$SETL("",IBY,IBL,22,3)
S IBL="Employment Status: ",IBY=$$EXPAND^IBTRE(355.33,61.03,$P(IB61,U,3)) S IBLINE=$$SETL(IBLINE,IBY,IBL,64,15)
D SET(IBLINE) S IBLINE=""
S IBL="Claim to Employer: ",IBY=$$YN($P(IB61,U,5)) S IBLINE=$$SETL("",IBY,IBL,22,3)
S IBL="Retirement Date: ",IBY=$$DATE($P(IB61,U,4)) S IBLINE=$$SETL(IBLINE,IBY,IBL,64,8)
D SET(IBLINE) S IBLINE=""
S IBL="Employer Name: ",IBY=$P(IB61,U,2) S IBLINE=$$SETL("",IBY,IBL,16,30)
S IBL="Employer Phone: ",IBY=$P(IB61,U,12) S IBLINE=$$SETL(IBLINE,IBY,IBL,64,15)
D SET(IBLINE) S IBLINE=""
S IBL="Address: ",IBY=ADDR(1) S IBLINE=$$SETL(IBLINE,IBY,IBL,16,64)
D SET(IBLINE) S IBLINE=""
F IBI=2:1:9 S IBL="",IBY=$G(ADDR(IBI)) Q:IBY="" S IBLINE=$$SETL(IBLINE,IBY,IBL,16,64) D SET(IBLINE) S IBLINE=""
;
NXT ;
D SET(" ") S IBY=$J("",26)_"Buffer Entry Information" D SET(IBY,"B") S IBLINE=""
S IBL="Date Entered: ",IBY=$$FMTE^XLFDT($P(IB0,U,1),2) S IBLINE=$$SETL("",IBY,IBL,18,17)
S IBL="Date Verified: ",IBY=$$FMTE^XLFDT($P(IB0,U,10),2) S IBLINE=$$SETL(IBLINE,IBY,IBL,62,17)
D SET(IBLINE) S IBLINE=""
S IBL="Entered By: ",IBY=$$EXPAND^IBTRE(355.33,.02,$P(IB0,U,2)) S IBLINE=$$SETL("",IBY,IBL,18,40)
S IBL="Verified By: ",IBY=$$EXPAND^IBTRE(355.33,.11,$P(IB0,U,11)) S IBLINE=$$SETL(IBLINE,IBY,IBL,62,17)
D SET(IBLINE) S IBLINE=""
; service date / service code
D SERVLN(IBBUFDA,.SRVARRAY) I SRVARRAY F IBI=1:1:SRVARRAY D SET(SRVARRAY(IBI))
K SRVARRAY
;
S IBLINE=$$TRACE(IBLINE,IBBUFDA) ; eIIV trace #
S IBL="eIV Processed Date: ",IBY=$S($P(IB0,U,15)="":"",1:$$FMTE^XLFDT($P(IB0,U,15),"2M"))
S IBLINE=$$SETL(IBLINE,IBY,IBL,62,17)
D SET(IBLINE) S IBLINE=""
S IBL="Source: ",IBY=$$EXPAND^IBTRE(355.33,.03,$P(IB0,U,3))
S IBLINE=$$SETL("",IBY,IBL,18,17)
D SET(IBLINE) S IBLINE=""
;
; Call another routine for continuation of list build
D BLD^IBCNBLE1
;
BLDQ Q
;
;
SETL(LINE,DATA,LABEL,COL,LNG) ;
S LINE=LINE_$J("",(COL-$L(LABEL)-$L(LINE)))_LABEL_$E(DATA,1,LNG)
Q LINE
;
SET(LINE,SPEC) ;
S VALMCNT=VALMCNT+1
S ^TMP("IBCNBLE",$J,VALMCNT,0)=LINE
I $G(SPEC)="B" D CNTRL^VALM10(VALMCNT,1,80,IOINHI,IOINORM)
Q
;
DATE(X) ;
N Y S Y="" I X?7N.E S Y=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)
Q Y
;
YN(X) ;
N Y S X=$G(X),Y=$S(X=1:"Yes",X=0:"No",1:"")
Q Y
;
ADDR(NODE,FLD) ; format address for output
N IBY,IB0,IBCS,IBST,IBZIP,IBJ,IBZ,IBX K ADDR S ADDR(1)=""
S IB0=$G(^IBA(355.33,IBBUFDA,NODE))
S IBCS=$P(IB0,U,FLD+3),IBST=$P($G(^DIC(5,+$P(IB0,U,FLD+4),0)),U,2),IBZIP=$P(IB0,U,FLD+5)
S IBZIP=$E(IBZIP,1,5)_$S($E(IBZIP,6,9)'="":"-"_$E(IBZIP,6,9),1:"")
S IBST=IBST_$S(IBST=""!(IBZIP=""):"",1:" ")_IBZIP
S IBCS=IBCS_$S(IBCS=""!(IBST=""):"",1:", ")_IBST
;
S IBJ=1 F IBY=$P(IB0,U,FLD),$P(IB0,U,(FLD+1)),$P(IB0,U,(FLD+2)),IBCS I IBY'="" S IBX=$G(ADDR(IBJ)),IBZ=", " D
. S:IBX="" IBZ="" S:($L(IBX)+2+$L(IBY))>64 IBZ="",IBJ=IBJ+1
. S ADDR(IBJ)=$G(ADDR(IBJ))_IBZ_IBY
Q
;
TRACE(IBLINE,IBBUFDA) ; Add the eIV Trace Number to the display
;IB*743/CKB - added variable IVPRDT, put variables in alphabetical order
; Only display the Trace # when field (#355.33,.15) is populated
NEW IBL,IBY,IVPRDT,RESP,TRACENUM
I '$G(IBBUFDA) G TRACEX
S RESP=$O(^IBCN(365,"AF",IBBUFDA,""),-1) ; response ien
S TRACENUM=""
S IVPRDT=$$GET1^DIQ(355.33,IBBUFDA_",",.15,"I") ;IB*743
I RESP S TRACENUM=$$GET1^DIQ(365,RESP_",",.09,"I") ; trace# field
;I RESP S TRACENUM=$P($G(^IBCN(365,RESP,0)),U,9)
S IBL="eIV Trace #: " ; field label
S IBY=$S(IVPRDT="":"",1:TRACENUM) ; field data
S IBLINE=$$SETL("",IBY,IBL,18,17) ; add it
TRACEX ;
Q IBLINE
;
SERVLN(IBBUFDA,SRVARRAY) ; create a service date/service type line for the display
;IB*743 added IVPRDT
N IVPRDT,NODE0,RIEN,SRVCODE,SRVDT,SRVSTR,TQIEN
S SRVSTR=""
I '$G(IBBUFDA) G SERVLNX
;IB*2.0*519 Start: Fix retrieving RIEN and TQIEN so display gets correct values
S RIEN=+$O(^IBCN(365,"AF",IBBUFDA,""))
S TQIEN=+$O(^IBCN(365.1,"D",IBBUFDA,""),-1)
I TQIEN=0 S TQIEN=$P($G(^IBCN(365,RIEN,0)),U,5)
;IB*2.0*519 End: Fix retrieving RIEN and TQIEN so display gets correct values
;
;IB*743 Service date/code (STC) ONLY applies if (#355.33,.15) is populated
S IVPRDT=$$GET1^DIQ(355.33,IBBUFDA_",",.15,"I")
S (SRVDT,SRVCODE)="" I TQIEN,IVPRDT D
.S NODE0=$G(^IBCN(365.1,TQIEN,0)),SRVCODE=$P(NODE0,U,20)
.;S RIEN=+$O(^IBCN(365,"AF",IBBUFDA,"")) ;IB*2.0*519: RIEN already retrieved above
.I RIEN S SRVDT=$P($G(^IBCN(365,RIEN,1)),U,10) ; try to get service date from file 365
.I SRVDT="" S SRVDT=$P(NODE0,U,12) ; if unsuccessful, get it from file 365.1
.S SRVSTR="** This response is based on service date "_$S(SRVDT:$$FMTE^XLFDT(SRVDT,"5Z"),1:"UNKNOWN")
.S SRVSTR=SRVSTR_" and service type: "_$S(SRVCODE:$P($G(^IBE(365.013,SRVCODE,0)),U,2),1:"UNKNOWN")_" **"
SERVLNX ;
D FSTRNG^IBJU1(SRVSTR,79,.SRVARRAY)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNBLE 12688 printed Oct 16, 2024@18:14:43 Page 2
IBCNBLE ;ALB/ARH - Ins Buffer: LM buffer entry screen ;1-Jun-97
+1 ;;2.0;INTEGRATED BILLING;**82,231,184,251,371,416,435,452,497,519,516,528,687,737,743**;21-MAR-94;Build 18
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
EN ; - main entry point for list manager display
+1 NEW DFN
+2 DO EN^VALM("IBCNB INSURANCE BUFFER ENTRY")
+3 QUIT
+4 ;
HDR ; - header code for list manager display
+1 NEW IBX,IB0,VADM,VA,VAERR
SET IBX=""
+2 IF +$GET(DFN)
DO DEM^VADPT
SET IBX=$EXTRACT(VADM(1),1,28)
SET IBX=IBX_$JUSTIFY("",35-$LENGTH(IBX))_$PIECE(VADM(2),U,2)_" DOB: "_$PIECE(VADM(3),U,2)_" AGE: "_VADM(4)
+3 SET VALMHDR(1)=IBX
+4 SET IB0=$GET(^IBA(355.33,+$GET(IBBUFDA),0))
+5 SET IBX=$EXTRACT($PIECE($GET(^VA(200,+$PIECE(IB0,U,2),0)),U,1),1,27)_" ("_$EXTRACT($$EXPAND^IBTRE(355.33,.03,$PIECE(IB0,U,3)),1,11)_")"
+6 SET IBX="Buffer entry created on "_$$DATE(+IB0)_" by "_IBX
SET IBX=$JUSTIFY("",40-($LENGTH(IBX)\2))_IBX
+7 SET VALMHDR(2)=IBX
+8 SET IBX=""
IF +$PIECE(IB0,U,10)
SET IBX="Buffer entry verified on "_$$DATE(+$PIECE(IB0,U,10))_" by "_$EXTRACT($PIECE($GET(^VA(200,+$PIECE(IB0,U,11),0)),U,1),1,27)
SET IBX=$JUSTIFY("",40-($LENGTH(IBX)\2))_IBX
+9 SET VALMHDR(3)=IBX
+10 QUIT
+11 ;
INIT ; - initialization of list manager screen, ien of record to display required IBBUFDA
+1 KILL ^TMP("IBCNBLE",$JOB)
+2 IF '$GET(IBBUFDA)
SET VALMQUIT=""
QUIT
+3 SET DFN=+$GET(^IBA(355.33,IBBUFDA,60))
+4 DO BLD
+5 QUIT
+6 ;
HELP ; - help text for list manager screen
+1 DO FULL^VALM1
+2 WRITE !!,"This screen displays all data in a Buffer File entry."
+3 WRITE !!,"The actions allow editing of all data and verification of coverage."
+4 ; IB*2.0*737/DTG remove verify action reference
+5 ; W !!,"It is not necessary to use the Verify Entry action, this action is optional."
+6 ; W !,"If the Verify Entry action is not used, the policy will be automatically flagged"
+7 ; W !,"as verified when it is Accepted and stored in the main Insurance files."
+8 ;
+9 DO PAUSE^VALM1
SET VALMBCK="R"
+10 QUIT
+11 ;
EXIT ; - exit list manager screen
+1 KILL ^TMP("IBCNBLE",$JOB)
+2 DO CLEAR^VALM1
+3 QUIT
+4 ;
BLD ; display buffer entry
+1 NEW DFN,CLIEN,CLDT,IB0,IB20,IB40,IB60,IB61,IB62,IB90,IB91,IBL,IBLINE,ADDR,IBI,IBY,SRVARRAY
+2 SET VALMCNT=0
+3 SET IB0=$GET(^IBA(355.33,IBBUFDA,0))
SET IB20=$GET(^IBA(355.33,IBBUFDA,20))
SET IB40=$GET(^IBA(355.33,IBBUFDA,40))
+4 SET IB60=$GET(^IBA(355.33,IBBUFDA,60))
SET IB61=$GET(^IBA(355.33,IBBUFDA,61))
SET IB62=$GET(^IBA(355.33,IBBUFDA,62))
+5 SET IB90=$GET(^IBA(355.33,IBBUFDA,90))
SET IB91=$GET(^IBA(355.33,IBBUFDA,91))
+6 ; check if we are coming from appointments view
+7 IF $GET(AVIEW)
Begin DoDot:1
+8 DO SET(" ")
SET IBY=$JUSTIFY("",26)_"Appointment Information"
DO SET(IBY,"B")
SET IBLINE=""
+9 SET DFN=+IB60
+10 SET CLIEN=""
FOR
SET CLIEN=$ORDER(^TMP($JOB,"IBCNAPPTS",DFN,CLIEN))
if CLIEN=""
QUIT
Begin DoDot:2
+11 SET CLDT=""
FOR
SET CLDT=$ORDER(^TMP($JOB,"IBCNAPPTS",DFN,CLIEN,CLDT))
if CLDT=""
QUIT
Begin DoDot:3
+12 SET IBL="Clinic: "
SET IBY=$PIECE($PIECE(^TMP($JOB,"IBCNAPPTS",DFN,CLIEN,CLDT),U,2),";",2)
+13 SET IBLINE=$$SETL(IBLINE,IBY,IBL,10,30)
+14 SET IBL="Appt. D/T: "
SET IBY=$$FMTE^XLFDT(CLDT)
+15 SET IBLINE=$$SETL(IBLINE,IBY,IBL,50,22)
+16 DO SET(IBLINE)
SET IBLINE=""
+17 QUIT
End DoDot:3
+18 QUIT
End DoDot:2
+19 QUIT
End DoDot:1
+20 ;
+21 ; IB*2*435 - Display e-Pharmacy ELIG response data
IF +$PIECE(IB0,U,17)
DO EN^IBCNBLE2
+22 ;
+23 DO SET(" ")
SET IBY=$JUSTIFY("",26)_"Insurance Company Information"
DO SET(IBY,"B")
SET IBLINE=""
+24 SET IBL="Name: "
SET IBY=$PIECE(IB20,U,1)
SET IBLINE=$$SETL("",IBY,IBL,10,30)
+25 SET IBL="Reimburse?: "
SET IBY=$$EXPAND^IBTRE(355.33,20.05,$PIECE(IB20,U,5))
SET IBLINE=$$SETL(IBLINE,IBY,IBL,57,20)
+26 DO SET(IBLINE)
SET IBLINE=""
+27 SET IBL="Phone: "
SET IBY=$PIECE(IB20,U,2)
SET IBLINE=$$SETL(IBLINE,IBY,IBL,10,20)
+28 SET IBL="Billing Phone: "
SET IBY=$PIECE(IB20,U,3)
SET IBLINE=$$SETL(IBLINE,IBY,IBL,57,20)
+29 DO SET(IBLINE)
SET IBLINE=""
+30 SET IBL="Precert Phone: "
SET IBY=$PIECE(IB20,U,4)
SET IBLINE=$$SETL(IBLINE,IBY,IBL,57,20)
+31 DO SET(IBLINE)
SET IBLINE=""
+32 ;IB*687/ckb Changed "Remote Query From" to "Received From"
+33 SET IBL="Received From: "
SET IBY=$$EXTERNAL^DILFD(355.33,.14,"",$PIECE(IB0,"^",14))
SET IBLINE=$$SETL(IBLINE,IBY,IBL,57,20)
+34 DO SET(IBLINE)
SET IBLINE=""
DO ADDR(21,1)
+35 SET IBL="Address: "
SET IBY=ADDR(1)
SET IBLINE=$$SETL(IBLINE,IBY,IBL,10,69)
+36 DO SET(IBLINE)
SET IBLINE=""
+37 FOR IBI=2:1:9
SET IBL=""
SET IBY=$GET(ADDR(IBI))
if IBY=""
QUIT
SET IBLINE=$$SETL(IBLINE,IBY,IBL,10,69)
DO SET(IBLINE)
SET IBLINE=""
+38 DO SET(" ")
SET IBY=$JUSTIFY("",29)_"Group/Plan Information"
DO SET(IBY,"B")
SET IBLINE=""
+39 SET IBL="Group Plan?: "
SET IBY=$$YN($PIECE(IB40,U,1))
SET IBLINE=$$SETL("",IBY,IBL,16,3)
+40 DO SET(IBLINE)
SET IBLINE=""
+41 SET IBL="Group Name: "
SET IBY=$PIECE(IB90,U,1)
SET IBLINE=$$SETL("",IBY,IBL,16,58)
DO SET(IBLINE)
SET IBLINE=""
+42 IF $TRANSLATE($EXTRACT(IBY,59,80)," ","")'=""
SET IBLINE=$$SETL("",$EXTRACT(IBY,59,80),"",16,22)
DO SET(IBLINE)
SET IBLINE=""
+43 ;
+44 SET IBL="Group Number: "
SET IBY=$PIECE(IB90,U,2)
SET IBLINE=$$SETL("",IBY,IBL,16,55)
+45 ;;Daou/EEN - Adding BIN and PCN
+46 DO SET(IBLINE)
SET IBLINE=""
+47 SET IBL="BIN: "
SET IBY=$PIECE(IB40,U,10)
SET IBLINE=$$SETL("",IBY,IBL,16,10)
+48 SET IBL="Require UR: "
SET IBY=$$YN($PIECE(IB40,U,4))
SET IBLINE=$$SETL(IBLINE,IBY,IBL,63,3)
+49 DO SET(IBLINE)
SET IBLINE=""
+50 SET IBL="PCN: "
SET IBY=$PIECE(IB40,U,11)
SET IBLINE=$$SETL("",IBY,IBL,16,20)
+51 SET IBL="Require Amb Cert: "
SET IBY=$$YN($PIECE(IB40,U,6))
SET IBLINE=$$SETL(IBLINE,IBY,IBL,63,3)
+52 DO SET(IBLINE)
SET IBLINE=""
+53 SET IBL="Require Pre-Cert: "
SET IBY=$$YN($PIECE(IB40,U,5))
SET IBLINE=$$SETL(IBLINE,IBY,IBL,63,3)
+54 DO SET(IBLINE)
SET IBLINE=""
+55 ;
+56 SET IBL="Type of Plan: "
SET IBY=$PIECE($GET(^IBE(355.1,+$PIECE(IB40,U,9),0)),U,1)
SET IBLINE=$$SETL("",IBY,IBL,16,25)
+57 SET IBL="Exclude Pre-Cond: "
SET IBY=$$YN($PIECE(IB40,U,7))
SET IBLINE=$$SETL(IBLINE,IBY,IBL,63,3)
+58 DO SET(IBLINE)
SET IBLINE=""
+59 SET IBL="Benefits Assignable: "
SET IBY=$$YN($PIECE(IB40,U,8))
SET IBLINE=$$SETL(IBLINE,IBY,IBL,63,3)
+60 DO SET(IBLINE)
SET IBLINE=""
+61 ;
+62 DO SET(" ")
SET IBY=$JUSTIFY("",26)_"Policy/Subscriber Information"
DO SET(IBY,"B")
SET IBLINE=""
+63 SET IBL="Whose Insurance: "
SET IBY=$$EXPAND^IBTRE(355.33,60.05,$PIECE(IB60,U,5))
SET IBLINE=$$SETL("",IBY,IBL,18,7)
+64 SET IBL="Effective: "
SET IBY=$$DATE($PIECE(IB60,U,2))
SET IBLINE=$$SETL(IBLINE,IBY,IBL,62,8)
+65 DO SET(IBLINE)
SET IBLINE=""
+66 SET IBL="Expiration: "
SET IBY=$$DATE($PIECE(IB60,U,3))
SET IBLINE=$$SETL(IBLINE,IBY,IBL,62,13)
+67 DO SET(IBLINE)
SET IBLINE=""
+68 SET IBL="Subscriber Name: "
SET IBY=$PIECE(IB91,U,1)
SET IBLINE=$$SETL("",IBY,IBL,18,56)
DO SET(IBLINE)
SET IBLINE=""
+69 IF $TRANSLATE($EXTRACT(IBY,57,130)," ","")'=""
SET IBLINE=$$SETL("",$EXTRACT(IBY,57,130),"",18,56)
DO SET(IBLINE)
SET IBLINE=""
+70 IF $TRANSLATE($EXTRACT(IBY,113,130)," ","")'=""
SET IBLINE=$$SETL("",$EXTRACT(IBY,113,130),"",18,18)
DO SET(IBLINE)
SET IBLINE=""
+71 SET IBL="Subscriber Id: "
SET IBY=$PIECE(IB90,U,3)
SET IBLINE=$$SETL("",IBY,IBL,18,56)
DO SET(IBLINE)
SET IBLINE=""
+72 IF $TRANSLATE($EXTRACT(IBY,57,80)," ","")'=""
SET IBLINE=$$SETL("",$EXTRACT(IBY,57,80),"",18,24)
DO SET(IBLINE)
SET IBLINE=""
+73 ;
+74 SET IBL="Relationship: "
SET IBY=$$EXPAND^IBTRE(355.33,60.06,$PIECE(IB60,U,6))
SET IBLINE=$$SETL("",IBY,IBL,18,16)
+75 SET IBL="Primary Provider: "
SET IBY=$PIECE(IB60,U,10)
SET IBLINE=$$SETL(IBLINE,IBY,IBL,62,17)
+76 DO SET(IBLINE)
SET IBLINE=""
+77 SET IBL="Provider Phone: "
SET IBY=$PIECE(IB60,U,11)
SET IBLINE=$$SETL(IBLINE,IBY,IBL,62,16)
+78 DO SET(IBLINE)
SET IBLINE=""
+79 IF $PIECE(IB60,U,6)'="01"!($PIECE(IB60,U,8)'="")
SET IBL="Insured's DOB: "
SET IBY=$$DATE($PIECE(IB60,U,8))
SET IBLINE=$$SETL("",IBY,IBL,18,8)
+80 SET IBL="Coord of Benefits: "
SET IBY=$$EXPAND^IBTRE(355.33,60.12,$PIECE(IB60,U,12))
SET IBLINE=$$SETL(IBLINE,IBY,IBL,62,16)
+81 DO SET(IBLINE)
SET IBLINE=""
+82 ;
+83 ; IB*2*452 - esg - display Pharmacy fields if they exist
IF $PIECE(IB60,U,15)'=""!($PIECE(IB60,U,16)'="")
Begin DoDot:1
+84 SET IBL="Rx Relationship: "
SET IBY=""
+85 NEW G
SET G=+$PIECE(IB60,U,15)
+86 IF G
SET IBY=$$GET1^DIQ(9002313.19,G_",",.01)_" - "_$$GET1^DIQ(9002313.19,G_",",.02)
+87 SET IBLINE=$$SETL("",IBY,IBL,18,20)
+88 SET IBL="Rx Person Code: "
SET IBY=$PIECE(IB60,U,16)
SET IBLINE=$$SETL(IBLINE,IBY,IBL,62,10)
+89 DO SET(IBLINE)
SET IBLINE=""
+90 QUIT
End DoDot:1
+91 ;
+92 IF $PIECE(IB62,U,1)'=""
SET IBL="Patient Id: "
SET IBY=$PIECE(IB62,U,1)
SET IBLINE=$$SETL(IBLINE,IBY,IBL,62,13)
+93 IF IBLINE'=""
DO SET(IBLINE)
SET IBLINE=""
+94 ;
+95 IF '$PIECE(IB61,U,1)
DO SET(" ")
SET IBL="Employer Sponsored Group Health Plan?: "
SET IBY=$$YN($PIECE(IB61,U,1))
SET IBLINE=$$SETL("",IBY,IBL,40,3)
DO SET(IBLINE)
SET IBLINE=""
GOTO NXT
+96 ;
+97 DO ADDR(61,6)
+98 DO SET(" ")
SET IBY=$JUSTIFY("",24)_"Subscriber's Employer Information"
DO SET(IBY,"B")
SET IBLINE=""
+99 SET IBL="Employer Sponsored?: "
SET IBY=$$YN($PIECE(IB61,U,1))
SET IBLINE=$$SETL("",IBY,IBL,22,3)
+100 SET IBL="Employment Status: "
SET IBY=$$EXPAND^IBTRE(355.33,61.03,$PIECE(IB61,U,3))
SET IBLINE=$$SETL(IBLINE,IBY,IBL,64,15)
+101 DO SET(IBLINE)
SET IBLINE=""
+102 SET IBL="Claim to Employer: "
SET IBY=$$YN($PIECE(IB61,U,5))
SET IBLINE=$$SETL("",IBY,IBL,22,3)
+103 SET IBL="Retirement Date: "
SET IBY=$$DATE($PIECE(IB61,U,4))
SET IBLINE=$$SETL(IBLINE,IBY,IBL,64,8)
+104 DO SET(IBLINE)
SET IBLINE=""
+105 SET IBL="Employer Name: "
SET IBY=$PIECE(IB61,U,2)
SET IBLINE=$$SETL("",IBY,IBL,16,30)
+106 SET IBL="Employer Phone: "
SET IBY=$PIECE(IB61,U,12)
SET IBLINE=$$SETL(IBLINE,IBY,IBL,64,15)
+107 DO SET(IBLINE)
SET IBLINE=""
+108 SET IBL="Address: "
SET IBY=ADDR(1)
SET IBLINE=$$SETL(IBLINE,IBY,IBL,16,64)
+109 DO SET(IBLINE)
SET IBLINE=""
+110 FOR IBI=2:1:9
SET IBL=""
SET IBY=$GET(ADDR(IBI))
if IBY=""
QUIT
SET IBLINE=$$SETL(IBLINE,IBY,IBL,16,64)
DO SET(IBLINE)
SET IBLINE=""
+111 ;
NXT ;
+1 DO SET(" ")
SET IBY=$JUSTIFY("",26)_"Buffer Entry Information"
DO SET(IBY,"B")
SET IBLINE=""
+2 SET IBL="Date Entered: "
SET IBY=$$FMTE^XLFDT($PIECE(IB0,U,1),2)
SET IBLINE=$$SETL("",IBY,IBL,18,17)
+3 SET IBL="Date Verified: "
SET IBY=$$FMTE^XLFDT($PIECE(IB0,U,10),2)
SET IBLINE=$$SETL(IBLINE,IBY,IBL,62,17)
+4 DO SET(IBLINE)
SET IBLINE=""
+5 SET IBL="Entered By: "
SET IBY=$$EXPAND^IBTRE(355.33,.02,$PIECE(IB0,U,2))
SET IBLINE=$$SETL("",IBY,IBL,18,40)
+6 SET IBL="Verified By: "
SET IBY=$$EXPAND^IBTRE(355.33,.11,$PIECE(IB0,U,11))
SET IBLINE=$$SETL(IBLINE,IBY,IBL,62,17)
+7 DO SET(IBLINE)
SET IBLINE=""
+8 ; service date / service code
+9 DO SERVLN(IBBUFDA,.SRVARRAY)
IF SRVARRAY
FOR IBI=1:1:SRVARRAY
DO SET(SRVARRAY(IBI))
+10 KILL SRVARRAY
+11 ;
+12 ; eIIV trace #
SET IBLINE=$$TRACE(IBLINE,IBBUFDA)
+13 SET IBL="eIV Processed Date: "
SET IBY=$SELECT($PIECE(IB0,U,15)="":"",1:$$FMTE^XLFDT($PIECE(IB0,U,15),"2M"))
+14 SET IBLINE=$$SETL(IBLINE,IBY,IBL,62,17)
+15 DO SET(IBLINE)
SET IBLINE=""
+16 SET IBL="Source: "
SET IBY=$$EXPAND^IBTRE(355.33,.03,$PIECE(IB0,U,3))
+17 SET IBLINE=$$SETL("",IBY,IBL,18,17)
+18 DO SET(IBLINE)
SET IBLINE=""
+19 ;
+20 ; Call another routine for continuation of list build
+21 DO BLD^IBCNBLE1
+22 ;
BLDQ QUIT
+1 ;
+2 ;
SETL(LINE,DATA,LABEL,COL,LNG) ;
+1 SET LINE=LINE_$JUSTIFY("",(COL-$LENGTH(LABEL)-$LENGTH(LINE)))_LABEL_$EXTRACT(DATA,1,LNG)
+2 QUIT LINE
+3 ;
SET(LINE,SPEC) ;
+1 SET VALMCNT=VALMCNT+1
+2 SET ^TMP("IBCNBLE",$JOB,VALMCNT,0)=LINE
+3 IF $GET(SPEC)="B"
DO CNTRL^VALM10(VALMCNT,1,80,IOINHI,IOINORM)
+4 QUIT
+5 ;
DATE(X) ;
+1 NEW Y
SET Y=""
IF X?7N.E
SET Y=$EXTRACT(X,4,5)_"/"_$EXTRACT(X,6,7)_"/"_$EXTRACT(X,2,3)
+2 QUIT Y
+3 ;
YN(X) ;
+1 NEW Y
SET X=$GET(X)
SET Y=$SELECT(X=1:"Yes",X=0:"No",1:"")
+2 QUIT Y
+3 ;
ADDR(NODE,FLD) ; format address for output
+1 NEW IBY,IB0,IBCS,IBST,IBZIP,IBJ,IBZ,IBX
KILL ADDR
SET ADDR(1)=""
+2 SET IB0=$GET(^IBA(355.33,IBBUFDA,NODE))
+3 SET IBCS=$PIECE(IB0,U,FLD+3)
SET IBST=$PIECE($GET(^DIC(5,+$PIECE(IB0,U,FLD+4),0)),U,2)
SET IBZIP=$PIECE(IB0,U,FLD+5)
+4 SET IBZIP=$EXTRACT(IBZIP,1,5)_$SELECT($EXTRACT(IBZIP,6,9)'="":"-"_$EXTRACT(IBZIP,6,9),1:"")
+5 SET IBST=IBST_$SELECT(IBST=""!(IBZIP=""):"",1:" ")_IBZIP
+6 SET IBCS=IBCS_$SELECT(IBCS=""!(IBST=""):"",1:", ")_IBST
+7 ;
+8 SET IBJ=1
FOR IBY=$PIECE(IB0,U,FLD),$PIECE(IB0,U,(FLD+1)),$PIECE(IB0,U,(FLD+2)),IBCS
IF IBY'=""
SET IBX=$GET(ADDR(IBJ))
SET IBZ=", "
Begin DoDot:1
+9 if IBX=""
SET IBZ=""
if ($LENGTH(IBX)+2+$LENGTH(IBY))>64
SET IBZ=""
SET IBJ=IBJ+1
+10 SET ADDR(IBJ)=$GET(ADDR(IBJ))_IBZ_IBY
End DoDot:1
+11 QUIT
+12 ;
TRACE(IBLINE,IBBUFDA) ; Add the eIV Trace Number to the display
+1 ;IB*743/CKB - added variable IVPRDT, put variables in alphabetical order
+2 ; Only display the Trace # when field (#355.33,.15) is populated
+3 NEW IBL,IBY,IVPRDT,RESP,TRACENUM
+4 IF '$GET(IBBUFDA)
GOTO TRACEX
+5 ; response ien
SET RESP=$ORDER(^IBCN(365,"AF",IBBUFDA,""),-1)
+6 SET TRACENUM=""
+7 ;IB*743
SET IVPRDT=$$GET1^DIQ(355.33,IBBUFDA_",",.15,"I")
+8 ; trace# field
IF RESP
SET TRACENUM=$$GET1^DIQ(365,RESP_",",.09,"I")
+9 ;I RESP S TRACENUM=$P($G(^IBCN(365,RESP,0)),U,9)
+10 ; field label
SET IBL="eIV Trace #: "
+11 ; field data
SET IBY=$SELECT(IVPRDT="":"",1:TRACENUM)
+12 ; add it
SET IBLINE=$$SETL("",IBY,IBL,18,17)
TRACEX ;
+1 QUIT IBLINE
+2 ;
SERVLN(IBBUFDA,SRVARRAY) ; create a service date/service type line for the display
+1 ;IB*743 added IVPRDT
+2 NEW IVPRDT,NODE0,RIEN,SRVCODE,SRVDT,SRVSTR,TQIEN
+3 SET SRVSTR=""
+4 IF '$GET(IBBUFDA)
GOTO SERVLNX
+5 ;IB*2.0*519 Start: Fix retrieving RIEN and TQIEN so display gets correct values
+6 SET RIEN=+$ORDER(^IBCN(365,"AF",IBBUFDA,""))
+7 SET TQIEN=+$ORDER(^IBCN(365.1,"D",IBBUFDA,""),-1)
+8 IF TQIEN=0
SET TQIEN=$PIECE($GET(^IBCN(365,RIEN,0)),U,5)
+9 ;IB*2.0*519 End: Fix retrieving RIEN and TQIEN so display gets correct values
+10 ;
+11 ;IB*743 Service date/code (STC) ONLY applies if (#355.33,.15) is populated
+12 SET IVPRDT=$$GET1^DIQ(355.33,IBBUFDA_",",.15,"I")
+13 SET (SRVDT,SRVCODE)=""
IF TQIEN
IF IVPRDT
Begin DoDot:1
+14 SET NODE0=$GET(^IBCN(365.1,TQIEN,0))
SET SRVCODE=$PIECE(NODE0,U,20)
+15 ;S RIEN=+$O(^IBCN(365,"AF",IBBUFDA,"")) ;IB*2.0*519: RIEN already retrieved above
+16 ; try to get service date from file 365
IF RIEN
SET SRVDT=$PIECE($GET(^IBCN(365,RIEN,1)),U,10)
+17 ; if unsuccessful, get it from file 365.1
IF SRVDT=""
SET SRVDT=$PIECE(NODE0,U,12)
+18 SET SRVSTR="** This response is based on service date "_$SELECT(SRVDT:$$FMTE^XLFDT(SRVDT,"5Z"),1:"UNKNOWN")
+19 SET SRVSTR=SRVSTR_" and service type: "_$SELECT(SRVCODE:$PIECE($GET(^IBE(365.013,SRVCODE,0)),U,2),1:"UNKNOWN")_" **"
End DoDot:1
SERVLNX ;
+1 DO FSTRNG^IBJU1(SRVSTR,79,.SRVARRAY)
+2 QUIT
