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

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

Change version to 1.4 on all routines
BSDX08 has fix for drag and drop because it referenced a non existent cancellation reason
File size: 6.3 KB
Line 
1BSDX34 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/15/10 12:37pm
2 ;;1.4;BSDX;;Sep 07, 2010
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.