Changeset 636 for FOIAVistA/tag/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNSP0.m

Timestamp:

Dec 4, 2009, 8:26:01 PM (14 years ago)

Author:

George Lilly

Message:

WorldVistAEHR overlayed on FOIAVistA

Location:

FOIAVistA/tag/r

Files:

• . (copied) (copied from FOIAVistA/trunk/r )
• INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNSP0.m (modified) (8 diffs)

FOIAVistA/tag/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNSP0.m

@@ -1 @@
-IBCNSP0 ;ALB/AAS - INSURANCE MANAGEMENT - EXPANDED POLICY ;05-MAR-1993
- ;;2.0;INTEGRATED BILLING;**28,43,52,85,93,103,137,229,251,363,371**;21-MAR-94;Build 57
+IBCNSP0 ;ALB/AAS - INSURANCE MANAGEMENT - EXPANDED POLICY  ;05-MAR-1993
+ ;;2.0;INTEGRATED BILLING;**28,43,52,85,93,103,137,229,251,363**;21-MAR-94;Build 35
  ;;Per VHA Directive 2004-038, this routine should not be modified.
  ;
@@ -6 +6 @@
 CONTACT ; -- Insurance Contact Information
  N OFFSET,START
- ;
- ; The start of this section is designed to start on the same line
- ; as the User Information section (see VER^IBCNSP01).
- ;
- S START=$O(^TMP("IBCNSVP",$J,""),-1)-8
- S IB1ST("CONTACT")=START
- S OFFSET=42
+ S START=41+$G(IBLCNT),OFFSET=42
  N IBTRC,IBTRCD,IBTCOD
  S IBTCOD=$O(^IBE(356.11,"ACODE",85,0))
@@ -22 +16 @@
  .S IBTRCD=$G(^IBT(356.2,+IBTRC,0))
  ;
+ I '$D(@VALMAR@(START-1)) D SET(START-1,OFFSET,"  ")
  D SET(START,OFFSET," Insurance Contact (last) ",IORVON,IORVOFF)
  D SET(START+1,OFFSET," Person Contacted: "_$$EXPAND^IBTRE(356.2,.06,$P(IBTRCD,"^",6)))
@@ -28 +23 @@
  D SET(START+4,OFFSET,"    Call Ref. No.: "_$$EXPAND^IBTRE(356.2,.09,$P(IBTRCD,"^",9)))
  D SET(START+5,OFFSET,"     Contact Date: "_$$EXPAND^IBTRE(356.2,.01,$P(IBTRCD,"^")))
- ; no blank lines here because the User Information section is on the
- ; left and it is bigger than this section
  Q
  ;
@@ -51 +44 @@
  . D SET(START+IBX,OFFSET," Electronic Type: "_$$EXPAND^IBTRE(355.3,.15,$P(IBCPOLD,"^",15))) S IBX=IBX+1
  D SET(START+IBX,OFFSET,"  Plan Filing TF: "_$P(IBCPOLD,"^",13)) S IBX=IBX+1
- ;
+ ; -- in case pointer is missing
  D SET(START+IBX,OFFSET,"      ePharmacy Plan ID: "_IBPLNID) S IBX=IBX+1
  D SET(START+IBX,OFFSET,"    ePharmacy Plan Name: "_IBPLNNM) S IBX=IBX+1
  D SET(START+IBX,OFFSET,"  ePharmacy Natl Status: "_IBPLNNA) S IBX=IBX+1
  D SET(START+IBX,OFFSET," ePharmacy Local Status: "_IBPLNLA) S IBX=IBX+1
- ;
- ; -- in case pointer is missing
  I '$G(^IBA(355.3,+$P(IBCDFND,"^",18),0)) D
  .D SET(START+1,OFFSET,"Insurance Number: "_$P(IBCDFND,"^",2))
@@ -82 +73 @@
  ;
 SPON ; -- Sponsor (Insured Person) Region
- N IBC3,IBZIP,START,OFFSET,IBA,DA,DR,DIC,DIQ
- S IBC3=$G(^DPT(DFN,.312,IBCDFN,3))
+ N IBC3,IBSSN,IBZIP,START,OFFSET,IBA,DA,DR,DIC,DIQ
+ S IBC3=$G(^DPT(DFN,.312,IBCDFN,3)),IBSSN=$P(IBC3,"^",5)
  S DA=+$P(IBC3,"^",2),DR=.01,DIQ(0)="E",DIC="^DIC(23,",DIQ="IBA" D EN^DIQ1
- S START=$O(^TMP("IBCNSVP",$J,""),-1)+1,OFFSET=4
- D SET(START,OFFSET," Insured Person's Information (use Subscriber Update Action) ",IORVON,IORVOFF)
+ S START=30,OFFSET=4
+ D SET(START,OFFSET," Insured Person's Information (use Subscriber Update action) ",IORVON,IORVOFF)
  D SET(START+1,OFFSET,"    Insured's DOB: "_$$DAT3^IBOUTL($P(IBC3,"^")))
- D SET(START+2,OFFSET,"    Insured's Sex: "_$$EXTERNAL^DILFD(2.312,3.12,,$P(IBC3,U,12)))
- D SET(START+3,OFFSET," Insured's Branch: "_$G(IBA(23,DA,.01,"E")))
- D SET(START+4,OFFSET,"   Insured's Rank: "_$P(IBC3,"^",3))
+ D SET(START+2,OFFSET," Insured's Branch: "_$G(IBA(23,DA,.01,"E")))
+ D SET(START+3,OFFSET,"   Insured's Rank: "_$P(IBC3,"^",3))
+ D SET(START+4,OFFSET,"    Insured's SSN: "_$S(IBSSN]"":$E(IBSSN,1,3)_"-"_$E(IBSSN,4,5)_"-"_$E(IBSSN,6,9),1:""))
  ;
  S OFFSET=43
@@ -99 +90 @@
  D SET(START+4,OFFSET,"St/Zip: "_$P($G(^DIC(5,+$P(IBC3,"^",9),0)),"^",2)_"  "_IBZIP)
  D SET(START+5,OFFSET," Phone: "_$P(IBC3,"^",11))
- ;
- ; blank lines at end of section
- D SET(START+6,2," ")
- D SET(START+7,2," ")
  Q
  ;
@@ -115 +102 @@
  W:'(LINE#5) "."
  Q
- ;
 GPLAN(IBPLDA) ; get data from PLAN file (#366.03) related to the
  ; GROUP INSURANCE PLAN file (#355.3) and the INSURANCE COMPANY file (#36)