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

IBCNSP.m

Go to the documentation of this file.
  1. IBCNSP ;ALB/AAS - INSURANCE MANAGEMENT - EXPANDED POLICY ;05-MAR-1993
  1. ;;2.0;INTEGRATED BILLING;**6,28,43,52,85,251,363,371,416,497,516,528,549,602**;21-MAR-94;Build 22
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. % ;
  1. EN ; -- main entry point for IBCNS EXPANDED POLICY
  1. N IB1ST
  1. K VALMQUIT,IBPPOL,IBTOP
  1. S IBTOP="IBCNSP"
  1. D EN^VALM("IBCNS EXPANDED POLICY")
  1. Q
  1. ;
  1. HDR ; -- header code
  1. N DOD,IBDOB,IBNAME,W,X,Y,Z ; IB*2.0*549 Added DOD
  1. S IBNAME=^DPT(DFN,0) ; Direct global read on file 2 supported by IA 10035
  1. S IBDOB=$P(IBNAME,"^",3)
  1. S IBNAME=$E($P(IBNAME,U),1,20)
  1. ;
  1. ; IB*2.0*549 Shortened 'Expanded Policy Information For ' to 'For: ' below
  1. S VALMHDR(1)="For: "_IBNAME_" "_$P($$PT^IBEFUNC(DFN),U,2)_" "_$$FMTE^XLFDT(IBDOB,"5DZ")
  1. ;
  1. ; IB*2.0*549 Added next 4 lines
  1. S DOD=$$GET1^DIQ(2,DFN_",",.351,"I")
  1. I DOD'="" D
  1. . S DOD=$$FMTE^XLFDT(DOD,"5DZ")
  1. . ;IB*2.0*602/DM display DoD properly with long patient name
  1. . S VALMHDR(1)=VALMHDR(1)_" DoD: "_DOD
  1. S Z=$G(^DPT(DFN,.312,+$P(IBPPOL,U,4),0))
  1. S W=$P($G(^IBA(355.3,+$P(Z,U,18),0)),U,11)
  1. S Y=$E($P($G(^DIC(36,+Z,0)),U),1,20)_" Insurance Company"
  1. S X="** Plan Currently "_$S(W:"Ina",1:"A")_"ctive **"
  1. S VALMHDR(2)=$$SETSTR^VALM1(X,Y,48,29)
  1. Q
  1. ;
  1. INIT ; -- init variables and list array
  1. K VALMQUIT
  1. S VALMCNT=0,VALMBG=1
  1. I '$D(IBPPOL) D PPOL Q:$D(VALMQUIT)
  1. D BLD,HDR
  1. Q
  1. ;
  1. BLD ; -- list builder
  1. K ^TMP("IBCNSVP",$J),^TMP("IBCNSVPDX",$J)
  1. D KILL^VALM10()
  1. N IBCDFND,IBCDFND1,IBCDFND2,IBCDFND4,IBCDFND5,IBCDFND7
  1. S IBCDFND=$G(^DPT(DFN,.312,$P(IBPPOL,U,4),0)),IBCDFND1=$G(^(1)),IBCDFND2=$G(^(2)),IBCDFND4=$G(^(4)),IBCDFND5=$G(^(5)),IBCDFND7=$G(^(7))
  1. ; MRD;IB*2.0*516 - Use $$ZND^IBCNS1 to pull zero node of 2.312.
  1. S IBCDFND=$$ZND^IBCNS1(DFN,$P(IBPPOL,U,4))
  1. S IBCPOL=+$P(IBCDFND,U,18),IBCNS=+IBCDFND,IBCDFN=$P(IBPPOL,U,4)
  1. S IBCPOLD=$G(^IBA(355.3,+$P(IBCDFND,U,18),0)),IBCPOLD1=$G(^(1))
  1. S IBCPOLD2=$G(^IBA(355.3,+$G(IBCPOL),6)) ;; Daou/EEN adding BIN and PCN
  1. S IBCPOLDL=$G(^IBA(355.3,+$G(IBCPOL),2)) ;IB*2*497 new group name and group number locations
  1. ;
  1. D INS^IBCNSP0 ; insurance company
  1. D POLICY^IBCNSP0 ; plan information
  1. D UR ; utilization review info
  1. D EFFECT ; effective dates & source of info
  1. D SUBSC^IBCNSP01 ; subscriber info
  1. D EMP ; subscriber's employer info
  1. D PRV^IBCNSP01 ; subscriber's provider contact info ;IB*2*497
  1. D SPON^IBCNSP0 ; insured person's info
  1. D ID^IBCNSP01 ; ins co ID numbers (IB*2*371)
  1. D PLIM ; plan coverage limitations
  1. D VER^IBCNSP01 ; user/verifier/editor info
  1. ;
  1. ;IB*2.0*549 Removed next line
  1. ;D CONTACT^IBCNSP0 ; last insurance contact
  1. D COMMENT ; comments - policy & plan
  1. D RIDER^IBCNSP01 ; policy rider info
  1. ;
  1. S VALMCNT=+$O(^TMP("IBCNSVP",$J,""),-1)
  1. Q
  1. ;
  1. COMMENT ; -- Comment region
  1. ; Input: DFN - IEN of the currently selected patient
  1. ; IBCPOL -
  1. ; IBPPOL - O node of the selected Patient Policy
  1. ; ^TMP("IBCNSVP",$J) - Current global Array of display lines
  1. ; Output: IB1ST("COMMENT") - 1st line of comments display
  1. ; ^TMP("IBCNSVP",$J) - Updated global Array of display lines
  1. ;
  1. ;IB*2.0*549 Moved Group Plan Comment above Patient Policy Comment. Changed
  1. ; Patient Policy Comment to display the two most recent comments
  1. ; in the patient policy comment multiple (2.342,1.18)
  1. N COMDT,COMIEN,COMCTR,COMSTOP,IBI,IBIIEN,IBL,OFFSET,XX
  1. S IBL=$O(^TMP("IBCNSVP",$J,""),-1)+1,OFFSET=2
  1. S IB1ST("COMMENT")=IBL
  1. ;
  1. ; Display Group Plan Comment
  1. D SET(IBL,OFFSET," Comment -- Group Plan ",IORVON,IORVOFF)
  1. S IBI=0
  1. F S IBI=$O(^IBA(355.3,+IBCPOL,11,IBI)) Q:IBI<1 D
  1. . S IBL=IBL+1
  1. . D SET(IBL,OFFSET," "_$E($G(^IBA(355.3,+IBCPOL,11,IBI,0)),1,80))
  1. S IBL=IBL+1
  1. D SET(IBL,OFFSET," ")
  1. ;
  1. ; Display Last two Patient Policy Comments
  1. S IBIIEN=$P(IBPPOL,"^",4),IBL=IBL+1
  1. D SET(IBL,OFFSET," Comment -- Patient Policy ",IORVON,IORVOFF)
  1. S IBL=IBL+1,XX=" Dt Entered Entered By Method Person Contacted"
  1. S XX=XX_$J("",78-$L(XX))
  1. D SET(IBL,OFFSET,XX,IOUON,IOUOFF)
  1. S COMDT="",(COMCTR,COMSTOP)=0
  1. F D Q:(COMDT="")!COMSTOP
  1. . S COMDT=$O(^DPT(DFN,.312,IBIIEN,13,"B",COMDT),-1)
  1. . Q:COMDT=""
  1. . S COMIEN=""
  1. . F D Q:(COMIEN="")!COMSTOP
  1. . . S COMIEN=$O(^DPT(DFN,.312,IBIIEN,13,"B",COMDT,COMIEN),-1)
  1. . . Q:COMIEN=""
  1. . . S COMCTR=COMCTR+1
  1. . . I COMCTR>2 S COMSTOP=1 Q
  1. . . I COMCTR=2 D
  1. . . . S IBL=IBL+1
  1. . . . D SET(IBL,OFFSET," ")
  1. . . D DISPPPC(.IBL,DFN,IBIIEN,COMIEN) ; Display Patient Policy Comment
  1. ;
  1. ; Add two blank lines at end
  1. S IBL=IBL+1
  1. D SET(IBL,OFFSET," ")
  1. S IBL=IBL+1
  1. D SET(IBL,OFFSET," ")
  1. Q
  1. ;
  1. DISPPPC(IBL,DFN,IBIIEN,COMIEN) ; Display one Patient Policy Comment
  1. ;IB*2.0*549 - Added sub-routine
  1. ; Input: IBL - Current Display Line Counter
  1. ; DFN - IEN of the currently selected patient
  1. ; IBIIEN - ^DPT(DFN,.312,IBIIEN,0) Where IBIIEN is the
  1. ; multiple IEN of the selected patient policy
  1. ; COMIEN - ^DPT(DFN,.312,IBIIEN,13,COMIEN,0) Where
  1. ; COMIEN is the multiple IEN of the selected
  1. ; Patient Policy Comment
  1. ; ^TMP("IBCNSVP",$J) - Current global Array of display lines
  1. ; Output: IBL - Updated Display Line Counter
  1. ; ^TMP("IBCNSVP",$J) - Updated global Array of display lines
  1. N COMDATA,LINE,XX,ZZ
  1. S COMDATA=$$GETONEC^IBCNCH2(DFN,IBIIEN,COMIEN,0,77,0,1)
  1. S LINE=$P(COMDATA,"^",1)_" "
  1. S XX=$P(COMDATA,"^",2),ZZ=$J("",26-$L(XX))
  1. S LINE=LINE_XX_ZZ
  1. S XX=$P(COMDATA,"^",4),ZZ=$J("",11-$L(XX))
  1. S LINE=LINE_XX_ZZ_$P(COMDATA,"^",3),IBL=IBL+1
  1. D SET(IBL,OFFSET,LINE)
  1. S IBL=IBL+1,LINE=" "_$P(COMDATA,"^",8)
  1. D SET(IBL,OFFSET,LINE)
  1. Q
  1. ;
  1. EFFECT ; -- Effective date region
  1. N START,OFFSET
  1. S START=$O(^TMP("IBCNSVP",$J,""),-1)-6 ;ib*2*497 lines need to be displayed alongside UR region
  1. S OFFSET=45
  1. D SET(START,OFFSET-4," Effective Dates & Source ",IORVON,IORVOFF)
  1. D SET(START+1,OFFSET," Effective Date: "_$$DAT1^IBOUTL($P(IBCDFND,U,8)))
  1. D SET(START+2,OFFSET,"Expiration Date: "_$$DAT1^IBOUTL($P(IBCDFND,U,4)))
  1. D SET(START+3,OFFSET," Source of Info: "_$$EXPAND^IBTRE(2.312,1.09,$P($G(IBCDFND1),U,9)))
  1. ;
  1. ;IB*2.0*549 Changed OFFSET-4 to OFFSET-8
  1. ; Changed 'Policy Not Billable' to 'Stop Policy From Billing'
  1. D SET(START+4,OFFSET-9,"Stop Policy From Billing: "_$S($P($G(^DPT(DFN,.312,IBCDFN,3)),"^",4):"YES",1:"NO"))
  1. Q
  1. ;
  1. UR ; -- UR of insurance region
  1. N START,OFFSET
  1. S START=$O(^TMP("IBCNSVP",$J,""),-1)+1,OFFSET=2 ;IB*2*497
  1. D SET(START,OFFSET," Utilization Review Info ",IORVON,IORVOFF)
  1. D SET(START+1,OFFSET," Require UR: "_$$EXPAND^IBTRE(355.3,.05,$P(IBCPOLD,U,5)))
  1. D SET(START+2,OFFSET," Require Amb Cert: "_$$EXPAND^IBTRE(355.3,.12,$P(IBCPOLD,U,12)))
  1. D SET(START+3,OFFSET," Require Pre-Cert: "_$$EXPAND^IBTRE(355.3,.06,$P(IBCPOLD,U,6)))
  1. D SET(START+4,OFFSET," Exclude Pre-Cond: "_$$EXPAND^IBTRE(355.3,.07,$P(IBCPOLD,U,7)))
  1. D SET(START+5,OFFSET,"Benefits Assignable: "_$$EXPAND^IBTRE(355.3,.08,$P(IBCPOLD,U,8)))
  1. D SET(START+6,2," ")
  1. Q
  1. EMP ; -- Insurance Employer Region
  1. ; ib*2*497 move employer lines around
  1. N OFFSET,START,IBADD,COL2
  1. S START=$O(^TMP("IBCNSVP",$J,""),-1)+1,OFFSET=2
  1. D SET(START,OFFSET," Subscriber's Employer Information ",IORVON,IORVOFF)
  1. D SET(START+1,OFFSET,$$RJ^XLFSTR(" Employment Status: ",20)_$$EXPAND^IBTRE(2.312,2.11,$P(IBCDFND2,U,11)))
  1. S COL2=START+1
  1. D SET(START+2,OFFSET,$$RJ^XLFSTR("Employer: ",20)_$P(IBCDFND2,U,9))
  1. D SET(START+3,OFFSET,$$RJ^XLFSTR("Street: ",20)_$P(IBCDFND2,U,2)) S IBADD=1
  1. I $P(IBCDFND2,U,3)'="" D SET(START+4,OFFSET,$$RJ^XLFSTR("Street 2: ",20)_$P(IBCDFND2,U,3)) S IBADD=2
  1. I $P(IBCDFND2,U,4)'="" D SET(START+5,OFFSET,$$RJ^XLFSTR("Street 3: ",20)_$P(IBCDFND2,U,4)) S IBADD=3
  1. D SET(START+3+IBADD,OFFSET,$$RJ^XLFSTR("City/State: ",20)_$E($P(IBCDFND2,U,5),1,15)_$S($P(IBCDFND2,U,5)="":"",1:", ")_$P($G(^DIC(5,+$P(IBCDFND2,U,6),0)),U,2)_" "_$E($P(IBCDFND2,U,7),1,5))
  1. D SET(START+4+IBADD,OFFSET,$$RJ^XLFSTR("Phone: ",20)_$P(IBCDFND2,U,8))
  1. D SET(START+5+IBADD,OFFSET," ") ; ib*2*497 only 1 blank line to end the section
  1. ;
  1. S START=COL2,OFFSET=40
  1. D SET(START,OFFSET,"Emp Sponsored Plan: "_$S(+$P(IBCDFND2,U,10):"Yes",1:"No"))
  1. D SET(START+1,OFFSET,"Claims to Employer: "_$S(+IBCDFND2:"Yes, Send to Employer",1:"No, Send to Insurance Company"))
  1. D SET(START+2,OFFSET," Retirement Date: "_$$DAT1^IBOUTL($P(IBCDFND2,U,12)))
  1. ;
  1. EMPQ Q
  1. ;
  1. PLIM ; plan coverage limitations/plan limitation category display
  1. N START,END S START=$O(^TMP("IBCNSVP",$J,""),-1)+1
  1. S IB1ST("PLIM")=START
  1. D LIMBLD^IBCNSC41(START,2)
  1. S END=$O(^TMP("IBCNSVP",$J,""),-1) ; last line constructed
  1. D SET(END+1,2," ") ; 2 blank lines to end this section
  1. D SET(END+2,2," ")
  1. PLIMX ;
  1. Q
  1. ;
  1. HELP ; -- help code
  1. S X="?" D DISP^XQORM1 W !!
  1. Q
  1. ;
  1. EXIT ; -- exit code
  1. K IBPPOL,VALMQUIT,IBCNS,IBCDFN,IBCPOL,IBCPOLD,IBCPOLD1,IBCPOLD2,IBCPOLDL,IBCDFND,IBCDFND1,IBCDFND2,IBVPCLBG,IBVPCLEN
  1. D CLEAN^VALM10,CLEAR^VALM1
  1. Q
  1. ;
  1. EXPND ; -- expand code
  1. Q
  1. ;
  1. PPOL ; -- select patient, select policy
  1. I '$D(DFN) D G:$D(VALMQUIT) PPOLQ
  1. .S DIC="^DPT(",DIC(0)="AEQMN" D ^DIC
  1. .S DFN=+Y
  1. I $G(DFN)<1 S VALMQUIT="" G PPOLQ
  1. ;
  1. I '$O(^DPT(DFN,.312,0)) W !!,"Patient doesn't have Insurance" K DFN G PPOL
  1. ;
  1. S DIC="^DPT("_DFN_",.312,",DIC(0)="AEQMN",DIC("A")="Select Patient Policy: "
  1. D ^DIC I +Y<1 S VALMQUIT=""
  1. G:$D(VALMQUIT) PPOLQ
  1. S IBPPOL="^2^"_DFN_U_+Y_U_$G(^DPT(DFN,.312,+Y,0))
  1. PPOLQ K DIC Q
  1. ;
  1. BLANK(LINE) ; -- Build blank line
  1. D SET^VALM10(.LINE,$J("",80))
  1. Q
  1. ;
  1. SET(LINE,COL,TEXT,ON,OFF) ; -- set display info in array
  1. I '$D(@VALMAR@(LINE,0)) D BLANK(.LINE) S VALMCNT=$G(VALMCNT)+1
  1. D SET^VALM10(.LINE,$$SETSTR^VALM1(.TEXT,@VALMAR@(LINE,0),.COL,$L(TEXT)))
  1. D:$G(ON)]""!($G(OFF)]"") CNTRL^VALM10(.LINE,.COL,$L(TEXT),$G(ON),$G(OFF))
  1. W:'(LINE#5) "."
  1. Q
  1. ;