Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: IBCNS

IBCNS.m

Go to the documentation of this file.
  1. IBCNS ;ALB/AAS - IS INSURANCE ACTIVE ; 22-JULY-91
  1. ;;2.0;INTEGRATED BILLING;**28,43,80,82,133,399,516**;21-MAR-94;Build 123
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. ;MAP TO DGCRNS
  1. ;
  1. ;Input - DFN = patient
  1. ; - IBINDT = (optional) date to check ins active for or today if not defined
  1. ; - IBOUTP = (optional) 1 if want active insurance returned in IBDD(insurance company)=node in patient file
  1. ; - = 2 if want all ins returned
  1. ;
  1. ;Output - IBINS = 1 if has active ins., 0 if no active ins.
  1. ; - IBDD() = internal node in patient file of valid ins.
  1. ; - IBDDI() = internal node in patient file of invalid ins.
  1. ;
  1. % N J,X S IBINS=0 K IBDD,IBDDI
  1. ;IB*2.0*516/TAZ - Retrieve Insurance data with HIPAA compliant Fields
  1. ;S J=0 F S J=$O(^DPT(DFN,.312,J)) Q:'J I $D(^DPT(DFN,.312,J,0)) S X=^(0) D CHK
  1. S J=0 F S J=$O(^DPT(DFN,.312,J)) Q:'J I $D(^DPT(DFN,.312,J,0)) S X=$$ZND^IBCNS1(DFN,J) D CHK
  1. Q
  1. ;
  1. CHK ;
  1. ;Input - IBI = entry in insurance multiple
  1. ;
  1. S Z=$S($D(IBINDT):IBINDT,1:DT),Z1=$S($D(IBOUTP):IBOUTP,1:0)
  1. G:'$D(^DIC(36,+X,0)) CHKQ S X1=^(0) ;insurance company entry doesn't exist
  1. I $P(X,"^",8) G:Z<$P(X,"^",8) CHKQ ;effective date later than care
  1. I $P(X,"^",4) G:Z>$P(X,"^",4) CHKQ ;care after expiration date
  1. I $P($G(^IBA(355.3,+$P(X,"^",18),0)),"^",11) G CHKQ ;plan is inactive
  1. G:$P(X1,"^",5) CHKQ ;insurance company inactive
  1. I '$G(IBWNR) G:$P(X1,"^",2)="N" CHKQ ;insurance company will not reimburse
  1. ;IB*2.0*516/TAZ - Return Valid Insurance with HIPAA compliant fields
  1. S IBINS=1 I Z1 S IBDD(+X)=X
  1. ;S IBINS=1 I Z1 D
  1. ;.S IBDD(+X)=X
  1. ;.Q:'$P(IBDD(+X),"^",18)
  1. ;.S Y=$G(^IBA(355.3,+$P(IBDD(+X),"^",18),0))
  1. ;.I $P(Y,"^",4)'="" S $P(IBDD(+X),"^",3)=$P(Y,"^",4) ; move group number
  1. ;.I $P(Y,"^",3)'="" S $P(IBDD(+X),"^",15)=$P(Y,"^",3) ; move group name
  1. CHKQ ;
  1. ;IB*2.0*516/TAZ - Return Invalid Insurance with HIPAA compliant Fields
  1. I Z1=2&('$D(IBDD(+X))) S IBDDI(+X)=X
  1. ;I Z1=2&('$D(IBDD(+X))) D
  1. ;.S IBDDI(+X)=X
  1. ;.Q:'$P(IBDDI(+X),"^",18)
  1. ;.S Y=$G(^IBA(355.3,+$P(IBDDI(+X),"^",18),0))
  1. ;.I $P(Y,"^",4)'="" S $P(IBDDI(+X),"^",3)=$P(Y,"^",4) ; move group number
  1. ;.I $P(Y,"^",3)'="" S $P(IBDDI(+X),"^",15)=$P(Y,"^",3) ; move group name
  1. K X,X1,Z,Z1,Y Q
  1. ;
  1. DD ; - called from input transform and x-refs for field 101,102,103
  1. ; - input requires da=internal entry number in 399
  1. ; - outputs IBdd(ins co.) array
  1. ; patch 80 - Companies that Will Not Reimburse should be included so they can be added to the bill
  1. N DFN,IBWNR S DFN=$P(^DGCR(399,DA,0),"^",2),IBOUTP=1,IBINDT=$S(+$G(^DGCR(399,DA,"U")):+$G(^("U")),1:DT),IBWNR=1
  1. D %
  1. DDQ K IBOUTP,IBINDT Q
  1. ;
  1. ;
  1. DISP ; -Display all insurance company information
  1. ; -input DFN
  1. ;
  1. N IBDTIN
  1. DISPDT ; Entrypoint if IBDTIN is to be used to display coverage
  1. Q:'$D(DFN) D:'$D(IOF) HOME^%ZIS
  1. N X,IBINS,IBX
  1. D ALL^IBCNS1(DFN,"IBINS")
  1. ;
  1. D HDR
  1. I '$D(IBINS) W !," No Insurance Information" G DISPQ
  1. ;
  1. S X=0 F S X=$O(IBINS(X)) Q:'X S IBINS=IBINS(X,0) D D1 I +$G(IBCOVEXT) D D2EXT ; display
  1. ;
  1. DISPQ W ! S X=+$G(^IBA(354,DFN,60)) I +X W !,?16,"*** Verification of No Coverage ",$$FMTE^XLFDT(X)," ***"
  1. I $$BUFFER^IBCNBU1(DFN) W !,?17,"*** Patient has Insurance Buffer entries ***"
  1. Q
  1. ;
  1. OLDISP ; -Display all insurance company information
  1. ; -input DFN
  1. ;
  1. Q:'$D(DFN) D:'$D(IOF) HOME^%ZIS
  1. ;
  1. S IBOUTP=2 D IBCNS
  1. ;
  1. N IBDTIN
  1. D HDR
  1. I '$D(IBDD),'$D(IBDDI) W !," No Insurance Information" G DISPQ
  1. ;
  1. S X="" F S X=$O(IBDD(X)) Q:X="" S IBINS=IBDD(X) D D1 ;active insurance
  1. S X="" F S X=$O(IBDDI(X)) Q:X="" S IBINS=IBDDI(X) D D1 ;inactive ins
  1. ;
  1. OLDISPQ K IBDD,IBDDI,IBX
  1. Q
  1. ;
  1. HDR ; -- print standard header
  1. D HDR1("=",IOM-$S($G(IBDTIN):1,1:4))
  1. Q
  1. ;
  1. HDR1(CHAR,LENG) ; -- print header, specify character
  1. N OFF
  1. S OFF=$S($G(IBDTIN):0,1:2)
  1. W !?(1+OFF),"Insurance",?(13+OFF),"COB",?(17+OFF),"Subscriber ID",?(35+OFF),"Group",?(47+OFF),"Holder",?(55+OFF),"Effect"_$S('OFF:"",1:"i")_"ve",?(65+OFF+$S('OFF:0,1:1)),"Expires" W:'OFF ?75,"Only"
  1. I $G(CHAR)'="",LENG S X="",$P(X,CHAR,LENG)="" W !?(1+OFF),X
  1. Q
  1. ;
  1. D1 ; If IBDTIN is defined, this date is used for displaying insurance
  1. ; coverage if plan does not provide not full coverage for all categories
  1. N X,Y,Z,CAT,OFF Q:'$D(IBINS)
  1. S OFF=$S($G(IBDTIN):0,1:2)
  1. W !?(1+OFF),$S($D(^DIC(36,+IBINS,0)):$E($P(^(0),"^",1),1,10),1:"UNKNOWN")
  1. S X=$P(IBINS,U,20) I X'="" S X=$S(X=1:"p",X=2:"s",X=3:"t",1:"")
  1. W ?(14+OFF),X
  1. W ?(17+OFF),$E($P(IBINS,"^",2),1,16)
  1. ;W ?40,$E($S($P(IBINS,"^",15)'="":$P(IBINS,"^",15),1:$P(IBINS,"^",3)),1,10)
  1. W ?(35+OFF),$E($$GRP($P(IBINS,"^",18)),1,10)
  1. S X=$P(IBINS,"^",6) W ?(47+OFF),$S(X="v":"SELF",X="s":"SPOUSE",1:"OTHER")
  1. W ?(55+OFF),$$DAT1^IBOUTL($P(IBINS,"^",8)),?(65+OFF+$S(OFF:1,1:0)),$$DAT1^IBOUTL($P(IBINS,"^",4))
  1. I 'OFF D
  1. .I $P($G(^DIC(36,+IBINS,0)),U,2)="N" W ?74,"*WNR*" Q
  1. .S X="" F CAT="INPATIENT","OUTPATIENT","PHARMACY","MENTAL HEALTH","DENTAL","LONG TERM CARE" D
  1. .. S Y=$$PLCOV^IBCNSU3(+$P(IBINS,"^",18),$G(IBDTIN),+$O(^IBE(355.31,"B",CAT,"")))
  1. .. I +Y S Z=$S(CAT="PHARMACY":"R",1:$E(CAT)) S:Y>1 Z=$C($A(Z)+32) S X=X_Z
  1. .S:X="" X="no CV" I X'?6U W ?74,X
  1. Q
  1. ;
  1. GRP(IBCPOL) ; -- return group name/group policy
  1. ; input: IBCPOL = pointer to entry in 355.3
  1. ; output: group name or group number, if both group NUMBER
  1. ; if neither 'Individual PLAN'
  1. ;
  1. ;IB*2.0*516/TAZ Get HIPAA Compliant Fields
  1. ;original code:
  1. ;N X,Y S X=""
  1. ;S X=$G(^IBA(355.3,+$G(IBCPOL),0))
  1. ;S Y=$S($P(X,"^",4)'="":$P(X,"^",4),1:$P(X,"^",3))
  1. ;I $P(X,"^",10) S Y="Ind. Plan "_Y
  1. ;
  1. N Y
  1. S Y=$$GET1^DIQ(355.3,+$G(IBCPOL)_",",2.02) ;Group Number
  1. I Y="" S Y=$$GET1^DIQ(355.3,+$G(IBCPOL)_",",2.01) ;Group Name
  1. I $$GET1^DIQ(355.3,+$G(IBCPOL)_",",.1) S Y="Ind. Plan "_Y
  1. GRPQ ;
  1. Q Y
  1. ;
  1. D2EXT ; display Conditional Coverage Comments and Riders (DFN,IBINS,X required)
  1. N Y,CAT,IBX,IBY,IBZ,ARR,IBCDFN S IBCDFN=X,IBZ=0 N X
  1. F CAT="INPATIENT","OUTPATIENT","PHARMACY","MENTAL HEALTH","DENTAL","LONG TERM CARE" D
  1. . S Y=$$PLCOV^IBCNSU3(+$P(IBINS,"^",18),$G(IBDTIN),+$O(^IBE(355.31,"B",CAT,"")),.ARR)
  1. . S IBY=CAT_" Conditional: "
  1. . I +Y>1 S IBX=0 F S IBX=$O(ARR(IBX)) Q:'IBX W !,?17,IBY,?47,ARR(IBX) S IBY="",IBZ=1
  1. ;
  1. K ARR D RIDERS^IBCNSU3(DFN,IBCDFN,.ARR)
  1. S IBY="Policy Riders: " S IBX=0 F S IBX=$O(ARR(IBX)) Q:'IBX W !,?17,IBY,?35,ARR(IBX) S IBY="",IBZ=1
  1. I +IBZ W !
  1. Q