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

IBCNS4.m

Go to the documentation of this file.
  1. IBCNS4 ;ALB/JWS - Trigger Logic for fields 112, 113, 114 of file 399 ;03-SEP-2014
  1. ;;2.0;INTEGRATED BILLING;**517**;21-MAR-94;Build 240
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;
  1. Q
  1. ;Trigger logic to obtain the authorization number / referral number from the 278 transaction file, 356.22
  1. ; 399 (Bill/Claims file, fields 112, 113, 114 trigger fields 163 & 253, 230 & 254, 231 & 255 respectively
  1. AUTH(BIEN,INS) ;
  1. I $G(INS)="" Q
  1. N AUTH,PAT,LOC,DATE,HCSRIEN,RCAT,DATE1
  1. S AUTH=""
  1. S PAT=$P($G(^DGCR(399,BIEN,0)),"^",2) I PAT="" Q ""
  1. S LOC=$S($$INPAT^IBCEF(BIEN)=1:"I",1:"O")
  1. S DATE=$P($G(^DGCR(399,BIEN,0)),"^",3) I DATE="" Q ""
  1. S (DATE,DATE1)=$P(DATE,"."),DATE=DATE-1
  1. F S DATE=$O(^IBT(356.22,"E",PAT,LOC,INS,DATE)) Q:DATE="" Q:$P(DATE,".")'=DATE1 D I AUTH'="" Q
  1. . S HCSRIEN="" F S HCSRIEN=$O(^IBT(356.22,"E",PAT,LOC,INS,DATE,HCSRIEN)) Q:HCSRIEN="" D I AUTH'="" Q
  1. .. S AUTH=$P($G(^IBT(356.22,HCSRIEN,103)),"^",2),RCAT=$P($G(^(2)),"^")
  1. .. I RCAT=4 S AUTH=""
  1. Q AUTH
  1. ;
  1. REF(BIEN,INS) ;
  1. N REF,PAT,LOC,DATE,HCSRIEN,RCAT,DATE1
  1. S REF=""
  1. S PAT=$P($G(^DGCR(399,BIEN,0)),"^",2) I PAT="" Q ""
  1. S LOC=$S($$INPAT^IBCEF(BIEN)=1:"I",1:"O")
  1. S DATE=$P($G(^DGCR(399,BIEN,0)),"^",3) I DATE="" Q ""
  1. S (DATE,DATE1)=$P(DATE,"."),DATE=DATE-1
  1. F S DATE=$O(^IBT(356.22,"E",PAT,LOC,INS,DATE)) Q:DATE="" Q:$P(DATE,".")'=DATE1 D I REF'="" Q
  1. . S HCSRIEN="" F S HCSRIEN=$O(^IBT(356.22,"E",PAT,LOC,INS,DATE,HCSRIEN)) Q:HCSRIEN="" D I REF'="" Q
  1. .. S REF=$P($G(^IBT(356.22,HCSRIEN,103)),"^",2),RCAT=$P($G(^(2)),"^")
  1. .. I RCAT'=4 S REF=""
  1. Q REF