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

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

Changes to BSDX01 to prevent Scheduled,dc'ed,completed radiology appointments from being cancelled. Updated files to T2.

File size: 4.3 KB
RevLine 
[1187]1BSDX02 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 5/16/11 2:47pm
2 ;;1.6T2;BSDX;;May 16, 2011
[1161]3 ;Licensed under LGPL
4 ; Change Log
5 ; July 15 2010: UJO/SMH - Pass FM dates in instead of US dates for i18n
[1108]6 ; March 21 2011: UJO/SMH (v 1.5) - Return new fields: Patient SEX, PID, and DOB
[1172]7 ; April 11 2011: UJO/SMH (v 1.6) - Added Radiology Exam Field, to retrieve Radiology Exam associated with appt
[614]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_")"
[1172]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)
[614]33 D ^XBKVAR S X="ETRAP^BSDX02",@^%ZOSF("TRAP")
34 ;
[851]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
[888]39 ;
[614]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
[1108]94 S ^BSDXTMP($J,BSDXI)=^BSDXTMP($J,BSDXI)_U ; Add "^" to separate note from next fields.
[614]95 S BSDXI=BSDXI+1
[1108]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
[1109]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#.
[1108]101 N DOB S DOB=$$FMTE^XLFDT($$GET1^DIQ(2,BSDXPATD,.03,"I")) ; DOB
[1177]102 N RADEX S RADEX=$P(BSDXNOD,U,14) ;Radiology exam
[1172]103 S ^BSDXTMP($J,BSDXI)=SEX_U_PID_U_DOB_U_RADEX_$C(30)
[1108]104 ; end new code
[614]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.