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

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

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