IBTRC3 ;ALB/AAS - CLAIMS TRAINING INS. REV DEFAULTS ; 29-SEP-93
;;2.0;INTEGRATED BILLING;**458**;21-MAR-94;Build 4
;;Per VHA Directive 2004-038, this routine should not be modified.
;
LAST(IBTRN,IBTRC) ; -- return last insurance review
; -- Input IBTRN = claims tracking id
; IBTRC = ins. review being edited (option)
; (if hip is defined for ibtrc will use last review
; for that policy)
;
N X,Y,IBHIP,IBQUIT
S Y="",IBQUIT=0
I '$G(IBTRN) G LASTQ
S IBHIP=$P($G(^IBT(356.2,+$G(IBTRC),1)),"^",5)
S X=-$G(^IBT(356.2,+IBTRC,0)) F S X=$O(^IBT(356.2,"ATIDT",IBTRN,X)) Q:'X!(IBQUIT) D
.S Y="" F S Y=$O(^IBT(356.2,"ATIDT",IBTRN,X,Y)) Q:'Y!('IBHIP) D Q:IBQUIT
..I $P($G(^IBT(356.2,+Y,1)),"^",5)=IBHIP S IBQUIT=1 Q
LASTQ Q $S(+Y<1:"",Y:Y,1:"")
;
HIP(IBTRC) ; -- compute default health insurance policy for claims tracking
; -- called by trigger on patient field (.05) of file 356.2
; -- output pointer to subfile (2.312)^insurnace co name
N X,IBDD,IBINDT,DFN
S X=""
S DFN=$P($G(^IBT(356.2,+$G(IBTRC),0)),"^",5)
G:'DFN HIPQ
S IBINDT=$S($P($G(^IBT(356,+$P($G(^IBT(356.2,+IBTRC,0)),U,2),0)),U,6):$P(^(0),U,6),1:DT)
D ALL^IBCNS1(DFN,"IBDD",1,IBINDT)
I $G(IBDD(0))=1 S X=+$O(IBDD(0))
;
; -- if more than one look for primary
I 'X,$G(IBDD(0))>1 D
.S IBX=0
.F S IBX=$O(IBDD(IBX)) Q:'IBX I $P($G(IBDD(IBX,0)),"^",20)=1 S X=IBX Q
I X S X=X_"^"_$P($G(^DIC(36,+$G(IBDD(X,0)),0)),"^")
HIPQ Q X
;
HIPD(DA,IBTLST) ; -- compute default health insurance policy from last review
; -- called from input templates
; input da = current entry being edited
; ibtlst = last entry for this review as determine by $$LAST
;
N X,DFN
S X="" I $P($G(^IBT(356.2,DA,1)),"^",5) G HIPDQ
G:'$G(IBTLST) HIPDQ
S X=$P($G(^IBT(356.2,+IBTLST,1)),"^",5),DFN=$P(^(0),"^",5)
HIPDQ Q $S(+X<1:"",1:$P($G(^DIC(36,+$G(^DPT(DFN,.312,X,0)),0)),"^",1))
;
PC(DA,IBTLST) ; -- compute default person contacted from last review
; -- called from input templates
; input da = current entry being edited
; ibtlst = last entry for this review as determine by $$LAST
;
Q $P($G(^IBT(356.2,+$G(IBTLST),0)),"^",6)
;
MC(DA,IBTLST) ; -- compute default method of contact from last review
; -- called from input templates
; input da = current entry being edited
;
; ibtlst = last entry for this review as determine by $$LAST
;
N X
S X=$P($G(^IBT(356.2,+$G(IBTLST),0)),"^",17)
Q $S(+X>0:$$EXPAND^IBTRE(356.2,.17,X),1:"PHONE")
;
CP(DA,IBTLST) ; -- compute default contact phone number from last review
; -- called from input templates
; input da = current entry being edited
; ibtlst = last entry for this review as determine by $$LAST
;
Q $P($G(^IBT(356.2,+$G(IBTLST),0)),"^",7)
;
AN(DA,IBTLST) ; -- compute default authorization number policy (call ref default removed with *458)
; -- called from input templates
; input da = current entry being edited
; ibtlst = last entry for this review as determine by $$LAST
;
Q $P($G(^IBT(356.2,+$G(IBTLST),2)),"^",2)
;N X
;S X=$P(^IBT(356.2,DA,0),"^",9)
;Q $E($S($L(X):X,1:$P($G(^IBT(356.2,+$G(IBTLST),0)),"^",28)),1,10)
;
APPEAL ; -- called from IBTRC, needed more room to compute
; info if an appeal
N DAYS S DAYS=""
S X=$$SETFLD^VALM1($$EXPAND^IBTRE(356.2,.29,$P(IBTRCD,"^",29)),X,"ACTION")
S DAYS=$P(IBTRCD,"^",25) I $P(IBTRCD,"^",29)=1,$P(IBTRCD,"^",10)=3,$O(^IBT(356.2,+IBTRC,14,0)) S DAYS=$$AP^IBTODD1(IBTRC)
S X=$$SETFLD^VALM1($J(DAYS,3),X,"DAYS")
S X=$$SETFLD^VALM1($$TPE(),X,"TYPE")
Q
;
TPE() ; -- add appeal type to type of action
N X
S X=$P(IBETYP,"^",3)
I $P(IBTRCD,"^",23) S X=X_"-"_$S($P(IBTRCD,"^",23)=1:"Clin",$P(IBTRCD,"^",23)=2:"Admin",1:"")
Q X
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HIBTRC3 3853 printed Oct 16, 2024@18:28:14 Page 2
IBTRC3 ;ALB/AAS - CLAIMS TRAINING INS. REV DEFAULTS ; 29-SEP-93
+1 ;;2.0;INTEGRATED BILLING;**458**;21-MAR-94;Build 4
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 ;
LAST(IBTRN,IBTRC) ; -- return last insurance review
+1 ; -- Input IBTRN = claims tracking id
+2 ; IBTRC = ins. review being edited (option)
+3 ; (if hip is defined for ibtrc will use last review
+4 ; for that policy)
+5 ;
+6 NEW X,Y,IBHIP,IBQUIT
+7 SET Y=""
SET IBQUIT=0
+8 IF '$GET(IBTRN)
GOTO LASTQ
+9 SET IBHIP=$PIECE($GET(^IBT(356.2,+$GET(IBTRC),1)),"^",5)
+10 SET X=-$GET(^IBT(356.2,+IBTRC,0))
FOR
SET X=$ORDER(^IBT(356.2,"ATIDT",IBTRN,X))
if 'X!(IBQUIT)
QUIT
Begin DoDot:1
+11 SET Y=""
FOR
SET Y=$ORDER(^IBT(356.2,"ATIDT",IBTRN,X,Y))
if 'Y!('IBHIP)
QUIT
Begin DoDot:2
+12 IF $PIECE($GET(^IBT(356.2,+Y,1)),"^",5)=IBHIP
SET IBQUIT=1
QUIT
End DoDot:2
if IBQUIT
QUIT
End DoDot:1
LASTQ QUIT $SELECT(+Y<1:"",Y:Y,1:"")
+1 ;
HIP(IBTRC) ; -- compute default health insurance policy for claims tracking
+1 ; -- called by trigger on patient field (.05) of file 356.2
+2 ; -- output pointer to subfile (2.312)^insurnace co name
+3 NEW X,IBDD,IBINDT,DFN
+4 SET X=""
+5 SET DFN=$PIECE($GET(^IBT(356.2,+$GET(IBTRC),0)),"^",5)
+6 if 'DFN
GOTO HIPQ
+7 SET IBINDT=$SELECT($PIECE($GET(^IBT(356,+$PIECE($GET(^IBT(356.2,+IBTRC,0)),U,2),0)),U,6):$PIECE(^(0),U,6),1:DT)
+8 DO ALL^IBCNS1(DFN,"IBDD",1,IBINDT)
+9 IF $GET(IBDD(0))=1
SET X=+$ORDER(IBDD(0))
+10 ;
+11 ; -- if more than one look for primary
+12 IF 'X
IF $GET(IBDD(0))>1
Begin DoDot:1
+13 SET IBX=0
+14 FOR
SET IBX=$ORDER(IBDD(IBX))
if 'IBX
QUIT
IF $PIECE($GET(IBDD(IBX,0)),"^",20)=1
SET X=IBX
QUIT
End DoDot:1
+15 IF X
SET X=X_"^"_$PIECE($GET(^DIC(36,+$GET(IBDD(X,0)),0)),"^")
HIPQ QUIT X
+1 ;
HIPD(DA,IBTLST) ; -- compute default health insurance policy from last review
+1 ; -- called from input templates
+2 ; input da = current entry being edited
+3 ; ibtlst = last entry for this review as determine by $$LAST
+4 ;
+5 NEW X,DFN
+6 SET X=""
IF $PIECE($GET(^IBT(356.2,DA,1)),"^",5)
GOTO HIPDQ
+7 if '$GET(IBTLST)
GOTO HIPDQ
+8 SET X=$PIECE($GET(^IBT(356.2,+IBTLST,1)),"^",5)
SET DFN=$PIECE(^(0),"^",5)
HIPDQ QUIT $SELECT(+X<1:"",1:$PIECE($GET(^DIC(36,+$GET(^DPT(DFN,.312,X,0)),0)),"^",1))
+1 ;
PC(DA,IBTLST) ; -- compute default person contacted from last review
+1 ; -- called from input templates
+2 ; input da = current entry being edited
+3 ; ibtlst = last entry for this review as determine by $$LAST
+4 ;
+5 QUIT $PIECE($GET(^IBT(356.2,+$GET(IBTLST),0)),"^",6)
+6 ;
MC(DA,IBTLST) ; -- compute default method of contact from last review
+1 ; -- called from input templates
+2 ; input da = current entry being edited
+3 ;
+4 ; ibtlst = last entry for this review as determine by $$LAST
+5 ;
+6 NEW X
+7 SET X=$PIECE($GET(^IBT(356.2,+$GET(IBTLST),0)),"^",17)
+8 QUIT $SELECT(+X>0:$$EXPAND^IBTRE(356.2,.17,X),1:"PHONE")
+9 ;
CP(DA,IBTLST) ; -- compute default contact phone number from last review
+1 ; -- called from input templates
+2 ; input da = current entry being edited
+3 ; ibtlst = last entry for this review as determine by $$LAST
+4 ;
+5 QUIT $PIECE($GET(^IBT(356.2,+$GET(IBTLST),0)),"^",7)
+6 ;
AN(DA,IBTLST) ; -- compute default authorization number policy (call ref default removed with *458)
+1 ; -- called from input templates
+2 ; input da = current entry being edited
+3 ; ibtlst = last entry for this review as determine by $$LAST
+4 ;
+5 QUIT $PIECE($GET(^IBT(356.2,+$GET(IBTLST),2)),"^",2)
+6 ;N X
+7 ;S X=$P(^IBT(356.2,DA,0),"^",9)
+8 ;Q $E($S($L(X):X,1:$P($G(^IBT(356.2,+$G(IBTLST),0)),"^",28)),1,10)
+9 ;
APPEAL ; -- called from IBTRC, needed more room to compute
+1 ; info if an appeal
+2 NEW DAYS
SET DAYS=""
+3 SET X=$$SETFLD^VALM1($$EXPAND^IBTRE(356.2,.29,$PIECE(IBTRCD,"^",29)),X,"ACTION")
+4 SET DAYS=$PIECE(IBTRCD,"^",25)
IF $PIECE(IBTRCD,"^",29)=1
IF $PIECE(IBTRCD,"^",10)=3
IF $ORDER(^IBT(356.2,+IBTRC,14,0))
SET DAYS=$$AP^IBTODD1(IBTRC)
+5 SET X=$$SETFLD^VALM1($JUSTIFY(DAYS,3),X,"DAYS")
+6 SET X=$$SETFLD^VALM1($$TPE(),X,"TYPE")
+7 QUIT
+8 ;
TPE() ; -- add appeal type to type of action
+1 NEW X
+2 SET X=$PIECE(IBETYP,"^",3)
+3 IF $PIECE(IBTRCD,"^",23)
SET X=X_"-"_$SELECT($PIECE(IBTRCD,"^",23)=1:"Clin",$PIECE(IBTRCD,"^",23)=2:"Admin",1:"")
+4 QUIT X
