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

IBCNSU1.m

Go to the documentation of this file. 
  1. IBCNSU1 ;ALB/AAS - INSURANCE UTILITY ROUTINE ;19-MAY-93
  1.  ;;2.0;INTEGRATED BILLING;**103,133,244,371,416**;21-MAR-94;Build 58
  1.  ;;Per VHA Directive 2004-038, this routine should not be modified.
  1.  ;
  1. RCHK(X) ; -- Input transform for different revenue codes in file 36
  1.  ;    Returns 1 if passes, 0 if not pass input transform
  1.  ;
  1.  N I,Y,RC,NO S Y=0
  1.  I $G(X)="" G RCHKQ
  1.  F I=1:1 S RC=$P(X,",",I) Q:RC=""  I $S(RC?3N:0,RC?5N:0,1:1) S NO=1 Q
  1.  I '$G(NO) S Y=1
  1. RCHKQ Q Y
  1.  ;
  1. BU(DFN,IBCPOL,IBYR,IBCDFN,IBASK) ; -- Return entry in Benefits Used file
  1.  ;     Input:  IBCDFN  = pointer to patient file policy (2.312)
  1.  ;             DFN     = patient pointer        
  1.  ;             IBCPOL  = pointer to health insurance policy file
  1.  ;             IBYR    = fileman internal date, year will be calendar
  1.  ;                       year of the internal date, Default = dt
  1.  ;             IBASK   = 1 if want to ask okay to add new entry
  1.  ;
  1.  ;    Output:  IBCBU   = pointer to Benefits Used file if added,
  1.  ;                       else null
  1.  ;
  1.  N DIR,IBCBU
  1.  S IBCBU=""
  1.  I $G(IBCPOL)="" G BUQ
  1.  I $G(IBYR)="" S IBYR=DT
  1.  ;
  1.  ;if no match display message
  1.  I '$O(^IBA(355.4,"APY",IBCPOL,-IBYR,0)) W !!,"You cannot add a new Benefits Used BENEFIT YEAR",!! G BUQ
  1.  ;
  1.  ; -- try to find entry for policy for year
  1.  S IBCBU=$O(^IBA(355.5,"APPY",DFN,IBCPOL,-IBYR,IBCDFN,0))
  1.  ;
  1.  ; -- if no match add new entry
  1.  I 'IBCBU D
  1.  .I $G(IBASK) S DIR(0)="Y",DIR("A")="Are you adding a new Benefits Used YEAR",DIR("B")="YES" D ^DIR I $D(DIRUT)!(Y<1) S VALMQUIT="" Q
  1.  .S IBCBU=$$ADDBU(DFN,IBCPOL,IBYR,IBCDFN)
  1.  .Q
  1.  ;
  1. BUQ Q IBCBU
  1.  ;
  1. ADDBU(DFN,IBCPOL,IBYR,IBCDFN) ; -- add entries to Benefits Used file
  1.  ;     Input:  DFN     = pointer to patient file
  1.  ;             IBCDFN  = point to patient policy (2.312)
  1.  ;             IBCPOL  = pointer to health insurance policy file
  1.  ;             IBYR    = fileman internal date, year will be calendar
  1.  ;                       year of the internal date, Default = dt
  1.  ;
  1.  ;    Output:  IBCBU   = pointer to Benefits Used file if added,
  1.  ;                       else null
  1.  ;
  1.  N %DT,IBN1,IBCBU,DIC,DIE,DR,DA,DLAYGO,DO,DD
  1.  S IBCBU=""
  1.  I $G(IBCDFN)="" G ADDBUQ
  1.  I $G(IBCPOL)="" G ADDBUQ
  1.  I $G(IBYR)="" S IBYR=DT
  1.  K DD,DO,DIC,DR S DIC="^IBA(355.5,",DIC(0)="L",DLAYGO=355.5
  1.  ;
  1.  ;S IBYR=$E(IBYR,1,3)_"0000"
  1.  S X=IBCPOL D FILE^DICN I +Y<0 G ADDBUQ
  1.  S (IBCBU,DA)=+Y,DIE="^IBA(355.5,",DR=".02////"_DFN_";.03////"_IBYR_";.17////"_IBCDFN_";1.01///NOW;1.02////"_DUZ
  1.  D ^DIE K DIC,DIE,DA,DR
  1. ADDBUQ Q IBCBU
  1.  ;
  1. VET() ; -- Input Transform for sub-file 2.312, Name of Insured (#17)
  1.  ;    Quit 1 to stuff Patient Name
  1.  ;    Quit 0 to not stuff and allow editing
  1.  ;
  1.  N IBY,IB0 S IBY=0
  1.  G VETQ    ; IB*2*371 - Allow edits to the patient name in all cases
  1.  S IB0=$G(^DPT(+$G(DA(1)),.312,+$G(DA),0))
  1.  I $P(IB0,"^",6)'="v" G VETQ
  1.  I +IB0'=+$$GETWNR^IBCNSMM1 S IBY=1 G VETQ
  1.  I '$D(X),$P(IB0,"^",17)="" S IBY=1
  1. VETQ Q IBY
  1.  ;
  1.  ;
  1. SUBID ; -- Input Transform for sub-file #2.312, Subscriber ID (#1)
  1.  N NODE,L,X1
  1.  S NODE=$G(^DPT(DA(1),.312,DA,0))
  1.  ;
  1.  ; - if the policy is a Medicare policy, make sure the subscriber ID
  1.  ;   is a valid HICN number
  1.  I $P(NODE,U,1)=+$$GETWNR^IBCNSMM1 S X=$TR(X,"-","") I '$$VALHIC^IBCNSMM(X) D HLP^IBCNSM32 K X Q
  1.  ;
  1.  ; If subscriber ID is the SSN of patient, remove all extraneous characters
  1.  S L=$$NOPUNCT^IBCEF($P($G(^DPT(DA(1),0)),U,9),1)    ; patient SSN
  1.  S X1=$$NOPUNCT^IBCEF(X,1)  ; X1 is user's response w/o punctuation
  1.  I X1?9N,X1=L S X=X1
  1.  ;
  1.  K:$L(X)>20!($L(X)<3) X     ; Answer must be 3-20 characters in length
  1.  Q
  1.  ;
  1.  ;
  1. HICN(DFN) ; -- return Patient's Medicare HIC number
  1.  ;    Return HICN of Medicare WNR Part A or Part B
  1.  ;    Return -1 if none exits
  1.  ;
  1.  N IBWNR,IBX,IBY,IB0
  1.  S IBWNR=$$GETWNR^IBCNSMM1,IBY=""
  1.  I '$O(^DPT(DFN,.312,"B",+IBWNR,0)) S IBY=-1 G HICNQ
  1.  S IBX=0 F  S IBX=$O(^DPT(DFN,.312,"B",+IBWNR,IBX)) Q:('IBX)!(IBY]"")  D
  1.  .S IB0=$G(^DPT(DFN,.312,IBX,0))
  1.  .I $P(IB0,U,18)'=$P(IBWNR,U,3),$P(IB0,U,18)'=$P(IBWNR,U,5) Q
  1.  .; 8/18/2003 - Added translation code to remove hyphens if they exist.
  1.  .I $P(IB0,U,2)]"" S IBY=$TR($P(IB0,U,2),"- ","")
  1.  S:IBY="" IBY=-1
  1. HICNQ Q IBY
  1.  ;
  1. CHKQUAL(DFN,IEN,QUAL,PC1,PC2) ; check for duplicate qualifiers for patient
  1.  ; and subscriber secondary ID's.  All parameters required.
  1.  ;
  1.  ;   DFN - internal patient#
  1.  ;   IEN - ien of 2.312 subfile
  1.  ;  QUAL - passed in response of the user (this is what is being 
  1.  ;         checked to see if it is valid)
  1.  ;   PC1 - this is the piece# for one of the other qualifiers
  1.  ;   PC2 - this is the piece# for one of the other qualifiers
  1.  ;
  1.  ; Function returns 1 if the entered qualifier is OK.
  1.  ; Function returns 0 if the entered qualifier is not OK.  It is either
  1.  ;                    a duplicate or is otherwise invalid.
  1.  ;
  1.  NEW OK,DATA,INS
  1.  S OK=1
  1.  I $G(QUAL)="" G CHKQUALX
  1.  S DATA=$G(^DPT(+$G(DFN),.312,+$G(IEN),5))
  1.  I $G(QUAL)=$P(DATA,U,+$G(PC1)) D CQ1 G CHKQUALX   ; duplicate
  1.  I $G(QUAL)=$P(DATA,U,+$G(PC2)) D CQ1 G CHKQUALX   ; duplicate
  1.  ;
  1.  ; prevent the SSN qualifier when Medicare is the payer
  1.  S INS=+$G(^DPT(+$G(DFN),.312,+$G(IEN),0))
  1.  I $G(QUAL)="SY",$$MCRWNR^IBEFUNC(INS) D CQ2 G CHKQUALX
  1.  ;
  1. CHKQUALX ;
  1.  Q OK
  1.  ;
  1. CQ1 ; specific error message#1
  1.  S OK=0
  1.  D EN^DDIOL("You cannot use the same qualifier more than once.",,"!!")
  1.  D EN^DDIOL("",,"!!?5")
  1.  Q
  1.  ;
  1. CQ2 ; specific error message#2
  1.  S OK=0
  1.  D EN^DDIOL("You cannot use qualifier 'SY' for Medicare.",,"!!")
  1.  D EN^DDIOL("",,"!!?5")
  1.  Q
  1.  ;