| 1 | RCXVDC2 ;DAOU/ALA-AR Data Extraction Data Creation ;02-JUL-03
|
|---|
| 2 | ;;4.5;Accounts Receivable;**201,227,228**;Mar 20, 1995
|
|---|
| 3 | ;
|
|---|
| 4 | ; PATIENT FILE (# 2)
|
|---|
| 5 | Q
|
|---|
| 6 | D2 ;
|
|---|
| 7 | NEW RCXVDT,RCXVD,RCXVD1,RCXVD2,RCXVD3,RCXVPF,RCXVDA,RCXVENR,RCXVPE
|
|---|
| 8 | N RCXVPE1,RCXVCT,RCMTYP,RCMTDA,RCMTDT,PC1,PC2,PC3
|
|---|
| 9 | NEW RCXVCTY,RCXVICN,RCXVELG,VADM
|
|---|
| 10 | S RCXVD=$G(^DPT(DFN,0))
|
|---|
| 11 | S RCXVDT=$P(RCXVD,U,3)
|
|---|
| 12 | S RCXVDA=$E($$HLDATE^HLFNC(RCXVDT),1,8) ; DT of Birth
|
|---|
| 13 | S RCXVDA=RCXVDA_RCXVU_$P(RCXVD,U,9) ; SSN
|
|---|
| 14 | S RCXVICN=$P($G(^DPT(DFN,"MPI")),U,1)
|
|---|
| 15 | S RCXVDA=RCXVDA_RCXVU_RCXVICN ; ICN
|
|---|
| 16 | S RCXVDA=RCXVDA_RCXVU_$P($$SITE^VASITE(),U,3)_"v"_DFN ; IEN
|
|---|
| 17 | S RCXVDA=RCXVDA_RCXVU_$P(RCXVD,U,2) ; SEX
|
|---|
| 18 | S RCXVD1=$G(^DPT(DFN,.11))
|
|---|
| 19 | S RCXVD2=$G(^DPT(DFN,.35))
|
|---|
| 20 | S RCXVD3="^^^^^^^^^^^"
|
|---|
| 21 | S RCXVDA=RCXVDA_RCXVU_$P(RCXVD1,U,6) ; ZIPCODE
|
|---|
| 22 | ;
|
|---|
| 23 | NEW VAPA,VAERR
|
|---|
| 24 | D ADD^VADPT
|
|---|
| 25 | S RCXVCTY=$P($G(VAPA(7)),U,2)
|
|---|
| 26 | S RCXVDA=RCXVDA_RCXVU_RCXVCTY ; COUNTY
|
|---|
| 27 | ;
|
|---|
| 28 | S RCXVPE="",RCXVPE1=""
|
|---|
| 29 | S RCXVENR=$P($G(^DPT(DFN,"ENR")),U,1)
|
|---|
| 30 | I RCXVENR'="" D
|
|---|
| 31 | . S RCXVPE=$P($G(^DGEN(27.11,RCXVENR,0)),U,7) ; Enrollment priority
|
|---|
| 32 | . S RCXVPE1=$$GET1^DIQ(27.11,RCXVENR_",",.12,"E") ; Enrollment subgroup
|
|---|
| 33 | ;
|
|---|
| 34 | ;Primary Eligibility Code
|
|---|
| 35 | S RCXVELG=$P($G(^DPT(DFN,.36)),U,1)
|
|---|
| 36 | I RCXVELG'="" S RCXVELG=$P($G(^DIC(8,RCXVELG,0)),U,1)
|
|---|
| 37 | S RCXVDA=RCXVDA_RCXVU_RCXVPE_RCXVU_RCXVPE1_RCXVU_RCXVELG
|
|---|
| 38 | S RCXVDT=$P(RCXVD2,U)
|
|---|
| 39 | D DEM^VADPT S RCXVDT=$P(VADM(6),U)
|
|---|
| 40 | S RCXVDA=RCXVDA_RCXVU_$E($$HLDATE^HLFNC(RCXVDT),1,8) ;Date of Death
|
|---|
| 41 | S RCXVDA=RCXVDA_RCXVU_$P(VADM(10),U,2) ;Marital Status
|
|---|
| 42 | ;means test data
|
|---|
| 43 | F RCMTYP=1,2,3,4 D:$D(^DGMT(408.31,"AID",RCMTYP,DFN))
|
|---|
| 44 | . S PC3=RCMTYP*3,PC2=PC3-1,PC1=PC3-2
|
|---|
| 45 | . S RCMTDT=$O(^DGMT(408.31,"AID",RCMTYP,DFN,-9999999))
|
|---|
| 46 | . S RCMTDA=$O(^DGMT(408.31,"AID",RCMTYP,DFN,RCMTDT,0)) Q:'RCMTDA
|
|---|
| 47 | . S RCXVDT=-RCMTDT
|
|---|
| 48 | . S $P(RCXVD3,U,PC1)=$E($$HLDATE^HLFNC(RCXVDT),1,8) ;Test Date
|
|---|
| 49 | . S $P(RCXVD3,U,PC2)=$$GET1^DIQ(408.31,RCMTDA_",",.03,"E") ;Test Status
|
|---|
| 50 | . S $P(RCXVD3,U,PC3)=$P($G(^DGMT(408.31,RCMTDA,0)),U,4) ;Income
|
|---|
| 51 | . Q
|
|---|
| 52 | S ^TMP($J,RCXVBLN,"2-2A")=RCXVDA
|
|---|
| 53 | S ^TMP($J,RCXVBLN,"2-2B")=RCXVD3
|
|---|
| 54 | Q
|
|---|
| 55 | ;
|
|---|
