Routine: BSDX34

BSDX34 ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;

 ;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010

RBCLIND(BSDXY,BSDXCLST,BSDXBEG,BSDXEND) ;EP

 ;Entry point for debugging

 ;D DEBUG^%Serenji("RBCLIN^BSDX34(.BSDXY,BSDXCLST,BSDXBEG,BSDXEND)")

RBERR ;

 ;Called from RBCLIN on error to set up header

 K ^BSDXTMP($J)

 S ^BSDXTMP($J,0)="T00030Name^D00020DOB^T00030Sex^T00030HRN^D00030NewApptDate^T00030Clinic^T00030TypeStatus^I00010RESOURCEID"

 S ^BSDXTMP($J,0)=^(0)_"^T00030APPT_MADE_BY^D00020DATE_APPT_MADE^T00250NOTE^T00030STREET^T00030CITY^T00030STATE^T00030ZIP^T00030HOMEPHONE^D00030OldApptDate"_$C(30)

 D ERR(999)

CANCLIN(BSDXY,BSDXCLST,BSDXBEG,BSDXEND) ;EP

 ;Return recordset of CANCELLED patient appointments

 ;between dates BSDXBEG and BSDXEND for each clinic in BSDXCLST.

 ;Used in generating cancellation letters for a clinic

 ;BSDXCLST is a |-delimited list of BSDX RESOURCE iens.  (The last |-piece is null, so discard it.)

 ;BSDXBEG and BSDXEND are in external date form.

 ;Called by BSDX CANCEL CLINIC LIST

 N BSDXCAN

 S BSDXCAN=1

 D RBCLIN(.BSDXY,BSDXCLST,BSDXBEG,BSDXEND)

RBCLIN(BSDXY,BSDXCLST,BSDXBEG,BSDXEND) ;EP

 ;Return recordset of rebooked patient appointments

 ;between dates BSDXBEG and BSDXEND for each clinic in BSDXCLST.

 ;Used in generating rebook letters for a clinic

 ;BSDXCLST is a |-delimited list of BSDX RESOURCE iens.  (The last |-piece is null, so discard it.)

 ;BSDXBEG and BSDXEND are in external date form.

 ;Called by BSDX REBOOK CLINIC LIST and BSDX CANCEL CLINIC LIST via entry point CANCLIN above

 S X="RBERR^BSDX34",@^%ZOSF("TRAP")

 S BSDXY="^BSDXTMP("_$J_")"

 N %DT,Y,BSDXJ,BSDXCID,BSDXCLN,BSDXSTRT,BSDXAID,BSDXNOD,BSDXLIST,BSDX,BSDY

 ;Convert beginning and ending dates

 S X=BSDXBEG,%DT="XT" D ^%DT S BSDXBEG=$P(Y,"."),BSDXBEG=BSDXBEG-1,BSDXBEG=BSDXBEG_".9999"

 I Y=-1 D RBERR(1) Q

 S X=BSDXEND,%DT="XT" D ^%DT S BSDXEND=$P(Y,"."),BSDXEND=BSDXEND_".9999"

 I Y=-1 D RBERR(1) Q

 I BSDXCLST="" D RBERR(1) Q

 ;If BSDXCLST is a list of resource NAMES, look up each name and convert to IEN

 F BSDXJ=1:1:$L(BSDXCLST,"|")-1 S BSDX=$P(BSDXCLST,"|",BSDXJ) D  S $P(BSDXCLST,"|",BSDXJ)=BSDY

 . S BSDY=""

 . I BSDX]"",$D(^BSDXRES(BSDX,0)) S BSDY=BSDX Q

 . I BSDX]"",$D(^BSDXRES("B",BSDX)) S BSDY=$O(^BSDXRES("B",BSDX,0)) Q

