source: BMXNET_RPMS_dotNET_UTILITIES-BMX/trunk/m/BMXRPC6.m@ 738

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

Initial Import of BMX.net code

File size: 3.8 KB
RevLine 
[645]1BMXRPC6 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
2 ;;2.1;BMX;;Jul 26, 2009
3 ;
4 ;
5USRKEYRS(BMXY,BMXDUZ) ;EP - Returns recordset of user's keys
6 ;
7 N BMXDPT,BMXZ,BMXDLIM,BMXXX,BMXRET,BMXAGE,BMXNEXT,BMXSEX,BMXERR
8 S BMXDLIM="^",BMXERR=""
9 S BMXRET="T00050KEY"_$C(30)
10 I '$D(DUZ(2)) S BMXY=BMXRET_$C(31)_"No DUZ2" Q
11 ;Strip CRLFs from parameter
12 S BMXCRLF=$C(13)_$C(10)
13 S BMXDUZ=$TR(BMXDUZ,BMXCRLF,"")
14 I '$D(^VA(200,BMXDUZ)) S BMXY=BMXRET_$C(31)_"No such user" Q
15 S BMXK=0 F S BMXK=$O(^VA(200,BMXDUZ,51,BMXK)) Q:'+BMXK D
16 . S BMXKEY=$G(^VA(200,BMXDUZ,51,BMXK,0))
17 . Q:BMXKEY=""
18 . S BMXKEY=$P(BMXKEY,BMXDLIM)
19 . Q:'+BMXKEY
20 . Q:'$D(^DIC(19.1,BMXKEY,0))
21 . S BMXKEY=$P(^DIC(19.1,BMXKEY,0),BMXDLIM)
22 . Q:BMXKEY']""
23 . S BMXRET=BMXRET_BMXKEY_$C(30)
24 S BMXY=BMXRET_$C(30)_$C(31)_BMXERR
25 Q
26 ;
27PDATA(BMXY,BMXP) ;-EP Returns patient demographics for pt with
28 ;health record number BMXP at the current DUZ(2)
29 N BMXIEN,BMXDUZ2,BMXSQL
30 ;Strip CR, LF, TAB, SPACE
31 S BMXP=$TR(BMXP,$C(13),"")
32 S BMXP=$TR(BMXP,$C(10),"")
33 S BMXP=$TR(BMXP,$C(9),"")
34 S BMXP=$TR(BMXP,$C(32),"")
35 S BMXDUZ2=$G(DUZ(2)),BMXDUZ2=+BMXDUZ2
36 S BMXIEN=0
37 I +BMXDUZ2 F S BMXIEN=$O(^AUPNPAT("D",BMXP,BMXIEN)) Q:'+BMXIEN I $D(^AUPNPAT("D",BMXP,BMXIEN,BMXDUZ2)) Q
38 S BMXSQL="SELECT NAME 'Name', DOB 'DateOfBirth', TRIBE_OF_MEMBERSHIP 'Tribe', MAILING_ADDRESS-STREET 'Street',"
39 S BMXSQL=BMXSQL_" MAILING_ADDRESS-CITY 'City', MAILING_ADDRESS-STATE 'State', MAILING_ADDRESS-ZIP 'Zip', HOME_PHONE 'HomePhone', OFFICE_PHONE 'WorkPhone' FROM PATIENT WHERE BMXIEN='"_+BMXIEN_"'"
40 D SQL^BMXSQL(.BMXY,BMXSQL)
41 S @BMXY@(.5)="T00015Chart^"
42 I $D(@BMXY@(10)) S @BMXY@(10)=BMXP_"^"_@BMXY@(10)
43 ;
44 Q
45 ;
46PDEMOD(BMXY,BMXPAT,BMXCOUNT) ;EP
47 ;Entry point for Serenji debugging
48 ;
49 D DEBUG^%Serenji("PDEMO^BMXRPC6(.BMXY,BMXPAT,BMXCOUNT)")
50 Q
51 ;
52PDEMO(BMXY,BMXPAT,BMXCOUNT) ;EP
53 ;This simple RPC demonstrates how to format data
54 ;for the BMXNet ADO.NET data provider
55 ;
56 ;Returns a maximum of BMXCOUNT records from the
57 ;VA PATIENT file whose names begin with BMXPAT
58 ;
59 N BMXI,BMXD,BMXC,BMXNODE,BMXDOB
60 ;
61 ;When the VA BROKER calls this routine, BMXY is passed by reference
62 ;We set BMXY to the value of the variable in which we will return
63 ;our data:
64 ;S BMXY="^TMP(""BMX"","_$J_")"
65 N BMXUID
66 S BMXUID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
67 S BMXY=$NA(^BMXTMP("BMXTEST",BMXUID))
68 K ^BMXTMP("BMXTEST",BMXUID)
69 ;
70 ;The first subnode of the data global contains the column header information
71 ;in the form "TxxxxxCOLUMN1NAME^txxxxxCOLUMN2NAME"_$C(30)
72 ;where T is the column data type and can be either T for text, I for numeric or D for date/time.
73 ;xxxxx is the length of the column in characters:
74 ;
75 S BMXI=0,BMXC=0
76 S ^BMXTMP("BMXTEST",BMXUID,BMXI)="T00030NAME^T00010SEX^D00020DOB"_$C(30)
77 ;
78 ;You MUST set an error trap:
79 S X="PDERR^BMXRPC6",@^%ZOSF("TRAP")
80 ;
81 ;Strip CR, LF, TAB, SPACE from BMXCOUNT parameter
82 S BMXCOUNT=$TR(BMXCOUNT,$C(13),"")
83 S BMXCOUNT=$TR(BMXCOUNT,$C(10),"")
84 S BMXCOUNT=$TR(BMXCOUNT,$C(9),"")
85 S BMXCOUNT=$TR(BMXCOUNT,$C(32),"")
86 ;
87 ;Iterate through the global and set the data nodes:
88 S:BMXPAT="" BMXPAT="A"
89 S BMXPAT=$O(^DPT("B",BMXPAT),-1)
90 S BMXD=0
91 F S BMXPAT=$O(^DPT("B",BMXPAT)) Q:BMXPAT="" S BMXD=$O(^DPT("B",BMXPAT,0)) I +BMXD S BMXC=BMXC+1 Q:(BMXCOUNT)&(BMXC>BMXCOUNT) D
92 . Q:'$D(^DPT(BMXD,0))
93 . S BMXI=BMXI+1
94 . S BMXNODE=^DPT(BMXD,0)
95 . ;Convert the DOB from FM date
96 . S Y=$P(BMXNODE,U,3)
97 . I +Y X ^DD("DD")
98 . S BMXDOB=Y
99 . ;The data node fields are in the same order as the column header, i.e. NAME^SEX^DOB
100 . ;and terminated with a $C(30)
101 . S ^BMXTMP("BMXTEST",BMXUID,BMXI)=$P(BMXNODE,U)_U_$P(BMXNODE,U,2)_U_BMXDOB_$C(30)
102 ;
103 ;After all the data nodes have been set, set the final node to $C(31) to indicate
104 ;the end of the recordset
105 S BMXI=BMXI+1
106 S ^BMXTMP("BMXTEST",BMXUID,BMXI)=$C(31)
107 Q
108 ;
109PDERR ;Error trap for PDEMO
110 ;
111 S ^BMXTMP("BMXTEST",BMXUID,BMXI+1)=$C(31)
112 Q
Note: See TracBrowser for help on using the repository browser.