source: Scheduling/trunk/m/BSDX34.m@ 1187

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

Changes to BSDX01 to prevent Scheduled,dc'ed,completed radiology appointments from being cancelled. Updated files to T2.
File size: 6.3 KB
Line 
1BSDX34 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:29am
2 ;;1.6T2;BSDX;;May 16, 2011
3 ; Licensed under LGPL
4 ;
5 ; Change Log:
6 ; July 10 2010:
7 ; CANCLIN AND RBCLIN: Dates passed in FM format for i18n
8 ;
9 Q
10 ;
11RBCLIND(BSDXY,BSDXCLST,BSDXBEG,BSDXEND) ;EP
12 ;Entry point for debugging
13 ;
14 ;D DEBUG^%Serenji("RBCLIN^BSDX34(.BSDXY,BSDXCLST,BSDXBEG,BSDXEND)")
15 Q
16 ;
17RBERR ;
18 ;Called from RBCLIN on error to set up header
19 K ^BSDXTMP($J)
20 S ^BSDXTMP($J,0)="T00030Name^D00020DOB^T00030Sex^T00030HRN^D00030NewApptDate^T00030Clinic^T00030TypeStatus^I00010RESOURCEID"
21 S ^BSDXTMP($J,0)=^(0)_"^T00030APPT_MADE_BY^D00020DATE_APPT_MADE^T00250NOTE^T00030STREET^T00030CITY^T00030STATE^T00030ZIP^T00030HOMEPHONE^D00030OldApptDate"_$C(30)
22 D ERR(999)
23 Q
24 ;
25CANCLIN(BSDXY,BSDXCLST,BSDXBEG,BSDXEND) ;EP
26 ;
27 ;Return recordset of CANCELLED patient appointments
28 ;between dates BSDXBEG and BSDXEND for each clinic in BSDXCLST.
29 ;Used in generating cancellation letters for a clinic
30 ;BSDXCLST is a |-delimited list of BSDX RESOURCE iens. (The last |-piece is null, so discard it.)
31 ;v 1.3 BSDXBEG and BSDXEND are in fm format
32 ;Called by BSDX CANCEL CLINIC LIST
33 N BSDXCAN
34 S BSDXCAN=1
35 D RBCLIN(.BSDXY,BSDXCLST,BSDXBEG,BSDXEND)
36 ;
37 Q
38 ;
39RBCLIN(BSDXY,BSDXCLST,BSDXBEG,BSDXEND) ;EP
40 ;
41 ;Return recordset of rebooked patient appointments
42 ;between dates BSDXBEG and BSDXEND for each clinic in BSDXCLST.
43 ;Used in generating rebook letters for a clinic
44 ;BSDXCLST is a |-delimited list of BSDX RESOURCE iens. (The last |-piece is null, so discard it.)
45 ;Called by BSDX REBOOK CLINIC LIST and BSDX CANCEL CLINIC LIST via entry point CANCLIN above
46 ;Jul 11 2010 (smh):
47 ;for i18n, pass BSDXBEG and BSDXEND in FM format.
48 ;
49 S X="RBERR^BSDX34",@^%ZOSF("TRAP")
50 ;
51 S BSDXY="^BSDXTMP("_$J_")"
52 N %DT,Y,BSDXJ,BSDXCID,BSDXCLN,BSDXSTRT,BSDXAID,BSDXNOD,BSDXLIST,BSDX,BSDY
53 ;Convert beginning and ending dates
54 ;TODO: Validation of date to make sure it's a right FM Date
55 S BSDXBEG=$P(BSDXBEG,".")
56 S BSDXEND=$P(BSDXEND,".")
57 S BSDXBEG=BSDXBEG-1,BSDXBEG=BSDXBEG_".9999"
58 S BSDXEND=BSDXEND_".9999"
59 ;
60 I BSDXCLST="" D RBERR Q
61 ;
62 ;
63 ;If BSDXCLST is a list of resource NAMES, look up each name and convert to IEN
64 F BSDXJ=1:1:$L(BSDXCLST,"|")-1 S BSDX=$P(BSDXCLST,"|",BSDXJ) D S $P(BSDXCLST,"|",BSDXJ)=BSDY
65 . S BSDY=""
66 . I BSDX]"",$D(^BSDXRES(BSDX,0)) S BSDY=BSDX Q
67 . I BSDX]"",$D(^BSDXRES("B",BSDX)) S BSDY=$O(^BSDXRES("B",BSDX,0)) Q
68 . Q
69 ;
70 ;For each clinic in BSDXCLST $O through ^BSDXAPPT("ARSRC",ResourceIEN,FMDate,ApptIEN)
71 ;
72 S BSDXLIST=""
73 F BSDXJ=1:1:$L(BSDXCLST,"|")-1 S BSDXCID=$P(BSDXCLST,"|",BSDXJ) D:+BSDXCID
74 . S BSDXCLN=$G(^BSDXRES(BSDXCID,0)) S BSDXCLN=$P(BSDXCLN,U) Q:BSDXCLN=""
75 . S BSDXSTRT=BSDXBEG F S BSDXSTRT=$O(^BSDXAPPT("ARSRC",BSDXCID,BSDXSTRT)) Q:'+BSDXSTRT Q:BSDXSTRT>BSDXEND D
76 . . S BSDXAID=0 F S BSDXAID=$O(^BSDXAPPT("ARSRC",BSDXCID,BSDXSTRT,BSDXAID)) Q:'+BSDXAID D
77 . . . S BSDXNOD=$G(^BSDXAPPT(BSDXAID,0))
78 . . . I $D(BSDXCAN) D Q
79 . . . . I $P(BSDXNOD,U,12) S BSDXLIST=BSDXLIST_BSDXAID_"|" ;Cancelled appt
80 . . . I $P(BSDXNOD,U,11) S BSDXLIST=BSDXLIST_BSDXAID_"|" ;Rebooked appt
81 D RBLETT(.BSDXY,BSDXLIST)
82 Q
83 ;
84RBLETTD(BSDXY,BSDXLIST) ;EP
85 ;Entry point for debugging
86 ;
87 ;D DEBUG^%Serenji("RBLETT^BSDX34(.BSDXY,BSDXLIST)")
88 Q
89 ;
90RBLETT(BSDXY,BSDXLIST) ;EP
91 ;Return recordset of patient appointments used in listing
92 ;REBOOKED appointments for a list of appointmentIDs.
93 ;Called by rpc BSDX REBOOK LIST
94 ;BSDXLIST is a |-delimited list of BSDX APPOINTMENT iens (the last |-piece is null)
95 ;
96 N BSDXI,BSDXIEN,BSDXNOD,BSDXCNID,BSDXCNOD,BSDXMADE,BSDXCLRK,BSDXNOT,BSDXQ,BSDX
97 S BSDXY="^BSDXTMP("_$J_")"
98 S BSDXI=0
99 S ^BSDXTMP($J,BSDXI)="T00030Name^D00020DOB^T00030Sex^T00030HRN^D00030NewApptDate^T00030Clinic^T00030TypeStatus"
100 S ^BSDXTMP($J,BSDXI)=^(BSDXI)_"^I00010RESOURCEID^T00030APPT_MADE_BY^D00020DATE_APPT_MADE^T00250NOTE^T00030STREET^T00030CITY^T00030STATE^T00030ZIP^T00030HOMEPHONE^D00030OldApptDate"_$C(30)
101 S X="ERROR^BSDX34",@^%ZOSF("TRAP")
102 ;
103 ;Iterate through BSDXLIST
104 S BSDXIEN=0
105 F BSDX=1:1:$L(BSDXLIST,"|")-1 S BSDXIEN=$P(BSDXLIST,"|",BSDX) D
106 . N BSDXNOD,BSDXAPT,BSDXCID,BSDXCNOD,BSDXCLN,BSDX44,BSDXDNOD,BSDXSTAT,BSDX,BSDXTYPE,BSDXLIN,BSDXPAT
107 . N BSDXSTRE,BSDXCITY,BSDXST,BSDXZIP,BSDXPHON
108 . N BSDXNAM,BSDXDOB,BSDXHRN,BSDXSEX
109 . N BSDXREBK
110 . S BSDXNOD=$G(^BSDXAPPT(BSDXIEN,0))
111 . Q:BSDXNOD=""
112 . S BSDXPAT=$P(BSDXNOD,U,5) ;PATIENT ien
113 . Q:'+BSDXPAT
114 . Q:'$D(^DPT(BSDXPAT))
115 . D PINFO(BSDXPAT)
116 . S Y=$P(BSDXNOD,U)
117 . Q:'+Y
118 . X ^DD("DD") S Y=$TR(Y,"@"," ")
119 . S BSDXAPT=Y ;Appointment date time
120 . S BSDXREBK=""
121 . S Y=$P(BSDXNOD,U,11)
122 . I +Y X ^DD("DD") S Y=$TR(Y,"@"," ") S BSDXREBK=Y ;Rebook date time
123 . S BSDXCLRK=$P(BSDXNOD,U,8) ;Appointment made by
124 . S:+BSDXCLRK BSDXCLRK=$G(^VA(200,BSDXCLRK,0)),BSDXCLRK=$P(BSDXCLRK,U)
125 . S Y=$P(BSDXNOD,U,9) ;Date Appointment Made
126 . I +Y X ^DD("DD") S Y=$TR(Y,"@"," ")
127 . S BSDXMADE=Y
128 . ;NOTE
129 . S BSDXNOT=""
130 . I $D(^BSDXAPPT(BSDXIEN,1,0)) S BSDXNOT="",BSDXQ=0 F S BSDXQ=$O(^BSDXAPPT(BSDXIEN,1,BSDXQ)) Q:'+BSDXQ D
131 . . S BSDXLIN=$G(^BSDXAPPT(BSDXIEN,1,BSDXQ,0))
132 . . S:(BSDXLIN'="")&($E(BSDXLIN,$L(BSDXLIN)-1,$L(BSDXLIN))'=" ") BSDXLIN=BSDXLIN_" "
133 . . S BSDXNOT=BSDXNOT_BSDXLIN
134 . ;Resource
135 . S BSDXCID=$P(BSDXNOD,U,7) ;IEN of BSDX RESOURCE
136 . Q:'+BSDXCID
137 . Q:'$D(^BSDXRES(BSDXCID,0))
138 . S BSDXCNOD=$G(^BSDXRES(BSDXCID,0)) ;BSDX RESOURCE node
139 . Q:BSDXCNOD=""
140 . S BSDXCLN=$P(BSDXCNOD,U) ;Text name of BSDX Resource
141 . S BSDXTYPE="" ;Unused in this recordset
142 . S BSDXI=BSDXI+1
143 . S ^BSDXTMP($J,BSDXI)=BSDXNAM_"^"_BSDXDOB_"^"_BSDXSEX_"^"_BSDXHRN_"^"_BSDXREBK_"^"_BSDXCLN_"^"_BSDXTYPE_"^"_BSDXCID_"^"_BSDXCLRK_"^"_BSDXMADE_"^"_BSDXNOT_"^"_BSDXSTRE_"^"_BSDXCITY_"^"_BSDXST_"^"_BSDXZIP_"^"_BSDXPHON_"^"_BSDXAPT_$C(30)
144 . Q
145 ;
146 S BSDXI=BSDXI+1
147 S ^BSDXTMP($J,BSDXI)=$C(31)
148 Q
149 ;
150PINFO(BSDXPAT) ;
151 ;Get patient info
152 N BSDXNOD
153 S BSDXNOD=$$PATINFO^BSDX27(BSDXPAT)
154 S BSDXNAM=$P(BSDXNOD,U) ;NAME
155 S BSDXSEX=$P(BSDXNOD,U,2) ;SEX
156 S BSDXDOB=$P(BSDXNOD,U,3) ;DOB
157 S BSDXHRN=$P(BSDXNOD,U,4) ;Health Record Number for location DUZ(2)
158 S BSDXSTRE=$P(BSDXNOD,U,5) ;Street
159 S BSDXCITY=$P(BSDXNOD,U,6) ;City
160 S BSDXST=$P(BSDXNOD,U,7) ;State
161 S BSDXZIP=$P(BSDXNOD,U,8) ;zip
162 S BSDXPHON=$P(BSDXNOD,U,9) ;homephone
163 Q
164 ;
165ERROR ;
166 D ERR("RPMS Error")
167 Q
168 ;
169ERR(ERRNO) ;Error processing
170 S:'$D(BSDXI) BSDXI=999
171 I +ERRNO S BSDXERR=ERRNO+134234112 ;vbObjectError
172 E S BSDXERR=ERRNO
173 S BSDXI=BSDXI+1
174 S ^BSDXTMP($J,BSDXI)="^^^^^^^^^^^^^^^^"_$C(30)
175 S BSDXI=BSDXI+1
176 S ^BSDXTMP($J,BSDXI)=$C(31)
177 Q
Note: See TracBrowser for help on using the repository browser.