. Q

 ;For each clinic in BSDXCLST $O through ^BSDXAPPT("ARSRC",ResourceIEN,FMDate,ApptIEN)

 S BSDXLIST=""

 F BSDXJ=1:1:$L(BSDXCLST,"|")-1 S BSDXCID=$P(BSDXCLST,"|",BSDXJ) D:+BSDXCID

 . S BSDXCLN=$G(^BSDXRES(BSDXCID,0)) S BSDXCLN=$P(BSDXCLN,U) Q:BSDXCLN=""

 . S BSDXSTRT=BSDXBEG F  S BSDXSTRT=$O(^BSDXAPPT("ARSRC",BSDXCID,BSDXSTRT)) Q:'+BSDXSTRT  Q:BSDXSTRT>BSDXEND  D

 . . S BSDXAID=0 F  S BSDXAID=$O(^BSDXAPPT("ARSRC",BSDXCID,BSDXSTRT,BSDXAID)) Q:'+BSDXAID  D

 . . . S BSDXNOD=$G(^BSDXAPPT(BSDXAID,0))

 . . . I $D(BSDXCAN) D  Q

 . . . . I $P(BSDXNOD,U,12) S BSDXLIST=BSDXLIST_BSDXAID_"|" ;Cancelled appt

 . . . I $P(BSDXNOD,U,11) S BSDXLIST=BSDXLIST_BSDXAID_"|" ;Rebooked appt

 D RBLETT(.BSDXY,BSDXLIST)

RBLETTD(BSDXY,BSDXLIST) ;EP

 ;Entry point for debugging

 ;D DEBUG^%Serenji("RBLETT^BSDX34(.BSDXY,BSDXLIST)")

