FBAAUTL4 ;AISC/CMR,dmk,WCIOFO/SAB-UTILITY ROUTINE ;7/11/2001
 ;;3.5;FEE BASIS;**4,32,77,81**;JAN 30, 1995
 ;;Per VHA Directive 10-93-142, this routine should not be modified.
 ;
CPT(X,Y,FBSRVDT) ;return external format of CPT code
 ;INPUT   X = ien of CPT
 ;optional Y I Y return description, I 'Y return external format of CPT
 ;optional FBSRVDT - date of service
 ;OUTPUT  external format of CPT code or description of CPT code
 I '$G(X) Q ""
 N Z
 S Z=$$CPT^ICPTCOD(X,$S($G(FBSRVDT)>0:+$G(FBSRVDT),1:""),1)
 Q $S('$G(Y):$P(Z,U,2),1:$P(Z,U,3))
 ;
MOD(X,Y,FBSRVDT) ;return external format of modifier
 ;INPUT   X = ien of modifier
 ;optional Y I Y return description, I 'Y return external format of mod
 ;optional FBSRVDT - date of service
 ;OUTPUT  external format of modifier or description of CPT code
 I '$G(X) Q ""
 N Z
 S Z=$$MOD^ICPTMOD(X,"I",$S($G(FBSRVDT)>0:+$G(FBSRVDT),1:""),1)
 Q $S('$G(Y):$P(Z,U,2),1:$P(Z,U,3))
 ;
CPTDATA(W,X,Y,Z) ;get internal value of CPT
 ; input
 ;   W = IEN of PATIENT in file 162
 ;   X = IEN of VENDOR multiple in file 162
 ;   Y = IEN of INITIAL TREATMENT DATE multiple in file 162
 ;   Z = IEN of SERVICE PROVIDED multiple in file 162
 ; returns
 ;   value of SERVICE PROVIDED (internal)
 ;
 I '$G(W)!('$G(X))!('$G(Y))!('$G(Z)) Q ""
 Q $P($G(^FBAAC(W,1,X,1,Y,1,Z,0)),U)
 ;
MODDATA(W,X,Y,Z) ;get internal values of CPT Modifier
 ; input
 ;   W = IEN of PATIENT in file 162
 ;   X = IEN of VENDOR multiple in file 162
 ;   Y = IEN of INITIAL TREATMENT DATE multiple in file 162
 ;   Z = IEN of SERVICE PROVIDED multiple in file 162
 ; output
 ;   FBMODA( array of CPT MODIFIERs
 ;     FBMODA(#)=CPT MODIFIER (internal value)
 ;     where # is the IEN for an entry in the CPT MODIFIER multiple
 K FBMODA
 I '$G(W)!('$G(X))!('$G(Y))!('$G(Z)) Q
 N FBI,FBMOD
 S FBI=0 F  S FBI=$O(^FBAAC(W,1,X,1,Y,1,Z,"M",FBI)) Q:'FBI  D
 . S FBMOD=$P($G(^FBAAC(W,1,X,1,Y,1,Z,"M",FBI,0)),U)
 . Q:FBMOD=""
 . S FBMODA(FBI)=FBMOD
 Q
 ;
APS(FBJ,FBK,FBL,FBM) ; amount paid symbol
 ; input
 ;   FBJ = IEN of PATIENT in file 162
 ;   FBK = IEN of VENDOR multiple in file 162
 ;   FBL = IEN of INITIAL TREATMENT DATE multiple in file 162
 ;   FBM = IEN of SERVICE PROVIDED multiple in file 162
 ; returns symbol
 ;   where value is M (Mill Bill emergency care - 38 U.S.C. 1725)
 ;                  R (RBRVS fee schedule amount)
 ;                  F (VA fee schedule amount)
 ;                  C (contracted service amount)
 ;                  U (usual & customary - claimed)
 ;                  null if no amount paid
 N FBAP,FBRET,FBY0,FBY2
 S FBRET=""
 S FBY0=$G(^FBAAC(FBJ,1,FBK,1,FBL,1,FBM,0))
 S FBY2=$G(^FBAAC(FBJ,1,FBK,1,FBL,1,FBM,2))
 S FBAP=$P(FBY0,U,3)
 I FBAP>0 D
 . ; use fee schedule info for payment (if any)
 . I +FBAP=+$P(FBY2,U,12) S FBRET=$P(FBY2,U,13) Q:FBRET]""
 . ; if no fee schedule info then calc 75th percentile and check
 . I $P(FBY2,U,12)="" D  Q:FBRET]""
 . . S FBCPT=$$CPT($P(FBY0,U))
 . . S FBMODL=$$MODL("^FBAAC("_FBJ_",1,"_FBK_",1,"_FBL_",1,"_FBM_",""M"")","E")
 . . S FBDOS=$P($G(^FBAAC(FBJ,1,FBK,1,FBL,0)),U)
 . . I +FBAP=+$$PRCTL^FBAAFSF(FBCPT,FBMODL,FBDOS) S FBRET="F"
 . ; since not paid by a fee schedule, check prompt pay type
 . I $P(FBY2,U,2) S FBRET="C" Q
 . ; since not fee schedule or contract check POV code to identify
 . ;   Mill Bill payments
 . S:"^39^52^"[(U_$P($G(^FBAA(161.82,+$P(FBY0,U,18),0)),U,3)_U) FBRET="M"
 . Q:FBRET]""
 . ; all other payments considered u&c
 . S FBRET="U"
 Q FBRET
 ;
