| [613] | 1 | IBCEF78 ;ALB/WCJ - Provider ID functions ;13 May 2007
|
|---|
| 2 | ;;2.0;INTEGRATED BILLING;**371**;21-MAR-94;Build 57
|
|---|
| 3 | ;;Per VHA Directive 2004-038, this routine should not be modified.
|
|---|
| 4 | ;;
|
|---|
| 5 | G AWAY
|
|---|
| 6 | AWAY Q
|
|---|
| 7 | ;
|
|---|
| 8 | PAYERIDS(IBXIEN,IBRET) ; This function returns all the PAYER IDS for the current and other insurance(s)
|
|---|
| 9 | ;
|
|---|
| 10 | D PRIPAYID(IBXIEN,.IBRET)
|
|---|
| 11 | D SECPAYID(IBXIEN,.IBRET)
|
|---|
| 12 | Q
|
|---|
| 13 | ;
|
|---|
| 14 | PRIPAYID(IBXIEN,IBXRET) ; Primary Payer IDs
|
|---|
| 15 | ; Incoming:
|
|---|
| 16 | ; IBXIEN = IEN for File # 399
|
|---|
| 17 | ; IBXRET = Return Array for Qualifiers and IDs
|
|---|
| 18 | ;
|
|---|
| 19 | ; Outgoing
|
|---|
| 20 | ; IBXRET("CI_PID",1)=QUAL^ID
|
|---|
| 21 | ; IBXRET("OI_PID",#)=QUAL^ID
|
|---|
| 22 | ;
|
|---|
| 23 | N RET,I
|
|---|
| 24 | S RET=$$PAYERID^IBCEF2(IBXIEN)
|
|---|
| 25 | I RET]"" S IBXRET("CI_PID",1)="PI"_U_RET
|
|---|
| 26 | ;
|
|---|
| 27 | D OTHINSID^IBCEF72(IBXIEN,.RET)
|
|---|
| 28 | F I=1,2 I $G(RET(I))]"" S IBXRET("OI_PID",I)="PI"_U_RET(I)
|
|---|
| 29 | Q
|
|---|
| 30 | ;
|
|---|
| 31 | ;
|
|---|
| 32 | SECPAYID(IBXIEN,IBXRET) ; This returns all of the secondary payer IDs from file #36
|
|---|
| 33 | ; for the insurance companies on a given claim
|
|---|
| 34 | ;
|
|---|
| 35 | ; Incoming:
|
|---|
| 36 | ; IBXIEN = IEN for File # 399
|
|---|
| 37 | ; IBXRET = Return Array for Qualifiers and IDs
|
|---|
| 38 | ;
|
|---|
| 39 | ; Outgoing
|
|---|
| 40 | ; IBXRET("CI_PSIDS",1)=QUAL^ID^QUAL^ID
|
|---|
| 41 | ; IBXRET("OI_PSIDS",#)=QUAL^ID^QUAL^ID
|
|---|
| 42 | ;
|
|---|
| 43 | N Z,C,IBZ,Z0,FT
|
|---|
| 44 | F Z=1:1:3 S IBZ(Z)=$$POLICY^IBCEF(IBXIEN,1,Z)
|
|---|
| 45 | S Z0=0,C=$$COBN^IBCEF(IBXIEN),FT=$$FT^IBCEF(IBXIEN)
|
|---|
| 46 | F Z=1:1:3 S:C'=Z Z0=Z0+1 S IBXRET($S(C=Z:"CI_PSIDS",1:"OI_PSIDS"),$S(C=Z:1,1:Z0))=$$SPIDS(+IBZ(Z),FT)
|
|---|
| 47 | Q
|
|---|
| 48 | ;
|
|---|
| 49 | SPIDS(INS,FT) ;
|
|---|
| 50 | ; FT = FORM TYPE (2 PROFESSIONAL 3 INSTITUTIONAL)
|
|---|
| 51 | ; INS = INSURANCE COMPANY (FILE #36) IEN
|
|---|
| 52 | ; Returns String (^ delimited)
|
|---|
| 53 | ; [1] = QUAL 1
|
|---|
| 54 | ; [2] = PAYER ID 1
|
|---|
| 55 | ; [3] = QUAL 2
|
|---|
| 56 | ; [4] = PAYER ID 2
|
|---|
| 57 | Q:'+INS ""
|
|---|
| 58 | ;
|
|---|
| 59 | N DATA,PCE
|
|---|
| 60 | S DATA=$S(FT=3:$P($G(^DIC(36,+INS,6)),U,1,4),FT=2:$P($G(^DIC(36,+INS,6)),U,5,8),1:"")
|
|---|
| 61 | ;
|
|---|
| 62 | ; Check for dangling IDs/Qualifiers
|
|---|
| 63 | F PCE=1,3 D
|
|---|
| 64 | . I $P(DATA,U,PCE)'="",$P(DATA,U,PCE+1)'="" Q
|
|---|
| 65 | . S ($P(DATA,U,PCE),$P(DATA,U,PCE+1))=""
|
|---|
| 66 | ;
|
|---|
| 67 | ; fill in the gap if there is one
|
|---|
| 68 | I $P(DATA,U,1)="",$P(DATA,U,3)'="" D
|
|---|
| 69 | . S $P(DATA,U,1)=$P(DATA,U,3)
|
|---|
| 70 | . S $P(DATA,U,2)=$P(DATA,U,4)
|
|---|
| 71 | . S ($P(DATA,U,3),$P(DATA,U,4))=""
|
|---|
| 72 | ;
|
|---|
| 73 | Q DATA
|
|---|
| 74 | ;
|
|---|
| 75 | CLEANUP(IBRET) ;
|
|---|
| 76 | K IBRET("CI_PID"),IBRET("OI_PID"),IBRET("CI_PSIDS"),IBRET("OI_PSIDS")
|
|---|
| 77 | Q
|
|---|
| 78 | ;
|
|---|