RBLETT(BSDXY,BSDXLIST) ;EP

 ;Return recordset of patient appointments used in listing

 ;REBOOKED appointments for a list of appointmentIDs.

 ;Called by rpc BSDX REBOOK LIST

 ;BSDXLIST is a |-delimited list of BSDX APPOINTMENT iens (the last |-piece is null)

 N BSDXI,BSDXIEN,BSDXNOD,BSDXCNID,BSDXCNOD,BSDXMADE,BSDXCLRK,BSDXNOT,BSDXQ,BSDX

 S BSDXY="^BSDXTMP("_$J_")"

 S BSDXI=0

 S ^BSDXTMP($J,BSDXI)="T00030Name^D00020DOB^T00030Sex^T00030HRN^D00030NewApptDate^T00030Clinic^T00030TypeStatus"

 S ^BSDXTMP($J,BSDXI)=^(BSDXI)_"^I00010RESOURCEID^T00030APPT_MADE_BY^D00020DATE_APPT_MADE^T00250NOTE^T00030STREET^T00030CITY^T00030STATE^T00030ZIP^T00030HOMEPHONE^D00030OldApptDate"_$C(30)

 S X="ERROR^BSDX34",@^%ZOSF("TRAP")

 ;Iterate through BSDXLIST

 S BSDXIEN=0

 F BSDX=1:1:$L(BSDXLIST,"|")-1 S BSDXIEN=$P(BSDXLIST,"|",BSDX) D

 . N BSDXNOD,BSDXAPT,BSDXCID,BSDXCNOD,BSDXCLN,BSDX44,BSDXDNOD,BSDXSTAT,BSDX,BSDXTYPE,BSDXLIN,BSDXPAT

 . N BSDXSTRE,BSDXCITY,BSDXST,BSDXZIP,BSDXPHON

 . N BSDXNAM,BSDXDOB,BSDXHRN,BSDXSEX

 . N BSDXREBK

 . S BSDXNOD=$G(^BSDXAPPT(BSDXIEN,0))

 . Q:BSDXNOD=""

 . S BSDXPAT=$P(BSDXNOD,U,5) ;PATIENT ien

 . Q:'+BSDXPAT

 . Q:'$D(^DPT(BSDXPAT))

 . D PINFO(BSDXPAT)

 . S Y=$P(BSDXNOD,U)

 . Q:'+Y

 . X ^DD("DD") S Y=$TR(Y,"@"," ")

 . S BSDXAPT=Y ;Appointment date time

 . S BSDXREBK=""

 . S Y=$P(BSDXNOD,U,11)

 . I +Y X ^DD("DD") S Y=$TR(Y,"@"," ") S BSDXREBK=Y ;Rebook date time

 . S BSDXCLRK=$P(BSDXNOD,U,8) ;Appointment made by

 . S:+BSDXCLRK BSDXCLRK=$G(^VA(200,BSDXCLRK,0)),BSDXCLRK=$P(BSDXCLRK,U)

 . S Y=$P(BSDXNOD,U,9) ;Date Appointment Made

 . I +Y X ^DD("DD") S Y=$TR(Y,"@"," ")

 . S BSDXMADE=Y

 . ;NOTE

 . S BSDXNOT=""

 . I $D(^BSDXAPPT(BSDXIEN,1,0)) S BSDXNOT="",BSDXQ=0 F  S BSDXQ=$O(^BSDXAPPT(BSDXIEN,1,BSDXQ)) Q:'+BSDXQ  D

 . . S BSDXLIN=$G(^BSDXAPPT(BSDXIEN,1,BSDXQ,0))

 . . S:(BSDXLIN'="")&($E(BSDXLIN,$L(BSDXLIN)-1,$L(BSDXLIN))'=" ") BSDXLIN=BSDXLIN_" "

 . . S BSDXNOT=BSDXNOT_BSDXLIN

 . ;Resource

 . S BSDXCID=$P(BSDXNOD,U,7) ;IEN of BSDX RESOURCE

 . Q:'+BSDXCID

 . Q:'$D(^BSDXRES(BSDXCID,0))

 . S BSDXCNOD=$G(^BSDXRES(BSDXCID,0)) ;BSDX RESOURCE node

 . Q:BSDXCNOD=""

 . S BSDXCLN=$P(BSDXCNOD,U) ;Text name of BSDX Resource

 . S BSDXTYPE="" ;Unused in this recordset

 . S BSDXI=BSDXI+1

 . S ^BSDXTMP($J,BSDXI)=BSDXNAM_"^"_BSDXDOB_"^"_BSDXSEX_"^"_BSDXHRN_"^"_BSDXREBK_"^"_BSDXCLN_"^"_BSDXTYPE_"^"_BSDXCID_"^"_BSDXCLRK_"^"_BSDXMADE_"^"_BSDXNOT_"^"_BSDXSTRE_"^"_BSDXCITY_"^"_BSDXST_"^"_BSDXZIP_"^"_BSDXPHON_"^"_BSDXAPT_$C(30)

. Q

 S BSDXI=BSDXI+1

 S ^BSDXTMP($J,BSDXI)=$C(31)

PINFO(BSDXPAT) ;

 ;Get patient info

 N BSDXNOD

 S BSDXNOD=$$PATINFO^BSDX27(BSDXPAT)

 S BSDXNAM=$P(BSDXNOD,U) ;NAME

 S BSDXSEX=$P(BSDXNOD,U,2) ;SEX

 S BSDXDOB=$P(BSDXNOD,U,3) ;DOB

 S BSDXHRN=$P(BSDXNOD,U,4) ;Health Record Number for location DUZ(2)

 S BSDXSTRE=$P(BSDXNOD,U,5) ;Street

 S BSDXCITY=$P(BSDXNOD,U,6) ;City

 S BSDXST=$P(BSDXNOD,U,7) ;State

 S BSDXZIP=$P(BSDXNOD,U,8) ;zip

 S BSDXPHON=$P(BSDXNOD,U,9) ;homephone

ERROR ;

 D ERR("RPMS Error")

ERR(ERRNO) ;Error processing

 S:'$D(BSDXI) BSDXI=999

 I +ERRNO S BSDXERR=ERRNO+134234112 ;vbObjectError

 E  S BSDXERR=ERRNO

 S BSDXI=BSDXI+1

 S ^BSDXTMP($J,BSDXI)="^^^^^^^^^^^^^^^^"_$C(30)

 S BSDXI=BSDXI+1

 S ^BSDXTMP($J,BSDXI)=$C(31)

