| 1 | IBEFUNC2 ;ALB/ARH - CPT BILLING EXTRINSIC FUNCTIONS II ;11/27/91
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**51,266**;21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | MODLST(MODS,DESC,IBMOD,IBDATE) ; Function returns string of actual modifiers translated
|
|---|
| 6 | ; from the comma delimited string of modifier iens in MODS
|
|---|
| 7 | ; DESC = 1 if description of modifier should be returned in IBMOD(1)
|
|---|
| 8 | ; Must pass IBMOD by reference for this to work
|
|---|
| 9 | ; IBMOD = the ',' delimited list of modifiers,
|
|---|
| 10 | ; IBMOD(1) = the ',' delimited modifier descriptions, if
|
|---|
| 11 | ; DESC = 1 and IBMOD is passed by reference
|
|---|
| 12 | ; IBDATE = Date of Service (opt) for the versioned text description
|
|---|
| 13 | ;
|
|---|
| 14 | N Z,Z0,IBP
|
|---|
| 15 | S IBMOD="",IBMOD(1)=""
|
|---|
| 16 | F Z=1:1:$L(MODS,",") S IBP=$P(MODS,",",Z) I IBP D
|
|---|
| 17 | . S Z0=$$MOD^ICPTMOD(IBP,"I",$G(IBDATE)) Q:Z0<0
|
|---|
| 18 | . I $G(DESC) S IBMOD(1)=IBMOD(1)_$S(IBMOD="":"",1:",")_$P(Z0,U,3)
|
|---|
| 19 | . S IBMOD=IBMOD_$S(IBMOD="":"",1:",")_$P(Z0,U,2)
|
|---|
| 20 | Q IBMOD
|
|---|
| 21 | ;
|
|---|
| 22 | CPTSTAT(CPT,DATE) ;determine the overall status for a CPT for given date, assumes today if no date given
|
|---|
| 23 | ;if DATE is not today, assumes that if active in either 409.71 or 350.4 then also active in 81 for that DATE
|
|---|
| 24 | ;(ICPT is not a date sensitive file, so will only check (81) if want todays status), returns:
|
|---|
| 25 | ; 1 - if DATE=DT and CPT currently only active in ICPT file (81) (not active in 409.71 or 350.4)
|
|---|
| 26 | ; 2A - if CPT is Nationally Active only in SD(409.71) and not BASC for DATE
|
|---|
| 27 | ; 2B - if CPT is Locally Active only in SD(409.71) and not BASC for DATE
|
|---|
| 28 | ; 2C - if CPT is Nationally and Locally Active in SD(409.71) and not BASC for DATE
|
|---|
| 29 | ; 3 - if CPT is Billing Active (BASC) in IBE(350.4) and not active in (409.71) for DATE
|
|---|
| 30 | ; 4A - if CPT is Nationally Active in SD(409.71) and Billing Active in IBE(350.4) for DATE
|
|---|
| 31 | ; 4B - if CPT is Locally Active only in SD(409.71) and Billing Active in IBE(350.4) for DATE
|
|---|
| 32 | ; 4C - if CPT is Nationally and Locally Active in SD(409.71) and Billing Active in IBE(350.4) for DATE
|
|---|
| 33 | ; 0 - otherwise
|
|---|
| 34 | N X,X1,Y,POST
|
|---|
| 35 | S:'$D(CPT) CPT=0 S:'$D(DATE) DATE=DT S:'DATE DATE=DT
|
|---|
| 36 | S Y=0,POST="" G:$$CPT^ICPTCOD(+CPT)<1 CEND
|
|---|
| 37 | I $E(DATE,1,7)=DT G:'$P($$CPT^ICPTCOD(+CPT),"^",7) CEND S Y=1
|
|---|
| 38 | S X=CPT,X1=DATE D STATUS^SDAMBAE4 I X'["INACTIVE"&(X'="") D
|
|---|
| 39 | . S Y=2,POST="A" I X["LOCAL" S POST="B" I X["NATIONAL" S POST="C"
|
|---|
| 40 | I $$CPTBSTAT^IBEFUNC1(CPT,DATE) S Y=3 I POST'="" S Y=Y+1
|
|---|
| 41 | CEND Q Y_POST
|
|---|
| 42 | ;
|
|---|
| 43 | TDG(SSN) ;reformat SSN into terminal digit order
|
|---|
| 44 | ; returns either 0 or ssn in terminal digit order
|
|---|
| 45 | N X,Y,I S Y="" F I=1:1 S X=$E(SSN,I) Q:X="" I X?1N S Y=Y_X
|
|---|
| 46 | S Y=$S(Y'?9N:0,1:$E(Y,8,9)_$E(Y,6,7)_$E(Y,4,5)_$E(Y,1,3))
|
|---|
| 47 | ENDP Q Y
|
|---|
| 48 | ;
|
|---|
| 49 | FFMT ;
|
|---|
| 50 | S IBLNGX=$$FORMAT($S('$D(IBGRPX):"",1:IBGRPX),$S('$D(IBCPX):"",1:IBCPX)) Q
|
|---|
| 51 | ;
|
|---|
| 52 | FORMAT(GRP,CP) ;calculate spacing format for clinic CPT list
|
|---|
| 53 | ;input GRP - the ifn of the GROUP to be calculated or ""
|
|---|
| 54 | ; or CP - the ifn of the entry in 350.71 to return format or ""
|
|---|
| 55 | ;returns - "" if GRP not defined in ^IBE(350.7, or GRP of CP not found
|
|---|
| 56 | ; - margin width & intercolumn width ^ header width (same for both groups and catigories)
|
|---|
| 57 | ; ^ procedure name width
|
|---|
| 58 | ;if # of columns not defined for group, assumes 2
|
|---|
| 59 | ;if display charge not defined for group, assumes negative
|
|---|
| 60 | ;assumes that charge and code widths are not variable
|
|---|
| 61 | N X,DCHG,CD,IC,PN,H,COL,M,CHK
|
|---|
| 62 | S:'$D(GRP) GRP="" S:'$D(CP) CP="" I 'GRP&'CP S X="" G ENDFMT
|
|---|
| 63 | S DCHG=10,CD=7,CHK=7,IC=3,M=132
|
|---|
| 64 | S:'+GRP GRP=$G(^IBE(350.71,+CP,0)),GRP=$S($P(GRP,"^",4):$P(GRP,"^",4),1:$P($G(^IBE(350.71,+$P(GRP,"^",5),0)),"^",4))
|
|---|
| 65 | S X=$G(^IBE(350.7,+GRP,0)),COL=$P(X,"^",3) S:COL="" COL=2
|
|---|
| 66 | I X'="" S DCHG=$S($P(X,"^",2):DCHG,1:0),DCHG=DCHG*COL,CD=CD*COL,CHK=CHK*COL
|
|---|
| 67 | I X'="" S H=(M-(2*COL*IC)),PN=(H-DCHG-CD-CHK)\COL,H=H\COL
|
|---|
| 68 | ENDFMT Q $S(X="":X,1:IC_"^"_H_"^"_PN)
|
|---|
| 69 | ;
|
|---|
| 70 | FPO ;
|
|---|
| 71 | S X=$$PO(DA,X) Q
|
|---|
| 72 | ;
|
|---|
| 73 | PO(DA,X) ;check that the print order entered has not already been used for the group/sub-header
|
|---|
| 74 | ;used to ensure unique print orders within groups and sub-headers
|
|---|
| 75 | ; input: DA - the IFN of the entry being added/edited may be a subheader or procedure
|
|---|
| 76 | ; X - the print order to check
|
|---|
| 77 | ;returns: "" - if bad input or print order already defined
|
|---|
| 78 | ; X - input value of X if not previously defined for group/sub-header
|
|---|
| 79 | I '$D(DA)!('$D(^IBE(350.71,+DA,0)))!('$D(X))!('X) S X="" G ENDPO
|
|---|
| 80 | N Y S Y=^IBE(350.71,+DA,0)
|
|---|
| 81 | I $P(Y,"^",3)="S",$D(^IBE(350.71,"AG",+$P(Y,"^",4),X)) S X=""
|
|---|
| 82 | I $P(Y,"^",3)="P",$D(^IBE(350.71,"AS",+$P(Y,"^",5),X)) S X=""
|
|---|
| 83 | ENDPO Q X
|
|---|
