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. 	;;Version 2.0 ; INTEGRATED BILLING ;; 21-MAR-94
  1. 	;;Per VHA Directive 10-93-142, this routine should not be modified.
  1. %	;
  1. EN	; -- main entry point for IBCNS EXPANDED POLICY
  1. 	K VALMQUIT,IBPPOL
  1. 	S IBTOP="IBCNSP"
  1. 	D EN^VALM("IBCNS EXPANDED POLICY")
  1. 	Q
  1. 	;
  1. HDR	; -- header code
  1. 	S VALMHDR(1)="Expanded Policy Information for: "_$E($P(^DPT(DFN,0),"^"),1,20)
  1. 	S VALMHDR(2)=$E($P($G(^DIC(36,+$P(IBPPOL,"^",5),0)),"^"),1,20)_" Insurance Company"
  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. 	K ^TMP("IBCNSVP",$J)
  1. 	D BLD,HDR
  1. 	Q
  1. 	;
  1. BLD	; -- list builder
  1. 	K ^TMP("IBCNSVP",$J),^TMP("IBCNSVPDX",$J)
  1. 	D KILL^VALM10()
  1. 	F I=1:1:35 D BLANK(.I)
  1. 	S VALMCNT=35
  1. 	N IBCDFND,IBCDFND1,IBCDFND2
  1. 	S IBCDFND=$G(^DPT(DFN,.312,$P(IBPPOL,"^",4),0)),IBCNS=+IBCDFND
  1. 	S IBCDFND1=$G(^DPT(DFN,.312,$P(IBPPOL,"^",4),1))
  1. 	S IBCDFND2=$G(^DPT(DFN,.312,$P(IBPPOL,"^",4),2))
  1. 	S IBCPOL=+$P(IBCDFND,"^",18),IBCNS=+IBCDFND,IBCDFN=$P(IBPPOL,"^",4)
  1. 	S IBCPOLD=$G(^IBA(355.3,+$P(IBCDFND,"^",18),0))
  1. 	S IBCPOLD1=$G(^IBA(355.3,+$P(IBCDFND,"^",18),1))
  1. 	D POLICY^IBCNSP0,INS^IBCNSP0,CONTACT^IBCNSP0,EFFECT,UR,COMMENT,EMP,^IBCNSP01
  1. 	Q
  1. 	;
  1. COMMENT	; -- Comment region
  1. 	N START,OFFSET
  1. 	S START=30,OFFSET=2
  1. 	D SET(START,OFFSET," Comment -- Patient Policy ",IORVON,IORVOFF)
  1. 	D SET(START+1,OFFSET,$S($P(IBCDFND1,"^",8)="":"None",1:$P(IBCDFND1,"^",8)))
  1. 	D SET(START+3,OFFSET," Comment -- Group Plan ",IORVON,IORVOFF)
  1. 	S (IBLCNT,IBI)=0 F  S IBI=$O(^IBA(355.3,+IBCPOL,11,IBI)) Q:IBI<1  D
  1. 	.S IBLCNT=IBLCNT+1
  1. 	.D SET(START+3+IBLCNT,OFFSET,"  "_$E($G(^IBA(355.3,+IBCPOL,11,IBI,0)),1,80))
  1. 	S IBLCNT=IBLCNT+1 D SET(START+3+IBLCNT,OFFSET,"  ")
  1. 	Q
  1. 	;
  1. EFFECT	; -- Effective date region
  1. 	N START,OFFSET
  1. 	S START=9,OFFSET=45
  1. 	D SET(START,OFFSET," Effective Dates ",IORVON,IORVOFF)
  1. 	D SET(START+1,OFFSET," Effective Date: "_$$DAT1^IBOUTL($P(IBCDFND,"^",8)))
  1. 	D SET(START+2,OFFSET,"Expiration Date: "_$$DAT1^IBOUTL($P(IBCDFND,"^",4)))
  1. 	Q
  1. 	;
  1. UR	; -- UR of insurance region
  1. 	N START,OFFSET
  1. 	S START=9,OFFSET=2
  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,"^",5)))
  1. 	D SET(START+2,OFFSET,"   Require Pre-Cert: "_$$EXPAND^IBTRE(355.3,.06,$P(IBCPOLD,"^",6)))
  1. 	D SET(START+3,OFFSET,"   Exclude Pre-Cond: "_$$EXPAND^IBTRE(355.3,.07,$P(IBCPOLD,"^",7)))
  1. 	D SET(START+4,OFFSET,"Benefits Assignable: "_$$EXPAND^IBTRE(355.3,.08,$P(IBCPOLD,"^",8)))
  1. 	Q
  1. EMP	; -- Insurance Employer Region
  1. 	N OFFSET,START,IBADD
  1. 	S START=15,OFFSET=40
  1. 	D SET(START,OFFSET," Subscriber's Employer Information ",IORVON,IORVOFF)
  1. 	D SET(START+1,OFFSET,"Claims to Employer: "_$S(+IBCDFND2:"Yes, Send to Employer",1:"No, Send to Insurance Company"))
  1. 	;I +IBCDFND2 W !!,"If ROI applies, make sure current consent is signed.",!! D PAUSE^VALM1
  1. 	;
  1. 	D SET(START+2,OFFSET,"           Company: "_$P(IBCDFND2,"^",9))
  1. 	D SET(START+3,OFFSET,"            Street: "_$P(IBCDFND2,"^",2)) S IBADD=1
  1. 	I $P(IBCDFND2,"^",3)'="" D SET(START+4,OFFSET,"          Street 2: "_$P(IBCDFND2,"^",3)) S IBADD=2
  1. 	I $P(IBCDFND2,"^",4)'="" D SET(START+5,OFFSET,"          Street 3: "_$P(IBCDFND2,"^",4)) S IBADD=3
  1. 	D SET(START+3+IBADD,OFFSET,"        City/State: "_$E($P(IBCDFND2,"^",5),1,15)_$S($P(IBCDFND2,"^",5)="":"",1:", ")_$P($G(^DIC(5,+$P(IBCDFND2,"^",6),0)),"^",2)_" "_$E($P(IBCDFND2,"^",7),1,5))
  1. 	D SET(START+4+IBADD,OFFSET,"             Phone: "_$P(IBCDFND2,"^",8))
  1. 	;
  1. EMPQ	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,IBCPOL,IBCPOLD,IBCPOLD1,IBCDFND,IBCDFND1,IBCDFND2
  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_"^"_+Y_"^"_$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