BSDX34    ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;

 +1       ;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010

 +2       ;

 +3       ;

 +4        QUIT

 +5       ;

RBCLIND(BSDXY,BSDXCLST,BSDXBEG,BSDXEND) ;EP

 +1       ;Entry point for debugging

 +2       ;

 +3       ;D DEBUG^%Serenji("RBCLIN^BSDX34(.BSDXY,BSDXCLST,BSDXBEG,BSDXEND)")

 +4        QUIT

 +5       ;

RBERR     ;

 +1       ;Called from RBCLIN on error to set up header

 +2        KILL ^BSDXTMP($JOB)

 +3        SET ^BSDXTMP($JOB,0)="T00030Name^D00020DOB^T00030Sex^T00030HRN^D00030NewApptDate^T00030Clinic^T00030TypeStatus^I00010RESOURCEID"

 +4        SET ^BSDXTMP($JOB,0)=^(0)_"^T00030APPT_MADE_BY^D00020DATE_APPT_MADE^T00250NOTE^T00030STREET^T00030CITY^T00030STATE^T00030ZIP^T00030HOMEPHONE^D00030OldApptDate"_$CHAR(30)

 +5        DO ERR(999)

 +6        QUIT

 +7       ;

CANCLIN(BSDXY,BSDXCLST,BSDXBEG,BSDXEND) ;EP

 +1       ;

 +2       ;Return recordset of CANCELLED patient appointments

 +3       ;between dates BSDXBEG and BSDXEND for each clinic in BSDXCLST.

 +4       ;Used in generating cancellation letters for a clinic

 +5       ;BSDXCLST is a |-delimited list of BSDX RESOURCE iens.  (The last |-piece is null, so discard it.)

 +6       ;BSDXBEG and BSDXEND are in external date form.

 +7       ;Called by BSDX CANCEL CLINIC LIST

 +8        NEW BSDXCAN

 +9        SET BSDXCAN=1

 +10       DO RBCLIN(.BSDXY,BSDXCLST,BSDXBEG,BSDXEND)

 +11      ;

 +12       QUIT

 +13      ;

