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

RCXVDC2.m

Go to the documentation of this file.
  1. RCXVDC2 ;DAOU/ALA-AR Data Extraction Data Creation ;02-JUL-03
  1. ;;4.5;Accounts Receivable;**201,227,228**;Mar 20, 1995
  1. ;
  1. ; PATIENT FILE (# 2)
  1. Q
  1. D2 ;
  1. NEW RCXVDT,RCXVD,RCXVD1,RCXVD2,RCXVD3,RCXVPF,RCXVDA,RCXVENR,RCXVPE
  1. N RCXVPE1,RCXVCT,RCMTYP,RCMTDA,RCMTDT,PC1,PC2,PC3
  1. NEW RCXVCTY,RCXVICN,RCXVELG,VADM
  1. S RCXVD=$G(^DPT(DFN,0))
  1. S RCXVDT=$P(RCXVD,U,3)
  1. S RCXVDA=$E($$HLDATE^HLFNC(RCXVDT),1,8) ; DT of Birth
  1. S RCXVDA=RCXVDA_RCXVU_$P(RCXVD,U,9) ; SSN
  1. S RCXVICN=$P($G(^DPT(DFN,"MPI")),U,1)
  1. S RCXVDA=RCXVDA_RCXVU_RCXVICN ; ICN
  1. S RCXVDA=RCXVDA_RCXVU_$P($$SITE^VASITE(),U,3)_"v"_DFN ; IEN
  1. S RCXVDA=RCXVDA_RCXVU_$P(RCXVD,U,2) ; SEX
  1. S RCXVD1=$G(^DPT(DFN,.11))
  1. S RCXVD2=$G(^DPT(DFN,.35))
  1. S RCXVD3="^^^^^^^^^^^"
  1. S RCXVDA=RCXVDA_RCXVU_$P(RCXVD1,U,6) ; ZIPCODE
  1. ;
  1. NEW VAPA,VAERR
  1. D ADD^VADPT
  1. S RCXVCTY=$P($G(VAPA(7)),U,2)
  1. S RCXVDA=RCXVDA_RCXVU_RCXVCTY ; COUNTY
  1. ;
  1. S RCXVPE="",RCXVPE1=""
  1. S RCXVENR=$P($G(^DPT(DFN,"ENR")),U,1)
  1. I RCXVENR'="" D
  1. . S RCXVPE=$P($G(^DGEN(27.11,RCXVENR,0)),U,7) ; Enrollment priority
  1. . S RCXVPE1=$$GET1^DIQ(27.11,RCXVENR_",",.12,"E") ; Enrollment subgroup
  1. ;
  1. ;Primary Eligibility Code
  1. S RCXVELG=$P($G(^DPT(DFN,.36)),U,1)
  1. I RCXVELG'="" S RCXVELG=$P($G(^DIC(8,RCXVELG,0)),U,1)
  1. S RCXVDA=RCXVDA_RCXVU_RCXVPE_RCXVU_RCXVPE1_RCXVU_RCXVELG
  1. S RCXVDT=$P(RCXVD2,U)
  1. D DEM^VADPT S RCXVDT=$P(VADM(6),U)
  1. S RCXVDA=RCXVDA_RCXVU_$E($$HLDATE^HLFNC(RCXVDT),1,8) ;Date of Death
  1. S RCXVDA=RCXVDA_RCXVU_$P(VADM(10),U,2) ;Marital Status
  1. ;means test data
  1. F RCMTYP=1,2,3,4 D:$D(^DGMT(408.31,"AID",RCMTYP,DFN))
  1. . S PC3=RCMTYP*3,PC2=PC3-1,PC1=PC3-2
  1. . S RCMTDT=$O(^DGMT(408.31,"AID",RCMTYP,DFN,-9999999))
  1. . S RCMTDA=$O(^DGMT(408.31,"AID",RCMTYP,DFN,RCMTDT,0)) Q:'RCMTDA
  1. . S RCXVDT=-RCMTDT
  1. . S $P(RCXVD3,U,PC1)=$E($$HLDATE^HLFNC(RCXVDT),1,8) ;Test Date
  1. . S $P(RCXVD3,U,PC2)=$$GET1^DIQ(408.31,RCMTDA_",",.03,"E") ;Test Status
  1. . S $P(RCXVD3,U,PC3)=$P($G(^DGMT(408.31,RCMTDA,0)),U,4) ;Income
  1. . Q
  1. S ^TMP($J,RCXVBLN,"2-2A")=RCXVDA
  1. S ^TMP($J,RCXVBLN,"2-2B")=RCXVD3
  1. Q
  1. ;