- 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 Jan 18, 2025@03:28:48 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