Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCNBLE

IBCNBLE.m

Go to the documentation of this file. 
  1. 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
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1. EN ; - main entry point for list manager display
  1.  N DFN
  1.  D EN^VALM("IBCNB INSURANCE BUFFER ENTRY")
  1.  Q
  1.  ;
  1. HDR ; - header code for list manager display
  1.  N IBX,IB0,VADM,VA,VAERR S IBX=""
  1.  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)
  1.  S VALMHDR(1)=IBX
  1.  S IB0=$G(^IBA(355.33,+$G(IBBUFDA),0))
  1.  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)_")"
  1.  S IBX="Buffer entry created on "_$$DATE(+IB0)_" by "_IBX,IBX=$J("",40-($L(IBX)\2))_IBX
  1.  S VALMHDR(2)=IBX
  1.  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
  1.  S VALMHDR(3)=IBX
  1.  Q
  1.  ;
  1. INIT ; - initialization of list manager screen, ien of record to display required IBBUFDA
  1.  K ^TMP("IBCNBLE",$J)
  1.  I '$G(IBBUFDA) S VALMQUIT="" Q
  1.  S DFN=+$G(^IBA(355.33,IBBUFDA,60))
  1.  D BLD
  1.  Q
  1.  ;
  1. HELP ; - help text for list manager screen
  1.  D FULL^VALM1
  1.  W !!,"This screen displays all data in a Buffer File entry."
  1.  W !!,"The actions allow editing of all data and verification of coverage."
  1.  ; IB*2.0*737/DTG remove verify action reference
  1.  ; W !!,"It is not necessary to use the Verify Entry action, this action is optional."
  1.  ; W !,"If the Verify Entry action is not used, the policy will be automatically flagged"
  1.  ; W !,"as verified when it is Accepted and stored in the main Insurance files."
  1.  ;
  1.  D PAUSE^VALM1 S VALMBCK="R"
  1.  Q
  1.  ;
  1. EXIT ; - exit list manager screen
  1.  K ^TMP("IBCNBLE",$J)
  1.  D CLEAR^VALM1
  1.  Q
  1.  ;
  1. BLD ; display buffer entry
  1.  N DFN,CLIEN,CLDT,IB0,IB20,IB40,IB60,IB61,IB62,IB90,IB91,IBL,IBLINE,ADDR,IBI,IBY,SRVARRAY
  1.  S VALMCNT=0
  1.  S IB0=$G(^IBA(355.33,IBBUFDA,0)),IB20=$G(^IBA(355.33,IBBUFDA,20)),IB40=$G(^IBA(355.33,IBBUFDA,40))
  1.  S IB60=$G(^IBA(355.33,IBBUFDA,60)),IB61=$G(^IBA(355.33,IBBUFDA,61)),IB62=$G(^IBA(355.33,IBBUFDA,62))
  1.  S IB90=$G(^IBA(355.33,IBBUFDA,90)),IB91=$G(^IBA(355.33,IBBUFDA,91))
  1.  ; check if we are coming from appointments view
  1.  I $G(AVIEW) D
  1.  .D SET(" ") S IBY=$J("",26)_"Appointment Information" D SET(IBY,"B") S IBLINE=""
  1.  .S DFN=+IB60
  1.  .S CLIEN="" F  S CLIEN=$O(^TMP($J,"IBCNAPPTS",DFN,CLIEN)) Q:CLIEN=""  D
  1.  ..S CLDT="" F  S CLDT=$O(^TMP($J,"IBCNAPPTS",DFN,CLIEN,CLDT)) Q:CLDT=""  D
  1.  ...S IBL="Clinic: ",IBY=$P($P(^TMP($J,"IBCNAPPTS",DFN,CLIEN,CLDT),U,2),";",2)
  1.  ...S IBLINE=$$SETL(IBLINE,IBY,IBL,10,30)
  1.  ...S IBL="Appt. D/T: ",IBY=$$FMTE^XLFDT(CLDT)
  1.  ...S IBLINE=$$SETL(IBLINE,IBY,IBL,50,22)
  1.  ...D SET(IBLINE) S IBLINE=""
  1.  ...Q
  1.  ..Q
  1.  .Q
  1.  ;
  1.  I +$P(IB0,U,17) D EN^IBCNBLE2    ; IB*2*435 - Display e-Pharmacy ELIG response data
  1.  ;
  1.  D SET(" ") S IBY=$J("",26)_"Insurance Company Information" D SET(IBY,"B") S IBLINE=""
  1.  S IBL="Name: ",IBY=$P(IB20,U,1) S IBLINE=$$SETL("",IBY,IBL,10,30)
  1.  S IBL="Reimburse?: ",IBY=$$EXPAND^IBTRE(355.33,20.05,$P(IB20,U,5)) S IBLINE=$$SETL(IBLINE,IBY,IBL,57,20)
  1.  D SET(IBLINE) S IBLINE=""
  1.  S IBL="Phone: ",IBY=$P(IB20,U,2) S IBLINE=$$SETL(IBLINE,IBY,IBL,10,20)
  1.  S IBL="Billing Phone: ",IBY=$P(IB20,U,3) S IBLINE=$$SETL(IBLINE,IBY,IBL,57,20)
  1.  D SET(IBLINE) S IBLINE=""
  1.  S IBL="Precert Phone: ",IBY=$P(IB20,U,4) S IBLINE=$$SETL(IBLINE,IBY,IBL,57,20)
  1.  D SET(IBLINE) S IBLINE=""
  1.  ;IB*687/ckb Changed "Remote Query From" to "Received From"
  1.  S IBL="Received From: ",IBY=$$EXTERNAL^DILFD(355.33,.14,"",$P(IB0,"^",14)) S IBLINE=$$SETL(IBLINE,IBY,IBL,57,20)
  1.  D SET(IBLINE) S IBLINE="" D ADDR(21,1)
  1.  S IBL="Address: ",IBY=ADDR(1) S IBLINE=$$SETL(IBLINE,IBY,IBL,10,69)
  1.  D SET(IBLINE) S IBLINE=""
  1.  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=""
  1.  D SET(" ") S IBY=$J("",29)_"Group/Plan Information" D SET(IBY,"B") S IBLINE=""
  1.  S IBL="Group Plan?: ",IBY=$$YN($P(IB40,U,1)) S IBLINE=$$SETL("",IBY,IBL,16,3)
  1.  D SET(IBLINE) S IBLINE=""
  1.  S IBL="Group Name: ",IBY=$P(IB90,U,1) S IBLINE=$$SETL("",IBY,IBL,16,58) D SET(IBLINE) S IBLINE=""
  1.  I $TR($E(IBY,59,80)," ","")'="" S IBLINE=$$SETL("",$E(IBY,59,80),"",16,22) D SET(IBLINE) S IBLINE=""
  1.  ;
  1.  S IBL="Group Number: ",IBY=$P(IB90,U,2) S IBLINE=$$SETL("",IBY,IBL,16,55)
  1.  ;;Daou/EEN - Adding BIN and PCN
  1.  D SET(IBLINE) S IBLINE=""
  1.  S IBL="BIN: ",IBY=$P(IB40,U,10) S IBLINE=$$SETL("",IBY,IBL,16,10)
  1.  S IBL="Require UR: ",IBY=$$YN($P(IB40,U,4)) S IBLINE=$$SETL(IBLINE,IBY,IBL,63,3)
  1.  D SET(IBLINE) S IBLINE=""
  1.  S IBL="PCN: ",IBY=$P(IB40,U,11) S IBLINE=$$SETL("",IBY,IBL,16,20)
  1.  S IBL="Require Amb Cert: ",IBY=$$YN($P(IB40,U,6)) S IBLINE=$$SETL(IBLINE,IBY,IBL,63,3)
  1.  D SET(IBLINE) S IBLINE=""
  1.  S IBL="Require Pre-Cert: ",IBY=$$YN($P(IB40,U,5)) S IBLINE=$$SETL(IBLINE,IBY,IBL,63,3)
  1.  D SET(IBLINE) S IBLINE=""
  1.  ;
  1.  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)
  1.  S IBL="Exclude Pre-Cond: ",IBY=$$YN($P(IB40,U,7)) S IBLINE=$$SETL(IBLINE,IBY,IBL,63,3)
  1.  D SET(IBLINE) S IBLINE=""
  1.  S IBL="Benefits Assignable: ",IBY=$$YN($P(IB40,U,8)) S IBLINE=$$SETL(IBLINE,IBY,IBL,63,3)
  1.  D SET(IBLINE) S IBLINE=""
  1.  ;
  1.  D SET(" ") S IBY=$J("",26)_"Policy/Subscriber Information" D SET(IBY,"B") S IBLINE=""
  1.  S IBL="Whose Insurance: ",IBY=$$EXPAND^IBTRE(355.33,60.05,$P(IB60,U,5)) S IBLINE=$$SETL("",IBY,IBL,18,7)
  1.  S IBL="Effective: ",IBY=$$DATE($P(IB60,U,2)) S IBLINE=$$SETL(IBLINE,IBY,IBL,62,8)
  1.  D SET(IBLINE) S IBLINE=""
  1.  S IBL="Expiration: ",IBY=$$DATE($P(IB60,U,3)) S IBLINE=$$SETL(IBLINE,IBY,IBL,62,13)
  1.  D SET(IBLINE) S IBLINE=""
  1.  S IBL="Subscriber Name: ",IBY=$P(IB91,U,1) S IBLINE=$$SETL("",IBY,IBL,18,56) D SET(IBLINE) S IBLINE=""
  1.  I $TR($E(IBY,57,130)," ","")'="" S IBLINE=$$SETL("",$E(IBY,57,130),"",18,56) D SET(IBLINE) S IBLINE=""
  1.  I $TR($E(IBY,113,130)," ","")'="" S IBLINE=$$SETL("",$E(IBY,113,130),"",18,18) D SET(IBLINE) S IBLINE=""
  1.  S IBL="Subscriber Id: ",IBY=$P(IB90,U,3) S IBLINE=$$SETL("",IBY,IBL,18,56) D SET(IBLINE) S IBLINE=""
  1.  I $TR($E(IBY,57,80)," ","")'="" S IBLINE=$$SETL("",$E(IBY,57,80),"",18,24) D SET(IBLINE) S IBLINE=""
  1.  ;
  1.  S IBL="Relationship: ",IBY=$$EXPAND^IBTRE(355.33,60.06,$P(IB60,U,6)) S IBLINE=$$SETL("",IBY,IBL,18,16)
  1.  S IBL="Primary Provider: ",IBY=$P(IB60,U,10) S IBLINE=$$SETL(IBLINE,IBY,IBL,62,17)
  1.  D SET(IBLINE) S IBLINE=""
  1.  S IBL="Provider Phone: ",IBY=$P(IB60,U,11) S IBLINE=$$SETL(IBLINE,IBY,IBL,62,16)
  1.  D SET(IBLINE) S IBLINE=""
  1.  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)
  1.  S IBL="Coord of Benefits: ",IBY=$$EXPAND^IBTRE(355.33,60.12,$P(IB60,U,12)) S IBLINE=$$SETL(IBLINE,IBY,IBL,62,16)
  1.  D SET(IBLINE) S IBLINE=""
  1.  ;
  1.  I $P(IB60,U,15)'=""!($P(IB60,U,16)'="") D      ; IB*2*452 - esg - display Pharmacy fields if they exist
  1.  . S IBL="Rx Relationship: ",IBY=""
  1.  . N G S G=+$P(IB60,U,15)
  1.  . I G S IBY=$$GET1^DIQ(9002313.19,G_",",.01)_" - "_$$GET1^DIQ(9002313.19,G_",",.02)
  1.  . S IBLINE=$$SETL("",IBY,IBL,18,20)
  1.  . S IBL="Rx Person Code: ",IBY=$P(IB60,U,16),IBLINE=$$SETL(IBLINE,IBY,IBL,62,10)
  1.  . D SET(IBLINE) S IBLINE=""
  1.  . Q
  1.  ;
  1.  I $P(IB62,U,1)'="" S IBL="Patient Id: ",IBY=$P(IB62,U,1) S IBLINE=$$SETL(IBLINE,IBY,IBL,62,13)
  1.  I IBLINE'="" D SET(IBLINE) S IBLINE=""
  1.  ;
  1.  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
  1.  ;
  1.  D ADDR(61,6)
  1.  D SET(" ") S IBY=$J("",24)_"Subscriber's Employer Information" D SET(IBY,"B") S IBLINE=""
  1.  S IBL="Employer Sponsored?: ",IBY=$$YN($P(IB61,U,1)) S IBLINE=$$SETL("",IBY,IBL,22,3)
  1.  S IBL="Employment Status: ",IBY=$$EXPAND^IBTRE(355.33,61.03,$P(IB61,U,3)) S IBLINE=$$SETL(IBLINE,IBY,IBL,64,15)
  1.  D SET(IBLINE) S IBLINE=""
  1.  S IBL="Claim to Employer: ",IBY=$$YN($P(IB61,U,5)) S IBLINE=$$SETL("",IBY,IBL,22,3)
  1.  S IBL="Retirement Date: ",IBY=$$DATE($P(IB61,U,4)) S IBLINE=$$SETL(IBLINE,IBY,IBL,64,8)
  1.  D SET(IBLINE) S IBLINE=""
  1.  S IBL="Employer Name: ",IBY=$P(IB61,U,2) S IBLINE=$$SETL("",IBY,IBL,16,30)
  1.  S IBL="Employer Phone: ",IBY=$P(IB61,U,12) S IBLINE=$$SETL(IBLINE,IBY,IBL,64,15)
  1.  D SET(IBLINE) S IBLINE=""
  1.  S IBL="Address: ",IBY=ADDR(1) S IBLINE=$$SETL(IBLINE,IBY,IBL,16,64)
  1.  D SET(IBLINE) S IBLINE=""
  1.  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=""
  1.  ;
  1. NXT ;
  1.  D SET(" ") S IBY=$J("",26)_"Buffer Entry Information" D SET(IBY,"B") S IBLINE=""
  1.  S IBL="Date Entered: ",IBY=$$FMTE^XLFDT($P(IB0,U,1),2) S IBLINE=$$SETL("",IBY,IBL,18,17)
  1.  S IBL="Date Verified: ",IBY=$$FMTE^XLFDT($P(IB0,U,10),2) S IBLINE=$$SETL(IBLINE,IBY,IBL,62,17)
  1.  D SET(IBLINE) S IBLINE=""
  1.  S IBL="Entered By: ",IBY=$$EXPAND^IBTRE(355.33,.02,$P(IB0,U,2)) S IBLINE=$$SETL("",IBY,IBL,18,40)
  1.  S IBL="Verified By: ",IBY=$$EXPAND^IBTRE(355.33,.11,$P(IB0,U,11)) S IBLINE=$$SETL(IBLINE,IBY,IBL,62,17)
  1.  D SET(IBLINE) S IBLINE=""
  1.  ; service date / service code
  1.  D SERVLN(IBBUFDA,.SRVARRAY) I SRVARRAY F IBI=1:1:SRVARRAY D SET(SRVARRAY(IBI))
  1.  K SRVARRAY
  1.  ;
  1.  S IBLINE=$$TRACE(IBLINE,IBBUFDA)       ; eIIV trace #
  1.  S IBL="eIV Processed Date: ",IBY=$S($P(IB0,U,15)="":"",1:$$FMTE^XLFDT($P(IB0,U,15),"2M"))
  1.  S IBLINE=$$SETL(IBLINE,IBY,IBL,62,17)
  1.  D SET(IBLINE) S IBLINE=""
  1.  S IBL="Source: ",IBY=$$EXPAND^IBTRE(355.33,.03,$P(IB0,U,3))
  1.  S IBLINE=$$SETL("",IBY,IBL,18,17)
  1.  D SET(IBLINE) S IBLINE=""
  1.  ;
  1.  ; Call another routine for continuation of list build
  1.  D BLD^IBCNBLE1
  1.  ;
  1. BLDQ Q
  1.  ;
  1.  ;
  1. SETL(LINE,DATA,LABEL,COL,LNG) ;
  1.  S LINE=LINE_$J("",(COL-$L(LABEL)-$L(LINE)))_LABEL_$E(DATA,1,LNG)
  1.  Q LINE
  1.  ;
  1. SET(LINE,SPEC) ;
  1.  S VALMCNT=VALMCNT+1
  1.  S ^TMP("IBCNBLE",$J,VALMCNT,0)=LINE
  1.  I $G(SPEC)="B" D CNTRL^VALM10(VALMCNT,1,80,IOINHI,IOINORM)
  1.  Q
  1.  ;
  1. DATE(X) ;
  1.  N Y S Y="" I X?7N.E S Y=$E(X,4,5)_"/"_$E(X,6,7)_"/"_$E(X,2,3)
  1.  Q Y
  1.  ;
  1. YN(X) ;
  1.  N Y S X=$G(X),Y=$S(X=1:"Yes",X=0:"No",1:"")
  1.  Q Y
  1.  ;
  1. ADDR(NODE,FLD) ; format address for output
  1.  N IBY,IB0,IBCS,IBST,IBZIP,IBJ,IBZ,IBX K ADDR S ADDR(1)=""
  1.  S IB0=$G(^IBA(355.33,IBBUFDA,NODE))
  1.  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)
  1.  S IBZIP=$E(IBZIP,1,5)_$S($E(IBZIP,6,9)'="":"-"_$E(IBZIP,6,9),1:"")
  1.  S IBST=IBST_$S(IBST=""!(IBZIP=""):"",1:"  ")_IBZIP
  1.  S IBCS=IBCS_$S(IBCS=""!(IBST=""):"",1:", ")_IBST
  1.  ;
  1.  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
  1.  . S:IBX="" IBZ="" S:($L(IBX)+2+$L(IBY))>64 IBZ="",IBJ=IBJ+1
  1.  . S ADDR(IBJ)=$G(ADDR(IBJ))_IBZ_IBY
  1.  Q
  1.  ;
  1. TRACE(IBLINE,IBBUFDA) ; Add the eIV Trace Number to the display
  1.  ;IB*743/CKB - added variable IVPRDT, put variables in alphabetical order
  1.  ;  Only display the Trace # when field (#355.33,.15) is populated
  1.  NEW IBL,IBY,IVPRDT,RESP,TRACENUM
  1.  I '$G(IBBUFDA) G TRACEX
  1.  S RESP=$O(^IBCN(365,"AF",IBBUFDA,""),-1)          ; response ien
  1.  S TRACENUM=""
  1.  S IVPRDT=$$GET1^DIQ(355.33,IBBUFDA_",",.15,"I") ;IB*743
  1.  I RESP S TRACENUM=$$GET1^DIQ(365,RESP_",",.09,"I") ; trace# field
  1.  ;I RESP S TRACENUM=$P($G(^IBCN(365,RESP,0)),U,9)
  1.  S IBL="eIV Trace #: "                              ; field label
  1.  S IBY=$S(IVPRDT="":"",1:TRACENUM)                  ; field data
  1.  S IBLINE=$$SETL("",IBY,IBL,18,17)             ; add it
  1. TRACEX ;
  1.  Q IBLINE
  1.  ;
  1. SERVLN(IBBUFDA,SRVARRAY) ; create a service date/service type line for the display
  1.  ;IB*743 added IVPRDT
  1.  N IVPRDT,NODE0,RIEN,SRVCODE,SRVDT,SRVSTR,TQIEN
  1.  S SRVSTR=""
  1.  I '$G(IBBUFDA) G SERVLNX
  1.  ;IB*2.0*519 Start: Fix retrieving RIEN and TQIEN so display gets correct values
  1.  S RIEN=+$O(^IBCN(365,"AF",IBBUFDA,""))
  1.  S TQIEN=+$O(^IBCN(365.1,"D",IBBUFDA,""),-1)
  1.  I TQIEN=0 S TQIEN=$P($G(^IBCN(365,RIEN,0)),U,5)
  1.  ;IB*2.0*519 End: Fix retrieving RIEN and TQIEN so display gets correct values
  1.  ;
  1.  ;IB*743 Service date/code (STC) ONLY applies if (#355.33,.15) is populated
  1.  S IVPRDT=$$GET1^DIQ(355.33,IBBUFDA_",",.15,"I")
  1.  S (SRVDT,SRVCODE)="" I TQIEN,IVPRDT D
  1.  .S NODE0=$G(^IBCN(365.1,TQIEN,0)),SRVCODE=$P(NODE0,U,20)
  1.  .;S RIEN=+$O(^IBCN(365,"AF",IBBUFDA,""))  ;IB*2.0*519: RIEN already retrieved above
  1.  .I RIEN S SRVDT=$P($G(^IBCN(365,RIEN,1)),U,10) ; try to get service date from file 365
  1.  .I SRVDT="" S SRVDT=$P(NODE0,U,12) ; if unsuccessful, get it from file 365.1
  1.  .S SRVSTR="** This response is based on service date "_$S(SRVDT:$$FMTE^XLFDT(SRVDT,"5Z"),1:"UNKNOWN")
  1.  .S SRVSTR=SRVSTR_" and service type: "_$S(SRVCODE:$P($G(^IBE(365.013,SRVCODE,0)),U,2),1:"UNKNOWN")_" **"
  1. SERVLNX ;
  1.  D FSTRNG^IBJU1(SRVSTR,79,.SRVARRAY)
  1.  Q