BMXRPC6 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
;;4.0;BMX;;JUN 28, 2010
;
;
USRKEYRS(BMXY,BMXDUZ) ;EP - Returns recordset of user's keys
;
N BMXDPT,BMXZ,BMXDLIM,BMXXX,BMXRET,BMXAGE,BMXNEXT,BMXSEX,BMXERR
S BMXDLIM="^",BMXERR=""
S BMXRET="T00050KEY"_$C(30)
I '$D(DUZ(2)) S BMXY=BMXRET_$C(31)_"No DUZ2" Q
;Strip CRLFs from parameter
S BMXCRLF=$C(13)_$C(10)
S BMXDUZ=$TR(BMXDUZ,BMXCRLF,"")
I '$D(^VA(200,BMXDUZ)) S BMXY=BMXRET_$C(31)_"No such user" Q
S BMXK=0 F S BMXK=$O(^VA(200,BMXDUZ,51,BMXK)) Q:'+BMXK D
. S BMXKEY=$G(^VA(200,BMXDUZ,51,BMXK,0))
. Q:BMXKEY=""
. S BMXKEY=$P(BMXKEY,BMXDLIM)
. Q:'+BMXKEY
. Q:'$D(^DIC(19.1,BMXKEY,0))
. S BMXKEY=$P(^DIC(19.1,BMXKEY,0),BMXDLIM)
. Q:BMXKEY']""
. S BMXRET=BMXRET_BMXKEY_$C(30)
S BMXY=BMXRET_$C(30)_$C(31)_BMXERR
Q
;
PDATA(BMXY,BMXP) ;-EP Returns patient demographics for pt with
;health record number BMXP at the current DUZ(2)
N BMXIEN,BMXDUZ2,BMXSQL
;Strip CR, LF, TAB, SPACE
S BMXP=$TR(BMXP,$C(13),"")
S BMXP=$TR(BMXP,$C(10),"")
S BMXP=$TR(BMXP,$C(9),"")
S BMXP=$TR(BMXP,$C(32),"")
S BMXDUZ2=$G(DUZ(2)),BMXDUZ2=+BMXDUZ2
S BMXIEN=0
I +BMXDUZ2 F S BMXIEN=$O(^AUPNPAT("D",BMXP,BMXIEN)) Q:'+BMXIEN I $D(^AUPNPAT("D",BMXP,BMXIEN,BMXDUZ2)) Q
S BMXSQL="SELECT NAME 'Name', DOB 'DateOfBirth', TRIBE_OF_MEMBERSHIP 'Tribe', MAILING_ADDRESS-STREET 'Street',"
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_"'"
D SQL^BMXSQL(.BMXY,BMXSQL)
S @BMXY@(.5)="T00015Chart^"
I $D(@BMXY@(10)) S @BMXY@(10)=BMXP_"^"_@BMXY@(10)
;
Q
;
PDEMOD(BMXY,BMXPAT,BMXCOUNT) ;EP
;Entry point for Serenji debugging
;
;D DEBUG^%Serenji("PDEMOD^BMXRPC6(.BMXY,BMXPAT,BMXCOUNT)")
Q
;
PDEMO(BMXY,BMXPAT,BMXCOUNT) ;EP
;This simple RPC demonstrates how to format data
;for the BMXNet ADO.NET data provider
;
;Returns a maximum of BMXCOUNT records from the
;VA PATIENT file whose names begin with BMXPAT
;
N BMXI,BMXD,BMXC,BMXNODE,BMXDOB
;
;When the VA BROKER calls this routine, BMXY is passed by reference
;We set BMXY to the value of the variable in which we will return
;our data:
;S BMXY="^TMP(""BMX"","_$J_")"
N BMXUID
S BMXUID=$S($G(ZTSK):"Z"_ZTSK,1:$J)
S BMXY=$NA(^BMXTMP("BMXTEST",BMXUID))
K ^BMXTMP("BMXTEST",BMXUID)
;
;The first subnode of the data global contains the column header information
;in the form "TxxxxxCOLUMN1NAME^txxxxxCOLUMN2NAME"_$C(30)
;where T is the column data type and can be either T for text, I for numeric or D for date/time.
;xxxxx is the length of the column in characters:
;
S BMXI=0,BMXC=0
S ^BMXTMP("BMXTEST",BMXUID,BMXI)="T00030NAME^T00010SEX^D00020DOB"_$C(30)
;
;You MUST set an error trap:
S X="PDERR^BMXRPC6",@^%ZOSF("TRAP")
;
;Strip CR, LF, TAB, SPACE from BMXCOUNT parameter
S BMXCOUNT=$TR(BMXCOUNT,$C(13),"")
S BMXCOUNT=$TR(BMXCOUNT,$C(10),"")
S BMXCOUNT=$TR(BMXCOUNT,$C(9),"")
S BMXCOUNT=$TR(BMXCOUNT,$C(32),"")
;
;Iterate through the global and set the data nodes:
S:BMXPAT="" BMXPAT="A"
S BMXPAT=$O(^DPT("B",BMXPAT),-1)
S BMXD=0
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
. Q:'$D(^DPT(BMXD,0))
. S BMXI=BMXI+1
. S BMXNODE=^DPT(BMXD,0)
. ;Convert the DOB from FM date
. S Y=$P(BMXNODE,U,3)
. I +Y X ^DD("DD")
. S BMXDOB=Y
. ;The data node fields are in the same order as the column header, i.e. NAME^SEX^DOB
. ;and terminated with a $C(30)
. S ^BMXTMP("BMXTEST",BMXUID,BMXI)=$P(BMXNODE,U)_U_$P(BMXNODE,U,2)_U_BMXDOB_$C(30)
;
;After all the data nodes have been set, set the final node to $C(31) to indicate
;the end of the recordset
S BMXI=BMXI+1
S ^BMXTMP("BMXTEST",BMXUID,BMXI)=$C(31)
Q
;
PDERR ;Error trap for PDEMO
;
S ^BMXTMP("BMXTEST",BMXUID,BMXI+1)=$C(31)
Q
BMXRPC6 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
+1 ;;4.0;BMX;;JUN 28, 2010
+2 ;
+3 ;
USRKEYRS(BMXY,BMXDUZ) ;EP - Returns recordset of user's keys
+1 ;
+2 NEW BMXDPT,BMXZ,BMXDLIM,BMXXX,BMXRET,BMXAGE,BMXNEXT,BMXSEX,BMXERR
+3 SET BMXDLIM="^"
SET BMXERR=""
+4 SET BMXRET="T00050KEY"_$CHAR(30)
+5 IF '$DATA(DUZ(2))
SET BMXY=BMXRET_$CHAR(31)_"No DUZ2"
QUIT
+6 ;Strip CRLFs from parameter
+7 SET BMXCRLF=$CHAR(13)_$CHAR(10)
+8 SET BMXDUZ=$TRANSLATE(BMXDUZ,BMXCRLF,"")
+9 IF '$DATA(^VA(200,BMXDUZ))
SET BMXY=BMXRET_$CHAR(31)_"No such user"
QUIT
+10 SET BMXK=0
FOR
SET BMXK=$ORDER(^VA(200,BMXDUZ,51,BMXK))
IF '+BMXK
QUIT
Begin DoDot:1
+11 SET BMXKEY=$GET(^VA(200,BMXDUZ,51,BMXK,0))
+12 IF BMXKEY=""
QUIT
+13 SET BMXKEY=$PIECE(BMXKEY,BMXDLIM)
+14 IF '+BMXKEY
QUIT
+15 IF '$DATA(^DIC(19.1,BMXKEY,0))
QUIT
+16 SET BMXKEY=$PIECE(^DIC(19.1,BMXKEY,0),BMXDLIM)
+17 IF BMXKEY']""
QUIT
+18 SET BMXRET=BMXRET_BMXKEY_$CHAR(30)
End DoDot:1
+19 SET BMXY=BMXRET_$CHAR(30)_$CHAR(31)_BMXERR
+20 QUIT
+21 ;
PDATA(BMXY,BMXP) ;-EP Returns patient demographics for pt with
+1 ;health record number BMXP at the current DUZ(2)
+2 NEW BMXIEN,BMXDUZ2,BMXSQL
+3 ;Strip CR, LF, TAB, SPACE
+4 SET BMXP=$TRANSLATE(BMXP,$CHAR(13),"")
+5 SET BMXP=$TRANSLATE(BMXP,$CHAR(10),"")
+6 SET BMXP=$TRANSLATE(BMXP,$CHAR(9),"")
+7 SET BMXP=$TRANSLATE(BMXP,$CHAR(32),"")
+8 SET BMXDUZ2=$GET(DUZ(2))
SET BMXDUZ2=+BMXDUZ2
+9 SET BMXIEN=0
+10 IF +BMXDUZ2
FOR
SET BMXIEN=$ORDER(^AUPNPAT("D",BMXP,BMXIEN))
IF '+BMXIEN
QUIT
IF $DATA(^AUPNPAT("D",BMXP,BMXIEN,BMXDUZ2))
QUIT
+11 SET BMXSQL="SELECT NAME 'Name', DOB 'DateOfBirth', TRIBE_OF_MEMBERSHIP 'Tribe', MAILING_ADDRESS-STREET 'Street',"
+12 SET 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_"'"
+13 DO SQL^BMXSQL(.BMXY,BMXSQL)
+14 SET @BMXY@(.5)="T00015Chart^"
+15 IF $DATA(@BMXY@(10))
SET @BMXY@(10)=BMXP_"^"_@BMXY@(10)
+16 ;
+17 QUIT
+18 ;
PDEMOD(BMXY,BMXPAT,BMXCOUNT) ;EP
+1 ;Entry point for Serenji debugging
+2 ;
+3 ;D DEBUG^%Serenji("PDEMOD^BMXRPC6(.BMXY,BMXPAT,BMXCOUNT)")
+4 QUIT
+5 ;
PDEMO(BMXY,BMXPAT,BMXCOUNT) ;EP
+1 ;This simple RPC demonstrates how to format data
+2 ;for the BMXNet ADO.NET data provider
+3 ;
+4 ;Returns a maximum of BMXCOUNT records from the
+5 ;VA PATIENT file whose names begin with BMXPAT
+6 ;
+7 NEW BMXI,BMXD,BMXC,BMXNODE,BMXDOB
+8 ;
+9 ;When the VA BROKER calls this routine, BMXY is passed by reference
+10 ;We set BMXY to the value of the variable in which we will return
+11 ;our data:
+12 ;S BMXY="^TMP(""BMX"","_$J_")"
+13 NEW BMXUID
+14 SET BMXUID=$SELECT($GET(ZTSK):"Z"_ZTSK,1:$JOB)
+15 SET BMXY=$NAME(^BMXTMP("BMXTEST",BMXUID))
+16 KILL ^BMXTMP("BMXTEST",BMXUID)
+17 ;
+18 ;The first subnode of the data global contains the column header information
+19 ;in the form "TxxxxxCOLUMN1NAME^txxxxxCOLUMN2NAME"_$C(30)
+20 ;where T is the column data type and can be either T for text, I for numeric or D for date/time.
+21 ;xxxxx is the length of the column in characters:
+22 ;
+23 SET BMXI=0
SET BMXC=0
+24 SET ^BMXTMP("BMXTEST",BMXUID,BMXI)="T00030NAME^T00010SEX^D00020DOB"_$CHAR(30)
+25 ;
+26 ;You MUST set an error trap:
+27 SET X="PDERR^BMXRPC6"
SET @^%ZOSF("TRAP")
+28 ;
+29 ;Strip CR, LF, TAB, SPACE from BMXCOUNT parameter
+30 SET BMXCOUNT=$TRANSLATE(BMXCOUNT,$CHAR(13),"")
+31 SET BMXCOUNT=$TRANSLATE(BMXCOUNT,$CHAR(10),"")
+32 SET BMXCOUNT=$TRANSLATE(BMXCOUNT,$CHAR(9),"")
+33 SET BMXCOUNT=$TRANSLATE(BMXCOUNT,$CHAR(32),"")
+34 ;
+35 ;Iterate through the global and set the data nodes:
+36 IF BMXPAT=""
SET BMXPAT="A"
+37 SET BMXPAT=$ORDER(^DPT("B",BMXPAT),-1)
+38 SET BMXD=0
+39 FOR
SET BMXPAT=$ORDER(^DPT("B",BMXPAT))
IF BMXPAT=""
QUIT
SET BMXD=$ORDER(^DPT("B",BMXPAT,0))
IF +BMXD
SET BMXC=BMXC+1
IF (BMXCOUNT)&(BMXC>BMXCOUNT)
QUIT
Begin DoDot:1
+40 IF '$DATA(^DPT(BMXD,0))
QUIT
+41 SET BMXI=BMXI+1
+42 SET BMXNODE=^DPT(BMXD,0)
+43 ;Convert the DOB from FM date
+44 SET Y=$PIECE(BMXNODE,U,3)
+45 IF +Y
XECUTE ^DD("DD")
+46 SET BMXDOB=Y
+47 ;The data node fields are in the same order as the column header, i.e. NAME^SEX^DOB
+48 ;and terminated with a $C(30)
+49 SET ^BMXTMP("BMXTEST",BMXUID,BMXI)=$PIECE(BMXNODE,U)_U_$PIECE(BMXNODE,U,2)_U_BMXDOB_$CHAR(30)
End DoDot:1
+50 ;
+51 ;After all the data nodes have been set, set the final node to $C(31) to indicate
+52 ;the end of the recordset
+53 SET BMXI=BMXI+1
+54 SET ^BMXTMP("BMXTEST",BMXUID,BMXI)=$CHAR(31)
+55 QUIT
+56 ;
PDERR ;Error trap for PDEMO
+1 ;
+2 SET ^BMXTMP("BMXTEST",BMXUID,BMXI+1)=$CHAR(31)
+3 QUIT
