Changeset 1467 for Scheduling/trunk/m/BSDX07.m
- Timestamp:
- Jul 5, 2012, 7:42:34 PM (12 years ago)
- File:
-
- 1 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
Note:
See TracChangeset
for help on using the changeset viewer.