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

IBJTU31.m

Go to the documentation of this file. 
  1. IBJTU31 ;ALB/ARH - TPI UTILITIES - INS ; 2/14/95
  1.  ;;2.0;INTEGRATED BILLING;**39,61,516**;21-MAR-94;Build 123
  1.  ;;Per VA Directive 6402, this routine should not be modified.
  1.  ;
  1. BPP(IBIFN,ARRAY) ; returns array of patient policy info on all of a bill's carriers
  1.  ; returns PPIFN ^ p/s/t ^ policy node from patient insurance record (2,.312), also adds correct group #/name
  1.  N DFN,IBDM,IBI,IBDFN,IBCDFN,IBGRP K ARRAY S ARRAY=0
  1.  S DFN=$P($G(^DGCR(399,+$G(IBIFN),0)),U,2) I 'DFN G BPPQ
  1.  S IBDM=$G(^DGCR(399,IBIFN,"M")) I 'IBDM G BPPQ
  1.  ;
  1.  F IBI=1,2,3 S IBCDFN="" D  I +IBCDFN S ARRAY(IBI)=IBDFN_U_IBI_U_IBCDFN,ARRAY=IBI
  1.  . S IBDFN=$P(IBDM,U,(IBI+11)) I 'IBDFN,+$P(IBDM,U,IBI) S IBDFN=$O(^DPT(DFN,.312,"B",+$P(IBDM,U,IBI),0))
  1.  . ;IB*2.0*516/TAZ - Use HIPAA compliant fields
  1.  . ;Q:'IBDFN  S IBCDFN=$G(^DPT(DFN,.312,+IBDFN,0)) I 'IBCDFN Q
  1.  . Q:'IBDFN  S IBCDFN=$$ZND^IBCNS1(DFN,+IBDFN) I 'IBCDFN Q  ; 516 - baa
  1.  . ;The following line is no longer necessary since the move is completed in the $$ZND^IBCNS1 function.
  1.  . ;S IBGRP=$G(^IBA(355.3,+$P(IBCDFN,U,18),0)) S:IBGRP'="" $P(IBCDFN,U,3)=$P(IBGRP,U,4),$P(IBCDFN,U,15)=$P(IBGRP,U,3)  ;516 - baa
  1. BPPQ Q
  1.  ;
  1. PST(IBIFN) ; called by insurance screens ACTION PROTOCOL ENTRY ACTION code, allow user to choose which policy
  1.  ; to display ins screens for default will be either the primary or last viewed
  1.  ; IBPOLICY used by this procedure to define last viewed, must be killed when exiting primary screen (CI)
  1.  ;
  1.  N IBY,IBX,X,Y S IBY=0
  1.  D BPP(IBIFN,.IBX)
  1.  I IBX<1 S IBY=-1 G PSTQ ; bill has no policies
  1.  I IBX=1 S IBY=$O(IBX(0)),IBY=IBX(IBY) G PSTQ ; bill has only primary policy
  1.  S IBPOLICY=$S($G(IBPOLICY):IBPOLICY,1:$O(IBX(0))) I 'IBPOLICY G PSTQ
  1.  W ! D DBPOL(.IBX)
  1.  S DIR("?")="Only policies associated with this bill may be chosen: Primary, Secondary, or Tertiary."
  1.  S DIR(0)="SOB^P:Primary;S:Secondary;T:Tertiary",DIR(0)=$P(DIR(0),";",1,IBX)
  1.  S DIR("A")="Select Policy",DIR("B")=$S(IBPOLICY=2:"S",IBPOLICY=3:"T",1:"P") D ^DIR K DIR
  1.  I Y?1U S IBY=$S(Y="P":1,Y="S":2,Y="T":3,1:0),IBPOLICY=IBY,IBY=$G(IBX(IBY))
  1. PSTQ Q IBY
  1.  ;
  1. DBPOL(IBINS) ; display patient policy info for all carriers of a bill, input array from BPP
  1.  ;
  1.  N IBI,IBCDFN,IBCNS0
  1.  W !,?12,"Carrier",?39,"Subscriber ID",?62,"Group #",!,?12,"--------------------------------------------------------------------"
  1.  ;
  1.  S IBI=0 F  S IBI=$O(IBINS(IBI)) Q:'IBI  D
  1.  . S IBCDFN=$P(IBINS(IBI),U,3,99),IBCNS0=$G(^DIC(36,+IBCDFN,0))
  1.  . W !,$S(IBI=2:"Secondary",IBI=3:"Tertiary",1:"Primary")_": ",?12,$E($P(IBCNS0,U,1),1,25),?39,$P(IBCDFN,U,2),?62,$P(IBCDFN,U,3)
  1.  W !
  1. DBPOLQ Q
  1.  ;
  1. MINS(IBIFN) ;Called by IBJT LIST TEMPLATE screens and RCRC LIST TEMPLATES
  1.  ; Return true if Bill has multiple Insurance Policies
  1.  N IBDM,IBY S IBY=0
  1.  S IBDM=$G(^DGCR(399,IBIFN,"M"))
  1.  S IBY=$S(+$P(IBDM,U,13):1,+$P(IBDM,U,14):1,1:0)
  1. MINSQ Q IBY
  1.  ;
  1. REF(IBIFN) ;Called by IBJT LIST TEMPLATE screens
  1.  ;Return Referral Date if Bill is Referred
  1.  N IBRDT,X
  1.  S IBRDT="IBRDT"
  1.  D DIQ^RCJIBFN2(IBIFN,64,.IBRDT)
  1. REFQ Q +$G(IBRDT(430,IBIFN,64,"I"))
  1.  ;IBJTU31