- 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/IBCNSP0.m
r613 r623 1 IBCNSP0 ;ALB/AAS - INSURANCE MANAGEMENT - EXPANDED POLICY ;05-MAR-1993 2 ;;2.0;INTEGRATED BILLING;**28,43,52,85,93,103,137,229,251,363,371**;21-MAR-94;Build 57 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 ; 6 CONTACT ; -- Insurance Contact Information 7 N OFFSET,START 8 ; 9 ; The start of this section is designed to start on the same line 10 ; as the User Information section (see VER^IBCNSP01). 11 ; 12 S START=$O(^TMP("IBCNSVP",$J,""),-1)-8 13 S IB1ST("CONTACT")=START 14 S OFFSET=42 15 N IBTRC,IBTRCD,IBTCOD 16 S IBTCOD=$O(^IBE(356.11,"ACODE",85,0)) 17 ; 18 S IBTRC=0,IBTRCD="" 19 F S IBTRC=$O(^IBT(356.2,"D",DFN,IBTRC)) Q:'IBTRC D 20 .Q:$P($G(^IBT(356.2,+IBTRC,1)),"^",5)'=IBCDFN ; must be same policy 21 .Q:$P($G(^IBT(356.2,+IBTRC,0)),"^",4)'=IBTCOD ; must be ins. ver. type 22 .S IBTRCD=$G(^IBT(356.2,+IBTRC,0)) 23 ; 24 D SET(START,OFFSET," Insurance Contact (last) ",IORVON,IORVOFF) 25 D SET(START+1,OFFSET," Person Contacted: "_$$EXPAND^IBTRE(356.2,.06,$P(IBTRCD,"^",6))) 26 D SET(START+2,OFFSET,"Method of Contact: "_$$EXPAND^IBTRE(356.2,.17,$P(IBTRCD,"^",17))) 27 D SET(START+3,OFFSET," Contact's Phone: "_$$EXPAND^IBTRE(356.2,.07,$P(IBTRCD,"^",7))) 28 D SET(START+4,OFFSET," Call Ref. No.: "_$$EXPAND^IBTRE(356.2,.09,$P(IBTRCD,"^",9))) 29 D SET(START+5,OFFSET," Contact Date: "_$$EXPAND^IBTRE(356.2,.01,$P(IBTRCD,"^"))) 30 ; no blank lines here because the User Information section is on the 31 ; left and it is bigger than this section 32 Q 33 ; 34 POLICY ; -- Policy Region 35 ; -- if pointer to policy file exists get data from policy file 36 N OFFSET,START,IBP,IBX,IBPLNID,IBPLNNM,IBPLNNA,IBPLNLA 37 S (IBPLNID,IBPLNNM,IBPLNNA,IBPLNLA)="" 38 S START=1,OFFSET=2 39 D GPLAN(+IBCPOLD2) 40 D SET(START,OFFSET," Plan Information ",IORVON,IORVOFF) 41 D SET(START+1,OFFSET," Is Group Plan: "_$S($P(IBCPOLD,"^",2)=1:"YES",1:"NO")) 42 D SET(START+2,OFFSET," Group Name: "_$P(IBCPOLD,"^",3)) 43 D SET(START+3,OFFSET," Group Number: "_$P(IBCPOLD,"^",4)) 44 D SET(START+4,OFFSET," BIN: "_$P(IBCPOLD2,"^",2)) ;;Daou/EEN 45 D SET(START+5,OFFSET," PCN: "_$P(IBCPOLD2,"^",3)) ;;04/09/04 46 D SET(START+6,OFFSET," Type of Plan: "_$E($P($G(^IBE(355.1,+$P(IBCPOLD,"^",9),0)),"^"),1,23)) 47 S IBX=7 48 I $P(IBCPOLD,U,14)]"" D 49 . D SET(START+IBX,OFFSET," Plan Category: "_$$EXPAND^IBTRE(355.3,.14,$P(IBCPOLD,"^",14))) S IBX=IBX+1 50 I $P(IBCPOLD,U,15)]"" D 51 . D SET(START+IBX,OFFSET," Electronic Type: "_$$EXPAND^IBTRE(355.3,.15,$P(IBCPOLD,"^",15))) S IBX=IBX+1 52 D SET(START+IBX,OFFSET," Plan Filing TF: "_$P(IBCPOLD,"^",13)) S IBX=IBX+1 53 ; 54 D SET(START+IBX,OFFSET," ePharmacy Plan ID: "_IBPLNID) S IBX=IBX+1 55 D SET(START+IBX,OFFSET," ePharmacy Plan Name: "_IBPLNNM) S IBX=IBX+1 56 D SET(START+IBX,OFFSET," ePharmacy Natl Status: "_IBPLNNA) S IBX=IBX+1 57 D SET(START+IBX,OFFSET," ePharmacy Local Status: "_IBPLNLA) S IBX=IBX+1 58 ; 59 ; -- in case pointer is missing 60 I '$G(^IBA(355.3,+$P(IBCDFND,"^",18),0)) D 61 .D SET(START+1,OFFSET,"Insurance Number: "_$P(IBCDFND,"^",2)) 62 .D SET(START+2,OFFSET," Group Name: "_$P(IBCDFND,"^",15)) 63 .D SET(START+3,OFFSET," Group Number: "_$P(IBCDFND,"^",3)) 64 .Q 65 Q 66 ; 67 INS ; -- Insurance Co. Region 68 N OFFSET,START,IBADD,IBCDFNDA,IBCDFNDB 69 S START=1,OFFSET=45 70 D SET(START,OFFSET," Insurance Company ",IORVON,IORVOFF) 71 D SET(START+1,OFFSET," Company: "_$P($G(^DIC(36,+IBCDFND,0)),"^")) 72 S IBCDFNDA=$G(^DIC(36,+IBCDFND,.11)),IBCDFNDB=$G(^(.13)) 73 G:IBCDFNDA="" INSQ 74 D SET(START+2,OFFSET," Street: "_$P(IBCDFNDA,"^")) S IBADD=1 75 I $P(IBCDFNDA,"^",2)'="" D SET(START+3,OFFSET," Street 2: "_$P(IBCDFNDA,"^",2)) S IBADD=2 76 I $P(IBCDFNDA,"^",3)'="" D SET(START+4,OFFSET," Street 3: "_$P(IBCDFNDA,"^",3)) S IBADD=3 77 D SET(START+2+IBADD,OFFSET,"City/State: "_$E($P(IBCDFNDA,"^",4),1,15)_$S($P(IBCDFNDA,"^",4)="":"",1:", ")_$P($G(^DIC(5,+$P(IBCDFNDA,"^",5),0)),"^",2)_" "_$E($P(IBCDFNDA,"^",6),1,5)) 78 D SET(START+3+IBADD,OFFSET,"Billing Ph: "_$P(IBCDFNDB,"^",2)) 79 D SET(START+4+IBADD,OFFSET,"Precert Ph: "_$$PHONE^IBCNSC01(IBCDFNDB)) 80 ; 81 INSQ Q 82 ; 83 SPON ; -- Sponsor (Insured Person) Region 84 N IBC3,IBZIP,START,OFFSET,IBA,DA,DR,DIC,DIQ 85 S IBC3=$G(^DPT(DFN,.312,IBCDFN,3)) 86 S DA=+$P(IBC3,"^",2),DR=.01,DIQ(0)="E",DIC="^DIC(23,",DIQ="IBA" D EN^DIQ1 87 S START=$O(^TMP("IBCNSVP",$J,""),-1)+1,OFFSET=4 88 D SET(START,OFFSET," Insured Person's Information (use Subscriber Update Action) ",IORVON,IORVOFF) 89 D SET(START+1,OFFSET," Insured's DOB: "_$$DAT3^IBOUTL($P(IBC3,"^"))) 90 D SET(START+2,OFFSET," Insured's Sex: "_$$EXTERNAL^DILFD(2.312,3.12,,$P(IBC3,U,12))) 91 D SET(START+3,OFFSET," Insured's Branch: "_$G(IBA(23,DA,.01,"E"))) 92 D SET(START+4,OFFSET," Insured's Rank: "_$P(IBC3,"^",3)) 93 ; 94 S OFFSET=43 95 S Y=$P(IBC3,"^",10) D ZIPOUT^VAFADDR S IBZIP=Y 96 D SET(START+1,OFFSET," Str 1: "_$P(IBC3,"^",6)) 97 D SET(START+2,OFFSET," Str 2: "_$P(IBC3,"^",7)) 98 D SET(START+3,OFFSET," City: "_$P(IBC3,"^",8)) 99 D SET(START+4,OFFSET,"St/Zip: "_$P($G(^DIC(5,+$P(IBC3,"^",9),0)),"^",2)_" "_IBZIP) 100 D SET(START+5,OFFSET," Phone: "_$P(IBC3,"^",11)) 101 ; 102 ; blank lines at end of section 103 D SET(START+6,2," ") 104 D SET(START+7,2," ") 105 Q 106 ; 107 BLANK(LINE) ; -- Build blank line 108 D SET^VALM10(.LINE,$J("",80)) 109 Q 110 ; 111 SET(LINE,COL,TEXT,ON,OFF) ; -- set display info in array 112 D:'$D(@VALMAR@(LINE,0)) BLANK(.LINE) 113 D SET^VALM10(.LINE,$$SETSTR^VALM1(.TEXT,@VALMAR@(LINE,0),.COL,$L(TEXT))) 114 D:$G(ON)]""!($G(OFF)]"") CNTRL^VALM10(.LINE,.COL,$L(TEXT),$G(ON),$G(OFF)) 115 W:'(LINE#5) "." 116 Q 117 ; 118 GPLAN(IBPLDA) ; get data from PLAN file (#366.03) related to the 119 ; GROUP INSURANCE PLAN file (#355.3) and the INSURANCE COMPANY file (#36) 120 ; that is associated with the PATIENT 121 ; input - IBPLDA - ien of the PLAN file (#366.03) 122 N IBPLN0,IBAIEN,IBAPIEN,IBAP0 123 S IBPLN0=$G(^IBCNR(366.03,IBPLDA,0)) ;; Q:'$P(IBPLN0,"^",3) ;quit if payer not defined 124 S IBPLNID=$P(IBPLN0,"^"),IBPLNNM=$P(IBPLN0,"^",2) 125 S IBAIEN=$O(^IBCNR(366.13,"B","E-PHARM","")) Q:'IBAIEN 126 S IBAPIEN=$O(^IBCNR(366.03,IBPLDA,3,"B",IBAIEN,"")) Q:'IBAPIEN 127 S IBAP0=$G(^IBCNR(366.03,IBPLDA,3,IBAPIEN,0)) 128 S IBPLNNA=$S($P(IBAP0,"^",2)=0:"NOT ACTIVE",1:"ACTIVE") 129 S IBPLNLA=$S($P(IBAP0,"^",3)=0:"NOT ACTIVE",1:"ACTIVE") 130 Q 131 ; 132 ;IBCNSP0 1 IBCNSP0 ;ALB/AAS - INSURANCE MANAGEMENT - EXPANDED POLICY ;05-MAR-1993 2 ;;2.0;INTEGRATED BILLING;**28,43,52,85,93,103,137,229,251,363**;21-MAR-94;Build 35 3 ;;Per VHA Directive 2004-038, this routine should not be modified. 4 ; 5 ; 6 CONTACT ; -- Insurance Contact Information 7 N OFFSET,START 8 S START=41+$G(IBLCNT),OFFSET=42 9 N IBTRC,IBTRCD,IBTCOD 10 S IBTCOD=$O(^IBE(356.11,"ACODE",85,0)) 11 ; 12 S IBTRC=0,IBTRCD="" 13 F S IBTRC=$O(^IBT(356.2,"D",DFN,IBTRC)) Q:'IBTRC D 14 .Q:$P($G(^IBT(356.2,+IBTRC,1)),"^",5)'=IBCDFN ; must be same policy 15 .Q:$P($G(^IBT(356.2,+IBTRC,0)),"^",4)'=IBTCOD ; must be ins. ver. type 16 .S IBTRCD=$G(^IBT(356.2,+IBTRC,0)) 17 ; 18 I '$D(@VALMAR@(START-1)) D SET(START-1,OFFSET," ") 19 D SET(START,OFFSET," Insurance Contact (last) ",IORVON,IORVOFF) 20 D SET(START+1,OFFSET," Person Contacted: "_$$EXPAND^IBTRE(356.2,.06,$P(IBTRCD,"^",6))) 21 D SET(START+2,OFFSET,"Method of Contact: "_$$EXPAND^IBTRE(356.2,.17,$P(IBTRCD,"^",17))) 22 D SET(START+3,OFFSET," Contact's Phone: "_$$EXPAND^IBTRE(356.2,.07,$P(IBTRCD,"^",7))) 23 D SET(START+4,OFFSET," Call Ref. No.: "_$$EXPAND^IBTRE(356.2,.09,$P(IBTRCD,"^",9))) 24 D SET(START+5,OFFSET," Contact Date: "_$$EXPAND^IBTRE(356.2,.01,$P(IBTRCD,"^"))) 25 Q 26 ; 27 POLICY ; -- Policy Region 28 ; -- if pointer to policy file exists get data from policy file 29 N OFFSET,START,IBP,IBX,IBPLNID,IBPLNNM,IBPLNNA,IBPLNLA 30 S (IBPLNID,IBPLNNM,IBPLNNA,IBPLNLA)="" 31 S START=1,OFFSET=2 32 D GPLAN(+IBCPOLD2) 33 D SET(START,OFFSET," Plan Information ",IORVON,IORVOFF) 34 D SET(START+1,OFFSET," Is Group Plan: "_$S($P(IBCPOLD,"^",2)=1:"YES",1:"NO")) 35 D SET(START+2,OFFSET," Group Name: "_$P(IBCPOLD,"^",3)) 36 D SET(START+3,OFFSET," Group Number: "_$P(IBCPOLD,"^",4)) 37 D SET(START+4,OFFSET," BIN: "_$P(IBCPOLD2,"^",2)) ;;Daou/EEN 38 D SET(START+5,OFFSET," PCN: "_$P(IBCPOLD2,"^",3)) ;;04/09/04 39 D SET(START+6,OFFSET," Type of Plan: "_$E($P($G(^IBE(355.1,+$P(IBCPOLD,"^",9),0)),"^"),1,23)) 40 S IBX=7 41 I $P(IBCPOLD,U,14)]"" D 42 . D SET(START+IBX,OFFSET," Plan Category: "_$$EXPAND^IBTRE(355.3,.14,$P(IBCPOLD,"^",14))) S IBX=IBX+1 43 I $P(IBCPOLD,U,15)]"" D 44 . D SET(START+IBX,OFFSET," Electronic Type: "_$$EXPAND^IBTRE(355.3,.15,$P(IBCPOLD,"^",15))) S IBX=IBX+1 45 D SET(START+IBX,OFFSET," Plan Filing TF: "_$P(IBCPOLD,"^",13)) S IBX=IBX+1 46 ; -- in case pointer is missing 47 D SET(START+IBX,OFFSET," ePharmacy Plan ID: "_IBPLNID) S IBX=IBX+1 48 D SET(START+IBX,OFFSET," ePharmacy Plan Name: "_IBPLNNM) S IBX=IBX+1 49 D SET(START+IBX,OFFSET," ePharmacy Natl Status: "_IBPLNNA) S IBX=IBX+1 50 D SET(START+IBX,OFFSET," ePharmacy Local Status: "_IBPLNLA) S IBX=IBX+1 51 I '$G(^IBA(355.3,+$P(IBCDFND,"^",18),0)) D 52 .D SET(START+1,OFFSET,"Insurance Number: "_$P(IBCDFND,"^",2)) 53 .D SET(START+2,OFFSET," Group Name: "_$P(IBCDFND,"^",15)) 54 .D SET(START+3,OFFSET," Group Number: "_$P(IBCDFND,"^",3)) 55 .Q 56 Q 57 ; 58 INS ; -- Insurance Co. Region 59 N OFFSET,START,IBADD,IBCDFNDA,IBCDFNDB 60 S START=1,OFFSET=45 61 D SET(START,OFFSET," Insurance Company ",IORVON,IORVOFF) 62 D SET(START+1,OFFSET," Company: "_$P($G(^DIC(36,+IBCDFND,0)),"^")) 63 S IBCDFNDA=$G(^DIC(36,+IBCDFND,.11)),IBCDFNDB=$G(^(.13)) 64 G:IBCDFNDA="" INSQ 65 D SET(START+2,OFFSET," Street: "_$P(IBCDFNDA,"^")) S IBADD=1 66 I $P(IBCDFNDA,"^",2)'="" D SET(START+3,OFFSET," Street 2: "_$P(IBCDFNDA,"^",2)) S IBADD=2 67 I $P(IBCDFNDA,"^",3)'="" D SET(START+4,OFFSET," Street 3: "_$P(IBCDFNDA,"^",3)) S IBADD=3 68 D SET(START+2+IBADD,OFFSET,"City/State: "_$E($P(IBCDFNDA,"^",4),1,15)_$S($P(IBCDFNDA,"^",4)="":"",1:", ")_$P($G(^DIC(5,+$P(IBCDFNDA,"^",5),0)),"^",2)_" "_$E($P(IBCDFNDA,"^",6),1,5)) 69 D SET(START+3+IBADD,OFFSET,"Billing Ph: "_$P(IBCDFNDB,"^",2)) 70 D SET(START+4+IBADD,OFFSET,"Precert Ph: "_$$PHONE^IBCNSC01(IBCDFNDB)) 71 ; 72 INSQ Q 73 ; 74 SPON ; -- Sponsor (Insured Person) Region 75 N IBC3,IBSSN,IBZIP,START,OFFSET,IBA,DA,DR,DIC,DIQ 76 S IBC3=$G(^DPT(DFN,.312,IBCDFN,3)),IBSSN=$P(IBC3,"^",5) 77 S DA=+$P(IBC3,"^",2),DR=.01,DIQ(0)="E",DIC="^DIC(23,",DIQ="IBA" D EN^DIQ1 78 S START=30,OFFSET=4 79 D SET(START,OFFSET," Insured Person's Information (use Subscriber Update action) ",IORVON,IORVOFF) 80 D SET(START+1,OFFSET," Insured's DOB: "_$$DAT3^IBOUTL($P(IBC3,"^"))) 81 D SET(START+2,OFFSET," Insured's Branch: "_$G(IBA(23,DA,.01,"E"))) 82 D SET(START+3,OFFSET," Insured's Rank: "_$P(IBC3,"^",3)) 83 D SET(START+4,OFFSET," Insured's SSN: "_$S(IBSSN]"":$E(IBSSN,1,3)_"-"_$E(IBSSN,4,5)_"-"_$E(IBSSN,6,9),1:"")) 84 ; 85 S OFFSET=43 86 S Y=$P(IBC3,"^",10) D ZIPOUT^VAFADDR S IBZIP=Y 87 D SET(START+1,OFFSET," Str 1: "_$P(IBC3,"^",6)) 88 D SET(START+2,OFFSET," Str 2: "_$P(IBC3,"^",7)) 89 D SET(START+3,OFFSET," City: "_$P(IBC3,"^",8)) 90 D SET(START+4,OFFSET,"St/Zip: "_$P($G(^DIC(5,+$P(IBC3,"^",9),0)),"^",2)_" "_IBZIP) 91 D SET(START+5,OFFSET," Phone: "_$P(IBC3,"^",11)) 92 Q 93 ; 94 BLANK(LINE) ; -- Build blank line 95 D SET^VALM10(.LINE,$J("",80)) 96 Q 97 ; 98 SET(LINE,COL,TEXT,ON,OFF) ; -- set display info in array 99 D:'$D(@VALMAR@(LINE,0)) BLANK(.LINE) 100 D SET^VALM10(.LINE,$$SETSTR^VALM1(.TEXT,@VALMAR@(LINE,0),.COL,$L(TEXT))) 101 D:$G(ON)]""!($G(OFF)]"") CNTRL^VALM10(.LINE,.COL,$L(TEXT),$G(ON),$G(OFF)) 102 W:'(LINE#5) "." 103 Q 104 GPLAN(IBPLDA) ; get data from PLAN file (#366.03) related to the 105 ; GROUP INSURANCE PLAN file (#355.3) and the INSURANCE COMPANY file (#36) 106 ; that is associated with the PATIENT 107 ; input - IBPLDA - ien of the PLAN file (#366.03) 108 N IBPLN0,IBAIEN,IBAPIEN,IBAP0 109 S IBPLN0=$G(^IBCNR(366.03,IBPLDA,0)) ;; Q:'$P(IBPLN0,"^",3) ;quit if payer not defined 110 S IBPLNID=$P(IBPLN0,"^"),IBPLNNM=$P(IBPLN0,"^",2) 111 S IBAIEN=$O(^IBCNR(366.13,"B","E-PHARM","")) Q:'IBAIEN 112 S IBAPIEN=$O(^IBCNR(366.03,IBPLDA,3,"B",IBAIEN,"")) Q:'IBAPIEN 113 S IBAP0=$G(^IBCNR(366.03,IBPLDA,3,IBAPIEN,0)) 114 S IBPLNNA=$S($P(IBAP0,"^",2)=0:"NOT ACTIVE",1:"ACTIVE") 115 S IBPLNLA=$S($P(IBAP0,"^",3)=0:"NOT ACTIVE",1:"ACTIVE") 116 Q 117 ; 118 ;IBCNSP0
Note:
See TracChangeset
for help on using the changeset viewer.
