From f3701ce2bf0d2dd05846190bde1585218c7c3e1d Mon Sep 17 00:00:00 2001 From: sam Date: Thu, 5 Jul 2012 23:42:34 +0000 Subject: [PATCH] BSDX25 refactoring is done; moved PIMS availability change logic from BSDX07 and BSDX08 to BSDXAPI*.m. Calling these has moved from BSDX07 and BSDX08 to 1926MAKE and 1926CANCEL^BSDXAPI. --- m/BSDX07.m | 64 ++------------------------- m/BSDX08.m | 65 +++------------------------ m/BSDX25.m | 53 +++++++++++++++------- m/BSDXAPI.m | 12 ++++- m/BSDXAPI1.m | 122 +++++++++++++++++++++++++++++++++++++++++++++++++-- m/BSDXUT2.m | 36 ++++++++++++++- 6 files changed, 211 insertions(+), 141 deletions(-) diff --git a/m/BSDX07.m b/m/BSDX07.m index ee5529c..1a55a45 100644 --- a/m/BSDX07.m +++ b/m/BSDX07.m @@ -1,4 +1,4 @@ -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 ; @@ -11,6 +11,7 @@ BSDX07 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 6/21/12 3:54pm ; It could be midnight of the next day ; 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: ; -1: Patient Record is locked. This means something is wrong!!!! @@ -57,7 +58,7 @@ APPADD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID,BSDXR ; AppointmentID and ErrorNumber ; ; NB: Specifying BSDXLEN and BSDXEND is redundant. For future programmers - ; to sort out + ; to sort out. Needs changes on client. ; ;Test lines: ;BSDX ADD NEW APPOINTMENT^3091122.0930^3091122.1000^370^Dr Office^30^EXAM^WALKIN @@ -161,8 +162,6 @@ APPADD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID,BSDXR ; NB: $$MAKE itself calls $$MAKECK to check again for being okay. 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 L -^BSDXAPPT(BSDXPATID) @@ -243,7 +242,7 @@ ROLLBACK(BSDXAPPTID,BSDXC) ; Private EP; Roll back appointment set ; Input: ; 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) S:$D(BSDXC) %=$$UNMAKE^BSDXAPI(.BSDXC) ; rtn value always 0 @@ -275,58 +274,3 @@ ETRAP ;EP Error trap entry D ERR(BSDXI,"-100~BSDX07 Error: "_$G(%ZTERZE)) 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 diff --git a/m/BSDX08.m b/m/BSDX08.m index d9b521e..b526b55 100644 --- a/m/BSDX08.m +++ b/m/BSDX08.m @@ -1,4 +1,4 @@ -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 ; ; Original by HMW. New Written by Sam Habiel. Licensed under LGPL. @@ -15,6 +15,8 @@ BSDX08 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 6/26/12 10:49am ; ; 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: ; -1~BSDX08: Appt record is locked. Please contact technical support. @@ -127,18 +129,9 @@ APPDEL(BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT) ;EP ; cancel appt in "S" nodes in file 2 and 44, then update Legacy PIMS Availability ; 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) S BSDXI=BSDXI+1 @@ -147,52 +140,6 @@ APPDEL(BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT) ;EP 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 - ; BSDXCAN(BSDXAPTID) ; $$; Private; Cancel BSDX APPOINTMENT entry ; Input: Appt IEN in ^BSDXAPPT ; Output: 0 for success and 1^Msg for failure @@ -253,6 +200,8 @@ CANEVT3(BSDXRES) ; Q ; 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,"^","~") S ^BSDXTMP($J,BSDXI)=BSDXERR_$C(30) @@ -264,9 +213,9 @@ ERR(BSDXI,BSDXERR) ;Error processing ETRAP ;EP Error trap entry 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 I '$D(BSDXI) N BSDXI S BSDXI=0 diff --git a/m/BSDX25.m b/m/BSDX25.m index f28c580..a17351f 100644 --- a/m/BSDX25.m +++ b/m/BSDX25.m @@ -1,9 +1,12 @@ -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 ; ; 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 ; ; CHECKIND(BSDXY,BSDXAPPTID,BSDXCDT,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG) ;EP @@ -159,26 +162,42 @@ RMCI(BSDXY,BSDXAPPTID) ; EP - Remove Check-in from BSDX APPT and 2/44 I '+$G(BSDXAPPTID) D ERR("-1~Invalid Appointment ID") QUIT I '$D(^BSDXAPPT(BSDXAPPTID,0)) D ERR("-2~Invalid Appointment ID") QUIT ; + ; 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 BSDXRESID S BSDXRESID=$P(BSDXNOD,U,7) ; Resource ID + ; + ; If the resource doesn't exist, error out. DB is corrupt. + 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 - 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 - ; - ; 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 + ; 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 S BSDXI=BSDXI+1 @@ -237,7 +256,7 @@ ERROR ; ; undo or redo the check-in. ; 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 D ERR("-100~Mumps Error") diff --git a/m/BSDXAPI.m b/m/BSDXAPI.m index aa610d9..ee3fe19 100644 --- a/m/BSDXAPI.m +++ b/m/BSDXAPI.m @@ -1,4 +1,4 @@ -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,6 +110,9 @@ MAKE(BSDR) ;PEP; call to store appt made ;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 NEW DFN,SDT,SDCL,SDDA,SDMODE S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2 @@ -326,9 +329,11 @@ CANCEL(BSDR) ;PEP; called to cancel appt ; ; 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 ;NEW DIE,DA,DR @@ -349,7 +354,6 @@ CANCEL(BSDR) ;PEP; called to cancel appt D FILE^DIE("","BSDXFDA","BSDXERR") 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 NEW DIK,DA @@ -358,8 +362,12 @@ CANCEL(BSDR) ;PEP; called to cancel appt D ^DIK ; 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 ; CANCELCK(BSDR) ; $$ PEP; Okay to Cancel Appointment? diff --git a/m/BSDXAPI1.m b/m/BSDXAPI1.m index 011f90e..e3fc822 100644 --- a/m/BSDXAPI1.m +++ b/m/BSDXAPI1.m @@ -1,4 +1,4 @@ -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 ; @@ -41,9 +41,13 @@ BSDXAPI1 ; VEN/SMH - SCHEDULING APIs - Continued!!! ; 7/3/12 12:37pm ; actually make the appointment. ; 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) ; PAT = DFN @@ -124,6 +128,12 @@ RMCI(PAT,CLINIC,DATE) ;PEP; -- Remove Check-in; $$ S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL 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_"," N BSDXFDA @@ -149,10 +159,13 @@ RMCICK(PAT,CLINIC,DATE) ;PEP; Can you remove a check-in for this patient? ; DATE - Appointment Date ; 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 ; ; Check if checked out @@ -181,3 +194,106 @@ UPDATENT(PAT,CLINIC,DATE,NOTE) ; PEP; Update Note in ^SC for patient's appointme I $D(BSDXERR) QUIT "-1~Can't file for Pat "_PAT_" in Clinic "_CLINIC_" at "_DATE_". Fileman reported an error: "_BSDXERR("DIERR",1,"TEXT",1) 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 + ; diff --git a/m/BSDXUT2.m b/m/BSDXUT2.m index 3b3a88a..df417e2 100644 --- a/m/BSDXUT2.m +++ b/m/BSDXUT2.m @@ -1,4 +1,4 @@ -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 ; EN ; Run all unit tests in this routine @@ -64,6 +64,11 @@ UT25 ; Unit Tests for BSDX25 D CHECKIN^BSDX25(.ZZZ,APPTID,$$NOW^XLFDT()) 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 N TIMES S TIMES=$$TIMES^BSDXUT ; appt time^end time @@ -101,6 +106,35 @@ UT25 ; Unit Tests for BSDX25 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 + ; ; Unlinked Clinic Tests N RESNAM S RESNAM="UTCLINICUL" ; Unlinked Clinic N RESIEN