Changeset 1467
- Timestamp:
- Jul 5, 2012, 7:42:34 PM (12 years ago)
- Location:
- Scheduling/trunk/m
- Files:
-
- 6 edited
Legend:
- Unmodified
- Added
- Removed
-
Scheduling/trunk/m/BSDX07.m
r1454 r1467 1 BSDX07 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 6/21/12 3:54pm1 BSDX07 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 7/5/12 12:57pm 2 2 ;;1.7T1;BSDX;;Aug 31, 2011;Build 18 3 3 ; Licensed under LGPL … … 12 12 ; v1.6 Apr 11 2011 - Support for Scheduling Radiology Exams... 13 13 ; v1.7 Jun 20 2012 - Refactoring to remove transactions - many changes 14 ; - AVUPDT moved to AVUPDTMK in BSDXAPI1 14 15 ; 15 16 ; Error Reference: … … 58 59 ; 59 60 ; NB: Specifying BSDXLEN and BSDXEND is redundant. For future programmers 60 ; to sort out 61 ; to sort out. Needs changes on client. 61 62 ; 62 63 ;Test lines: … … 162 163 I +BSDXSCD,$D(^SC(BSDXSCD,0)) D I +BSDXERR D ERR(BSDXI,"-10~BSDX07 Error: MAKE^BSDXAPI returned error code: "_BSDXERR),ROLLBACK(BSDXAPPTID,.BSDXC) Q 163 164 . S BSDXERR=$$MAKE^BSDXAPI(.BSDXC) 164 . Q:BSDXERR165 . D AVUPDT(BSDXSCD,BSDXSTART,BSDXLEN) ; Update RPMS Clinic availability166 165 ; 167 166 ;Return Recordset … … 244 243 ; Appointment ID to remove from ^BSDXAPPT 245 244 ; BSDXC array (see array format in $$MAKE^BSDXAPI) 246 ; NB: I am not sure whether I want to do $G to protect ??245 ; NB: I am not sure whether I want to do $G to protect against undefs? 247 246 ; I send the variables to this EP from the Symbol Table in ETRAP 248 247 D BSDXDEL^BSDX07(BSDXAPPTID) … … 276 275 Q:$Q 1_U_"Mumps Error" Q 277 276 ; 278 DAY ;;^SUN^MON^TUES^WEDNES^THURS^FRI^SATUR279 ;280 DOW S %=$E(X,1,3),Y=$E(X,4,5),Y=Y>2&'(%#4)+$E("144025036146",Y)281 F %=%:-1:281 S Y=%#4=1+1+Y282 S Y=$E(X,6,7)+Y#7283 Q284 ;285 AVUPDT(BSDXSCD,BSDXSTART,BSDXLEN) ;Update RPMS Clinic availability286 ;SEE SDM1287 N Y,DFN288 N SL,STARTDAY,X,SC,SB,HSI,SI,STR,SDDIF,SDMAX,SDDATE,SDDMAX,SDSDATE,CCXN,MXOK,COV,SDPROG289 N X1,SDEDT,X2,SD,SM,SS,S,SDLOCK,ST,I290 S Y=BSDXSCD,DFN=BSDXPATID291 S SL=$G(^SC(+Y,"SL")),X=$P(SL,U,3),STARTDAY=$S($L(X):X,1:8),SC=Y,SB=STARTDAY-1/100,X=$P(SL,U,6),HSI=$S(X=1:X,X:X,1:4),SI=$S(X="":4,X<3:4,X:X,1:4),STR="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz",SDDIF=$S(HSI<3:8/HSI,1:2) K Y292 ;Determine maximum days for scheduling293 S SDMAX(1)=$P($G(^SC(+SC,"SDP")),U,2) S:'SDMAX(1) SDMAX(1)=365294 S (SDMAX,SDDMAX)=$$FMADD^XLFDT(DT,SDMAX(1))295 S SDDATE=BSDXSTART296 S SDSDATE=SDDATE,SDDATE=SDDATE\1297 1 ;L Q:$D(SDXXX) S CCXN=0 K MXOK,COV,SDPROT Q:DFN<0 S SC=+SC298 Q:$D(SDXXX) S CCXN=0 K MXOK,COV,SDPROT Q:DFN<0 S SC=+SC299 S X1=DT,SDEDT=365 S:$D(^SC(SC,"SDP")) SDEDT=$P(^SC(SC,"SDP"),"^",2)300 S X2=SDEDT D C^%DTC S SDEDT=X301 S Y=BSDXSTART302 EN1 S (X,SD)=Y,SM=0 D DOW303 S I '$D(^SC(SC,"ST",$P(SD,"."),1)) S SS=+$O(^SC(+SC,"T"_Y,SD)) Q:SS'>0 Q:^(SS,1)="" S ^SC(+SC,"ST",$P(SD,"."),1)=$E($P($T(DAY),U,Y+2),1,2)_" "_$E(SD,6,7)_$J("",SI+SI-6)_^(1),^(0)=$P(SD,".")304 S S=BSDXLEN305 ;Check if BSDXLEN evenly divisible by appointment length306 S RPMSL=$P(SL,U)307 I BSDXLEN<RPMSL S BSDXLEN=RPMSL308 I BSDXLEN#RPMSL'=0 D309 . S BSDXINC=BSDXLEN\RPMSL310 . S BSDXINC=BSDXINC+1311 . S BSDXLEN=RPMSL*BSDXINC312 S SL=S_U_$P(SL,U,2,99)313 SC S SDLOCK=$S('$D(SDLOCK):1,1:SDLOCK+1) Q:SDLOCK>9314 L +^SC(SC,"ST",$P(SD,"."),1):5 G:'$T SC315 S SDLOCK=0,S=^SC(SC,"ST",$P(SD,"."),1)316 S I=SD#1-SB*100,ST=I#1*SI\.6+($P(I,".")*SI),SS=SL*HSI/60*SDDIF+ST+ST317 I (I<1!'$F(S,"["))&(S'["CAN") L -^SC(SC,"ST",$P(SD,"."),1) Q318 I SM<7 S %=$F(S,"[",SS-1) S:'%!($P(SL,"^",6)<3) %=999 I $F(S,"]",SS)'<%!(SDDIF=2&$E(S,ST+ST+1,SS-1)["[") S SM=7319 ;320 SP I ST+ST>$L(S),$L(S)<80 S S=S_" " G SP321 S SDNOT=1322 S ABORT=0323 F I=ST+ST:SDDIF:SS-SDDIF D Q:ABORT324 . S ST=$E(S,I+1) S:ST="" ST=" "325 . S Y=$E(STR,$F(STR,ST)-2)326 . I S["CAN"!(ST="X"&($D(^SC(+SC,"ST",$P(SD,"."),"CAN")))) S ABORT=1 Q327 . I Y="" S ABORT=1 Q328 . S:Y'?1NL&(SM<6) SM=6 S ST=$E(S,I+2,999) S:ST="" ST=" " S S=$E(S,1,I)_Y_ST329 . Q330 S ^SC(SC,"ST",$P(SD,"."),1)=S331 L -^SC(SC,"ST",$P(SD,"."),1)332 Q -
Scheduling/trunk/m/BSDX08.m
r1461 r1467 1 BSDX08 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 6/26/12 10:49am1 BSDX08 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 7/5/12 12:39pm 2 2 ;;1.7T1;BSDX;;Aug 31, 2011;Build 18 3 3 ; … … 16 16 ; 3120625 VEN/SMH v1.7 17 17 ; - Transactions removed. Code refactored to work w/o txns. 18 ; - Moved AVUPDT to AVUPDTCN in BSDXAPI1. BSDXAPI takes care of calling 19 ; that. 18 20 ; 19 21 ; Error Reference: … … 128 130 ; If error happens, must rollback ^BSDXAPPT 129 131 I BSDXLOC D QUIT:BSDXERR 130 . N BSDXLEN S BSDXLEN=$$APPLEN^BSDXAPI(BSDXPATID,BSDXLOC,BSDXSTART) ; appt length131 132 . S BSDXERR=$$CANCEL^BSDXAPI(.BSDXC) ; Cancel through BSDXAPI 132 133 . ; Rollback BSDXAPPT if error occurs 133 . ; TODO: If an M error occurs in BSDXAPI, ETRAP gets called, ^BSDXTMP is134 . ; populated, then the output of $$CANCEL is the output of ETRAP.135 . ; Then, we see that BSDXERR is true, and we do another write,136 . ; which deletes the information we had in ^BSDXTMP. What to do???137 134 . I BSDXERR D ERR(BSDXI,"-9^BSDX08: BSDXAPI returned an error: "_$P(BSDXERR,U,2)),ROLLBACK(BSDXAPTID) QUIT 138 . ;139 . ; Update Legacy PIMS clinic Availability ; no failure expected here.140 . D AVUPDT(BSDXLOC,BSDXSTART,BSDXLEN)141 ;142 135 ; 143 136 L -^BSDXAPPT(BSDXAPTID) … … 146 139 S BSDXI=BSDXI+1 147 140 S ^BSDXTMP($J,BSDXI)=$C(31) 148 Q149 ;150 AVUPDT(BSDXSCD,BSDXSTART,BSDXLEN) ;Update Legacy PIMS Clinic availability151 ;See SDCNP0152 N SD,S ; Start Date153 S (SD,S)=BSDXSTART154 N I ; Clinic IEN in 44155 S I=BSDXSCD156 ; if day has no schedule in legacy PIMS, forget about this update.157 Q:'$D(^SC(I,"ST",SD\1,1))158 N SL ; Clinic characteristics node (length of appt, when appts start etc)159 S SL=^SC(I,"SL")160 N X ; Hour Clinic Display Begins161 S X=$P(SL,U,3)162 N STARTDAY ; When does the day start?163 S STARTDAY=$S($L(X):X,1:8) ; If defined, use it; otherwise, 8am164 N SB ; ?? Who knows? Day Start - 1 divided by 100.165 S SB=STARTDAY-1/100166 S X=$P(SL,U,6) ; Now X is Display increments per hour167 N HSI ; Slots per hour, try 1168 S HSI=$S(X:X,1:4) ; if defined, use it; otherwise, 4169 N SI ; Slots per hour, try 2170 S SI=$S(X="":4,X<3:4,X:X,1:4) ; If slots "", or less than 3, then 4171 N STR ; ??172 S STR="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz"173 N SDDIF ; Slots per hour diff??174 S SDDIF=$S(HSI<3:8/HSI,1:2)175 S SL=BSDXLEN ; Dammit, reusing variable; SL now Appt Length from GUI176 S S=^SC(I,"ST",SD\1,1) ; reusing var again; S now Day Pattern from PIMS177 N Y ; Hours since start of Date178 S Y=SD#1-SB*100 ;SD#1=FM Time portion; -SB minus start of day; conv to hrs179 N ST ; ??180 ; Y#1 -> Minutes; *SI -> * Slots per hour; \.6 trunc min to hour181 ; Y\1 -> Hours since start of day; * SI: * slots182 S ST=Y#1*SI\.6+(Y\1*SI)183 N SS ; how many slots are supposed to be taken by appointment184 S SS=SL*HSI/60 ; (nb: try SL: 30 min; HSI: 4 slots)185 N I186 I Y'<1 D ; If Hours since start of Date is greater than 1187 . ; loop through pattern. Tired of documenting.188 . F I=ST+ST:SDDIF D Q:Y="" Q:SS'>0189 . . S Y=$E(STR,$F(STR,$E(S,I+1))) Q:Y=""190 . . S S=$E(S,1,I)_Y_$E(S,I+2,999)191 . . S SS=SS-1192 . . Q:SS'>0193 S ^SC(BSDXSCD,"ST",SD\1,1)=S ; new pattern; global set194 141 Q 195 142 ; … … 254 201 ; 255 202 ERR(BSDXI,BSDXERR) ;Error processing 203 ; If last line is $C(31), we are done. No more errors to send to client. 204 I ^BSDXTMP($J,$O(^BSDXTMP($J," "),-1))=$C(31) QUIT 256 205 S BSDXI=BSDXI+1 257 206 S BSDXERR=$TR(BSDXERR,"^","~") … … 265 214 N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap 266 215 D ^%ZTER 267 S $EC="" ; Clear Error268 216 ; Roll back BSDXAPPT; 269 ; TODO: What if a Mumps error happens in fileman in BSDXAPI? The Scheduling files can potentially be out of sync 217 ; NB: What if a Mumps error happens inside fileman in BSDXAPI? 218 ; I have decided the M errors are out of scope for me to handle. 270 219 D:$G(BSDXAPTID) ROLLBACK(BSDXAPTID) 271 220 ; Log error message and send to client -
Scheduling/trunk/m/BSDX25.m
r1466 r1467 1 BSDX25 ; VEN/SMH - WINDOWS SCHEDULING RPCS ; 7/ 3/12 12:27pm1 BSDX25 ; VEN/SMH - WINDOWS SCHEDULING RPCS ; 7/5/12 11:55am 2 2 ;;1.7T1;BSDX;;Aug 31, 2011;Build 18 3 3 ; Licensed under LGPL … … 5 5 ; Change Log: 6 6 ; 3110106: SMH -> Changed Check-in EP - Removed unused paramters. Will change C# 7 ; 3120630: VEN/SMH -> Extensive Refactoring to remove transactions. 8 ; -> Functionality still the same. 9 ; -> Unit Tests in UT25^BSDXUT2 7 10 ; 8 11 ; … … 160 163 I '$D(^BSDXAPPT(BSDXAPPTID,0)) D ERR("-2~Invalid Appointment ID") QUIT 161 164 ; 162 ; Remove checkin from BSDX APPOINTMENT entry 163 N BSDXERR S BSDXERR=$$BSDXCHK(BSDXAPPTID,"@") 164 I BSDXERR D ERR("-6~Cannot file data in $$BSDXCHK") QUIT 165 ; 166 ; Now, remove checkin from PIMS files 2/44 165 ; Get appointment Data 167 166 N BSDXNOD S BSDXNOD=^BSDXAPPT(BSDXAPPTID,0) 168 167 N BSDXPATID S BSDXPATID=$P(BSDXNOD,U,5) ; DFN 169 168 N BSDXSTART S BSDXSTART=$P(BSDXNOD,U) ; Start Date 170 N BSDX SC1 S BSDXSC1=$P(BSDXNOD,U,7) ; Resource ID169 N BSDXRESID S BSDXRESID=$P(BSDXNOD,U,7) ; Resource ID 171 170 ; 172 171 ; If the resource doesn't exist, error out. DB is corrupt. 173 I 'BSDXSC1 D ERR("-3~DB has corruption. Call Tech Support.") QUIT 174 I '$D(^BSDXRES(BSDXSC1,0)) D ERR("-4~DB has corruption. Call Tech Support.") QUIT 175 ; 176 N BSDXNOD S BSDXNOD=^BSDXRES(BSDXSC1,0) ; Resource 0 node 177 S BSDXSC1=$P(BSDXNOD,U,4) ;HOSPITAL LOCATION 178 ; 179 N BSDXZ ; Scratch variable to hold error message 180 I BSDXSC1]"",$D(^SC(BSDXSC1,0)) S BSDXZ=$$RMCI^BSDXAPI1(BSDXPATID,BSDXSC1,BSDXSTART) 181 I +$G(BSDXZ) D ERR("-5~"_$P(BSDXZ,U,2)) QUIT 172 I 'BSDXRESID D ERR("-3~DB has corruption. Call Tech Support.") QUIT 173 I '$D(^BSDXRES(BSDXRESID,0)) D ERR("-4~DB has corruption. Call Tech Support.") QUIT 174 ; 175 ; Get HL Data 176 N BSDXNOD S BSDXNOD=^BSDXRES(BSDXRESID,0) ; Resource 0 node 177 N BSDXSC1 S BSDXSC1=$P(BSDXNOD,U,4) ;HOSPITAL LOCATION IEN 178 I BSDXSC1,'$D(^SC(BSDXSC1,0)) S BSDXSC1="" ; Zero out if HL doesn't exist 179 ; 180 ; Is it okay to remove check-in from PIMS? 181 N BSDXERR S BSDXERR=0 ; Scratch variable 182 ; $$RMCICK = Remove Check-in Check 183 I BSDXSC1 S BSDXERR=$$RMCICK^BSDXAPI1(BSDXPATID,BSDXSC1,BSDXSTART) 184 I BSDXERR D ERR("-5~"_$P(BSDXERR,U,2)) QUIT 185 ; 186 ; For possible rollback, get old check-in date (internal value) 187 N BSDXCDT S BSDXCDT=$$GET1^DIQ(9002018.4,BSDXAPPTID_",",.03,"I") 188 ; 189 ; Remove checkin from BSDX APPOINTMENT entry 190 ; No need to rollback here on failure. 191 N BSDXERR S BSDXERR=$$BSDXCHK(BSDXAPPTID,"@") 192 I BSDXERR D ERR("-6~Cannot file data in $$BSDXCHK") QUIT 193 ; 194 ; Now, remove checkin from PIMS files 2/44 195 ; Restore BSDXCDT into ^BSDXAPPT if we fail. 196 N BSDXERR S BSDXERR=0 ; Scratch variable to hold error message 197 I BSDXSC1 S BSDXERR=$$RMCI^BSDXAPI1(BSDXPATID,BSDXSC1,BSDXSTART) 198 I BSDXERR D QUIT 199 . N % S %=$$BSDXCHK(BSDXAPPTID,BSDXCDT) ; No error checking here. 200 . D ERR("-5~"_$P(BSDXERR,U,2)) ; Send error message to client 182 201 ; 183 202 ; Return ADO recordset … … 238 257 ; Individual portions of this routine may choose to do rolling back 239 258 ; of their own (e.g. a failed call to BSDXAPI causes rollback to occur 240 ; in CHECKIN )259 ; in CHECKIN and RMCI) 241 260 ; 242 261 ; Log error message and send to client -
Scheduling/trunk/m/BSDXAPI.m
r1466 r1467 1 BSDXAPI ; IHS/ ANMC/LJF & VW/SMH - SCHEDULING APIs ; 7/3/12 12:30pm1 BSDXAPI ; IHS/LJF,HMW,MAW & VEN/SMH - SCHEDULING APIs ; 7/5/12 12:52pm 2 2 ;;1.7T1;BSDX;;Aug 31, 2011;Build 18 3 3 ; Licensed under LGPL … … 110 110 ;Q:$G(BSDXSIMERR5) 1_U_$NA(BSDXSIMERR5) ; Unit Test line 111 111 S:$G(BSDXSIMERR5) X=1/0 112 ; 113 ; Update the Availablilities ; Doesn't fail. Global reads and sets. 114 D AVUPDTMK^BSDXAPI1(BSDR("CLN"),BSDR("ADT"),BSDR("LEN")) 112 115 ; 113 116 ; call event driver … … 327 330 ; get user who made appt and date appt made from ^SC 328 331 ; because data in ^SC will be deleted 332 ; Appointment Length: ditto 329 333 NEW USER,DATE 330 334 S USER=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,6) 331 335 S DATE=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,7) 336 N BSDXLEN S BSDXLEN=$$APPLEN(DFN,SDCL,SDT) ; appt length 332 337 ; 333 338 ; update file 2 info --old code; keep for reference … … 350 355 I $D(BSDXERR) Q 1_U_"Cannot cancel appointment in File 2" 351 356 ; Failure point 1: If we fail here, nothing has happened yet. 352 ; No rollback needed in ^BSDXAPPT353 357 ; 354 358 ; delete data in ^SC -- this does not (typically) fail. Fileman won't stop … … 359 363 ; Failure point 2: not expected to happen here 360 364 ; 365 ; Update PIMS availability -- this doesn't fail. Global gets/sets only. 366 D AVUPDTCN^BSDXAPI1(SDCL,SDT,BSDXLEN) 367 ; 361 368 ; call event driver -- point of no return 362 369 D CANCEL^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDCPHDL) 370 ; 363 371 Q 0 364 372 ; -
Scheduling/trunk/m/BSDXAPI1.m
r1466 r1467 1 BSDXAPI1 ; VEN/SMH - SCHEDULING APIs - Continued!!! ; 7/ 3/12 12:37pm1 BSDXAPI1 ; VEN/SMH - SCHEDULING APIs - Continued!!! ; 7/5/12 12:55pm 2 2 ;;1.7T1;BSDX;;Aug 31, 2011;Build 18 3 3 ; Licensed under LGPL … … 42 42 ; CANCELCK exists for the same purpose. 43 43 ; CHECKINK ditto 44 ; New API: $$NO WSHOW^BSDXAPI1 for no-showing patients44 ; New API: $$NOSHOW^BSDXAPI1 for no-showing patients 45 45 ; Moved RMCI from BSDXAPI to BSDXAPI1 because BSDXAPI1 is getting larger 46 46 ; than 20000 characters. 47 ; Added RMCICK (Remove check-in check) 48 ; Moved Availability update EPs in BSDX07 and BSDX08 b/c they really 49 ; belong to PIMS, not to the Scheduling GUI. $$MAKE and $$CANCEL now 50 ; call the EPs here. 47 51 ; 48 52 NOSHOW(PAT,CLINIC,DATE,NSFLAG) ; $$ PEP; No-show Patient at appt date (new in v1.7) … … 125 129 D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL) 126 130 ; 131 ; M Error Test - Simulate behavior when an M error occurs 132 I $G(BSDXDIE2) N X S X=1/0 133 ; 134 ; Simulate a failure to file the data in Fileman 135 I $D(BSDXSIMERR3) Q 1_U_"Simulated Error" 136 ; 127 137 ; remove check-in using filer. 128 138 N BSDXIENS S BSDXIENS=SDDA_","_DATE_","_CLINIC_"," … … 150 160 ; Output: 0 if okay or 1 if error 151 161 ; 162 ; Error for Unit Tests 163 I $G(BSDXSIMERR2) Q 1_U_"Simulated Error" 164 ; 152 165 ; Get appointment IEN in ^SC(DA(2),"S",DA(1),1, 153 166 N SCIEN S SCIEN=$$SCIEN^BSDXAPI(PAT,CLINIC,DATE) 154 167 ; 155 ; If not there, it has been cancelled. 168 ; If not there, it has been cancelled. Okay to Remove Check-in. 156 169 I 'SCIEN QUIT 0 157 170 ; … … 182 195 QUIT 0 183 196 ; 197 AVUPDTCN(BSDXSCD,BSDXSTART,BSDXLEN) ;Update PIMS Clinic availability for cancel 198 ; NB: VEN/SMH: This code has never been tested. It's here for its 199 ; presumptive function, but I don't know whether it works accurately! 200 ;See SDCNP0 201 N SD,S ; Start Date 202 S (SD,S)=BSDXSTART 203 N I ; Clinic IEN in 44 204 S I=BSDXSCD 205 ; if day has no schedule in legacy PIMS, forget about this update. 206 Q:'$D(^SC(I,"ST",SD\1,1)) 207 N SL ; Clinic characteristics node (length of appt, when appts start etc) 208 S SL=^SC(I,"SL") 209 N X ; Hour Clinic Display Begins 210 S X=$P(SL,U,3) 211 N STARTDAY ; When does the day start? 212 S STARTDAY=$S($L(X):X,1:8) ; If defined, use it; otherwise, 8am 213 N SB ; ?? Who knows? Day Start - 1 divided by 100. 214 S SB=STARTDAY-1/100 215 S X=$P(SL,U,6) ; Now X is Display increments per hour 216 N HSI ; Slots per hour, try 1 217 S HSI=$S(X:X,1:4) ; if defined, use it; otherwise, 4 218 N SI ; Slots per hour, try 2 219 S SI=$S(X="":4,X<3:4,X:X,1:4) ; If slots "", or less than 3, then 4 220 N STR ; ?? 221 S STR="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz" 222 N SDDIF ; Slots per hour diff?? 223 S SDDIF=$S(HSI<3:8/HSI,1:2) 224 S SL=BSDXLEN ; Dammit, reusing variable; SL now Appt Length from GUI 225 S S=^SC(I,"ST",SD\1,1) ; reusing var again; S now Day Pattern from PIMS 226 N Y ; Hours since start of Date 227 S Y=SD#1-SB*100 ;SD#1=FM Time portion; -SB minus start of day; conv to hrs 228 N ST ; ?? 229 ; Y#1 -> Minutes; *SI -> * Slots per hour; \.6 trunc min to hour 230 ; Y\1 -> Hours since start of day; * SI: * slots 231 S ST=Y#1*SI\.6+(Y\1*SI) 232 N SS ; how many slots are supposed to be taken by appointment 233 S SS=SL*HSI/60 ; (nb: try SL: 30 min; HSI: 4 slots) 234 N I 235 I Y'<1 D ; If Hours since start of Date is greater than 1 236 . ; loop through pattern. Tired of documenting. 237 . F I=ST+ST:SDDIF D Q:Y="" Q:SS'>0 238 . . S Y=$E(STR,$F(STR,$E(S,I+1))) Q:Y="" 239 . . S S=$E(S,1,I)_Y_$E(S,I+2,999) 240 . . S SS=SS-1 241 . . Q:SS'>0 242 S ^SC(BSDXSCD,"ST",SD\1,1)=S ; new pattern; global set 243 Q 244 ; 245 AVUPDTMK(BSDXSCD,BSDXSTART,BSDXLEN) ; Update RPMS Clinic availability for Make 246 ;SEE SDM1 247 N Y,DFN 248 N SL,STARTDAY,X,SC,SB,HSI,SI,STR,SDDIF,SDMAX,SDDATE,SDDMAX,SDSDATE,CCXN,MXOK,COV,SDPROG 249 N X1,SDEDT,X2,SD,SM,SS,S,SDLOCK,ST,I 250 S Y=BSDXSCD,DFN=BSDXPATID 251 S SL=$G(^SC(+Y,"SL")),X=$P(SL,U,3),STARTDAY=$S($L(X):X,1:8),SC=Y,SB=STARTDAY-1/100,X=$P(SL,U,6),HSI=$S(X=1:X,X:X,1:4),SI=$S(X="":4,X<3:4,X:X,1:4),STR="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz",SDDIF=$S(HSI<3:8/HSI,1:2) K Y 252 ;Determine maximum days for scheduling 253 S SDMAX(1)=$P($G(^SC(+SC,"SDP")),U,2) S:'SDMAX(1) SDMAX(1)=365 254 S (SDMAX,SDDMAX)=$$FMADD^XLFDT(DT,SDMAX(1)) 255 S SDDATE=BSDXSTART 256 S SDSDATE=SDDATE,SDDATE=SDDATE\1 257 1 ;L Q:$D(SDXXX) S CCXN=0 K MXOK,COV,SDPROT Q:DFN<0 S SC=+SC 258 Q:$D(SDXXX) S CCXN=0 K MXOK,COV,SDPROT Q:DFN<0 S SC=+SC 259 S X1=DT,SDEDT=365 S:$D(^SC(SC,"SDP")) SDEDT=$P(^SC(SC,"SDP"),"^",2) 260 S X2=SDEDT D C^%DTC S SDEDT=X 261 S Y=BSDXSTART 262 EN1 S (X,SD)=Y,SM=0 D DOW 263 S I '$D(^SC(SC,"ST",$P(SD,"."),1)) S SS=+$O(^SC(+SC,"T"_Y,SD)) Q:SS'>0 Q:^(SS,1)="" S ^SC(+SC,"ST",$P(SD,"."),1)=$E($P($T(DAY),U,Y+2),1,2)_" "_$E(SD,6,7)_$J("",SI+SI-6)_^(1),^(0)=$P(SD,".") 264 S S=BSDXLEN 265 ;Check if BSDXLEN evenly divisible by appointment length 266 S RPMSL=$P(SL,U) 267 I BSDXLEN<RPMSL S BSDXLEN=RPMSL 268 I BSDXLEN#RPMSL'=0 D 269 . S BSDXINC=BSDXLEN\RPMSL 270 . S BSDXINC=BSDXINC+1 271 . S BSDXLEN=RPMSL*BSDXINC 272 S SL=S_U_$P(SL,U,2,99) 273 SC S SDLOCK=$S('$D(SDLOCK):1,1:SDLOCK+1) Q:SDLOCK>9 274 L +^SC(SC,"ST",$P(SD,"."),1):5 G:'$T SC 275 S SDLOCK=0,S=^SC(SC,"ST",$P(SD,"."),1) 276 S I=SD#1-SB*100,ST=I#1*SI\.6+($P(I,".")*SI),SS=SL*HSI/60*SDDIF+ST+ST 277 I (I<1!'$F(S,"["))&(S'["CAN") L -^SC(SC,"ST",$P(SD,"."),1) Q 278 I SM<7 S %=$F(S,"[",SS-1) S:'%!($P(SL,"^",6)<3) %=999 I $F(S,"]",SS)'<%!(SDDIF=2&$E(S,ST+ST+1,SS-1)["[") S SM=7 279 ; 280 SP I ST+ST>$L(S),$L(S)<80 S S=S_" " G SP 281 S SDNOT=1 282 S ABORT=0 283 F I=ST+ST:SDDIF:SS-SDDIF D Q:ABORT 284 . S ST=$E(S,I+1) S:ST="" ST=" " 285 . S Y=$E(STR,$F(STR,ST)-2) 286 . I S["CAN"!(ST="X"&($D(^SC(+SC,"ST",$P(SD,"."),"CAN")))) S ABORT=1 Q 287 . I Y="" S ABORT=1 Q 288 . S:Y'?1NL&(SM<6) SM=6 S ST=$E(S,I+2,999) S:ST="" ST=" " S S=$E(S,1,I)_Y_ST 289 . Q 290 S ^SC(SC,"ST",$P(SD,"."),1)=S 291 L -^SC(SC,"ST",$P(SD,"."),1) 292 Q 293 DAY ;;^SUN^MON^TUES^WEDNES^THURS^FRI^SATUR 294 ; 295 DOW S %=$E(X,1,3),Y=$E(X,4,5),Y=Y>2&'(%#4)+$E("144025036146",Y) 296 F %=%:-1:281 S Y=%#4=1+1+Y 297 S Y=$E(X,6,7)+Y#7 298 Q 299 ; -
Scheduling/trunk/m/BSDXUT2.m
r1466 r1467 1 BSDXUT2 ; VEN/SMH - Unit Tests for Scheduling GUI - cont. ; 7/ 3/12 12:03pm1 BSDXUT2 ; VEN/SMH - Unit Tests for Scheduling GUI - cont. ; 7/5/12 11:39am 2 2 ;;1.7T1;BSDX;;Aug 31, 2011;Build 18 3 3 ; … … 65 65 IF +^BSDXTMP($J,1)'=-100 WRITE "ERROR IN Etest 9",! 66 66 K BSDXDIE2 67 ; M Error in $$RMCI^BSDXAPI1 68 N BSDXDIE2 S BSDXDIE2=1 69 D RMCI^BSDX25(.ZZZ,APPTID) 70 IF +^BSDXTMP($J,1)'=-100 WRITE "ERROR IN Etest 13",! 71 K BSDXDIE2 67 72 ; 68 73 ; Get start and end times … … 100 105 IF $P(^BSDXAPPT(APPTID,0),U,3) WRITE "ERROR IN CHECKIN 115",! 101 106 IF +$G(^SC(HL,"S",APPTTIME,1,1,"C")) WRITE "ERROR IN CHECKIN 116",! 107 K BSDXSIMERR3 108 ; 109 ; Check-in for real for the subsequent tests 110 D CHECKIN^BSDX25(.ZZZ,APPTID,$$NOW^XLFDT()) ; Check-in first! 111 IF '$P(^BSDXAPPT(APPTID,0),U,3) WRITE "ERROR IN CHECKIN 1110",! 112 IF '+$G(^SC(HL,"S",APPTTIME,1,1,"C")) WRITE "ERROR IN RMCI 1120",! 113 ; 114 ; Simulated Error in $$BSDXCHK^BSDX25; This time for remove check-in 115 N BSDXSIMERR1 S BSDXSIMERR1=1 116 D RMCI^BSDX25(.ZZZ,APPTID) 117 IF +^BSDXTMP($J,1)'=-6 WRITE "ERROR in Etest 14",! 118 IF '$P(^BSDXAPPT(APPTID,0),U,3) WRITE "ERROR IN RMCI 111",! 119 IF '+$G(^SC(HL,"S",APPTTIME,1,1,"C")) WRITE "ERROR IN RMCI 112",! 120 K BSDXSIMERR1 121 ; 122 ; Simulated Error in $$RMCICK^BSDXAPI1 123 N BSDXSIMERR2 S BSDXSIMERR2=1 124 D RMCI^BSDX25(.ZZZ,APPTID) 125 IF +^BSDXTMP($J,1)'=-5 WRITE "ERROR in Etest 15",! 126 IF '$P(^BSDXAPPT(APPTID,0),U,3) WRITE "ERROR IN RMCI 113",! 127 IF '+$G(^SC(HL,"S",APPTTIME,1,1,"C")) WRITE "ERROR IN RMCI 114",! 128 K BSDXSIMERR2 129 ; 130 ; Simulated Error in $$RMCI^BSDXAPI1 131 N BSDXSIMERR3 S BSDXSIMERR3=1 132 D RMCI^BSDX25(.ZZZ,APPTID) 133 IF +^BSDXTMP($J,1)'=-5 WRITE "ERROR in Etest 16",! 134 IF '$P(^BSDXAPPT(APPTID,0),U,3) WRITE "ERROR IN RMCI 115",! 135 IF '+$G(^SC(HL,"S",APPTTIME,1,1,"C")) WRITE "ERROR IN RMCI 116",! 102 136 K BSDXSIMERR3 103 137 ;
Note:
See TracChangeset
for help on using the changeset viewer.
