| 1 | BSDX02 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 5/16/11 2:47pm
|
|---|
| 2 | ;;1.6;BSDX;;Aug 31, 2011;Build 25
|
|---|
| 3 | ;Licensed under LGPL
|
|---|
| 4 | ; Change Log
|
|---|
| 5 | ; July 15 2010: UJO/SMH - Pass FM dates in instead of US dates for i18n
|
|---|
| 6 | ; March 21 2011: UJO/SMH (v 1.5) - Return new fields: Patient SEX, PID, and DOB
|
|---|
| 7 | ; April 11 2011: UJO/SMH (v 1.6) - Added Radiology Exam Field, to retrieve Radiology Exam associated with appt
|
|---|
| 8 | ;
|
|---|
| 9 | ;
|
|---|
| 10 | CRSCHD(BSDXY,BSDXRES,BSDXSTART,BSDXEND) ;EP
|
|---|
| 11 | ;Entry point for debugging
|
|---|
| 12 | ;
|
|---|
| 13 | ;D DEBUG^%Serenji("CRSCH^BSDX02(.BSDXY,BSDXRES,BSDXSTART,BSDXEND)")
|
|---|
| 14 | Q
|
|---|
| 15 | ;
|
|---|
| 16 | CRSCH(BSDXY,BSDXRES,BSDXSTART,BSDXEND,BSDXWKIN) ;
|
|---|
| 17 | ;Called by BSDX CREATE APPT SCHEDULE
|
|---|
| 18 | ;Create Resource Appointment Schedule recordset
|
|---|
| 19 | ;On error, returns 0 in APPOINTMENTID field and error text in NOTE field
|
|---|
| 20 | ;
|
|---|
| 21 | ;$O Thru ^BSDXAPPT("ARSRC", RESOURCE, STARTTIME, APPTID)
|
|---|
| 22 | ;BMXRES is a | delimited list of resource names
|
|---|
| 23 | ;BSDXWKIN - If 1, then return walkins, otherwise skip them
|
|---|
| 24 | ;9-27-2004 Added walkin to returned datatable
|
|---|
| 25 | ;TODO: Change BSDXRES from names to IDs
|
|---|
| 26 | ;
|
|---|
| 27 | N BSDXERR,BSDXIEN,BSDXDEPD,BSDXDEPN,BSDXRESD,BSDXI,BSDXJ,BSDXRESN,BSDXS,BSDXAD,BSDXZ,BSDXQ,BSDXNOD
|
|---|
| 28 | N BSDXPAT,BSDXNOT,BSDXZPCD,BSDXPCD
|
|---|
| 29 | K ^BSDXTMP($J)
|
|---|
| 30 | S BSDXERR=""
|
|---|
| 31 | S BSDXY="^BSDXTMP("_$J_")"
|
|---|
| 32 | S ^BSDXTMP($J,0)="I00020APPOINTMENTID^D00030START_TIME^D00030END_TIME^D00030CHECKIN^D00030AUXTIME^I00020PATIENTID^T00030PATIENTNAME^T00030RESOURCENAME^I00005NOSHOW^T00020HRN^I00005ACCESSTYPEID^I00005WALKIN^T00250NOTE^T00006SEX^T00040PID^D00030DOB^I00020RADIOLOGY_EXAM"_$C(30)
|
|---|
| 33 | D ^XBKVAR S X="ETRAP^BSDX02",@^%ZOSF("TRAP")
|
|---|
| 34 | ;
|
|---|
| 35 | ; S %DT="T",X=BSDXSTART D ^%DT S BSDXSTART=Y
|
|---|
| 36 | ; I BSDXSTART=-1 S ^BSDXTMP($J,1)=$C(31) Q
|
|---|
| 37 | ; S %DT="T",X=BSDXEND D ^%DT S BSDXEND=Y
|
|---|
| 38 | ; I BSDXEND=-1 S ^BSDXTMP($J,1)=$C(31) Q
|
|---|
| 39 | ;
|
|---|
| 40 | S BSDXI=0
|
|---|
| 41 | D STRES
|
|---|
| 42 | ;
|
|---|
| 43 | S BSDXI=BSDXI+1
|
|---|
| 44 | S ^BSDXTMP($J,BSDXI)=$C(31)
|
|---|
| 45 | Q
|
|---|
| 46 | ;
|
|---|
| 47 | STRES ;
|
|---|
| 48 | F BSDXJ=1:1:$L(BSDXRES,"|") S BSDXRESN=$P(BSDXRES,"|",BSDXJ) D
|
|---|
| 49 | . Q:BSDXRESN=""
|
|---|
| 50 | . Q:'$D(^BSDXRES("B",BSDXRESN))
|
|---|
| 51 | . S BSDXRESD=$O(^BSDXRES("B",BSDXRESN,0))
|
|---|
| 52 | . Q:'+BSDXRESD
|
|---|
| 53 | . Q:'$D(^BSDXAPPT("ARSRC",BSDXRESD))
|
|---|
| 54 | . S BSDXS=BSDXSTART-.0001
|
|---|
| 55 | . F S BSDXS=$O(^BSDXAPPT("ARSRC",BSDXRESD,BSDXS)) Q:'+BSDXS Q:BSDXS>BSDXEND D
|
|---|
| 56 | . . S BSDXAD=0 F S BSDXAD=$O(^BSDXAPPT("ARSRC",BSDXRESD,BSDXS,BSDXAD)) Q:'+BSDXAD D STCOMM(BSDXAD,BSDXRESN)
|
|---|
| 57 | Q
|
|---|
| 58 | ;
|
|---|
| 59 | STCOMM(BSDXAD,BSDXRESN) ;
|
|---|
| 60 | ;BSDXAD is the appointment IEN
|
|---|
| 61 | N BSDXC,BSDXQ,BSDXZ,BSDXSUBC,BSDXHRN,BSDXPATD,BSDXATID,BSDXISWK
|
|---|
| 62 | Q:'$D(^BSDXAPPT(BSDXAD,0))
|
|---|
| 63 | S BSDXNOD=^BSDXAPPT(BSDXAD,0)
|
|---|
| 64 | Q:$P(BSDXNOD,U,12)]"" ;CANCELLED
|
|---|
| 65 | S BSDXISWK=0
|
|---|
| 66 | S:$P(BSDXNOD,U,13)="y" BSDXISWK=1
|
|---|
| 67 | I +$G(BSDXWKIN) Q:BSDXISWK ;Don't return walkins if appt is WALKIN and BSDXWKIN is 1
|
|---|
| 68 | S BSDXZ=BSDXAD_"^"
|
|---|
| 69 | F BSDXQ=1:1:4 D
|
|---|
| 70 | . S Y=$P(BSDXNOD,U,BSDXQ)
|
|---|
| 71 | . X ^DD("DD") S Y=$TR(Y,"@"," ")
|
|---|
| 72 | . S BSDXZ=BSDXZ_Y_"^"
|
|---|
| 73 | S BSDXPATD=$P(BSDXNOD,U,5)
|
|---|
| 74 | S BSDXZ=BSDXZ_BSDXPATD_"^" ;PATIENT ID
|
|---|
| 75 | S BSDXPAT=""
|
|---|
| 76 | I BSDXPATD]"",$D(^DPT(BSDXPATD,0)) S BSDXPAT=$P(^DPT(BSDXPATD,0),U)
|
|---|
| 77 | S BSDXZ=BSDXZ_BSDXPAT_"^" ;PATIENT NAME
|
|---|
| 78 | S BSDXZ=BSDXZ_BSDXRESN_"^" ;RESOURCENAME
|
|---|
| 79 | S BSDXZ=BSDXZ_+$P(BSDXNOD,U,10)_"^" ;NOSHOW
|
|---|
| 80 | S BSDXHRN=""
|
|---|
| 81 | I $D(DUZ(2)),DUZ(2)>0 S BSDXHRN=$P($G(^AUPNPAT(BSDXPATD,41,DUZ(2),0)),U,2) ;HRN
|
|---|
| 82 | S BSDXZ=BSDXZ_BSDXHRN_"^"
|
|---|
| 83 | S BSDXATID=$P(BSDXNOD,U,6)
|
|---|
| 84 | S:'+BSDXATID BSDXATID=0 ;UNKNOWN TYPE
|
|---|
| 85 | S BSDXZ=BSDXZ_BSDXATID_"^"_BSDXISWK_"^"
|
|---|
| 86 | S BSDXI=BSDXI+1
|
|---|
| 87 | S ^BSDXTMP($J,BSDXI)=BSDXZ
|
|---|
| 88 | ;NOTE
|
|---|
| 89 | S BSDXNOT="",BSDXQ=0 F S BSDXQ=$O(^BSDXAPPT(BSDXAD,1,BSDXQ)) Q:'+BSDXQ D
|
|---|
| 90 | . S BSDXNOT=$G(^BSDXAPPT(BSDXAD,1,BSDXQ,0))
|
|---|
| 91 | . S:$E(BSDXNOT,$L(BSDXNOT)-1,$L(BSDXNOT))'=" " BSDXNOT=BSDXNOT_" "
|
|---|
| 92 | . S BSDXI=BSDXI+1
|
|---|
| 93 | . S ^BSDXTMP($J,BSDXI)=BSDXNOT
|
|---|
| 94 | S ^BSDXTMP($J,BSDXI)=^BSDXTMP($J,BSDXI)_U ; Add "^" to separate note from next fields.
|
|---|
| 95 | S BSDXI=BSDXI+1
|
|---|
| 96 | ; new code for V1.5. Extra fields to return.
|
|---|
| 97 | N SEX S SEX=$$GET1^DIQ(2,BSDXPATD,.02) ; SEX
|
|---|
| 98 | N PID S PID=$$GET1^DIQ(2,BSDXPATD,.363) ; PRIMARY LONG ID
|
|---|
| 99 | ; Note strange way I retrieve the value. B/c DOB Output Transform
|
|---|
| 100 | ; Outputs it in MM/DD/YYYY format, which is ambigous for C#.
|
|---|
| 101 | N DOB S DOB=$$FMTE^XLFDT($$GET1^DIQ(2,BSDXPATD,.03,"I")) ; DOB
|
|---|
| 102 | N RADEX S RADEX=$P(BSDXNOD,U,14) ;Radiology exam
|
|---|
| 103 | S ^BSDXTMP($J,BSDXI)=SEX_U_PID_U_DOB_U_RADEX_$C(30)
|
|---|
| 104 | ; end new code
|
|---|
| 105 | Q
|
|---|
| 106 | ;
|
|---|
| 107 | ERR(BSDXI,BSDXERR) ;Error processing
|
|---|
| 108 | S BSDXI=BSDXI+1
|
|---|
| 109 | S ^BSDXTMP($J,BSDXI)="0^^^^^^^^^^^"_BSDXERR_$C(30)
|
|---|
| 110 | S BSDXI=BSDXI+1
|
|---|
| 111 | S ^BSDXTMP($J,BSDXI)=$C(31)
|
|---|
| 112 | Q
|
|---|
| 113 | ;
|
|---|
| 114 | ETRAP ;EP Error trap entry
|
|---|
| 115 | D ^%ZTER
|
|---|
| 116 | I '$D(BSDXI) N BSDXI S BSDXI=999999
|
|---|
| 117 | S BSDXI=BSDXI+1
|
|---|
| 118 | D ERR(BSDXI,"BSDX31 Error: "_$G(%ZTERROR))
|
|---|
| 119 | Q
|
|---|
