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

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

Added LGPL license to routines
File size: 6.3 KB
Line 
1BSDX34 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:29am
2 ;;1.5;BSDX;;Apr 28, 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.