RBCLIN(BSDXY,BSDXCLST,BSDXBEG,BSDXEND) ;EP

 +1       ;

 +2       ;Return recordset of rebooked patient appointments

 +3       ;between dates BSDXBEG and BSDXEND for each clinic in BSDXCLST.

 +4       ;Used in generating rebook letters for a clinic

 +5       ;BSDXCLST is a |-delimited list of BSDX RESOURCE iens.  (The last |-piece is null, so discard it.)

 +6       ;BSDXBEG and BSDXEND are in external date form.

 +7       ;Called by BSDX REBOOK CLINIC LIST and BSDX CANCEL CLINIC LIST via entry point CANCLIN above

 +8       ;

 +9       ;

 +10       SET X="RBERR^BSDX34"

           SET @^%ZOSF("TRAP")

 +11      ;

 +12       SET BSDXY="^BSDXTMP("_$JOB_")"

 +13       NEW %DT,Y,BSDXJ,BSDXCID,BSDXCLN,BSDXSTRT,BSDXAID,BSDXNOD,BSDXLIST,BSDX,BSDY

 +14      ;Convert beginning and ending dates

 +15      ;

 +16       SET X=BSDXBEG

           SET %DT="XT"

           DO ^%DT

           SET BSDXBEG=$PIECE(Y,".")

           SET BSDXBEG=BSDXBEG-1

           SET BSDXBEG=BSDXBEG_".9999"

 +17       IF Y=-1

               DO RBERR(1)

               QUIT

 +18       SET X=BSDXEND

           SET %DT="XT"

           DO ^%DT

           SET BSDXEND=$PIECE(Y,".")

           SET BSDXEND=BSDXEND_".9999"

 +19       IF Y=-1

               DO RBERR(1)

               QUIT

 +20       IF BSDXCLST=""

               DO RBERR(1)

               QUIT

 +21      ;

 +22      ;

 +23      ;If BSDXCLST is a list of resource NAMES, look up each name and convert to IEN

 +24       FOR BSDXJ=1:1:$LENGTH(BSDXCLST,"|")-1

               SET BSDX=$PIECE(BSDXCLST,"|",BSDXJ)

               Begin DoDot:1

 +25               SET BSDY=""

 +26               IF BSDX]""

                       IF $DATA(^BSDXRES(BSDX,0))

                           SET BSDY=BSDX

                           QUIT

 +27               IF BSDX]""

                       IF $DATA(^BSDXRES("B",BSDX))

                           SET BSDY=$ORDER(^BSDXRES("B",BSDX,0))

                           QUIT

 +28               QUIT

               End DoDot:1

               SET $PIECE(BSDXCLST,"|",BSDXJ)=BSDY

 +29      ;

 +30      ;For each clinic in BSDXCLST $O through ^BSDXAPPT("ARSRC",ResourceIEN,FMDate,ApptIEN)

 +31      ;

 +32       SET BSDXLIST=""

 +33       FOR BSDXJ=1:1:$LENGTH(BSDXCLST,"|")-1

               SET BSDXCID=$PIECE(BSDXCLST,"|",BSDXJ)

               IF +BSDXCID

                   Begin DoDot:1

 +34                   SET BSDXCLN=$GET(^BSDXRES(BSDXCID,0))

                       SET BSDXCLN=$PIECE(BSDXCLN,U)

                       IF BSDXCLN=""

                           QUIT

 +35                   SET BSDXSTRT=BSDXBEG

FOR

                           SET BSDXSTRT=$ORDER(^BSDXAPPT("ARSRC",BSDXCID,BSDXSTRT))

                           IF '+BSDXSTRT

                               QUIT

                           IF BSDXSTRT>BSDXEND

                               QUIT

                           Begin DoDot:2

 +36                           SET BSDXAID=0

FOR

                                   SET BSDXAID=$ORDER(^BSDXAPPT("ARSRC",BSDXCID,BSDXSTRT,BSDXAID))

                                   IF '+BSDXAID

                                       QUIT

                                   Begin DoDot:3

 +37                                   SET BSDXNOD=$GET(^BSDXAPPT(BSDXAID,0))

 +38                                   IF $DATA(BSDXCAN)

                                           Begin DoDot:4

 +39      ;Cancelled appt

                                               IF $PIECE(BSDXNOD,U,12)

                                                   SET BSDXLIST=BSDXLIST_BSDXAID_"|"

                                           End DoDot:4

                                           QUIT

 +40      ;Rebooked appt

                                       IF $PIECE(BSDXNOD,U,11)

                                           SET BSDXLIST=BSDXLIST_BSDXAID_"|"

                                   End DoDot:3

                           End DoDot:2

                   End DoDot:1

 +41       DO RBLETT(.BSDXY,BSDXLIST)

 +42       QUIT

 +43      ;

RBLETTD(BSDXY,BSDXLIST) ;EP

 +1       ;Entry point for debugging

 +2       ;

 +3       ;D DEBUG^%Serenji("RBLETT^BSDX34(.BSDXY,BSDXLIST)")

 +4        QUIT

 +5       ;

