Ignore:
Timestamp:
Dec 4, 2009, 8:26:01 PM (14 years ago)
Author:
George Lilly
Message:

WorldVistAEHR overlayed on FOIAVistA

Location:
FOIAVistA/tag/r
Files:
1 edited
1 copied

Legend:

Unmodified
Added
Removed
  • FOIAVistA/tag/r/INTEGRATED_BILLING-IB-PRQ--IBD--IBQ--PRQS/IBCNSP01.m

    r628 r636  
    1 IBCNSP01 ;ALB/AAS - INSURANCE MANAGEMENT - EXPANDED POLICY  ;05-MAR-1993
    2  ;;2.0;INTEGRATED BILLING;**43,52,85,251,371,377**;21-MAR-94;Build 23
    3  ;;Per VHA Directive 2004-038, this routine should not be modified.
     1IBCNSP01 ;ALB/AAS - INSURANCE MANAGEMENT - EXPANDED POLICY  ; 05-MAR-1993
     2 ;;2.0;INTEGRATED BILLING;**43,52,85,251**;21-MAR-94
     3 ;;Per VHA Directive 10-93-142, this routine should not be modified.
    44 ;
    55 ;
     
    99SUBSC ; -- subscriber region
    1010 N OFFSET,START
    11  S START=24,OFFSET=2
     11 S START=19,OFFSET=2
    1212 D SET^IBCNSP(START,OFFSET," Subscriber Information ",IORVON,IORVOFF)
    1313 S Y=$P(IBCDFND,"^",6),C=$P(^DD(2.312,6,0),"^",2) D Y^DIQ
    1414 D SET^IBCNSP(START+1,OFFSET," Whose Insurance: "_Y)
    1515 D SET^IBCNSP(START+2,OFFSET," Subscriber Name: "_$P(IBCDFND,"^",17))
    16  S Y=$P(IBCDFND4,"^",3),C=$P(^DD(2.312,4.03,0),"^",2) D Y^DIQ
     16 S Y=$P(IBCDFND,"^",16),C=$P(^DD(2.312,16,0),"^",2) D Y^DIQ
    1717 D SET^IBCNSP(START+3,OFFSET,"    Relationship: "_Y)
    18  D SET^IBCNSP(START+4,OFFSET,"      Primary ID: "_$P(IBCDFND,"^",2))
     18 D SET^IBCNSP(START+4,OFFSET,"Insurance Number: "_$P(IBCDFND,"^",2))
    1919 S Y=$P(IBCDFND,"^",20),C=$P(^DD(2.312,.2,0),"^",2) D Y^DIQ
    2020 D SET^IBCNSP(START+5,OFFSET,"Coord.  Benefits: "_Y)
     
    2525VER ; -- Entered/Verfied Region
    2626 N OFFSET,START
    27  S START=$O(^TMP("IBCNSVP",$J,""),-1)+1,OFFSET=2
    28  S IB1ST("VERIFY")=START
     27 S START=41+$G(IBLCNT),OFFSET=2
     28 I '$D(@VALMAR@(START-1)) D SET^IBCNSP(START-1,OFFSET,"  ")
    2929 D SET^IBCNSP(START,OFFSET," User Information ",IORVON,IORVOFF)
     30 I IBCDFND1="" D SET^IBCNSP(START+1,OFFSET,"No User Information") G VERQ
    3031 D SET^IBCNSP(START+1,OFFSET,"      Entered By: "_$E($P($G(^VA(200,+$P(IBCDFND1,"^",2),0)),"^",1),1,20))
    3132 D SET^IBCNSP(START+2,OFFSET,"      Entered On: "_$$DAT1^IBOUTL(+IBCDFND1))
     
    3435 D SET^IBCNSP(START+5,OFFSET," Last Updated By: "_$E($P($G(^VA(200,+$P(IBCDFND1,"^",6),0)),"^",1),1,20))
    3536 D SET^IBCNSP(START+6,OFFSET," Last Updated On: "_$$DAT1^IBOUTL(+$P(IBCDFND1,"^",5)))
    36  D SET^IBCNSP(START+7,2," ")   ; 2 blank lines to end section
    37  D SET^IBCNSP(START+8,2," ")
    3837VERQ Q
    39  ;
    40 ID ; Subscriber and patient primary and secondary ID's and qualifiers
    41  NEW START,OFFSET,IBL,G,PCE,QUAL,QUAL1
    42  S G=IBCDFND5
    43  S (START,IBL)=$O(^TMP("IBCNSVP",$J,""),-1)+1,OFFSET=2
    44  S IB1ST("ID")=START
    45  D SET^IBCNSP(START,OFFSET," Insurance Company ID Numbers (use Subscriber Update Action) ",IORVON,IORVOFF)
    46  S IBL=IBL+1
    47  D SET^IBCNSP(IBL,OFFSET,"  Subscriber Primary ID: "_$P(IBCDFND,U,2))
    48  ;
    49  F PCE=3,5,7 D            ; subscriber secondary IDs
    50  . I $P(G,U,PCE)="" Q     ; no secondary ID#
    51  . S QUAL=$P(G,U,PCE-1)   ; internal qualifier code
    52  . S QUAL1=$S(QUAL="23":"Client#",QUAL="IG":"Ins. Policy#",QUAL="SY":"SSN",1:"Unknown")
    53  . S IBL=IBL+1
    54  . D SET^IBCNSP(IBL,OFFSET,"Subscriber Secondary ID: "_$P(G,U,PCE))
    55  . D SET^IBCNSP(IBL,52,"ID Qual: "_QUAL_" ("_QUAL1_")")
    56  . Q
    57  ;
    58  ; patient=subscriber so skip over patient ID# display
    59  I +$P(IBCDFND,U,16)=1 G ID1
    60  ;
    61  S IBL=IBL+1 D SET^IBCNSP(IBL,2," ")   ; blank line
    62  S IBL=IBL+1
    63  D SET^IBCNSP(IBL,OFFSET,"     Patient Primary ID: "_$P(G,U,1))
    64  ;
    65  F PCE=9,11,13 D          ; patient secondary IDs
    66  . I $P(G,U,PCE)="" Q     ; no secondary ID#
    67  . S QUAL=$P(G,U,PCE-1)   ; internal qualifier code
    68  . S QUAL1=$S(QUAL="23":"Client#",QUAL="IG":"Ins. Policy#",QUAL="SY":"SSN",1:"Unknown")
    69  . S IBL=IBL+1
    70  . D SET^IBCNSP(IBL,OFFSET,"   Patient Secondary ID: "_$P(G,U,PCE))
    71  . D SET^IBCNSP(IBL,52,"ID Qual: "_QUAL_" ("_QUAL1_")")
    72  . Q
    73  ;
    74 ID1 ; end of section - 2 blank lines
    75  S IBL=IBL+1 D SET^IBCNSP(IBL,2," ")
    76  S IBL=IBL+1 D SET^IBCNSP(IBL,2," ")
    77 IDQ ;
    78  Q
    7938 ;
    8039RIDER ; -- Personal policy riders
    8140 N OFFSET,START,IBI,IBL,IBPR,IBPRD
    82  S START=$O(^TMP("IBCNSVP",$J,""),-1)+1,OFFSET=2,IBL=0
     41 S START=53+$G(IBLCNT),OFFSET=2,IBL=0
     42 I '$D(@VALMAR@(START-1)) D SET^IBCNSP(START-1,OFFSET,"  ")
    8343 D SET^IBCNSP(START,OFFSET," Personal Riders ",IORVON,IORVOFF)
    8444 S IBI="" F  S IBI=$O(^IBA(355.7,"APP",DFN,IBCDFN,IBI)) Q:'IBI  S IBPR=$O(^(IBI,0)),IBPRD=+$G(^IBA(355.7,IBPR,0)),IBL=IBL+1 D
    85  . D SET^IBCNSP(START+IBL,OFFSET,"   Rider #"_IBL_": "_$$EXPAND^IBTRE(355.7,.01,IBPRD))
    86  . Q
    87  S IBL=IBL+1 D SET^IBCNSP(START+IBL,OFFSET," ")
    88  S IBL=IBL+1 D SET^IBCNSP(START+IBL,OFFSET," ")
     45 .D SET^IBCNSP(START+IBL,OFFSET,"   Rider #"_IBL_": "_$$EXPAND^IBTRE(355.7,.01,IBPRD))
     46 S IBLCNT=$G(IBLCNT)+IBL
    8947 Q
    9048 ;
    9149AI ; -- Add ins. verification entry
    9250 ;    called from ai^ibcnsp1
     51 ;N X,Y,I,J,DA,DR,DIC,DIE,DR,DD,DO,VA,VAIN,VAERR,IBQUIT,IBXIFN,IBTRN,DUOUT,IBX,IBQUIT,DTOUT
     52 ;Q:'$G(DFN)
     53 ;Q:'$G(IBCDFN)  S IBQUIT=0
    9354 ;
    9455 ; -- see if current inpatient
Note: See TracChangeset for help on using the changeset viewer.