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

Last change on this file since 700 was 614, checked in by Sam Habiel, 15 years ago

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