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.
This commit is contained in:
sam
parent
fba588405f
commit
f3701ce2bf
64
m/BSDX07.m
64
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 BSDXLEN<RPMSL S BSDXLEN=RPMSL
|
||||
I BSDXLEN#RPMSL'=0 D
|
||||
. S BSDXINC=BSDXLEN\RPMSL
|
||||
. S BSDXINC=BSDXINC+1
|
||||
. S BSDXLEN=RPMSL*BSDXINC
|
||||
S SL=S_U_$P(SL,U,2,99)
|
||||
SC S SDLOCK=$S('$D(SDLOCK):1,1:SDLOCK+1) Q:SDLOCK>9
|
||||
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
|
||||
|
|
|
|||
65
m/BSDX08.m
65
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
|
||||
|
|
|
|||
53
m/BSDX25.m
53
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")
|
||||
|
|
|
|||
12
m/BSDXAPI.m
12
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?
|
||||
|
|
|
|||
122
m/BSDXAPI1.m
122
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 BSDXLEN<RPMSL S BSDXLEN=RPMSL
|
||||
I BSDXLEN#RPMSL'=0 D
|
||||
. S BSDXINC=BSDXLEN\RPMSL
|
||||
. S BSDXINC=BSDXINC+1
|
||||
. S BSDXLEN=RPMSL*BSDXINC
|
||||
S SL=S_U_$P(SL,U,2,99)
|
||||
SC S SDLOCK=$S('$D(SDLOCK):1,1:SDLOCK+1) Q:SDLOCK>9
|
||||
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
|
||||
;
|
||||
|
|
|
|||
36
m/BSDXUT2.m
36
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
|
||||
|
|
|
|||
Loading…
Reference in New Issue