RBLETT(BSDXY,BSDXLIST) ;EP

 +1       ;Return recordset of patient appointments used in listing

 +2       ;REBOOKED appointments for a list of appointmentIDs.

 +3       ;Called by rpc BSDX REBOOK LIST

 +4       ;BSDXLIST is a |-delimited list of BSDX APPOINTMENT iens (the last |-piece is null)

 +5       ;

 +6        NEW BSDXI,BSDXIEN,BSDXNOD,BSDXCNID,BSDXCNOD,BSDXMADE,BSDXCLRK,BSDXNOT,BSDXQ,BSDX

 +7        SET BSDXY="^BSDXTMP("_$JOB_")"

 +8        SET BSDXI=0

 +9        SET ^BSDXTMP($JOB,BSDXI)="T00030Name^D00020DOB^T00030Sex^T00030HRN^D00030NewApptDate^T00030Clinic^T00030TypeStatus"

 +10       SET ^BSDXTMP($JOB,BSDXI)=^(BSDXI)_"^I00010RESOURCEID^T00030APPT_MADE_BY^D00020DATE_APPT_MADE^T00250NOTE^T00030STREET^T00030CITY^T00030STATE^T00030ZIP^T00030HOMEPHONE^D00030OldApptDate"_$CHAR(30)

 +11       SET X="ERROR^BSDX34"

           SET @^%ZOSF("TRAP")

 +12      ;

 +13      ;Iterate through BSDXLIST

 +14       SET BSDXIEN=0

 +15       FOR BSDX=1:1:$LENGTH(BSDXLIST,"|")-1

               SET BSDXIEN=$PIECE(BSDXLIST,"|",BSDX)

               Begin DoDot:1

 +16               NEW BSDXNOD,BSDXAPT,BSDXCID,BSDXCNOD,BSDXCLN,BSDX44,BSDXDNOD,BSDXSTAT,BSDX,BSDXTYPE,BSDXLIN,BSDXPAT

 +17               NEW BSDXSTRE,BSDXCITY,BSDXST,BSDXZIP,BSDXPHON

 +18               NEW BSDXNAM,BSDXDOB,BSDXHRN,BSDXSEX

 +19               NEW BSDXREBK

 +20               SET BSDXNOD=$GET(^BSDXAPPT(BSDXIEN,0))

 +21               IF BSDXNOD=""

                       QUIT

 +22      ;PATIENT ien

                   SET BSDXPAT=$PIECE(BSDXNOD,U,5)

 +23               IF '+BSDXPAT

                       QUIT

 +24               IF '$DATA(^DPT(BSDXPAT))

                       QUIT

 +25               DO PINFO(BSDXPAT)

 +26               SET Y=$PIECE(BSDXNOD,U)

 +27               IF '+Y

                       QUIT

 +28               XECUTE ^DD("DD")

                   SET Y=$TRANSLATE(Y,"@"," ")

 +29      ;Appointment date time

                   SET BSDXAPT=Y

 +30               SET BSDXREBK=""

 +31               SET Y=$PIECE(BSDXNOD,U,11)

 +32      ;Rebook date time

                   IF +Y

                       XECUTE ^DD("DD")

                       SET Y=$TRANSLATE(Y,"@"," ")

                       SET BSDXREBK=Y

 +33      ;Appointment made by

                   SET BSDXCLRK=$PIECE(BSDXNOD,U,8)

 +34               IF +BSDXCLRK

                       SET BSDXCLRK=$GET(^VA(200,BSDXCLRK,0))

                       SET BSDXCLRK=$PIECE(BSDXCLRK,U)

 +35      ;Date Appointment Made

                   SET Y=$PIECE(BSDXNOD,U,9)

 +36               IF +Y

                       XECUTE ^DD("DD")

                       SET Y=$TRANSLATE(Y,"@"," ")

 +37               SET BSDXMADE=Y

 +38      ;NOTE

 +39               SET BSDXNOT=""

 +40               IF $DATA(^BSDXAPPT(BSDXIEN,1,0))

                       SET BSDXNOT=""

                       SET BSDXQ=0

