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

BMXADOI.m

Go to the documentation of this file. 
  1. BMXADOI ; IHS/CIHA/GIS - RPC CALL: GENERATE DATA FOR AN ADO DATASET ;
  1.  ;;4.0;BMX;**1**;JUN 28, 2010;Build 12
  1.  ; CUSTOM IDENTIFIERS
  1.  ;
  1.  ;
  1.  ; 
  1. DEMOID(DA) ; EP-RETURN RPMS DEMOGRAPHIC INFO FOR IDENTIFIER FIELD
  1.  N SEX,DOB,CHART,AGE,TRIBE,CC,X,Y,%,STG,FMDOB,NAME,S,SSN,CSTG,LOC,ABB
  1.  I '$D(^DPT(+$G(DA),0)) Q ""
  1.  S S="  "
  1.  S X=$G(^DPT(DA,0)),SEX=$P(X,U,2),Y=$P(X,U,3),NAME=$P(X,U),SSN=$P(X,U,9)
  1.  I '$L(NAME) Q ""
  1.  I Y,$G(DT) S AGE=(DT-Y)\10000
  1.  I Y X ^DD("DD") S DOB=Y
  1.  S LOC=0,CSTG=""
  1.  F  S LOC=$O(^AUPNPAT(DA,41,LOC)) Q:'LOC  D  ; GET ALL THE CHART NUMBERS
  1.  . S CHART=$P($G(^AUPNPAT(DA,41,LOC,0)),U,2) I '$L(CHART) Q
  1.  . S ABB=$P($G(^AUTTLOC(LOC,0)),U,7) I '$L(ABB) Q
  1.  . I $L(CSTG) S CSTG=CSTG_", "
  1.  . S CSTG=CSTG_ABB_" #"_CHART
  1.  . Q
  1.  ;I $G(DUZ(2)) S CHART=$P($G(^AUPNPAT(DA,41,DUZ(2),0)),U,2)
  1.  S %=$P($G(^AUPNPAT(DA,11)),U,8) I % S TRIBE=$P($G(^AUTTTRI(%,0)),U)
  1.  S CC=$P($G(^AUPNPAT(DA,11)),U,18)
  1.  S STG=NAME_" "
  1.  I $L(CSTG) S STG=STG_CSTG_"  --"
  1.  I $G(AGE),$L(SEX) S STG=STG_S_AGE_" y/o "_SEX
  1.  I '$G(AGE),$L(SEX) S STG=STG_S_SEX
  1.  I $L($G(DOB)) S STG=STG_S_DOB
  1.  I $L($G(SSN)) S STG=STG_S_$E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,9)
  1.  I $L($G(TRIBE)) S STG=STG_S_TRIBE
  1.  I $L($G(CC)) S STG=STG_S_CC
  1.  Q STG
  1.  ; 
  1. DATE(DATE) ; TEST TRIGGER
  1.  Q DATE
  1.  ; 
  1. NAME(VIEN) ; RETURN THE PATIENT'S NAME
  1.  I '$G(VIEN) Q ""
  1.  N DFN
  1.  S DFN=$P($G(^AUPNVSIT(VIEN,0)),U,5) I 'DFN Q ""
  1.  Q $$GET1^DIQ(2,DFN_",",.01)
  1.  ; 
  1. SEX(VIEN) ; RETURN THE PATIENT'S SEX
  1.  I '$G(VIEN) Q ""
  1.  N DFN
  1.  S DFN=$P($G(^AUPNVSIT(VIEN,0)),U,5) I 'DFN Q ""
  1.  Q $$GET1^DIQ(2,DFN_",",.02)
  1.  ; 
  1. HRN(VIEN) ; RETURN THE CHART NUMBER FOR VISIT TRIGGER
  1.  I '$G(VIEN) Q ""
  1.  N DFN,LOC
  1.  S DFN=$P($G(^AUPNVSIT(VIEN,0)),U,5) I 'DFN Q ""
  1.  S LOC=$P($G(^AUPNVSIT(VIEN,0)),U,6) I 'LOC Q ""
  1.  Q $$HRN^AUPNPAT(DFN,LOC,2)
  1.  ;
  1. DOB(VIEN) ; RETURN THE PATIENT'S DOB
  1.  I '$G(VIEN) Q ""
  1.  N DFN,LOC
  1.  S DFN=$P($G(^AUPNVSIT(VIEN,0)),U,5) I 'DFN Q ""
  1.  Q $$DOB^AUPNPAT(DFN,"E")
  1.  ;
  1. SSN(VIEN) ; RETURN THE PATIENTS DOB
  1.  I '$G(VIEN) Q ""
  1.  N DFN,LOC
  1.  S DFN=$P($G(^AUPNVSIT(VIEN,0)),U,5) I 'DFN Q ""
  1.  Q $$SSN^AUPNPAT(DFN)
  1.  ; 
  1. VISDATE(VIEN) ; RETURN THE DATE OF THE VISIT
  1.  I '$G(VIEN) Q ""
  1.  N FMDT
  1.  S FMDT=+$G(^AUPNVSIT(VIEN,0))\1 I 'FMDT Q ""
  1.  S %=$$FMTE^XLFDT(FMDT,1)
  1.  G TD1
  1.  ;
  1. TODAY(VIEN) ; RETURN TODAY'S DATE
  1.  I '$G(DT) Q ""
  1.  S %=$$FMTE^XLFDT(DT,1)
  1. TD1 S %=$$UP^XLFSTR(%)
  1.  S %=$P(%," ",1,2)_$P(%," ",3)
  1.  Q %
  1.  ;