source: BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXRPC4.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: 5.0 KB
Line 
1BMXRPC4 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
2 ;;2.1;BMX;;Jul 26, 2009
3 ;
4PTINFORS(BMXY,BMXIEN) ;EP Patient Info Recordset
5 ;
6 N BMXDPT,BMXZ,BMXDLIM,BMXXX,BMXRET,BMXAGE,BMXNEXT,BMXSEX,BMXERR,BMXHRN
7 S BMXDLIM="^",BMXERR=""
8 S BMXRET="T00030NAME^T00030HRN^T00030SSN^D00030DOB^T00030IEN^T00020AGE^T00080NEXT_APPT^T00010SEX"_$C(30)
9 I '$D(DUZ(2)) S BMXY=BMXRET_$C(31)_"No DUZ2" Q
10 I +$G(DUZ) D
11 . S ^DISV(DUZ,"^AUPNPAT(")=BMXIEN
12 . S ^DISV(DUZ,"^DPT(")=BMXIEN
13 I '$D(^DPT(BMXIEN)) S BMXY=BMXRET_$C(31)_"No such patient" Q
14 S BMXDPT=$G(^DPT(BMXIEN,0))
15 S BMXZ=$P(BMXDPT,U) ;NAME
16 ;S $P(BMXZ,BMXDLIM,2)=$P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,2) ;CHART
17 S BMXHRN=$P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,2) ;CHART
18 ;I BMXHRN="" Q ;NO CHART AT THIS DUZ2
19 I $P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,3) S BMXHRN=BMXHRN_"(*)"
20 S $P(BMXZ,BMXDLIM,2)=BMXHRN
21 ;
22 S $P(BMXZ,BMXDLIM,3)=$P(BMXDPT,U,9) ;SSN
23 S Y=$P(BMXDPT,U,3) X ^DD("DD")
24 S $P(BMXZ,BMXDLIM,4)=Y ;DOB
25 S $P(BMXZ,BMXDLIM,5)=BMXIEN
26 S BMXAGE=$$AGEF^BMXUTL1(BMXIEN)
27 S $P(BMXZ,BMXDLIM,6)=BMXAGE
28 S BMXNEXT=$$NEXTAPPT^BMXUTL2(BMXIEN)
29 S $P(BMXZ,BMXDLIM,7)=BMXNEXT
30 S BMXSEX=$$SEXW^BMXUTL1(BMXIEN)
31 S $P(BMXZ,BMXDLIM,8)=BMXSEX
32 S BMXRET=BMXRET_BMXZ
33 S BMXY=BMXRET_$C(30)_$C(31)_BMXERR
34 Q
35 ;
36PTLOOKRS(BMXY,BMXP,BMXC) ;EP Patient Lookup
37 ;
38 ;Find up to BMXC patients matching BMXP*
39 ;Supports DOB Lookup, SSN Lookup
40 ;
41 ;S ^HW("PTLOOK","INPUT")=BMXP
42 ;S ^HW("PTLOOK","DUZ2")=$G(DUZ(2))
43 S BMXP=$TR(BMXP,$C(13),"")
44 S BMXP=$TR(BMXP,$C(10),"")
45 S BMXP=$TR(BMXP,$C(9),"")
46 S:BMXC="" BMXC=10
47 N BMXHRN,BMXZ,BMXDLIM,BMXRET
48 S BMXDLIM="^"
49 S BMXRET="T00030NAME^T00030HRN^T00030SSN^D00030DOB^T00030IEN"_$C(30)
50 I '+$G(DUZ) S BMXY=BMXRET_$C(31) Q
51 I '$D(DUZ(2)) S BMXY=BMXRET_$C(31) Q
52DOB ;DOB Lookup
53 I +DUZ(2),((BMXP?1.2N1"/"1.2N1"/"1.4N)!(BMXP?1.2N1" "1.2N1" "1.4N)!(BMXP?1.2N1"-"1.2N1"-"1.4N)) D S BMXY=BMXRET_$C(31) Q
54 . S X=BMXP S %DT="P" D ^%DT S BMXP=Y Q:'+Y
55 . Q:'$D(^DPT("ADOB",BMXP))
56 . S BMXIEN=0,BMXXX=1 F S BMXIEN=$O(^DPT("ADOB",BMXP,BMXIEN)) Q:'+BMXIEN D
57 . . Q:'$D(^DPT(BMXIEN,0))
58 . . S BMXDPT=$G(^DPT(BMXIEN,0))
59 . . S BMXZ=$P(BMXDPT,U) ;NAME
60 . . ;S $P(BMXZ,BMXDLIM,2)=$P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,2) ;CHART
61 . . S BMXHRN=$P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,2) ;CHART
62 . . I BMXHRN="" Q ;NO CHART AT THIS DUZ2
63 . . I $P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,3) S BMXHRN=BMXHRN_"(*)"
64 . . S $P(BMXZ,BMXDLIM,2)=BMXHRN
65 . . ;
66 . . S $P(BMXZ,BMXDLIM,3)=$P(BMXDPT,U,9) ;SSN
67 . . S Y=$P(BMXDPT,U,3) X ^DD("DD")
68 . . S $P(BMXZ,BMXDLIM,4)=Y ;DOB
69 . . S $P(BMXZ,BMXDLIM,5)=BMXIEN
70 . . S BMXXX=BMXXX+1
71 . . ;S $P(BMXRET,$C(30),BMXXX)=BMXZ
72 . . S BMXRET=BMXRET_BMXZ_$C(30)
73 . . Q
74 . Q
75 ;
76 ;Chart# Lookup
77 I +DUZ(2),BMXP]"",$D(^AUPNPAT("D",BMXP)) D S BMXY=BMXRET_$C(30)_$C(31) Q
78 . S BMXIEN=0 F S BMXIEN=$O(^AUPNPAT("D",BMXP,BMXIEN)) Q:'+BMXIEN I $D(^AUPNPAT("D",BMXP,BMXIEN,DUZ(2))) D Q
79 . . Q:'$D(^DPT(BMXIEN,0))
80 . . S BMXDPT=$G(^DPT(BMXIEN,0))
81 . . S BMXZ=$P(BMXDPT,U) ;NAME
82 . . ;S $P(BMXZ,BMXDLIM,2)=BMXP ;CHART
83 . . S BMXHRN=BMXP ;CHART
84 . . I $D(^AUPNPAT(BMXIEN,41,DUZ(2),0)),$P(^(0),U,3) S BMXHRN=BMXHRN_"(*)"
85 . . S $P(BMXZ,BMXDLIM,2)=BMXHRN
86 . . S $P(BMXZ,BMXDLIM,3)=$P(BMXDPT,U,9) ;SSN
87 . . S Y=$P(BMXDPT,U,3) X ^DD("DD")
88 . . S $P(BMXZ,BMXDLIM,4)=Y ;DOB
89 . . S $P(BMXZ,BMXDLIM,5)=BMXIEN
90 . . S $P(BMXRET,$C(30),2)=BMXZ
91 . . Q
92 . Q
93 ;
94 ;SSN Lookup
95 I (BMXP?9N)!(BMXP?3N1"-"2N1"-"4N),$D(^DPT("SSN",BMXP)) D S BMXY=BMXRET_$C(30)_$C(31) Q
96 . S BMXIEN=0 F S BMXIEN=$O(^DPT("SSN",BMXP,BMXIEN)) Q:'+BMXIEN D Q
97 . . Q:'$D(^DPT(BMXIEN,0))
98 . . S BMXDPT=$G(^DPT(BMXIEN,0))
99 . . S BMXZ=$P(BMXDPT,U) ;NAME
100 . . S BMXHRN=$P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,2) ;CHART
101 . . I BMXHRN="" Q ;NO CHART AT THIS DUZ2
102 . . I $P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,3) S BMXHRN=BMXHRN_"(*)"
103 . . S $P(BMXZ,BMXDLIM,2)=BMXHRN
104 . . S $P(BMXZ,BMXDLIM,3)=$P(BMXDPT,U,9) ;SSN
105 . . S Y=$P(BMXDPT,U,3) X ^DD("DD")
106 . . S $P(BMXZ,BMXDLIM,4)=Y ;DOB
107 . . S $P(BMXZ,BMXDLIM,5)=BMXIEN
108 . . S $P(BMXRET,$C(30),2)=BMXZ
109 . . Q
110 . Q
111 ;
112 S BMXFILE=9000001
113 S BMXIENS=""
114 S BMXFIELDS=".01"
115 S BMXFLAGS="M"
116 S BMXVALUE=BMXP
117 S BMXNUMBER=BMXC
118 S BMXINDEXES=""
119 S BMXSCREEN=$S(+DUZ(2):"I $D(^AUPNPAT(Y,41,DUZ(2),0))",1:"")
120 ;I BMXSCREEN]"" S DIC("S")=BMXSCREEN
121 ;S BMXSCREEN="I 0"
122 S BMXIDEN=""
123 S BMXTARG="BMXRSLT"
124 S BMXMSG=""
125 D FIND^DIC(BMXFILE,BMXIENS,BMXFIELDS,BMXFLAGS,BMXVALUE,BMXNUMBER,BMXINDEXES,BMXSCREEN,BMXIDEN,BMXTARG,BMXMSG)
126 ;S BMXRET=""
127 ;B
128 I '+$G(BMXRSLT("DILIST",0)) S BMXY=BMXRET_$C(31) Q
129 F BMXX=1:1:$P(BMXRSLT("DILIST",0),U) D
130 . ;B
131 . S BMXIEN=BMXRSLT("DILIST",2,BMXX)
132 . S BMXZ=BMXRSLT("DILIST","ID",BMXX,.01) ;NAME
133 . ;S $P(BMXZ,BMXDLIM,2)=$P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,2) ;CHART
134 . S BMXHRN=$P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,2) ;CHART
135 . I BMXHRN="" Q ;NO CHART AT THIS DUZ2
136 . I $P($G(^AUPNPAT(BMXIEN,41,DUZ(2),0)),U,3) S BMXHRN=BMXHRN_"(*)"
137 . S $P(BMXZ,BMXDLIM,2)=BMXHRN
138 . S BMXDPT=$G(^DPT(BMXIEN,0))
139 . S $P(BMXZ,BMXDLIM,3)=$P(BMXDPT,U,9) ;SSN
140 . S Y=$P(BMXDPT,U,3) X ^DD("DD")
141 . S $P(BMXZ,BMXDLIM,4)=Y ;DOB
142 . S $P(BMXZ,BMXDLIM,5)=BMXIEN
143 . S $P(BMXRET,$C(30),BMXX+1)=BMXZ
144 . Q
145 ;K BMXRSLT
146 S BMXY=BMXRET_$C(30)_$C(31)
147 Q
148ZZZ ;
Note: See TracBrowser for help on using the repository browser.