CHKBI(X,Y) ;called to determine if batch number or invoice number
 ;already exists
 ;X= next batch/invoice number
 ;Y=1 if Batch
 ;Y undefined if invoice number passed
 ;returns a truth if X is ok for next batch/invoice #
 ;
 I 'X Q ""
 I $G(Y) Q $S($D(^FBAA(161.7,"B",X)):"",1:1)
 I '$G(Y) Q $S($D(^FBAA(162.1,"B",X)):"",$D(^FBAAI("B",X)):"",$D(^FBAAC("C",X)):"",1:1)
 ;
MODL(FBAN,FBFLAG) ;return sorted list given array of modifiers
 ; Input
 ;   FBAN - closed root of array containing modifiers
 ;          the data must be in nodes descendent from this root.
 ;          The subscripts of the nodes below FBAN must be
 ;          positive numbers. The CPT MODIFIER internal value
 ;          must be the first piece in these nodes or in the
 ;          0-node descendent from these nodes.
 ;          i.e.
 ;            ARRAY(number)=CPT MODIFIER (internal value)
 ;                  OR
 ;            ARRAY(number,0)=CPT MODIFIER (internal value)
 ;   FBFLAG - (optional) flag, E or I, default I
 ;          I to return internal values of modifiers
 ;          E to return external values of modifiers
 ; Returns string of sorted modifiers (e.g. "1,3,7") 
 ;
 N FBI,FBRET,FBSORT,FBX,FBZERO
 S FBRET=""
 S FBFLAG=$G(FBFLAG,"I")
 ;
 ; if any descendent data then determine if it is 0-node descendent
 S FBZERO=0 I $O(@FBAN@(0)),$D(@FBAN@($O(@FBAN@(0)),0))#2 S FBZERO=1
 ;
 ; loop thru input array and place modifiers in a sort array
 S FBI=0 F  S FBI=$O(@FBAN@(FBI)) Q:'FBI  D
 . ; get the cpt modifier
 . I FBZERO S FBX=$P(@FBAN@(FBI,0),U)
 . E  S FBX=$P(@FBAN@(FBI),U)
 . I FBFLAG="E" D
 . . ; convert to external value
 . . S FBX=$$MOD^ICPTMOD(FBX,"I")
 . . I FBX>0 S FBX=$P(FBX,U,2)
 . . E  S FBX=""
 . I FBX]"" S FBSORT(FBX)=""
 ;
 ; loop thru sorted array and add the modifiers to return value
 S FBX="" F  S FBX=$O(FBSORT(FBX)) Q:FBX=""  S FBRET=FBRET_","_FBX
 ;
 ; strip leading comma (if any)
 I $E(FBRET)="," S FBRET=$E(FBRET,2,999)
 ;
 ; return value
 Q FBRET
 ;
REPMOD(FBJ,FBK,FBL,FBM) ; Replace CPT Modifier(s) in payment
 ; input
 ;   FBJ = IEN of PATIENT in file 162
 ;   FBK = IEN of VENDOR multiple in file 162
 ;   FBL = IEN of INITIAL TREATMENT DATE multiple in file 162
 ;   FBM = IEN of SERVICE PROVIDED multiple in file 162
 ;   FBMODA( array of modifiers
 ;      where FBMODA(number)=CPT Modifier (internal)
 ;
 N FBI,FBIENS,FBFDA
 S FBIENS=FBM_","_FBL_","_FBK_","_FBJ_","
 ;
 ; delete any existing CPT MODIFIER entries from global
 I $O(^FBAAC(FBJ,1,FBK,1,FBL,1,FBM,"M",0)) D
 . K FBFDA S FBI=0
 . F  S FBI=$O(^FBAAC(FBJ,1,FBK,1,FBL,1,FBM,"M",FBI)) Q:'FBI  D
 . . S FBFDA(162.06,FBI_","_FBIENS,.01)="@"
 . D FILE^DIE("","FBFDA") D MSG^DIALOG()
 ;
 ; create CPT MODIFIER entries from data in array FBMODA
 I $O(FBMODA(0)) D
 . K FBFDA S FBI=0 F  S FBI=$O(FBMODA(FBI)) Q:'FBI  D
 . . S FBFDA(162.06,"+"_FBI_","_FBIENS,.01)=FBMODA(FBI)
 . D UPDATE^DIE("","FBFDA") D MSG^DIALOG()
 ;
 Q
 ;
 ;FBAAUTL4