Index: Scheduling/trunk/m/BSDX07.m =================================================================== --- Scheduling/trunk/m/BSDX07.m (revision 1466) +++ Scheduling/trunk/m/BSDX07.m (revision 1467) @@ -1,3 +1,3 @@ -BSDX07 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 6/21/12 3:54pm +BSDX07 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 7/5/12 12:57pm ;;1.7T1;BSDX;;Aug 31, 2011;Build 18 ; Licensed under LGPL @@ -12,4 +12,5 @@ ; v1.6 Apr 11 2011 - Support for Scheduling Radiology Exams... ; v1.7 Jun 20 2012 - Refactoring to remove transactions - many changes + ; - AVUPDT moved to AVUPDTMK in BSDXAPI1 ; ; Error Reference: @@ -58,5 +59,5 @@ ; ; NB: Specifying BSDXLEN and BSDXEND is redundant. For future programmers - ; to sort out + ; to sort out. Needs changes on client. ; ;Test lines: @@ -162,6 +163,4 @@ 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 . S BSDXERR=$$MAKE^BSDXAPI(.BSDXC) - . Q:BSDXERR - . D AVUPDT(BSDXSCD,BSDXSTART,BSDXLEN) ; Update RPMS Clinic availability ; ;Return Recordset @@ -244,5 +243,5 @@ ; Appointment ID to remove from ^BSDXAPPT ; BSDXC array (see array format in $$MAKE^BSDXAPI) - ; NB: I am not sure whether I want to do $G to protect?? + ; NB: I am not sure whether I want to do $G to protect against undefs? ; I send the variables to this EP from the Symbol Table in ETRAP D BSDXDEL^BSDX07(BSDXAPPTID) @@ -276,57 +275,2 @@ Q:$Q 1_U_"Mumps Error" Q ; -DAY ;;^SUN^MON^TUES^WEDNES^THURS^FRI^SATUR - ; -DOW S %=$E(X,1,3),Y=$E(X,4,5),Y=Y>2&'(%#4)+$E("144025036146",Y) - F %=%:-1:281 S Y=%#4=1+1+Y - S Y=$E(X,6,7)+Y#7 - Q - ; -AVUPDT(BSDXSCD,BSDXSTART,BSDXLEN) ;Update RPMS Clinic availability - ;SEE SDM1 - N Y,DFN - N SL,STARTDAY,X,SC,SB,HSI,SI,STR,SDDIF,SDMAX,SDDATE,SDDMAX,SDSDATE,CCXN,MXOK,COV,SDPROG - N X1,SDEDT,X2,SD,SM,SS,S,SDLOCK,ST,I - S Y=BSDXSCD,DFN=BSDXPATID - 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 - ;Determine maximum days for scheduling - S SDMAX(1)=$P($G(^SC(+SC,"SDP")),U,2) S:'SDMAX(1) SDMAX(1)=365 - S (SDMAX,SDDMAX)=$$FMADD^XLFDT(DT,SDMAX(1)) - S SDDATE=BSDXSTART - S SDSDATE=SDDATE,SDDATE=SDDATE\1 -1 ;L Q:$D(SDXXX) S CCXN=0 K MXOK,COV,SDPROT Q:DFN<0 S SC=+SC - Q:$D(SDXXX) S CCXN=0 K MXOK,COV,SDPROT Q:DFN<0 S SC=+SC - S X1=DT,SDEDT=365 S:$D(^SC(SC,"SDP")) SDEDT=$P(^SC(SC,"SDP"),"^",2) - S X2=SDEDT D C^%DTC S SDEDT=X - S Y=BSDXSTART -EN1 S (X,SD)=Y,SM=0 D DOW -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,".") - S S=BSDXLEN - ;Check if BSDXLEN evenly divisible by appointment length - S RPMSL=$P(SL,U) - I BSDXLEN9 - L +^SC(SC,"ST",$P(SD,"."),1):5 G:'$T SC - S SDLOCK=0,S=^SC(SC,"ST",$P(SD,"."),1) - S I=SD#1-SB*100,ST=I#1*SI\.6+($P(I,".")*SI),SS=SL*HSI/60*SDDIF+ST+ST - I (I<1!'$F(S,"["))&(S'["CAN") L -^SC(SC,"ST",$P(SD,"."),1) Q - 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 - ; -SP I ST+ST>$L(S),$L(S)<80 S S=S_" " G SP - S SDNOT=1 - S ABORT=0 - F I=ST+ST:SDDIF:SS-SDDIF D Q:ABORT - . S ST=$E(S,I+1) S:ST="" ST=" " - . S Y=$E(STR,$F(STR,ST)-2) - . I S["CAN"!(ST="X"&($D(^SC(+SC,"ST",$P(SD,"."),"CAN")))) S ABORT=1 Q - . I Y="" S ABORT=1 Q - . 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 - . Q - S ^SC(SC,"ST",$P(SD,"."),1)=S - L -^SC(SC,"ST",$P(SD,"."),1) - Q Index: Scheduling/trunk/m/BSDX08.m =================================================================== --- Scheduling/trunk/m/BSDX08.m (revision 1466) +++ Scheduling/trunk/m/BSDX08.m (revision 1467) @@ -1,3 +1,3 @@ -BSDX08 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 6/26/12 10:49am +BSDX08 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 7/5/12 12:39pm ;;1.7T1;BSDX;;Aug 31, 2011;Build 18 ; @@ -16,4 +16,6 @@ ; 3120625 VEN/SMH v1.7 ; - Transactions removed. Code refactored to work w/o txns. + ; - Moved AVUPDT to AVUPDTCN in BSDXAPI1. BSDXAPI takes care of calling + ; that. ; ; Error Reference: @@ -128,16 +130,7 @@ ; If error happens, must rollback ^BSDXAPPT I BSDXLOC D QUIT:BSDXERR - . N BSDXLEN S BSDXLEN=$$APPLEN^BSDXAPI(BSDXPATID,BSDXLOC,BSDXSTART) ; appt length . S BSDXERR=$$CANCEL^BSDXAPI(.BSDXC) ; Cancel through BSDXAPI . ; Rollback BSDXAPPT if error occurs - . ; TODO: If an M error occurs in BSDXAPI, ETRAP gets called, ^BSDXTMP is - . ; populated, then the output of $$CANCEL is the output of ETRAP. - . ; Then, we see that BSDXERR is true, and we do another write, - . ; which deletes the information we had in ^BSDXTMP. What to do??? . I BSDXERR D ERR(BSDXI,"-9^BSDX08: BSDXAPI returned an error: "_$P(BSDXERR,U,2)),ROLLBACK(BSDXAPTID) QUIT - . ; - . ; Update Legacy PIMS clinic Availability ; no failure expected here. - . D AVUPDT(BSDXLOC,BSDXSTART,BSDXLEN) - ; ; L -^BSDXAPPT(BSDXAPTID) @@ -146,50 +139,4 @@ S BSDXI=BSDXI+1 S ^BSDXTMP($J,BSDXI)=$C(31) - Q - ; -AVUPDT(BSDXSCD,BSDXSTART,BSDXLEN) ;Update Legacy PIMS Clinic availability - ;See SDCNP0 - N SD,S ; Start Date - S (SD,S)=BSDXSTART - N I ; Clinic IEN in 44 - S I=BSDXSCD - ; if day has no schedule in legacy PIMS, forget about this update. - Q:'$D(^SC(I,"ST",SD\1,1)) - N SL ; Clinic characteristics node (length of appt, when appts start etc) - S SL=^SC(I,"SL") - N X ; Hour Clinic Display Begins - S X=$P(SL,U,3) - N STARTDAY ; When does the day start? - S STARTDAY=$S($L(X):X,1:8) ; If defined, use it; otherwise, 8am - N SB ; ?? Who knows? Day Start - 1 divided by 100. - S SB=STARTDAY-1/100 - S X=$P(SL,U,6) ; Now X is Display increments per hour - N HSI ; Slots per hour, try 1 - S HSI=$S(X:X,1:4) ; if defined, use it; otherwise, 4 - N SI ; Slots per hour, try 2 - S SI=$S(X="":4,X<3:4,X:X,1:4) ; If slots "", or less than 3, then 4 - N STR ; ?? - S STR="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz" - N SDDIF ; Slots per hour diff?? - S SDDIF=$S(HSI<3:8/HSI,1:2) - S SL=BSDXLEN ; Dammit, reusing variable; SL now Appt Length from GUI - S S=^SC(I,"ST",SD\1,1) ; reusing var again; S now Day Pattern from PIMS - N Y ; Hours since start of Date - S Y=SD#1-SB*100 ;SD#1=FM Time portion; -SB minus start of day; conv to hrs - N ST ; ?? - ; Y#1 -> Minutes; *SI -> * Slots per hour; \.6 trunc min to hour - ; Y\1 -> Hours since start of day; * SI: * slots - S ST=Y#1*SI\.6+(Y\1*SI) - N SS ; how many slots are supposed to be taken by appointment - S SS=SL*HSI/60 ; (nb: try SL: 30 min; HSI: 4 slots) - N I - I Y'<1 D ; If Hours since start of Date is greater than 1 - . ; loop through pattern. Tired of documenting. - . F I=ST+ST:SDDIF D Q:Y="" Q:SS'>0 - . . S Y=$E(STR,$F(STR,$E(S,I+1))) Q:Y="" - . . S S=$E(S,1,I)_Y_$E(S,I+2,999) - . . S SS=SS-1 - . . Q:SS'>0 - S ^SC(BSDXSCD,"ST",SD\1,1)=S ; new pattern; global set Q ; @@ -254,4 +201,6 @@ ; ERR(BSDXI,BSDXERR) ;Error processing + ; If last line is $C(31), we are done. No more errors to send to client. + I ^BSDXTMP($J,$O(^BSDXTMP($J," "),-1))=$C(31) QUIT S BSDXI=BSDXI+1 S BSDXERR=$TR(BSDXERR,"^","~") @@ -265,7 +214,7 @@ N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap D ^%ZTER - S $EC="" ; Clear Error ; Roll back BSDXAPPT; - ; TODO: What if a Mumps error happens in fileman in BSDXAPI? The Scheduling files can potentially be out of sync + ; NB: What if a Mumps error happens inside fileman in BSDXAPI? + ; I have decided the M errors are out of scope for me to handle. D:$G(BSDXAPTID) ROLLBACK(BSDXAPTID) ; Log error message and send to client Index: Scheduling/trunk/m/BSDX25.m =================================================================== --- Scheduling/trunk/m/BSDX25.m (revision 1466) +++ Scheduling/trunk/m/BSDX25.m (revision 1467) @@ -1,3 +1,3 @@ -BSDX25 ; VEN/SMH - WINDOWS SCHEDULING RPCS ; 7/3/12 12:27pm +BSDX25 ; VEN/SMH - WINDOWS SCHEDULING RPCS ; 7/5/12 11:55am ;;1.7T1;BSDX;;Aug 31, 2011;Build 18 ; Licensed under LGPL @@ -5,4 +5,7 @@ ; Change Log: ; 3110106: SMH -> Changed Check-in EP - Removed unused paramters. Will change C# + ; 3120630: VEN/SMH -> Extensive Refactoring to remove transactions. + ; -> Functionality still the same. + ; -> Unit Tests in UT25^BSDXUT2 ; ; @@ -160,24 +163,40 @@ I '$D(^BSDXAPPT(BSDXAPPTID,0)) D ERR("-2~Invalid Appointment ID") QUIT ; - ; Remove checkin from BSDX APPOINTMENT entry - N BSDXERR S BSDXERR=$$BSDXCHK(BSDXAPPTID,"@") - I BSDXERR D ERR("-6~Cannot file data in $$BSDXCHK") QUIT - ; - ; Now, remove checkin from PIMS files 2/44 + ; Get appointment Data N BSDXNOD S BSDXNOD=^BSDXAPPT(BSDXAPPTID,0) N BSDXPATID S BSDXPATID=$P(BSDXNOD,U,5) ; DFN N BSDXSTART S BSDXSTART=$P(BSDXNOD,U) ; Start Date - N BSDXSC1 S BSDXSC1=$P(BSDXNOD,U,7) ; Resource ID + N BSDXRESID S BSDXRESID=$P(BSDXNOD,U,7) ; Resource ID ; ; If the resource doesn't exist, error out. DB is corrupt. - I 'BSDXSC1 D ERR("-3~DB has corruption. Call Tech Support.") QUIT - I '$D(^BSDXRES(BSDXSC1,0)) D ERR("-4~DB has corruption. Call Tech Support.") QUIT - ; - N BSDXNOD S BSDXNOD=^BSDXRES(BSDXSC1,0) ; Resource 0 node - S BSDXSC1=$P(BSDXNOD,U,4) ;HOSPITAL LOCATION - ; - N BSDXZ ; Scratch variable to hold error message - I BSDXSC1]"",$D(^SC(BSDXSC1,0)) S BSDXZ=$$RMCI^BSDXAPI1(BSDXPATID,BSDXSC1,BSDXSTART) - I +$G(BSDXZ) D ERR("-5~"_$P(BSDXZ,U,2)) QUIT + I 'BSDXRESID D ERR("-3~DB has corruption. Call Tech Support.") QUIT + I '$D(^BSDXRES(BSDXRESID,0)) D ERR("-4~DB has corruption. Call Tech Support.") QUIT + ; + ; Get HL Data + N BSDXNOD S BSDXNOD=^BSDXRES(BSDXRESID,0) ; Resource 0 node + N BSDXSC1 S BSDXSC1=$P(BSDXNOD,U,4) ;HOSPITAL LOCATION IEN + I BSDXSC1,'$D(^SC(BSDXSC1,0)) S BSDXSC1="" ; Zero out if HL doesn't exist + ; + ; Is it okay to remove check-in from PIMS? + N BSDXERR S BSDXERR=0 ; Scratch variable + ; $$RMCICK = Remove Check-in Check + I BSDXSC1 S BSDXERR=$$RMCICK^BSDXAPI1(BSDXPATID,BSDXSC1,BSDXSTART) + I BSDXERR D ERR("-5~"_$P(BSDXERR,U,2)) QUIT + ; + ; For possible rollback, get old check-in date (internal value) + N BSDXCDT S BSDXCDT=$$GET1^DIQ(9002018.4,BSDXAPPTID_",",.03,"I") + ; + ; Remove checkin from BSDX APPOINTMENT entry + ; No need to rollback here on failure. + N BSDXERR S BSDXERR=$$BSDXCHK(BSDXAPPTID,"@") + I BSDXERR D ERR("-6~Cannot file data in $$BSDXCHK") QUIT + ; + ; Now, remove checkin from PIMS files 2/44 + ; Restore BSDXCDT into ^BSDXAPPT if we fail. + N BSDXERR S BSDXERR=0 ; Scratch variable to hold error message + I BSDXSC1 S BSDXERR=$$RMCI^BSDXAPI1(BSDXPATID,BSDXSC1,BSDXSTART) + I BSDXERR D QUIT + . N % S %=$$BSDXCHK(BSDXAPPTID,BSDXCDT) ; No error checking here. + . D ERR("-5~"_$P(BSDXERR,U,2)) ; Send error message to client ; ; Return ADO recordset @@ -238,5 +257,5 @@ ; Individual portions of this routine may choose to do rolling back ; of their own (e.g. a failed call to BSDXAPI causes rollback to occur - ; in CHECKIN) + ; in CHECKIN and RMCI) ; ; Log error message and send to client Index: Scheduling/trunk/m/BSDXAPI.m =================================================================== --- Scheduling/trunk/m/BSDXAPI.m (revision 1466) +++ Scheduling/trunk/m/BSDXAPI.m (revision 1467) @@ -1,3 +1,3 @@ -BSDXAPI ; IHS/ANMC/LJF & VW/SMH - SCHEDULING APIs ; 7/3/12 12:30pm +BSDXAPI ; IHS/LJF,HMW,MAW & VEN/SMH - SCHEDULING APIs ; 7/5/12 12:52pm ;;1.7T1;BSDX;;Aug 31, 2011;Build 18 ; Licensed under LGPL @@ -110,4 +110,7 @@ ;Q:$G(BSDXSIMERR5) 1_U_$NA(BSDXSIMERR5) ; Unit Test line S:$G(BSDXSIMERR5) X=1/0 + ; + ; Update the Availablilities ; Doesn't fail. Global reads and sets. + D AVUPDTMK^BSDXAPI1(BSDR("CLN"),BSDR("ADT"),BSDR("LEN")) ; ; call event driver @@ -327,7 +330,9 @@ ; get user who made appt and date appt made from ^SC ; because data in ^SC will be deleted + ; Appointment Length: ditto NEW USER,DATE S USER=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,6) S DATE=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,7) + N BSDXLEN S BSDXLEN=$$APPLEN(DFN,SDCL,SDT) ; appt length ; ; update file 2 info --old code; keep for reference @@ -350,5 +355,4 @@ I $D(BSDXERR) Q 1_U_"Cannot cancel appointment in File 2" ; Failure point 1: If we fail here, nothing has happened yet. - ; No rollback needed in ^BSDXAPPT ; ; delete data in ^SC -- this does not (typically) fail. Fileman won't stop @@ -359,6 +363,10 @@ ; Failure point 2: not expected to happen here ; + ; Update PIMS availability -- this doesn't fail. Global gets/sets only. + D AVUPDTCN^BSDXAPI1(SDCL,SDT,BSDXLEN) + ; ; call event driver -- point of no return D CANCEL^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDCPHDL) + ; Q 0 ; Index: Scheduling/trunk/m/BSDXAPI1.m =================================================================== --- Scheduling/trunk/m/BSDXAPI1.m (revision 1466) +++ Scheduling/trunk/m/BSDXAPI1.m (revision 1467) @@ -1,3 +1,3 @@ -BSDXAPI1 ; VEN/SMH - SCHEDULING APIs - Continued!!! ; 7/3/12 12:37pm +BSDXAPI1 ; VEN/SMH - SCHEDULING APIs - Continued!!! ; 7/5/12 12:55pm ;;1.7T1;BSDX;;Aug 31, 2011;Build 18 ; Licensed under LGPL @@ -42,7 +42,11 @@ ; CANCELCK exists for the same purpose. ; CHECKINK ditto - ; New API: $$NOWSHOW^BSDXAPI1 for no-showing patients + ; New API: $$NOSHOW^BSDXAPI1 for no-showing patients ; Moved RMCI from BSDXAPI to BSDXAPI1 because BSDXAPI1 is getting larger ; than 20000 characters. + ; Added RMCICK (Remove check-in check) + ; Moved Availability update EPs in BSDX07 and BSDX08 b/c they really + ; belong to PIMS, not to the Scheduling GUI. $$MAKE and $$CANCEL now + ; call the EPs here. ; NOSHOW(PAT,CLINIC,DATE,NSFLAG) ; $$ PEP; No-show Patient at appt date (new in v1.7) @@ -125,4 +129,10 @@ D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL) ; + ; M Error Test - Simulate behavior when an M error occurs + I $G(BSDXDIE2) N X S X=1/0 + ; + ; Simulate a failure to file the data in Fileman + I $D(BSDXSIMERR3) Q 1_U_"Simulated Error" + ; ; remove check-in using filer. N BSDXIENS S BSDXIENS=SDDA_","_DATE_","_CLINIC_"," @@ -150,8 +160,11 @@ ; Output: 0 if okay or 1 if error ; + ; Error for Unit Tests + I $G(BSDXSIMERR2) Q 1_U_"Simulated Error" + ; ; Get appointment IEN in ^SC(DA(2),"S",DA(1),1, N SCIEN S SCIEN=$$SCIEN^BSDXAPI(PAT,CLINIC,DATE) ; - ; If not there, it has been cancelled. + ; If not there, it has been cancelled. Okay to Remove Check-in. I 'SCIEN QUIT 0 ; @@ -182,2 +195,105 @@ QUIT 0 ; +AVUPDTCN(BSDXSCD,BSDXSTART,BSDXLEN) ;Update PIMS Clinic availability for cancel + ; NB: VEN/SMH: This code has never been tested. It's here for its + ; presumptive function, but I don't know whether it works accurately! + ;See SDCNP0 + N SD,S ; Start Date + S (SD,S)=BSDXSTART + N I ; Clinic IEN in 44 + S I=BSDXSCD + ; if day has no schedule in legacy PIMS, forget about this update. + Q:'$D(^SC(I,"ST",SD\1,1)) + N SL ; Clinic characteristics node (length of appt, when appts start etc) + S SL=^SC(I,"SL") + N X ; Hour Clinic Display Begins + S X=$P(SL,U,3) + N STARTDAY ; When does the day start? + S STARTDAY=$S($L(X):X,1:8) ; If defined, use it; otherwise, 8am + N SB ; ?? Who knows? Day Start - 1 divided by 100. + S SB=STARTDAY-1/100 + S X=$P(SL,U,6) ; Now X is Display increments per hour + N HSI ; Slots per hour, try 1 + S HSI=$S(X:X,1:4) ; if defined, use it; otherwise, 4 + N SI ; Slots per hour, try 2 + S SI=$S(X="":4,X<3:4,X:X,1:4) ; If slots "", or less than 3, then 4 + N STR ; ?? + S STR="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz" + N SDDIF ; Slots per hour diff?? + S SDDIF=$S(HSI<3:8/HSI,1:2) + S SL=BSDXLEN ; Dammit, reusing variable; SL now Appt Length from GUI + S S=^SC(I,"ST",SD\1,1) ; reusing var again; S now Day Pattern from PIMS + N Y ; Hours since start of Date + S Y=SD#1-SB*100 ;SD#1=FM Time portion; -SB minus start of day; conv to hrs + N ST ; ?? + ; Y#1 -> Minutes; *SI -> * Slots per hour; \.6 trunc min to hour + ; Y\1 -> Hours since start of day; * SI: * slots + S ST=Y#1*SI\.6+(Y\1*SI) + N SS ; how many slots are supposed to be taken by appointment + S SS=SL*HSI/60 ; (nb: try SL: 30 min; HSI: 4 slots) + N I + I Y'<1 D ; If Hours since start of Date is greater than 1 + . ; loop through pattern. Tired of documenting. + . F I=ST+ST:SDDIF D Q:Y="" Q:SS'>0 + . . S Y=$E(STR,$F(STR,$E(S,I+1))) Q:Y="" + . . S S=$E(S,1,I)_Y_$E(S,I+2,999) + . . S SS=SS-1 + . . Q:SS'>0 + S ^SC(BSDXSCD,"ST",SD\1,1)=S ; new pattern; global set + Q + ; +AVUPDTMK(BSDXSCD,BSDXSTART,BSDXLEN) ; Update RPMS Clinic availability for Make + ;SEE SDM1 + N Y,DFN + N SL,STARTDAY,X,SC,SB,HSI,SI,STR,SDDIF,SDMAX,SDDATE,SDDMAX,SDSDATE,CCXN,MXOK,COV,SDPROG + N X1,SDEDT,X2,SD,SM,SS,S,SDLOCK,ST,I + S Y=BSDXSCD,DFN=BSDXPATID + 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 + ;Determine maximum days for scheduling + S SDMAX(1)=$P($G(^SC(+SC,"SDP")),U,2) S:'SDMAX(1) SDMAX(1)=365 + S (SDMAX,SDDMAX)=$$FMADD^XLFDT(DT,SDMAX(1)) + S SDDATE=BSDXSTART + S SDSDATE=SDDATE,SDDATE=SDDATE\1 +1 ;L Q:$D(SDXXX) S CCXN=0 K MXOK,COV,SDPROT Q:DFN<0 S SC=+SC + Q:$D(SDXXX) S CCXN=0 K MXOK,COV,SDPROT Q:DFN<0 S SC=+SC + S X1=DT,SDEDT=365 S:$D(^SC(SC,"SDP")) SDEDT=$P(^SC(SC,"SDP"),"^",2) + S X2=SDEDT D C^%DTC S SDEDT=X + S Y=BSDXSTART +EN1 S (X,SD)=Y,SM=0 D DOW +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,".") + S S=BSDXLEN + ;Check if BSDXLEN evenly divisible by appointment length + S RPMSL=$P(SL,U) + I BSDXLEN9 + L +^SC(SC,"ST",$P(SD,"."),1):5 G:'$T SC + S SDLOCK=0,S=^SC(SC,"ST",$P(SD,"."),1) + S I=SD#1-SB*100,ST=I#1*SI\.6+($P(I,".")*SI),SS=SL*HSI/60*SDDIF+ST+ST + I (I<1!'$F(S,"["))&(S'["CAN") L -^SC(SC,"ST",$P(SD,"."),1) Q + 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 + ; +SP I ST+ST>$L(S),$L(S)<80 S S=S_" " G SP + S SDNOT=1 + S ABORT=0 + F I=ST+ST:SDDIF:SS-SDDIF D Q:ABORT + . S ST=$E(S,I+1) S:ST="" ST=" " + . S Y=$E(STR,$F(STR,ST)-2) + . I S["CAN"!(ST="X"&($D(^SC(+SC,"ST",$P(SD,"."),"CAN")))) S ABORT=1 Q + . I Y="" S ABORT=1 Q + . 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 + . Q + S ^SC(SC,"ST",$P(SD,"."),1)=S + L -^SC(SC,"ST",$P(SD,"."),1) + Q +DAY ;;^SUN^MON^TUES^WEDNES^THURS^FRI^SATUR + ; +DOW S %=$E(X,1,3),Y=$E(X,4,5),Y=Y>2&'(%#4)+$E("144025036146",Y) + F %=%:-1:281 S Y=%#4=1+1+Y + S Y=$E(X,6,7)+Y#7 + Q + ; Index: Scheduling/trunk/m/BSDXUT2.m =================================================================== --- Scheduling/trunk/m/BSDXUT2.m (revision 1466) +++ Scheduling/trunk/m/BSDXUT2.m (revision 1467) @@ -1,3 +1,3 @@ -BSDXUT2 ; VEN/SMH - Unit Tests for Scheduling GUI - cont. ; 7/3/12 12:03pm +BSDXUT2 ; VEN/SMH - Unit Tests for Scheduling GUI - cont. ; 7/5/12 11:39am ;;1.7T1;BSDX;;Aug 31, 2011;Build 18 ; @@ -65,4 +65,9 @@ IF +^BSDXTMP($J,1)'=-100 WRITE "ERROR IN Etest 9",! K BSDXDIE2 + ; M Error in $$RMCI^BSDXAPI1 + N BSDXDIE2 S BSDXDIE2=1 + D RMCI^BSDX25(.ZZZ,APPTID) + IF +^BSDXTMP($J,1)'=-100 WRITE "ERROR IN Etest 13",! + K BSDXDIE2 ; ; Get start and end times @@ -100,4 +105,33 @@ IF $P(^BSDXAPPT(APPTID,0),U,3) WRITE "ERROR IN CHECKIN 115",! IF +$G(^SC(HL,"S",APPTTIME,1,1,"C")) WRITE "ERROR IN CHECKIN 116",! + K BSDXSIMERR3 + ; + ; Check-in for real for the subsequent tests + D CHECKIN^BSDX25(.ZZZ,APPTID,$$NOW^XLFDT()) ; Check-in first! + IF '$P(^BSDXAPPT(APPTID,0),U,3) WRITE "ERROR IN CHECKIN 1110",! + IF '+$G(^SC(HL,"S",APPTTIME,1,1,"C")) WRITE "ERROR IN RMCI 1120",! + ; + ; Simulated Error in $$BSDXCHK^BSDX25; This time for remove check-in + N BSDXSIMERR1 S BSDXSIMERR1=1 + D RMCI^BSDX25(.ZZZ,APPTID) + IF +^BSDXTMP($J,1)'=-6 WRITE "ERROR in Etest 14",! + IF '$P(^BSDXAPPT(APPTID,0),U,3) WRITE "ERROR IN RMCI 111",! + IF '+$G(^SC(HL,"S",APPTTIME,1,1,"C")) WRITE "ERROR IN RMCI 112",! + K BSDXSIMERR1 + ; + ; Simulated Error in $$RMCICK^BSDXAPI1 + N BSDXSIMERR2 S BSDXSIMERR2=1 + D RMCI^BSDX25(.ZZZ,APPTID) + IF +^BSDXTMP($J,1)'=-5 WRITE "ERROR in Etest 15",! + IF '$P(^BSDXAPPT(APPTID,0),U,3) WRITE "ERROR IN RMCI 113",! + IF '+$G(^SC(HL,"S",APPTTIME,1,1,"C")) WRITE "ERROR IN RMCI 114",! + K BSDXSIMERR2 + ; + ; Simulated Error in $$RMCI^BSDXAPI1 + N BSDXSIMERR3 S BSDXSIMERR3=1 + D RMCI^BSDX25(.ZZZ,APPTID) + IF +^BSDXTMP($J,1)'=-5 WRITE "ERROR in Etest 16",! + IF '$P(^BSDXAPPT(APPTID,0),U,3) WRITE "ERROR IN RMCI 115",! + IF '+$G(^SC(HL,"S",APPTTIME,1,1,"C")) WRITE "ERROR IN RMCI 116",! K BSDXSIMERR3 ;