Routine: BMXRPC6

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

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)

PDEMOD(BMXY,BMXPAT,BMXCOUNT) ;EP

 ;Entry point for Serenji debugging

 ;D DEBUG^%Serenji("PDEMOD^BMXRPC6(.BMXY,BMXPAT,BMXCOUNT)")

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)

PDERR ;Error trap for PDEMO

 S ^BMXTMP("BMXTEST",BMXUID,BMXI+1)=$C(31)

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

BMXRPC6.m