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

IBCNSP1.m

Go to the documentation of this file.
  1. IBCNSP1 ;ALB/AAS - INSURANCE MANAGEMENT - policy actions ;05-MAY-2015
  1. ;;2.0;INTEGRATED BILLING;**6,28,40,43,52,85,103,361,371,377,497,549**;21-MAR-94;Build 54
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;;ICR#5002 for read of ^DIE input template data
  1. ;
  1. % G EN^IBCNSP
  1. ;
  1. EA ; -- Edit all
  1. N IBCDFN,IBTRC,IBTRN
  1. D FULL^VALM1
  1. ;
  1. ;IB*2.0*549 - Added Security Key check
  1. I '$D(^XUSEC("IB GROUP PLAN EDIT",DUZ)) D Q
  1. . W !!,*7,"Sorry, but you do not have the required privileges to Edit All"
  1. . K DIR
  1. . D PAUSE^VALM1
  1. . D EAQ
  1. ;
  1. W !!
  1. S IBCDFN=$P($G(IBPPOL),"^",4)
  1. I 'IBCDFN W !!,"Can't identify the policy!" G EAQ
  1. S IBCNSEH=1 D PAT^IBCNSEH
  1. ;
  1. D BEFORE^IBCNSEVT
  1. D PATPOL^IBCNSM32(IBCDFN)
  1. D AFTER^IBCNSEVT,^IBCNSEVT
  1. ;
  1. ; -- edit policy data
  1. D POL^IBCNSEH
  1. D EDPOL^IBCNSM3(IBCDFN)
  1. ;
  1. W !!
  1. D AI
  1. ;
  1. EAQ ; Edit All Exit
  1. D:$G(IBTRC) AIP^IBCNSP02(IBTRC)
  1. D BLD^IBCNSP
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. AB ; -- Annual Benefits
  1. ;
  1. ; IB*2.0*549 - Added Security Key check
  1. I '$D(^XUSEC("IB GROUP PLAN EDIT",DUZ)) D Q
  1. . W !!,*7,"Sorry, but you do not have the required privileges to edit Annual Benefits."
  1. . K DIR
  1. . D PAUSE^VALM1
  1. . S VALMBCK="R"
  1. ;
  1. S X=+$P($G(IBPPOL),"^",4),IBCNS=+$G(^DPT(DFN,.312,X,0)),IBCPOL=+$P($G(^(0)),"^",18)
  1. I 'IBCPOL W !!,"Can't identify the plan!" S VALMBCK="" G ABQ
  1. D FULL^VALM1 W !!
  1. D EN^VALM("IBCNS ANNUAL BENEFITS")
  1. S VALMBCK="R"
  1. ABQ Q
  1. ;
  1. BU ; -- Benefits Used
  1. S IBCDFN=+$P($G(IBPPOL),"^",4),IBCNS=+$G(^DPT(DFN,.312,IBCDFN,0)),IBCPOL=+$P($G(^(0)),"^",18)
  1. I 'IBCPOL W !!,"Can't identify the plan!" S VALMBCK="" G BUQ
  1. D FULL^VALM1 W !!
  1. D EN^VALM("IBCNS BENEFITS USED BY DATE")
  1. S VALMBCK="R"
  1. BUQ Q
  1. ;
  1. IT ; -- edit insurance type info from patient policy and plan edit
  1. D FULL^VALM1
  1. ;
  1. ;IB*2.0*549 - Added Security Key check
  1. I '$D(^XUSEC("IB GROUP PLAN EDIT",DUZ)) D Q
  1. . W !!,*7,"Sorry, but you do not have the required privileges to edit Insurance Type"
  1. . W !,"Information."
  1. . K DIR
  1. . D PAUSE^VALM1
  1. . D ITQ
  1. ;
  1. W !!
  1. N IBCDFN
  1. S IBCDFN=+$P($G(IBPPOL),"^",4),IBCPOL=+$P($G(^DPT(DFN,.312,IBCDFN,0)),"^",18)
  1. I 'IBCPOL W !!,"Can't identify the plan!" S VALMBCK="" G ITQ
  1. D ITEDIT(IBCPOL,IBCDFN)
  1. ITQ ; Edit Insurance Type Exit
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. IT1 ; -- edit insurance type info from patient policy
  1. D FULL^VALM1
  1. ;
  1. ;IB*2.0*549 - Added Security Key check
  1. I '$D(^XUSEC("IB GROUP PLAN EDIT",DUZ)) D Q
  1. . W !!,*7,"Sorry, but you do not have the required privileges to edit Insurance Type"
  1. . W !,"Information."
  1. . K DIR
  1. . D PAUSE^VALM1
  1. . S VALMBCK="R"
  1. ;
  1. D ITEDIT(IBCPOL)
  1. S VALMBCK="R"
  1. Q
  1. ;
  1. ITEDIT(IBCPOL,IBCDFN) ;Edit insurance type info once you have plan (IBCPOL)
  1. ; IBCDFN = the ifn of the policy multiple for pt in ^DPT, node .312
  1. ; only defined for editing via patient policy
  1. G:'$G(IBCPOL) ITEDITQ
  1. D SAVE^IBCNSP3(IBCPOL)
  1. L +^IBA(355.3,+IBCPOL):5 I '$T D LOCKED^IBTRCD1 G ITEDITQ
  1. I $G(IBCDFN) S IBCNSEH=+$G(^IBE(350.9,1,4)) D POL^IBCNSEH
  1. I $P($G(^IBA(355.3,IBCPOL,0)),"^",11) W !?2,*7,"Please note that this plan is inactive!",!
  1. S DA=IBCPOL,DIE="^IBA(355.3,",DR=".05;.12;.06;.07;.08"
  1. D ^DIE K DIC,DIE,DA,DR
  1. D COMP^IBCNSP3(IBCPOL)
  1. I IBDIF D UPDATE^IBCNSP3(IBCPOL) D:$G(IBCDFN) UPDATPT^IBCNSP3(DFN,IBCDFN),BLD^IBCNSP D:'$G(IBCDFN) INIT^IBCNSC4
  1. L -^IBA(355.3,+IBCPOL)
  1. ITEDITQ Q
  1. ;
  1. ED ; -- Edit effective dates
  1. D FULL^VALM1 W !!
  1. N IBDIF,DA,DR,DIE,DIC
  1. D BEFORE^IBCNSEVT
  1. D SAVEPT^IBCNSP3(DFN,IBCDFN)
  1. L +^DPT(DFN,.312,+$P($G(IBPPOL),"^",4)):5 I '$T D LOCKED^IBTRCD1 G EDQ
  1. D VARS^IBCNSP3
  1. S DR="8;3;1.09//;3.04"
  1. D ^DIE K DIC,DIE,DA,DR
  1. D COMPPT^IBCNSP3(DFN,IBCDFN) I IBDIF D UPDATPT^IBCNSP3(DFN,IBCDFN),UPDCLM(DFN,IBCDFN),AFTER^IBCNSEVT,^IBCNSEVT,BLD^IBCNSP
  1. L -^DPT(DFN,.312,+$P($G(IBPPOL),"^",4))
  1. EDQ S VALMBCK="R" Q
  1. ;
  1. VC ; -- Verify Coverage
  1. D FULL^VALM1 W !!
  1. D VFY^IBCNSM2
  1. D BLD^IBCNSP
  1. S VALMBCK="R" Q
  1. ;
  1. SU ; -- Subscriber Update
  1. D FULL^VALM1 W !!
  1. ;Patch 40
  1. N IBDIF,DA,DR,DIC,DIE,DGSENFLG
  1. S DGSENFLG=1
  1. D SAVEPT^IBCNSP3(DFN,IBCDFN)
  1. D VARS^IBCNSP3
  1. L +^DPT(DFN,.312,+$P($G(IBPPOL),"^",4)):5 I '$T D LOCKED^IBTRCD1 G SUQ
  1. ;
  1. D EDIT(DFN,IBCDFN) ; IB*371 - edit pat ins 2.312 subfile fields
  1. ;
  1. D COMPPT^IBCNSP3(DFN,IBCDFN)
  1. I IBDIF D UPDATPT^IBCNSP3(DFN,IBCDFN),BLD^IBCNSP
  1. L -^DPT(DFN,.312,+$P($G(IBPPOL),"^",4))
  1. SUQ S VALMBCK="R" Q
  1. ;
  1. IC ; -- Insurance Contact Information
  1. D FULL^VALM1 W !!
  1. N IBDIF,DA,DR,DIC,DIE,IBTRC,DIR,DUOUT,DTOUT,DIRUT,IBTRN
  1. D AI
  1. D:$G(IBTRC) AIP^IBCNSP02(IBTRC),BLD^IBCNSP
  1. S VALMBCK="R" Q
  1. Q
  1. AI ; -- Add ins. verification entry
  1. N X,Y,I,J,DA,DR,DIC,DIE,DR,DD,DO,VA,VAIN,VAERR,IBQUIT,IBXIFN,IBTRN,DUOUT,IBX,IBQUIT,DTOUT
  1. Q:'$G(DFN)
  1. Q:'$G(IBCDFN) S IBQUIT=0
  1. D AI^IBCNSP02
  1. Q
  1. ;
  1. PIDEF(IBREL,FLD,IBDFN,SPDEF) ; Function to return patient file defaults
  1. ; Called from input template IBCN PATIENT INSURANCE
  1. ; IBREL = value from 2.312,4.03 field (PT. RELATIONSHIP - HIPAA)
  1. ; FLD = field# in file 2.312
  1. ; IBDFN = patient ien to file 2
  1. ; SPDEF = spouse default flag =1 if this field should be defaulted
  1. ; when the spouse is the policy holder
  1. ;
  1. ; The purpose is to provide a default value for the field when the
  1. ; patient and the ins. subscriber are the same.
  1. ;
  1. NEW VAL
  1. S VAL=""
  1. I +$G(IBREL)'=1,+$G(IBREL)'=18 G PIDEFX ; patient not the insured or spouse, get out
  1. I +$G(IBREL)=1,'$G(SPDEF) G PIDEFX ; not a field for spouse default
  1. I '$G(FLD) G PIDEFX ; no field# passed in
  1. I '$G(IBDFN) G PIDEFX ; no patient passed in
  1. ;
  1. ; Build the patient demographics area
  1. I '$D(^UTILITY("VADM",$J)) D
  1. . N VAHOW,DFN,VADM
  1. . S VAHOW=2,DFN=IBDFN D DEM^VADPT
  1. . Q
  1. ;
  1. ; Build the patient address area
  1. I '$D(^UTILITY("VAPA",$J)) D
  1. . N VAHOW,DFN,VAPA
  1. . S VAHOW=2,DFN=IBDFN,VAPA("P")="" D ADD^VADPT
  1. . Q
  1. ;
  1. I FLD=7.01 S VAL=$P($G(^UTILITY("VADM",$J,1)),U,1) G PIDEFX ; Name - IB*2.0*497 (vd)
  1. I FLD=3.01 S VAL=$$FMTE^XLFDT($P($G(^UTILITY("VADM",$J,3)),U,1),"5Z") G PIDEFX ; Date of Birth
  1. I FLD=3.02 S VAL=$$EXTERNAL^DILFD(2,.325,,$P($G(^DPT(IBDFN,.32)),U,5)) G PIDEFX ; Branch
  1. I FLD=3.05 S VAL=$P($G(^UTILITY("VADM",$J,2)),U,2) G PIDEFX ; SSN
  1. I FLD=3.06 S VAL=$P($G(^UTILITY("VAPA",$J,1)),U,1) G PIDEFX ; Street Address 1
  1. I FLD=3.07 S VAL=$P($G(^UTILITY("VAPA",$J,2)),U,1) G PIDEFX ; Street Address 2
  1. I FLD=3.08 S VAL=$P($G(^UTILITY("VAPA",$J,4)),U,1) G PIDEFX ; City
  1. I FLD=3.09 S VAL=$P($G(^UTILITY("VAPA",$J,5)),U,2) G PIDEFX ; State
  1. I FLD=3.1 S VAL=$P($G(^UTILITY("VAPA",$J,11)),U,2) G PIDEFX ; Zipcode
  1. I FLD=3.11 S VAL=$P($G(^UTILITY("VAPA",$J,8)),U,1) G PIDEFX ; Phone#
  1. I FLD=3.12 S VAL=$P($G(^UTILITY("VADM",$J,5)),U,2) G PIDEFX ; Sex
  1. PIDEFX ;
  1. Q VAL
  1. ;
  1. ASK(QUES,DEFLT) ; Function to ask Yes/No Question
  1. ; Returns 1 (yes), 0 (no, up-arrow, or timeout)
  1. NEW X,Y,DIR,DTOUT,DUOUT,DIRUT,DIROUT
  1. S DIR(0)="Y",DIR("A")=$G(QUES)
  1. S DIR("B")=$S($G(DEFLT):"Yes",1:"No")
  1. W ! D ^DIR W:Y !
  1. I $D(DIRUT) S Y=0
  1. ASKX ;
  1. Q Y
  1. ;
  1. EDIT(IBDFN,IBCDFN,IBQUIT) ; Main call to edit data in 2.312 pat ins subfile
  1. ; IBDFN - patient DFN
  1. ; IBCDFN - ien for patient insurance policy in subfile 2.312
  1. ; IBQUIT - Output variable. Pass by reference. Will be set to 1 if
  1. ; the user entered an up-arrow, timed-out, or deleted the
  1. ; 2.312 subfile entry by entering "@" at the .01 field
  1. ;
  1. NEW DA,DR,DIE,IBZ,IBY,X,Y,DTOUT
  1. NEW IDS,SUB,PAT,PCE,SUB1,PAT1
  1. S DA(1)=+$G(IBDFN) ; patient IEN
  1. S DA=+$G(IBCDFN) ; patient insurance IEN
  1. I 'DA!'DA(1) G EDITX
  1. S DIE="^DPT("_IBDFN_",.312,"
  1. ;
  1. ; Find the input template IEN for the [IBCN PATIENT INSURANCE] template
  1. S IBY=+$$FIND1^DIC(.402,,"X","IBCN PATIENT INSURANCE")
  1. I 'IBY G EDITX
  1. ;
  1. ; Build the DR array/string - ICR# 5002
  1. M DR(1)=^DIE(IBY,"DR",2)
  1. S DR=$G(DR(1,2.312))
  1. I DR="" G EDITX
  1. ;
  1. S $P(^DIE(IBY,0),U,7)=DT ; see TEM+2^DIE ICR# 5002
  1. ;
  1. D ^DIE ; edit subfile data
  1. ;
  1. ; If the user entered an up-arrow, or timed-out, or deleted the entry,
  1. ; then set the output variable IBQUIT
  1. I $D(Y)!$D(DTOUT)!'$D(DA) S IBQUIT=1
  1. ;
  1. F IBZ="VADM","VAPA" K ^UTILITY(IBZ,$J) ; cleanup scratch global
  1. ;
  1. D UPDCLM(IBDFN,IBCDFN) ; update editable claims
  1. ;
  1. ; Cleanup any problems in the secondary ID area
  1. S IDS=$G(^DPT(IBDFN,.312,IBCDFN,5)) ; whole 5 node
  1. S (SUB,PAT)=""
  1. F PCE=3:1:8 S $P(SUB,U,PCE)=$P(IDS,U,PCE-1) ; subscriber sec ID/qual
  1. F PCE=3:1:8 S $P(PAT,U,PCE)=$P(IDS,U,PCE+5) ; patient sec ID/qual
  1. ; SUB and PAT are 8-piece strings with pieces 1 and 2 being nil
  1. S SUB1=$$SCRUB^IBCEF21(SUB) ; scrub 8-piece string
  1. S PAT1=$$SCRUB^IBCEF21(PAT) ; scrub 8-piece string
  1. I SUB'=SUB1 S $P(^DPT(IBDFN,.312,IBCDFN,5),U,2,7)=$P(SUB1,U,3,8)
  1. I PAT'=PAT1 S $P(^DPT(IBDFN,.312,IBCDFN,5),U,8,13)=$P(PAT1,U,3,8)
  1. ;
  1. EDITX ;
  1. Q
  1. ;
  1. UPDCLM(IBDFN,IBCDFN) ; Update the Insurance nodes of claims that are still editable
  1. NEW IBIFN
  1. S IBIFN=0 F S IBIFN=$O(^DGCR(399,"C",IBDFN,IBIFN)) Q:'IBIFN D UPDCLM^IBCNSP2(IBIFN,IBDFN,IBCDFN)
  1. ;
  1. UPDCLMX ;
  1. Q
  1. ;
  1. PRELCNV(CODE,FLG) ; conversion between X12, NCPDP and VistA pt. relationship codes
  1. ; CODE - code for pt. relationship to convert
  1. ; FLG - 0 for X12 -> VistA conversion, 1 for VistA -> X12 conversion, 2 - for VistA -> NCPDP conversion
  1. ; returns converted code for pt. relationship, or null if no match found
  1. N I,RES,VSTR,X12STR
  1. S VSTR="01^02^03^08^11^15^32^33^34^35^36"
  1. S X12STR="18^01^19^20^39^41^32^33^29^53^G8"
  1. S RES=""
  1. I FLG=0 F I=1:1:11 S:$P(X12STR,U,I)=CODE RES=$P(VSTR,U,I) Q:RES'=""
  1. I FLG=1 F I=1:1:11 S:$P(VSTR,U,I)=CODE RES=$P(X12STR,U,I) Q:RES'=""
  1. I FLG=2,+CODE>0 S RES=$S(+CODE>3:"04",1:CODE)
  1. Q RES