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