source: Scheduling/trunk/m/BSDX02.m@ 1475

Last change on this file since 1475 was 1472, checked in by Sam Habiel, 12 years ago

Updated version number on all routines to be 1.7T1.
Minor fixes here and there for XINDEX errors.

File size: 4.3 KB
Line 
1BSDX02 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/6/12 11:09am
2 ;;1.7T1;BSDX;;Jul 06, 2012;Build 18
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 ;
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"
33 S ^(0)=^(0)_"^I00005NOSHOW^T00020HRN^I00005ACCESSTYPEID^I00005WALKIN^T00250NOTE^T00006SEX^T00040PID^D00030DOB^I00020RADIOLOGY_EXAM"_$C(30)
34 D ^XBKVAR S X="ETRAP^BSDX02",@^%ZOSF("TRAP")
35 ;
36 ; S %DT="T",X=BSDXSTART D ^%DT S BSDXSTART=Y
37 ; I BSDXSTART=-1 S ^BSDXTMP($J,1)=$C(31) Q
38 ; S %DT="T",X=BSDXEND D ^%DT S BSDXEND=Y
39 ; I BSDXEND=-1 S ^BSDXTMP($J,1)=$C(31) Q
40 ;
41 S BSDXI=0
42 D STRES
43 ;
44 S BSDXI=BSDXI+1
45 S ^BSDXTMP($J,BSDXI)=$C(31)
46 Q
47 ;
48STRES ;
49 F BSDXJ=1:1:$L(BSDXRES,"|") S BSDXRESN=$P(BSDXRES,"|",BSDXJ) D
50 . Q:BSDXRESN=""
51 . Q:'$D(^BSDXRES("B",BSDXRESN))
52 . S BSDXRESD=$O(^BSDXRES("B",BSDXRESN,0))
53 . Q:'+BSDXRESD
54 . Q:'$D(^BSDXAPPT("ARSRC",BSDXRESD))
55 . S BSDXS=BSDXSTART-.0001
56 . F S BSDXS=$O(^BSDXAPPT("ARSRC",BSDXRESD,BSDXS)) Q:'+BSDXS Q:BSDXS>BSDXEND D
57 . . S BSDXAD=0 F S BSDXAD=$O(^BSDXAPPT("ARSRC",BSDXRESD,BSDXS,BSDXAD)) Q:'+BSDXAD D STCOMM(BSDXAD,BSDXRESN)
58 Q
59 ;
60STCOMM(BSDXAD,BSDXRESN) ;
61 ;BSDXAD is the appointment IEN
62 N BSDXC,BSDXQ,BSDXZ,BSDXSUBC,BSDXHRN,BSDXPATD,BSDXATID,BSDXISWK
63 Q:'$D(^BSDXAPPT(BSDXAD,0))
64 S BSDXNOD=^BSDXAPPT(BSDXAD,0)
65 Q:$P(BSDXNOD,U,12)]"" ;CANCELLED
66 S BSDXISWK=0
67 S:$P(BSDXNOD,U,13)="y" BSDXISWK=1
68 I +$G(BSDXWKIN) Q:BSDXISWK ;Don't return walkins if appt is WALKIN and BSDXWKIN is 1
69 S BSDXZ=BSDXAD_"^"
70 F BSDXQ=1:1:4 D
71 . S Y=$P(BSDXNOD,U,BSDXQ)
72 . X ^DD("DD") S Y=$TR(Y,"@"," ")
73 . S BSDXZ=BSDXZ_Y_"^"
74 S BSDXPATD=$P(BSDXNOD,U,5)
75 S BSDXZ=BSDXZ_BSDXPATD_"^" ;PATIENT ID
76 S BSDXPAT=""
77 I BSDXPATD]"",$D(^DPT(BSDXPATD,0)) S BSDXPAT=$P(^DPT(BSDXPATD,0),U)
78 S BSDXZ=BSDXZ_BSDXPAT_"^" ;PATIENT NAME
79 S BSDXZ=BSDXZ_BSDXRESN_"^" ;RESOURCENAME
80 S BSDXZ=BSDXZ_+$P(BSDXNOD,U,10)_"^" ;NOSHOW
81 S BSDXHRN=""
82 I $D(DUZ(2)),DUZ(2)>0 S BSDXHRN=$P($G(^AUPNPAT(BSDXPATD,41,DUZ(2),0)),U,2) ;HRN
83 S BSDXZ=BSDXZ_BSDXHRN_"^"
84 S BSDXATID=$P(BSDXNOD,U,6)
85 S:'+BSDXATID BSDXATID=0 ;UNKNOWN TYPE
86 S BSDXZ=BSDXZ_BSDXATID_"^"_BSDXISWK_"^"
87 S BSDXI=BSDXI+1
88 S ^BSDXTMP($J,BSDXI)=BSDXZ
89 ;NOTE
90 S BSDXNOT="",BSDXQ=0 F S BSDXQ=$O(^BSDXAPPT(BSDXAD,1,BSDXQ)) Q:'+BSDXQ D
91 . S BSDXNOT=$G(^BSDXAPPT(BSDXAD,1,BSDXQ,0))
92 . S:$E(BSDXNOT,$L(BSDXNOT)-1,$L(BSDXNOT))'=" " BSDXNOT=BSDXNOT_" "
93 . S BSDXI=BSDXI+1
94 . S ^BSDXTMP($J,BSDXI)=BSDXNOT
95 S ^BSDXTMP($J,BSDXI)=^BSDXTMP($J,BSDXI)_U ; Add "^" to separate note from next fields.
96 S BSDXI=BSDXI+1
97 ; new code for V1.5. Extra fields to return.
98 N SEX S SEX=$$GET1^DIQ(2,BSDXPATD,.02) ; SEX
99 N PID S PID=$$GET1^DIQ(2,BSDXPATD,.363) ; PRIMARY LONG ID
100 ; Note strange way I retrieve the value. B/c DOB Output Transform
101 ; Outputs it in MM/DD/YYYY format, which is ambigous for C#.
102 N DOB S DOB=$$FMTE^XLFDT($$GET1^DIQ(2,BSDXPATD,.03,"I")) ; DOB
103 N RADEX S RADEX=$P(BSDXNOD,U,14) ;Radiology exam
104 S ^BSDXTMP($J,BSDXI)=SEX_U_PID_U_DOB_U_RADEX_$C(30)
105 ; end new code
106 Q
107 ;
108ERR(BSDXI,BSDXERR) ;Error processing
109 S BSDXI=BSDXI+1
110 S ^BSDXTMP($J,BSDXI)="0^^^^^^^^^^^"_BSDXERR_$C(30)
111 S BSDXI=BSDXI+1
112 S ^BSDXTMP($J,BSDXI)=$C(31)
113 Q
114 ;
115ETRAP ;EP Error trap entry
116 D ^%ZTER
117 I '$D(BSDXI) N BSDXI S BSDXI=999999
118 S BSDXI=BSDXI+1
119 D ERR(BSDXI,"BSDX31 Error: "_$G(%ZTERROR))
120 Q
Note: See TracBrowser for help on using the repository browser.