| 1 | IBCNSU4 ;ALB/CPM - SPONSOR UTILITIES ; 21-JAN-97
|
|---|
| 2 | ;;Version 2.0 ; INTEGRATED BILLING ;**52**; 21-MAR-94
|
|---|
| 3 | ;;Per VHA Directive 10-93-142, this routine should not be modified.
|
|---|
| 4 | ;
|
|---|
| 5 | GET(DFN,ARR) ; Retrieve sponsor relationships for a patient.
|
|---|
| 6 | ; Input: DFN -- Pointer to the patient in file #2
|
|---|
| 7 | ; Output: ARR -- Passed by reference:
|
|---|
| 8 | ;
|
|---|
| 9 | ; ARR = #, where # is the number of relationships
|
|---|
| 10 | ;
|
|---|
| 11 | ; ARR(#,"REL")=1^2^3^4^5, where
|
|---|
| 12 | ; 1 => sponsor name
|
|---|
| 13 | ; 2 => family prefix
|
|---|
| 14 | ; 3 => type (tricare/champva)
|
|---|
| 15 | ; 4 => effective date (fm format)
|
|---|
| 16 | ; 5 => expiration date (fm format)
|
|---|
| 17 | ; 6 => pointer to the relationship in file #355.81
|
|---|
| 18 | ;
|
|---|
| 19 | ; ARR(#,"SPON")=1^2^3^4^5^6, where
|
|---|
| 20 | ; 1 => sponsor name
|
|---|
| 21 | ; 2 => sponsor dob (external format)
|
|---|
| 22 | ; 3 => sponsor ssn (external format [dashes])
|
|---|
| 23 | ; 4 => military status (active duty/retired)
|
|---|
| 24 | ; 5 => branch (expanded from file #23)
|
|---|
| 25 | ; 6 => rank
|
|---|
| 26 | ;
|
|---|
| 27 | N BRAN,REL,SPON,STAT,X,X1,XSPON,Y,Y1
|
|---|
| 28 | K ARR S ARR=0
|
|---|
| 29 | I '$G(DFN) G GETQ
|
|---|
| 30 | ;
|
|---|
| 31 | ; - look at all of the patient's sponsor relationships
|
|---|
| 32 | S X=0 F S X=$O(^IBA(355.81,"B",DFN,X)) Q:'X D
|
|---|
| 33 | .S REL=$G(^IBA(355.81,X,0)) Q:'REL
|
|---|
| 34 | .S SPON=$G(^IBA(355.8,+$P(REL,"^",2),0)) Q:'SPON
|
|---|
| 35 | .I $L(REL,"^")<6 S REL=REL_"^^^^^^^"
|
|---|
| 36 | .;
|
|---|
| 37 | .; - if the sponsor is a patient, gather attributes from file #2
|
|---|
| 38 | .I $P(SPON,"^")["DPT" D
|
|---|
| 39 | ..S X1=$G(^DPT(+SPON,0))
|
|---|
| 40 | ..S Y=$P(X1,"^",3) X ^DD("DD")
|
|---|
| 41 | ..S XSPON=$P(X1,"^")_"^"_Y_"^"_$$SSN($P(X1,"^",9))
|
|---|
| 42 | .;
|
|---|
| 43 | .; - if the sponsor is not a patient, go to file #355.82
|
|---|
| 44 | .E D
|
|---|
| 45 | ..S XSPON=$G(^IBA(355.82,+SPON,0)) S:$L(XSPON,"^")<3 XSPON=XSPON_"^^"
|
|---|
| 46 | ..S Y=$P(XSPON,"^",2) I Y X ^DD("DD") S $P(XSPON,"^",2)=Y
|
|---|
| 47 | ..S Y=$P(XSPON,"^",3) I Y S $P(XSPON,"^",3)=$$SSN(Y)
|
|---|
| 48 | .;
|
|---|
| 49 | .;
|
|---|
| 50 | .; - build sponsor relation array
|
|---|
| 51 | .S $P(REL,"^",4)=$S($P(REL,"^",4)="T":"TRICARE",$P(REL,"^",4)="C":"CHAMPVA",1:"")
|
|---|
| 52 | .S ARR=ARR+1,ARR(ARR,"REL")=$P(XSPON,"^")_"^"_$P(REL,"^",3,6)_"^"_X
|
|---|
| 53 | .;
|
|---|
| 54 | .; - build sponsor array
|
|---|
| 55 | .S STAT=$S($P(SPON,"^",2)="A":"ACTIVE DUTY",$P(SPON,"^",2)="R":"RETIRED",1:"")
|
|---|
| 56 | .S BRAN=$P($G(^DIC(23,+$P(SPON,"^",3),0)),"^")
|
|---|
| 57 | .S ARR(ARR,"SPON")=$P(XSPON,"^",1,3)_"^"_STAT_"^"_BRAN_"^"_$P(SPON,"^",4)
|
|---|
| 58 | ;
|
|---|
| 59 | GETQ Q
|
|---|
| 60 | ;
|
|---|
| 61 | ;
|
|---|
| 62 | SSN(X) ; Strip dashes from SSN and add them back in.
|
|---|
| 63 | S:$G(X)'="" X=$TR(X,"-","")
|
|---|
| 64 | Q $S($G(X)="":"",1:$E(X,1,3)_"-"_$E(X,4,5)_"-"_$E(X,6,13))
|
|---|
