BMXADOI ; IHS/CIHA/GIS - RPC CALL: GENERATE DATA FOR AN ADO DATASET ;
;;4.0;BMX;**1**;JUN 28, 2010;Build 12
; CUSTOM IDENTIFIERS
;
;
;
DEMOID(DA) ; EP-RETURN RPMS DEMOGRAPHIC INFO FOR IDENTIFIER FIELD
N SEX,DOB,CHART,AGE,TRIBE,CC,X,Y,%,STG,FMDOB,NAME,S,SSN,CSTG,LOC,ABB
I '$D(^DPT(+$G(DA),0)) Q ""
S S=" "
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)
I '$L(NAME) Q ""
I Y,$G(DT) S AGE=(DT-Y)\10000
I Y X ^DD("DD") S DOB=Y
S LOC=0,CSTG=""
F S LOC=$O(^AUPNPAT(DA,41,LOC)) Q:'LOC D ; GET ALL THE CHART NUMBERS
. S CHART=$P($G(^AUPNPAT(DA,41,LOC,0)),U,2) I '$L(CHART) Q
. S ABB=$P($G(^AUTTLOC(LOC,0)),U,7) I '$L(ABB) Q
. I $L(CSTG) S CSTG=CSTG_", "
. S CSTG=CSTG_ABB_" #"_CHART
. Q
;I $G(DUZ(2)) S CHART=$P($G(^AUPNPAT(DA,41,DUZ(2),0)),U,2)
S %=$P($G(^AUPNPAT(DA,11)),U,8) I % S TRIBE=$P($G(^AUTTTRI(%,0)),U)
S CC=$P($G(^AUPNPAT(DA,11)),U,18)
S STG=NAME_" "
I $L(CSTG) S STG=STG_CSTG_" --"
I $G(AGE),$L(SEX) S STG=STG_S_AGE_" y/o "_SEX
I '$G(AGE),$L(SEX) S STG=STG_S_SEX
I $L($G(DOB)) S STG=STG_S_DOB
I $L($G(SSN)) S STG=STG_S_$E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,9)
I $L($G(TRIBE)) S STG=STG_S_TRIBE
I $L($G(CC)) S STG=STG_S_CC
Q STG
;
DATE(DATE) ; TEST TRIGGER
Q DATE
;
NAME(VIEN) ; RETURN THE PATIENT'S NAME
I '$G(VIEN) Q ""
N DFN
S DFN=$P($G(^AUPNVSIT(VIEN,0)),U,5) I 'DFN Q ""
Q $$GET1^DIQ(2,DFN_",",.01)
;
SEX(VIEN) ; RETURN THE PATIENT'S SEX
I '$G(VIEN) Q ""
N DFN
S DFN=$P($G(^AUPNVSIT(VIEN,0)),U,5) I 'DFN Q ""
Q $$GET1^DIQ(2,DFN_",",.02)
;
HRN(VIEN) ; RETURN THE CHART NUMBER FOR VISIT TRIGGER
I '$G(VIEN) Q ""
N DFN,LOC
S DFN=$P($G(^AUPNVSIT(VIEN,0)),U,5) I 'DFN Q ""
S LOC=$P($G(^AUPNVSIT(VIEN,0)),U,6) I 'LOC Q ""
Q $$HRN^AUPNPAT(DFN,LOC,2)
;
DOB(VIEN) ; RETURN THE PATIENT'S DOB
I '$G(VIEN) Q ""
N DFN,LOC
S DFN=$P($G(^AUPNVSIT(VIEN,0)),U,5) I 'DFN Q ""
Q $$DOB^AUPNPAT(DFN,"E")
;
SSN(VIEN) ; RETURN THE PATIENTS DOB
I '$G(VIEN) Q ""
N DFN,LOC
S DFN=$P($G(^AUPNVSIT(VIEN,0)),U,5) I 'DFN Q ""
Q $$SSN^AUPNPAT(DFN)
;
VISDATE(VIEN) ; RETURN THE DATE OF THE VISIT
I '$G(VIEN) Q ""
N FMDT
S FMDT=+$G(^AUPNVSIT(VIEN,0))\1 I 'FMDT Q ""
S %=$$FMTE^XLFDT(FMDT,1)
G TD1
;
TODAY(VIEN) ; RETURN TODAY'S DATE
I '$G(DT) Q ""
S %=$$FMTE^XLFDT(DT,1)
TD1 S %=$$UP^XLFSTR(%)
S %=$P(%," ",1,2)_$P(%," ",3)
Q %
;
BMXADOI ; IHS/CIHA/GIS - RPC CALL: GENERATE DATA FOR AN ADO DATASET ;
+1 ;;4.0;BMX;**1**;JUN 28, 2010;Build 12
+2 ; CUSTOM IDENTIFIERS
+3 ;
+4 ;
+5 ;
DEMOID(DA) ; EP-RETURN RPMS DEMOGRAPHIC INFO FOR IDENTIFIER FIELD
+1 NEW SEX,DOB,CHART,AGE,TRIBE,CC,X,Y,%,STG,FMDOB,NAME,S,SSN,CSTG,LOC,ABB
+2 IF '$DATA(^DPT(+$GET(DA),0))
QUIT ""
+3 SET S=" "
+4 SET X=$GET(^DPT(DA,0))
SET SEX=$PIECE(X,U,2)
SET Y=$PIECE(X,U,3)
SET NAME=$PIECE(X,U)
SET SSN=$PIECE(X,U,9)
+5 IF '$LENGTH(NAME)
QUIT ""
+6 IF Y
IF $GET(DT)
SET AGE=(DT-Y)\10000
+7 IF Y
XECUTE ^DD("DD")
SET DOB=Y
+8 SET LOC=0
SET CSTG=""
+9 ; GET ALL THE CHART NUMBERS
FOR
SET LOC=$ORDER(^AUPNPAT(DA,41,LOC))
IF 'LOC
QUIT
Begin DoDot:1
+10 SET CHART=$PIECE($GET(^AUPNPAT(DA,41,LOC,0)),U,2)
IF '$LENGTH(CHART)
QUIT
+11 SET ABB=$PIECE($GET(^AUTTLOC(LOC,0)),U,7)
IF '$LENGTH(ABB)
QUIT
+12 IF $LENGTH(CSTG)
SET CSTG=CSTG_", "
+13 SET CSTG=CSTG_ABB_" #"_CHART
+14 QUIT
End DoDot:1
+15 ;I $G(DUZ(2)) S CHART=$P($G(^AUPNPAT(DA,41,DUZ(2),0)),U,2)
+16 SET %=$PIECE($GET(^AUPNPAT(DA,11)),U,8)
IF %
SET TRIBE=$PIECE($GET(^AUTTTRI(%,0)),U)
+17 SET CC=$PIECE($GET(^AUPNPAT(DA,11)),U,18)
+18 SET STG=NAME_" "
+19 IF $LENGTH(CSTG)
SET STG=STG_CSTG_" --"
+20 IF $GET(AGE)
IF $LENGTH(SEX)
SET STG=STG_S_AGE_" y/o "_SEX
+21 IF '$GET(AGE)
IF $LENGTH(SEX)
SET STG=STG_S_SEX
+22 IF $LENGTH($GET(DOB))
SET STG=STG_S_DOB
+23 IF $LENGTH($GET(SSN))
SET STG=STG_S_$EXTRACT(SSN,1,3)_"-"_$EXTRACT(SSN,4,5)_"-"_$EXTRACT(SSN,6,9)
+24 IF $LENGTH($GET(TRIBE))
SET STG=STG_S_TRIBE
+25 IF $LENGTH($GET(CC))
SET STG=STG_S_CC
+26 QUIT STG
+27 ;
DATE(DATE) ; TEST TRIGGER
+1 QUIT DATE
+2 ;
NAME(VIEN) ; RETURN THE PATIENT'S NAME
+1 IF '$GET(VIEN)
QUIT ""
+2 NEW DFN
+3 SET DFN=$PIECE($GET(^AUPNVSIT(VIEN,0)),U,5)
IF 'DFN
QUIT ""
+4 QUIT $$GET1^DIQ(2,DFN_",",.01)
+5 ;
SEX(VIEN) ; RETURN THE PATIENT'S SEX
+1 IF '$GET(VIEN)
QUIT ""
+2 NEW DFN
+3 SET DFN=$PIECE($GET(^AUPNVSIT(VIEN,0)),U,5)
IF 'DFN
QUIT ""
+4 QUIT $$GET1^DIQ(2,DFN_",",.02)
+5 ;
HRN(VIEN) ; RETURN THE CHART NUMBER FOR VISIT TRIGGER
+1 IF '$GET(VIEN)
QUIT ""
+2 NEW DFN,LOC
+3 SET DFN=$PIECE($GET(^AUPNVSIT(VIEN,0)),U,5)
IF 'DFN
QUIT ""
+4 SET LOC=$PIECE($GET(^AUPNVSIT(VIEN,0)),U,6)
IF 'LOC
QUIT ""
+5 QUIT $$HRN^AUPNPAT(DFN,LOC,2)
+6 ;
DOB(VIEN) ; RETURN THE PATIENT'S DOB
+1 IF '$GET(VIEN)
QUIT ""
+2 NEW DFN,LOC
+3 SET DFN=$PIECE($GET(^AUPNVSIT(VIEN,0)),U,5)
IF 'DFN
QUIT ""
+4 QUIT $$DOB^AUPNPAT(DFN,"E")
+5 ;
SSN(VIEN) ; RETURN THE PATIENTS DOB
+1 IF '$GET(VIEN)
QUIT ""
+2 NEW DFN,LOC
+3 SET DFN=$PIECE($GET(^AUPNVSIT(VIEN,0)),U,5)
IF 'DFN
QUIT ""
+4 QUIT $$SSN^AUPNPAT(DFN)
+5 ;
VISDATE(VIEN) ; RETURN THE DATE OF THE VISIT
+1 IF '$GET(VIEN)
QUIT ""
+2 NEW FMDT
+3 SET FMDT=+$GET(^AUPNVSIT(VIEN,0))\1
IF 'FMDT
QUIT ""
+4 SET %=$$FMTE^XLFDT(FMDT,1)
+5 GOTO TD1
+6 ;
TODAY(VIEN) ; RETURN TODAY'S DATE
+1 IF '$GET(DT)
QUIT ""
+2 SET %=$$FMTE^XLFDT(DT,1)
TD1 SET %=$$UP^XLFSTR(%)
+1 SET %=$PIECE(%," ",1,2)_$PIECE(%," ",3)
+2 QUIT %
+3 ;