FOR

                           SET BSDXQ=$ORDER(^BSDXAPPT(BSDXIEN,1,BSDXQ))

                           IF '+BSDXQ

                               QUIT

                           Begin DoDot:2

 +41                           SET BSDXLIN=$GET(^BSDXAPPT(BSDXIEN,1,BSDXQ,0))

 +42                           IF (BSDXLIN'="")&($EXTRACT(BSDXLIN,$LENGTH(BSDXLIN)-1,$LENGTH(BSDXLIN))'=" ")

                                   SET BSDXLIN=BSDXLIN_" "

 +43                           SET BSDXNOT=BSDXNOT_BSDXLIN

                           End DoDot:2

 +44      ;Resource

 +45      ;IEN of BSDX RESOURCE

                   SET BSDXCID=$PIECE(BSDXNOD,U,7)

 +46               IF '+BSDXCID

                       QUIT

 +47               IF '$DATA(^BSDXRES(BSDXCID,0))

                       QUIT

 +48      ;BSDX RESOURCE node

                   SET BSDXCNOD=$GET(^BSDXRES(BSDXCID,0))

 +49               IF BSDXCNOD=""

                       QUIT

 +50      ;Text name of BSDX Resource

                   SET BSDXCLN=$PIECE(BSDXCNOD,U)

 +51      ;Unused in this recordset

                   SET BSDXTYPE=""

 +52               SET BSDXI=BSDXI+1

 +53               SET ^BSDXTMP($JOB,BSDXI)=BSDXNAM_"^"_BSDXDOB_"^"_BSDXSEX_"^"_BSDXHRN_"^"_BSDXREBK_"^"_BSDXCLN_"^"_BSDXTYPE_"^"_BSDXCID_"^"_BSDXCLRK_"^"_BSDXMADE_"^"_BSDXNOT_"^"_BSDXSTRE_"^"_BSDXCITY_"^"_BSDXST_"^"_BSDXZIP_"^"_BSDXPHON_"^"_BSDXAPT_$CHAR

(30)

 +54               QUIT

               End DoDot:1

 +55      ;

 +56       SET BSDXI=BSDXI+1

 +57       SET ^BSDXTMP($JOB,BSDXI)=$CHAR(31)

 +58       QUIT

 +59      ;

PINFO(BSDXPAT) ;

 +1       ;Get patient info

 +2        NEW BSDXNOD

 +3        SET BSDXNOD=$$PATINFO^BSDX27(BSDXPAT)

 +4       ;NAME

           SET BSDXNAM=$PIECE(BSDXNOD,U)

 +5       ;SEX

           SET BSDXSEX=$PIECE(BSDXNOD,U,2)

 +6       ;DOB

           SET BSDXDOB=$PIECE(BSDXNOD,U,3)

 +7       ;Health Record Number for location DUZ(2)

           SET BSDXHRN=$PIECE(BSDXNOD,U,4)

 +8       ;Street

           SET BSDXSTRE=$PIECE(BSDXNOD,U,5)

 +9       ;City

           SET BSDXCITY=$PIECE(BSDXNOD,U,6)

 +10      ;State

           SET BSDXST=$PIECE(BSDXNOD,U,7)

 +11      ;zip

           SET BSDXZIP=$PIECE(BSDXNOD,U,8)

 +12      ;homephone

           SET BSDXPHON=$PIECE(BSDXNOD,U,9)

 +13       QUIT

 +14      ;

ERROR     ;

 +1        DO ERR("RPMS Error")

 +2        QUIT

 +3       ;

ERR(ERRNO) ;Error processing

 +1        IF '$DATA(BSDXI)

               SET BSDXI=999

 +2       ;vbObjectError

           IF +ERRNO

               SET BSDXERR=ERRNO+134234112

 +3       IF '$TEST

               SET BSDXERR=ERRNO

 +4        SET BSDXI=BSDXI+1

 +5        SET ^BSDXTMP($JOB,BSDXI)="^^^^^^^^^^^^^^^^"_$CHAR(30)

 +6        SET BSDXI=BSDXI+1

 +7        SET ^BSDXTMP($JOB,BSDXI)=$CHAR(31)

 +8        QUIT

BSDX34.m