- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNSP.m
r613 r623 1 IBCNSP ;ALB/AAS - INSURANCE MANAGEMENT - EXPANDED POLICY ;05-MAR-1993 2 ;;2.0;INTEGRATED BILLING;**6,28,43,52,85,251,363,371**;21-MAR-94;Build 57 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 % ; 5 EN ; -- main entry point for IBCNS EXPANDED POLICY 6 N IB1ST 7 K VALMQUIT,IBPPOL 8 S IBTOP="IBCNSP" 9 D EN^VALM("IBCNS EXPANDED POLICY") 10 Q 11 ; 12 HDR ; -- header code 13 N W,X,Y,Z 14 S VALMHDR(1)="Expanded Policy Information for: "_$E($P(^DPT(DFN,0),U),1,20)_" "_$P($$PT^IBEFUNC(DFN),U,2) 15 S Z=$G(^DPT(DFN,.312,+$P(IBPPOL,U,4),0)) 16 S W=$P($G(^IBA(355.3,+$P(Z,U,18),0)),U,11) 17 S Y=$E($P($G(^DIC(36,+Z,0)),U),1,20)_" Insurance Company" 18 S X="** Plan Currently "_$S(W:"Ina",1:"A")_"ctive **" 19 S VALMHDR(2)=$$SETSTR^VALM1(X,Y,48,29) 20 Q 21 ; 22 INIT ; -- init variables and list array 23 K VALMQUIT 24 S VALMCNT=0,VALMBG=1 25 I '$D(IBPPOL) D PPOL Q:$D(VALMQUIT) 26 K ^TMP("IBCNSVP",$J) 27 D BLD,HDR 28 Q 29 ; 30 BLD ; -- list builder 31 K ^TMP("IBCNSVP",$J),^TMP("IBCNSVPDX",$J) 32 D KILL^VALM10() 33 F I=1:1:20 D BLANK(.I) ; start with 20 blank lines 34 N IBCDFND,IBCDFND1,IBCDFND2,IBCDFND4,IBCDFND5 35 S IBCDFND=$G(^DPT(DFN,.312,$P(IBPPOL,U,4),0)),IBCDFND1=$G(^(1)),IBCDFND2=$G(^(2)),IBCDFND4=$G(^(4)),IBCDFND5=$G(^(5)) 36 S IBCPOL=+$P(IBCDFND,U,18),IBCNS=+IBCDFND,IBCDFN=$P(IBPPOL,U,4) 37 S IBCPOLD=$G(^IBA(355.3,+$P(IBCDFND,U,18),0)),IBCPOLD1=$G(^(1)) 38 S IBCPOLD2=$G(^IBA(355.3,+$G(IBCPOL),6)) ;; Daou/EEN adding BIN and PCN 39 ; 40 D POLICY^IBCNSP0 ; plan information 41 D INS^IBCNSP0 ; insurance company 42 D UR ; utilization review info 43 D EFFECT ; effective dates & source of info 44 D SUBSC^IBCNSP01 ; subscriber info 45 D EMP ; subscriber's employer info 46 D SPON^IBCNSP0 ; insured person's info 47 D ID^IBCNSP01 ; ins co ID numbers (IB*2*371) 48 D PLIM ; plan coverage limitations 49 D VER^IBCNSP01 ; user/verifier/editor info 50 D CONTACT^IBCNSP0 ; last insurance contact 51 D COMMENT ; comments - policy & plan 52 D RIDER^IBCNSP01 ; policy rider info 53 ; 54 S VALMCNT=+$O(^TMP("IBCNSVP",$J,""),-1) 55 Q 56 ; 57 COMMENT ; -- Comment region 58 N START,OFFSET,IBL,IBI 59 S (START,IBL)=$O(^TMP("IBCNSVP",$J,""),-1)+1,OFFSET=2 60 S IB1ST("COMMENT")=START 61 D SET(START,OFFSET," Comment -- Patient Policy ",IORVON,IORVOFF) 62 S IBL=IBL+1 63 D SET(IBL,OFFSET,$S($P(IBCDFND1,U,8)="":"None",1:$P(IBCDFND1,U,8))) 64 S IBL=IBL+1 65 D SET(IBL,OFFSET," ") 66 S IBL=IBL+1 67 D SET(IBL,OFFSET," Comment -- Group Plan ",IORVON,IORVOFF) 68 S IBI=0 F S IBI=$O(^IBA(355.3,+IBCPOL,11,IBI)) Q:IBI<1 D 69 . S IBL=IBL+1 70 . D SET(IBL,OFFSET," "_$E($G(^IBA(355.3,+IBCPOL,11,IBI,0)),1,80)) 71 . Q 72 S IBL=IBL+1 D SET(IBL,OFFSET," ") 73 S IBL=IBL+1 D SET(IBL,OFFSET," ") 74 Q 75 ; 76 EFFECT ; -- Effective date region 77 N START,OFFSET 78 S START=16,OFFSET=45 79 D SET(START,OFFSET-4," Effective Dates & Source ",IORVON,IORVOFF) 80 D SET(START+1,OFFSET," Effective Date: "_$$DAT1^IBOUTL($P(IBCDFND,U,8))) 81 D SET(START+2,OFFSET,"Expiration Date: "_$$DAT1^IBOUTL($P(IBCDFND,U,4))) 82 D SET(START+3,OFFSET," Source of Info: "_$$EXPAND^IBTRE(2.312,1.09,$P($G(IBCDFND1),U,9))) 83 D SET(START+4,OFFSET-4,"Policy Not Billable: "_$S($P($G(^DPT(DFN,.312,IBCDFN,3)),"^",4):"YES",1:"NO")) 84 Q 85 ; 86 UR ; -- UR of insurance region 87 N START,OFFSET 88 S START=16,OFFSET=2 89 D SET(START,OFFSET," Utilization Review Info ",IORVON,IORVOFF) 90 D SET(START+1,OFFSET," Require UR: "_$$EXPAND^IBTRE(355.3,.05,$P(IBCPOLD,U,5))) 91 D SET(START+2,OFFSET," Require Amb Cert: "_$$EXPAND^IBTRE(355.3,.12,$P(IBCPOLD,U,12))) 92 D SET(START+3,OFFSET," Require Pre-Cert: "_$$EXPAND^IBTRE(355.3,.06,$P(IBCPOLD,U,6))) 93 D SET(START+4,OFFSET," Exclude Pre-Cond: "_$$EXPAND^IBTRE(355.3,.07,$P(IBCPOLD,U,7))) 94 D SET(START+5,OFFSET,"Benefits Assignable: "_$$EXPAND^IBTRE(355.3,.08,$P(IBCPOLD,U,8))) 95 Q 96 EMP ; -- Insurance Employer Region 97 N OFFSET,START,IBADD 98 S START=24,OFFSET=40 99 D SET(START,OFFSET," Subscriber's Employer Information ",IORVON,IORVOFF) 100 D SET(START+1,OFFSET,"Emp Sponsored Plan: "_$S(+$P(IBCDFND2,U,10):"Yes",1:"No")) 101 D SET(START+2,OFFSET," Employer: "_$P(IBCDFND2,U,9)) 102 D SET(START+3,OFFSET," Employment Status: "_$$EXPAND^IBTRE(2.312,2.11,$P(IBCDFND2,U,11))) 103 D SET(START+4,OFFSET," Retirement Date: "_$$DAT1^IBOUTL($P(IBCDFND2,U,12))) 104 D SET(START+5,OFFSET,"Claims to Employer: "_$S(+IBCDFND2:"Yes, Send to Employer",1:"No, Send to Insurance Company")) 105 ; 106 D SET(START+6,OFFSET," Street: "_$P(IBCDFND2,U,2)) S IBADD=1 107 I $P(IBCDFND2,U,3)'="" D SET(START+7,OFFSET," Street 2: "_$P(IBCDFND2,U,3)) S IBADD=2 108 I $P(IBCDFND2,U,4)'="" D SET(START+8,OFFSET," Street 3: "_$P(IBCDFND2,U,4)) S IBADD=3 109 D SET(START+6+IBADD,OFFSET," City/State: "_$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)) 110 D SET(START+7+IBADD,OFFSET," Phone: "_$P(IBCDFND2,U,8)) 111 ; 112 ; couple of blank lines to end this section 113 D SET(START+8+IBADD,2," ") 114 D SET(START+9+IBADD,2," ") 115 ; 116 EMPQ Q 117 ; 118 PLIM ; plan coverage limitations/plan limitation category display 119 N START,END S START=$O(^TMP("IBCNSVP",$J,""),-1)+1 120 S IB1ST("PLIM")=START 121 D LIMBLD^IBCNSC41(START,2) 122 S END=$O(^TMP("IBCNSVP",$J,""),-1) ; last line constructed 123 D SET(END+1,2," ") ; 2 blank lines to end this section 124 D SET(END+2,2," ") 125 PLIMX ; 126 Q 127 ; 128 HELP ; -- help code 129 S X="?" D DISP^XQORM1 W !! 130 Q 131 ; 132 EXIT ; -- exit code 133 K IBPPOL,VALMQUIT,IBCNS,IBCPOL,IBCPOLD,IBCPOLD1,IBCPOLD2,IBCDFND,IBCDFND1,IBCDFND2 134 D CLEAN^VALM10,CLEAR^VALM1 135 Q 136 ; 137 EXPND ; -- expand code 138 Q 139 ; 140 PPOL ; -- select patient, select policy 141 I '$D(DFN) D G:$D(VALMQUIT) PPOLQ 142 .S DIC="^DPT(",DIC(0)="AEQMN" D ^DIC 143 .S DFN=+Y 144 I $G(DFN)<1 S VALMQUIT="" G PPOLQ 145 ; 146 I '$O(^DPT(DFN,.312,0)) W !!,"Patient doesn't have Insurance" K DFN G PPOL 147 ; 148 S DIC="^DPT("_DFN_",.312,",DIC(0)="AEQMN",DIC("A")="Select Patient Policy: " 149 D ^DIC I +Y<1 S VALMQUIT="" 150 G:$D(VALMQUIT) PPOLQ 151 S IBPPOL="^2^"_DFN_U_+Y_U_$G(^DPT(DFN,.312,+Y,0)) 152 PPOLQ K DIC Q 153 ; 154 BLANK(LINE) ; -- Build blank line 155 D SET^VALM10(.LINE,$J("",80)) 156 Q 157 ; 158 SET(LINE,COL,TEXT,ON,OFF) ; -- set display info in array 159 I '$D(@VALMAR@(LINE,0)) D BLANK(.LINE) S VALMCNT=$G(VALMCNT)+1 160 D SET^VALM10(.LINE,$$SETSTR^VALM1(.TEXT,@VALMAR@(LINE,0),.COL,$L(TEXT))) 161 D:$G(ON)]""!($G(OFF)]"") CNTRL^VALM10(.LINE,.COL,$L(TEXT),$G(ON),$G(OFF)) 162 W:'(LINE#5) "." 163 Q 1 IBCNSP ;ALB/AAS - INSURANCE MANAGEMENT - EXPANDED POLICY ;05-MAR-1993 2 ;;2.0;INTEGRATED BILLING;**6,28,43,52,85,251,363**;21-MAR-94;Build 35 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 % ; 5 EN ; -- main entry point for IBCNS EXPANDED POLICY 6 K VALMQUIT,IBPPOL 7 S IBTOP="IBCNSP" 8 D EN^VALM("IBCNS EXPANDED POLICY") 9 Q 10 ; 11 HDR ; -- header code 12 N W,X,Y,Z 13 S VALMHDR(1)="Expanded Policy Information for: "_$E($P(^DPT(DFN,0),U),1,20)_" "_$P($$PT^IBEFUNC(DFN),U,2) 14 S Z=$G(^DPT(DFN,.312,+$P(IBPPOL,U,4),0)) 15 S W=$P($G(^IBA(355.3,+$P(Z,U,18),0)),U,11) 16 S Y=$E($P($G(^DIC(36,+Z,0)),U),1,20)_" Insurance Company" 17 S X="** Plan Currently "_$S(W:"Ina",1:"A")_"ctive **" 18 S VALMHDR(2)=$$SETSTR^VALM1(X,Y,48,29) 19 Q 20 ; 21 INIT ; -- init variables and list array 22 K VALMQUIT 23 S VALMCNT=0,VALMBG=1 24 I '$D(IBPPOL) D PPOL Q:$D(VALMQUIT) 25 K ^TMP("IBCNSVP",$J) 26 D BLD,HDR 27 Q 28 ; 29 BLD ; -- list builder 30 K ^TMP("IBCNSVP",$J),^TMP("IBCNSVPDX",$J) 31 D KILL^VALM10() 32 F I=1:1:50 D BLANK(.I) 33 S VALMCNT=50 34 N IBCDFND,IBCDFND1,IBCDFND2,IBCDFND4 35 S IBCDFND=$G(^DPT(DFN,.312,$P(IBPPOL,U,4),0)),IBCDFND1=$G(^(1)),IBCDFND2=$G(^(2)),IBCDFND4=$G(^(4)) 36 S IBCPOL=+$P(IBCDFND,U,18),IBCNS=+IBCDFND,IBCDFN=$P(IBPPOL,U,4) 37 S IBCPOLD=$G(^IBA(355.3,+$P(IBCDFND,U,18),0)),IBCPOLD1=$G(^(1)) 38 S IBCPOLD2=$G(^IBA(355.3,+$G(IBCPOL),6)) ;; Daou/EEN adding BIN and PCN 39 S IBLCNT=0 40 D POLICY^IBCNSP0,INS^IBCNSP0,SPON^IBCNSP0,LIMBLD^IBCNSC41(36,2,.IBLCNT) 41 D CONTACT^IBCNSP0,EFFECT,UR,EMP,VER^IBCNSP01,COMMENT,^IBCNSP01 42 Q 43 ; 44 COMMENT ; -- Comment region 45 N START,OFFSET,IBL,IBI 46 S START=49+$G(IBLCNT),OFFSET=2,IBL=0 47 I '$D(@VALMAR@(START-1)) D SET(START-1,OFFSET," ") 48 D SET(START,OFFSET," Comment -- Patient Policy ",IORVON,IORVOFF) 49 D SET(START+1,OFFSET,$S($P(IBCDFND1,U,8)="":"None",1:$P(IBCDFND1,U,8))) 50 I '$D(@VALMAR@(START+2)) D SET(START+2,OFFSET," ") 51 D SET(START+3,OFFSET," Comment -- Group Plan ",IORVON,IORVOFF) 52 S IBI=0 F S IBI=$O(^IBA(355.3,+IBCPOL,11,IBI)) Q:IBI<1 D 53 .S IBL=IBL+1 54 .D SET(START+IBL+3,OFFSET," "_$E($G(^IBA(355.3,+IBCPOL,11,IBI,0)),1,80)) 55 S IBLCNT=$G(IBLCNT)+IBL+1 D SET(START+IBL+4,OFFSET," ") 56 Q 57 ; 58 EFFECT ; -- Effective date region 59 N START,OFFSET 60 S START=14,OFFSET=45 61 D SET(START,OFFSET-4," Effective Dates & Source ",IORVON,IORVOFF) 62 D SET(START+1,OFFSET," Effective Date: "_$$DAT1^IBOUTL($P(IBCDFND,U,8))) 63 D SET(START+2,OFFSET,"Expiration Date: "_$$DAT1^IBOUTL($P(IBCDFND,U,4))) 64 D SET(START+3,OFFSET," Source of Info: "_$$EXPAND^IBTRE(2.312,1.09,$P($G(IBCDFND1),U,9))) 65 D SET(START+4,OFFSET-4,"Policy Not Billable: "_$S($P($G(^DPT(DFN,.312,IBCDFN,3)),"^",4):"YES",1:"NO")) 66 Q 67 ; 68 UR ; -- UR of insurance region 69 N START,OFFSET 70 S START=14,OFFSET=2 71 D SET(START,OFFSET," Utilization Review Info ",IORVON,IORVOFF) 72 D SET(START+1,OFFSET," Require UR: "_$$EXPAND^IBTRE(355.3,.05,$P(IBCPOLD,U,5))) 73 D SET(START+2,OFFSET," Require Amb Cert: "_$$EXPAND^IBTRE(355.3,.12,$P(IBCPOLD,U,12))) 74 D SET(START+3,OFFSET," Require Pre-Cert: "_$$EXPAND^IBTRE(355.3,.06,$P(IBCPOLD,U,6))) 75 D SET(START+4,OFFSET," Exclude Pre-Cond: "_$$EXPAND^IBTRE(355.3,.07,$P(IBCPOLD,U,7))) 76 D SET(START+5,OFFSET,"Benefits Assignable: "_$$EXPAND^IBTRE(355.3,.08,$P(IBCPOLD,U,8))) 77 Q 78 EMP ; -- Insurance Employer Region 79 N OFFSET,START,IBADD 80 S START=19,OFFSET=40 81 D SET(START,OFFSET," Subscriber's Employer Information ",IORVON,IORVOFF) 82 D SET(START+1,OFFSET,"Emp Sponsored Plan: "_$S(+$P(IBCDFND2,U,10):"Yes",1:"No")) 83 D SET(START+2,OFFSET," Employer: "_$P(IBCDFND2,U,9)) 84 D SET(START+3,OFFSET," Employment Status: "_$$EXPAND^IBTRE(2.312,2.11,$P(IBCDFND2,U,11))) 85 D SET(START+4,OFFSET," Retirement Date: "_$$DAT1^IBOUTL($P(IBCDFND2,U,12))) 86 D SET(START+5,OFFSET,"Claims to Employer: "_$S(+IBCDFND2:"Yes, Send to Employer",1:"No, Send to Insurance Company")) 87 ;I +IBCDFND2 W !!,"If ROI applies, make sure current consent is signed.",!! D PAUSE^VALM1 88 ; 89 D SET(START+6,OFFSET," Street: "_$P(IBCDFND2,U,2)) S IBADD=1 90 I $P(IBCDFND2,U,3)'="" D SET(START+7,OFFSET," Street 2: "_$P(IBCDFND2,U,3)) S IBADD=2 91 I $P(IBCDFND2,U,4)'="" D SET(START+8,OFFSET," Street 3: "_$P(IBCDFND2,U,4)) S IBADD=3 92 D SET(START+6+IBADD,OFFSET," City/State: "_$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)) 93 D SET(START+7+IBADD,OFFSET," Phone: "_$P(IBCDFND2,U,8)) 94 ; 95 EMPQ Q 96 ; 97 HELP ; -- help code 98 S X="?" D DISP^XQORM1 W !! 99 Q 100 ; 101 EXIT ; -- exit code 102 K IBPPOL,VALMQUIT,IBCNS,IBCPOL,IBCPOLD,IBCPOLD1,IBCPOLD2,IBCDFND,IBCDFND1,IBCDFND2 103 D CLEAN^VALM10,CLEAR^VALM1 104 Q 105 ; 106 EXPND ; -- expand code 107 Q 108 ; 109 PPOL ; -- select patient, select policy 110 I '$D(DFN) D G:$D(VALMQUIT) PPOLQ 111 .S DIC="^DPT(",DIC(0)="AEQMN" D ^DIC 112 .S DFN=+Y 113 I $G(DFN)<1 S VALMQUIT="" G PPOLQ 114 ; 115 I '$O(^DPT(DFN,.312,0)) W !!,"Patient doesn't have Insurance" K DFN G PPOL 116 ; 117 S DIC="^DPT("_DFN_",.312,",DIC(0)="AEQMN",DIC("A")="Select Patient Policy: " 118 D ^DIC I +Y<1 S VALMQUIT="" 119 G:$D(VALMQUIT) PPOLQ 120 S IBPPOL="^2^"_DFN_U_+Y_U_$G(^DPT(DFN,.312,+Y,0)) 121 PPOLQ K DIC Q 122 ; 123 BLANK(LINE) ; -- Build blank line 124 D SET^VALM10(.LINE,$J("",80)) 125 Q 126 ; 127 SET(LINE,COL,TEXT,ON,OFF) ; -- set display info in array 128 I '$D(@VALMAR@(LINE,0)) D BLANK(.LINE) S VALMCNT=$G(VALMCNT)+1 129 D SET^VALM10(.LINE,$$SETSTR^VALM1(.TEXT,@VALMAR@(LINE,0),.COL,$L(TEXT))) 130 D:$G(ON)]""!($G(OFF)]"") CNTRL^VALM10(.LINE,.COL,$L(TEXT),$G(ON),$G(OFF)) 131 W:'(LINE#5) "." 132 Q
Note:
See TracChangeset
for help on using the changeset viewer.
