IBCNS4 ;ALB/JWS - Trigger Logic for fields 112, 113, 114 of file 399 ;03-SEP-2014
;;2.0;INTEGRATED BILLING;**517**;21-MAR-94;Build 240
;;Per VA Directive 6402, this routine should not be modified.
;
Q
;Trigger logic to obtain the authorization number / referral number from the 278 transaction file, 356.22
; 399 (Bill/Claims file, fields 112, 113, 114 trigger fields 163 & 253, 230 & 254, 231 & 255 respectively
AUTH(BIEN,INS) ;
I $G(INS)="" Q
N AUTH,PAT,LOC,DATE,HCSRIEN,RCAT,DATE1
S AUTH=""
S PAT=$P($G(^DGCR(399,BIEN,0)),"^",2) I PAT="" Q ""
S LOC=$S($$INPAT^IBCEF(BIEN)=1:"I",1:"O")
S DATE=$P($G(^DGCR(399,BIEN,0)),"^",3) I DATE="" Q ""
S (DATE,DATE1)=$P(DATE,"."),DATE=DATE-1
F S DATE=$O(^IBT(356.22,"E",PAT,LOC,INS,DATE)) Q:DATE="" Q:$P(DATE,".")'=DATE1 D I AUTH'="" Q
. S HCSRIEN="" F S HCSRIEN=$O(^IBT(356.22,"E",PAT,LOC,INS,DATE,HCSRIEN)) Q:HCSRIEN="" D I AUTH'="" Q
.. S AUTH=$P($G(^IBT(356.22,HCSRIEN,103)),"^",2),RCAT=$P($G(^(2)),"^")
.. I RCAT=4 S AUTH=""
Q AUTH
;
REF(BIEN,INS) ;
N REF,PAT,LOC,DATE,HCSRIEN,RCAT,DATE1
S REF=""
S PAT=$P($G(^DGCR(399,BIEN,0)),"^",2) I PAT="" Q ""
S LOC=$S($$INPAT^IBCEF(BIEN)=1:"I",1:"O")
S DATE=$P($G(^DGCR(399,BIEN,0)),"^",3) I DATE="" Q ""
S (DATE,DATE1)=$P(DATE,"."),DATE=DATE-1
F S DATE=$O(^IBT(356.22,"E",PAT,LOC,INS,DATE)) Q:DATE="" Q:$P(DATE,".")'=DATE1 D I REF'="" Q
. S HCSRIEN="" F S HCSRIEN=$O(^IBT(356.22,"E",PAT,LOC,INS,DATE,HCSRIEN)) Q:HCSRIEN="" D I REF'="" Q
.. S REF=$P($G(^IBT(356.22,HCSRIEN,103)),"^",2),RCAT=$P($G(^(2)),"^")
.. I RCAT'=4 S REF=""
Q REF
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBCNS4 1598 printed Dec 13, 2024@02:16:45 Page 2
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
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;
+4 QUIT
+5 ;Trigger logic to obtain the authorization number / referral number from the 278 transaction file, 356.22
+6 ; 399 (Bill/Claims file, fields 112, 113, 114 trigger fields 163 & 253, 230 & 254, 231 & 255 respectively
AUTH(BIEN,INS) ;
+1 IF $GET(INS)=""
QUIT
+2 NEW AUTH,PAT,LOC,DATE,HCSRIEN,RCAT,DATE1
+3 SET AUTH=""
+4 SET PAT=$PIECE($GET(^DGCR(399,BIEN,0)),"^",2)
IF PAT=""
QUIT ""
+5 SET LOC=$SELECT($$INPAT^IBCEF(BIEN)=1:"I",1:"O")
+6 SET DATE=$PIECE($GET(^DGCR(399,BIEN,0)),"^",3)
IF DATE=""
QUIT ""
+7 SET (DATE,DATE1)=$PIECE(DATE,".")
SET DATE=DATE-1
+8 FOR
SET DATE=$ORDER(^IBT(356.22,"E",PAT,LOC,INS,DATE))
if DATE=""
QUIT
if $PIECE(DATE,".")'=DATE1
QUIT
Begin DoDot:1
+9 SET HCSRIEN=""
FOR
SET HCSRIEN=$ORDER(^IBT(356.22,"E",PAT,LOC,INS,DATE,HCSRIEN))
if HCSRIEN=""
QUIT
Begin DoDot:2
+10 SET AUTH=$PIECE($GET(^IBT(356.22,HCSRIEN,103)),"^",2)
SET RCAT=$PIECE($GET(^(2)),"^")
+11 IF RCAT=4
SET AUTH=""
End DoDot:2
IF AUTH'=""
QUIT
End DoDot:1
IF AUTH'=""
QUIT
+12 QUIT AUTH
+13 ;
REF(BIEN,INS) ;
+1 NEW REF,PAT,LOC,DATE,HCSRIEN,RCAT,DATE1
+2 SET REF=""
+3 SET PAT=$PIECE($GET(^DGCR(399,BIEN,0)),"^",2)
IF PAT=""
QUIT ""
+4 SET LOC=$SELECT($$INPAT^IBCEF(BIEN)=1:"I",1:"O")
+5 SET DATE=$PIECE($GET(^DGCR(399,BIEN,0)),"^",3)
IF DATE=""
QUIT ""
+6 SET (DATE,DATE1)=$PIECE(DATE,".")
SET DATE=DATE-1
+7 FOR
SET DATE=$ORDER(^IBT(356.22,"E",PAT,LOC,INS,DATE))
if DATE=""
QUIT
if $PIECE(DATE,".")'=DATE1
QUIT
Begin DoDot:1
+8 SET HCSRIEN=""
FOR
SET HCSRIEN=$ORDER(^IBT(356.22,"E",PAT,LOC,INS,DATE,HCSRIEN))
if HCSRIEN=""
QUIT
Begin DoDot:2
+9 SET REF=$PIECE($GET(^IBT(356.22,HCSRIEN,103)),"^",2)
SET RCAT=$PIECE($GET(^(2)),"^")
+10 IF RCAT'=4
SET REF=""
End DoDot:2
IF REF'=""
QUIT
End DoDot:1
IF REF'=""
QUIT
+11 QUIT REF
