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

FBAAUTL4.m

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