source: BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXADOI.m@ 645

Last change on this file since 645 was 645, checked in by Sam Habiel, 14 years ago

Initial Import of BMX.net code

File size: 2.2 KB
Line 
1BMXADOI ; IHS/CIHA/GIS - RPC CALL: GENERATE DATA FOR AN ADO DATASET ;
2 ;;2.1;BMX;;Jul 26, 2009
3 ; CUSTOM IDENTIFIERS
4 ;
5 ;
6 ;
7DEMOID(DA) ; EP-RETURN RPMS DEMOGRAPHIC INFO FOR IDENTIFIER FIELD
8 N SEX,DOB,CHART,AGE,TRIBE,CC,X,Y,%,STG,FMDOB,NAME,S,SSN,CSTG,LOC,ABB
9 I '$D(^DPT(+$G(DA),0)) Q ""
10 S S=" "
11 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)
12 I '$L(NAME) Q ""
13 I Y,$G(DT) S AGE=(DT-Y)\10000
14 I Y X ^DD("DD") S DOB=Y
15 S LOC=0,CSTG=""
16 F S LOC=$O(^AUPNPAT(DA,41,"B",LOC)) Q:'LOC D ; GET ALL THE CHART NUMBERS
17 . S CHART=$O(^AUPNPAT(DA,41,"B",LOC,0)) I '$L(CHART) Q
18 . S ABB=$P($G(^AUTTLOC(LOC,0)),U,7) I '$L(ABB) Q
19 . I $L(CSTG) S CSTG=CSTG_", "
20 . S CSTG=CSTG_ABB_" #"_CHART
21 . Q
22 I $G(DUZ(2)) S CHART=$P($G(^AUPNPAT(DA,41,DUZ(2),0)),U,2)
23 S %=$P($G(^AUPNPAT(DA,11)),U,8) I % S TRIBE=$P($G(^AUTTTRI(%,0)),U)
24 S CC=$P($G(^AUPNPAT(DA,11)),U,18)
25 S STG=NAME
26 I $L(CSTG) S STG=STG_CSTG_" --"
27 I $G(AGE),$L(SEX) S STG=STG_S_AGE_" y/o "_SEX
28 I '$G(AGE),$L(SEX) S STG=STG_S_SEX
29 I $L($G(DOB)) S STG=STG_S_DOB
30 I $L($G(SSN)) S STG=STG_S_$E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,9)
31 I $L($G(TRIBE)) S STG=STG_S_TRIBE
32 I $L($G(CC)) S STG=STG_S_CC
33 Q STG
34 ;
35DATE(DATE) ; TEST TRIGGER
36 Q DATE
37 ;
38NAME(VIEN) ; RETURN THE PATIENT'S NAME
39 I '$G(VIEN) Q ""
40 N DFN
41 S DFN=$P($G(^AUPNVSIT(VIEN,0)),U,5) I 'DFN Q ""
42 Q $$GET1^DIQ(2,DFN_",",.01)
43 ;
44SEX(VIEN) ; RETURN THE PATIENT'S SEX
45 I '$G(VIEN) Q ""
46 N DFN
47 S DFN=$P($G(^AUPNVSIT(VIEN,0)),U,5) I 'DFN Q ""
48 Q $$GET1^DIQ(2,DFN_",",.02)
49 ;
50HRN(VIEN) ; RETURN THE CHART NUMBER FOR VISIT TRIGGER
51 I '$G(VIEN) Q ""
52 N DFN,LOC
53 S DFN=$P($G(^AUPNVSIT(VIEN,0)),U,5) I 'DFN Q ""
54 S LOC=$P($G(^AUPNVSIT(VIEN,0)),U,6) I 'LOC Q ""
55 Q $$HRN^AUPNPAT(DFN,LOC,2)
56 ;
57DOB(VIEN) ; RETURN THE PATIENT'S DOB
58 I '$G(VIEN) Q ""
59 N DFN,LOC
60 S DFN=$P($G(^AUPNVSIT(VIEN,0)),U,5) I 'DFN Q ""
61 Q $$DOB^AUPNPAT(DFN,"E")
62 ;
63SSN(VIEN) ; RETURN THE PATIENTS DOB
64 I '$G(VIEN) Q ""
65 N DFN,LOC
66 S DFN=$P($G(^AUPNVSIT(VIEN,0)),U,5) I 'DFN Q ""
67 Q $$SSN^AUPNPAT(DFN)
68 ;
69VISDATE(VIEN) ; RETURN THE DATE OF THE VISIT
70 I '$G(VIEN) Q ""
71 N FMDT
72 S FMDT=+$G(^AUPNVSIT(VIEN,0))\1 I 'FMDT Q ""
73 S %=$$FMTE^XLFDT(FMDT,1)
74 G TD1
75 ;
76TODAY(VIEN) ; RETURN TODAY'S DATE
77 I '$G(DT) Q ""
78 S %=$$FMTE^XLFDT(DT,1)
79TD1 S %=$$UP^XLFSTR(%)
80 S %=$P(%," ",1,2)_$P(%," ",3)
81 Q %
82 ;
Note: See TracBrowser for help on using the repository browser.