source: Scheduling/branches/Radiology-Support/m/BSDX02.m@ 1154

Last change on this file since 1154 was 1141, checked in by Sam Habiel, 14 years ago

BSDX32: Hospital Location has extra column IS_RADIOLOGY_LOCATION to link if that HL is tied to the Radiology Package
BDDX01: GETRADEX: Get Radiology Exams for a Patient in a specific HL;
BSDX01: SCHRAEX: Schedule Radiology Exam
BSDX01: HOLDRAEX: Hold Radiology Exam
BSDX02: Added Radiology Exam Field, to retrieve Radiology Exam associated with appt
BSDX07: Support for adding Radiology Exams to Appointment. BSDX APPOINTMENT file now has a Radiology Exam that points to file 75.1 (RAD/NUC MED ORDERS)
BSDX28: Added support for searching by DFN from Scheduling GUI by accent grave notation.
File size: 4.3 KB
Line 
1BSDX02 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/11/11 12:21pm
2 ;;1.5V3;BSDX;;Mar 16, 2011
3 ;
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 ;
10CRSCHD(BSDXY,BSDXRES,BSDXSTART,BSDXEND) ;EP
11 ;Entry point for debugging
12 ;
13 ;D DEBUG^%Serenji("CRSCH^BSDX02(.BSDXY,BSDXRES,BSDXSTART,BSDXEND)")
14 Q
15 ;
16CRSCH(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 ;
47STRES ;
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 ;
59STCOMM(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)
103 S ^BSDXTMP($J,BSDXI)=SEX_U_PID_U_DOB_U_RADEX_$C(30)
104 ; end new code
105 Q
106 ;
107ERR(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 ;
114ETRAP ;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
Note: See TracBrowser for help on using the repository browser.