refactored BSDX26; still working on BSDX08
This commit is contained in:
sam
parent
cc6a7cc9bf
commit
73927b151b
13
m/BSDX08.m
13
m/BSDX08.m
|
|
@ -1,4 +1,4 @@
|
|||
BSDX08 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 6/22/12 4:19pm
|
||||
BSDX08 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 6/25/12 6:17pm
|
||||
;;1.7T1;BSDX;;Aug 31, 2011;Build 18
|
||||
;
|
||||
; Original by HMW. New Written by Sam Habiel. Licensed under LGPL.
|
||||
|
|
@ -93,7 +93,10 @@ APPDEL(BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT) ;EP
|
|||
I BSDXSC1="" D ERR(BSDXI,"-4~BSDX08: Cancelled appointment does not have a Resouce ID") QUIT
|
||||
I '$D(^BSDXRES(BSDXSC1,0)) D ERR(BSDXI,"-5~BSDX08: Resouce ID does not exist in BSDX RESOURCE") QUIT
|
||||
;
|
||||
; Process PIMS issues first:
|
||||
; BSDXAPPT First; todo: check for error
|
||||
D BSDXCAN(BSDXAPTID) ; Add a cancellation date in BSDX APPOINTMENT
|
||||
;
|
||||
; Process PIMS issues second:
|
||||
; cancel appt in "S" nodes in file 2 and 44, then update Legacy PIMS Availability
|
||||
; Get zero node of resouce
|
||||
N BSDXNOD S BSDXNOD=^BSDXRES(BSDXSC1,0)
|
||||
|
|
@ -119,16 +122,13 @@ APPDEL(BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT) ;EP
|
|||
. I BSDXERR D ERR(BSDXI,"-9^BSDX08: BSDXAPI returned an error: "_$P(BSDXERR,U,2)) QUIT
|
||||
. ;
|
||||
. N BSDXLEN S BSDXLEN=$$APPLEN^BSDXAPI(BSDXPATID,BSDXLOC,BSDXSTART)
|
||||
. ; DEBUG
|
||||
. I 'BSDXLEN S $EC=",U1,"
|
||||
. ; DEBUG
|
||||
. ;
|
||||
. ; Cancel through BSDXAPI
|
||||
. S BSDXERR=$$CANCEL^BSDXAPI(.BSDXC)
|
||||
. I BSDXERR=1 D ERR(BSDXI,"-9^BSDX08: BSDXAPI returned an error: "_$P(BSDXZ,U,2)) QUIT
|
||||
. ; Update Legacy PIMS clinic Availability
|
||||
. D AVUPDT(BSDXLOC,BSDXSTART,BSDXLEN)
|
||||
;
|
||||
D BSDXCAN(BSDXAPTID) ; Add a cancellation date in BSDX APPOINTMENT
|
||||
;
|
||||
L -^BSDXAPPT(BSDXAPTID)
|
||||
S BSDXI=BSDXI+1
|
||||
|
|
@ -137,6 +137,7 @@ APPDEL(BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT) ;EP
|
|||
S ^BSDXTMP($J,BSDXI)=$C(31)
|
||||
Q
|
||||
;
|
||||
ROLLBACK(BSDXAPTID)
|
||||
AVUPDT(BSDXSCD,BSDXSTART,BSDXLEN) ;Update Legacy PIMS Clinic availability
|
||||
;See SDCNP0
|
||||
N SD,S ; Start Date
|
||||
|
|
|
|||
233
m/BSDX26.m
233
m/BSDX26.m
|
|
@ -1,133 +1,108 @@
|
|||
BSDX26 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 6/18/12 5:33pm
|
||||
;;1.7T1;BSDX;;Aug 31, 2011;Build 18
|
||||
; Licensed under LGPL
|
||||
; Change History:
|
||||
; 3101023 - UJO/SMH - Addition of restartable transaction; relocation of tx.
|
||||
; --> Thanks to Zach Gonzalez and Rick Marshall
|
||||
; 3101205 - UJO/SMH - Extensive refactoring.
|
||||
;
|
||||
; Error Reference:
|
||||
; -1: Appt ID is not a number
|
||||
; -2: Appt IEN is not in ^BSDXAPPT
|
||||
; -3: FM Failure to file WP field in ^BSDXAPPT
|
||||
;
|
||||
BSDX26 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 6/25/12 4:29pm
|
||||
;;1.7T1;BSDX;;Aug 31, 2011;Build 18
|
||||
; Licensed under LGPL
|
||||
; Change History:
|
||||
; 3101023 - UJO/SMH - Addition of restartable transaction; relocation of tx.
|
||||
; 3101205 - UJO/SMH - Extensive refactoring.
|
||||
; 3120625 - VEN/SMH - Removal of Transactions, reloation of UTs to BSDXUT1
|
||||
;
|
||||
; Error Reference:
|
||||
; -1: Appt ID is not a number
|
||||
; -2: Appt IEN is not in ^BSDXAPPT
|
||||
; -3: FM Failure to file WP field in ^BSDXAPPT
|
||||
; -4: BSDXAPI reports failure to change note field in ^SC
|
||||
;
|
||||
EDITAPTD(BSDXY,BSDXAPTID,BSDXNOTE) ;EP
|
||||
;Entry point for debugging
|
||||
;
|
||||
D DEBUG^%Serenji("EDITAPT^BSDX26(.BSDXY,BSDXAPTID,BSDXNOTE)")
|
||||
Q
|
||||
UT ; Unit Tests
|
||||
; Test 1: Make sure this damn thing works
|
||||
N ZZZ
|
||||
N %H S %H=$H
|
||||
N NOTE S NOTE="New Note "_%H
|
||||
D EDITAPT(.ZZZ,188,NOTE)
|
||||
I ^BSDXAPPT(188,1,1,0)'=NOTE W "ERROR",! B
|
||||
; Test 2: Test Errors -1 and -2
|
||||
N ZZZ
|
||||
N NOTE S NOTE="Nothing important"
|
||||
D EDITAPT(.ZZZ,"BLAHBLAH",NOTE)
|
||||
I +^BSDXTMP($J,1)'=-1 W "ERROR IN -1",! B
|
||||
D EDITAPT(.ZZZ,298734322,NOTE)
|
||||
I +^BSDXTMP($J,1)'=-2 W "ERROR IN -2",! B
|
||||
; Test 4: M Error
|
||||
N bsdxdie S bsdxdie=1
|
||||
D EDITAPT(.ZZZ,188,NOTE)
|
||||
I +^BSDXTMP($J,1)'=-100 W "ERROR IN -100",! B
|
||||
k bsdxdie
|
||||
; Test 5: Trestart
|
||||
N bsdxrestart S bsdxrestart=1
|
||||
N %H S %H=$H
|
||||
N NOTE S NOTE="New Note "_%H
|
||||
D EDITAPT(.ZZZ,188,NOTE)
|
||||
I ^BSDXAPPT(188,1,1,0)'=NOTE W "ERROR in TRESTART",! B
|
||||
; Test 6: for Hosp Location Update
|
||||
N DATE S DATE=$$NOW^XLFDT()
|
||||
S DATE=$E(DATE,1,12) ; Just get minutes b/c of HL file input transform
|
||||
D APPADD^BSDX07(.ZZZ,DATE,DATE+.001,3,"Dr Office",30,"Old Note",1)
|
||||
N APPID S APPID=+$P(^BSDXTMP($J,1),U)
|
||||
D EDITAPT(.ZZZ,APPID,"New Note")
|
||||
I ^BSDXAPPT(APTID,1,1,0)'="New Note" W "Error in HL Section",! B
|
||||
I $P(^SC(2,"S",DATE,1,1,0),U,4)'="New Note" W "Error in HL Section",! B
|
||||
QUIT
|
||||
;
|
||||
;Entry point for debugging
|
||||
;
|
||||
;D DEBUG^%Serenji("EDITAPT^BSDX26(.BSDXY,BSDXAPTID,BSDXNOTE)")
|
||||
Q
|
||||
EDITAPT(BSDXY,BSDXAPTID,BSDXNOTE) ;EP Edit appointment (only note text can be edited)
|
||||
; Called by RPC: BSDX EDIT APPOINTMENT
|
||||
;
|
||||
; Edits Appointment Text in BSDX APPOINTMENT file & Hosp Location (44) file
|
||||
;
|
||||
; Parameters:
|
||||
; - BSDXY: Global Return (RPC must be set to Global Array)
|
||||
; - BSDXAPTID: Appointment IEN in BSDX APPOINTMENT
|
||||
; - BSDXNOTE: New note
|
||||
;
|
||||
; Return:
|
||||
; ADO.net Recordset having 1 field: ERRORID
|
||||
; If Okay: -1; otherwise, positive integer with message
|
||||
;
|
||||
; Return Array; set Return and clear array
|
||||
S BSDXY=$NA(^BSDXTMP($J))
|
||||
K ^BSDXTMP($J)
|
||||
; ET
|
||||
N $ET S $ET="G ETRAP^BSDX26"
|
||||
; Set up basic DUZ variables
|
||||
D ^XBKVAR
|
||||
; Counter
|
||||
N BSDXI S BSDXI=0
|
||||
; Header Node
|
||||
S ^BSDXTMP($J,BSDXI)="T00100ERRORID"_$C(30)
|
||||
; Restartable txn for GT.M. Restored vars are Params + BSDXI.
|
||||
TSTART (BSDXY,BSDXAPTID,BSDXNOTE,BSDXI):T="BSDX EDIT APPOINTMENT^BSDX26"
|
||||
;
|
||||
;;;test for error inside transaction. See if %ZTER works
|
||||
I $G(bsdxdie) S X=1/0
|
||||
;;;test
|
||||
;;;test for TRESTART
|
||||
I $G(bsdxrestart) K bsdxrestart TRESTART
|
||||
;;;test
|
||||
;
|
||||
; Validate Appointment ID
|
||||
I '+BSDXAPTID D ERR(BSDXI,"-1~BSDX26: Invalid Appointment ID") QUIT
|
||||
I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR(BSDXI,"-2~BSDX26: Invalid Appointment ID") QUIT
|
||||
; Put the WP in decendant fields from the root to file as a WP field
|
||||
S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE=""
|
||||
I $D(BSDXNOTE(0)) S BSDXNOTE(.5)=BSDXNOTE(0) K BSDXNOTE(0)
|
||||
N BSDXMSG ; Message in case of error in filing.
|
||||
I $D(BSDXNOTE(.5)) D
|
||||
. D WP^DIE(9002018.4,BSDXAPTID_",",1,"","BSDXNOTE","BSDXMSG")
|
||||
I $D(BSDXMSG) D ERR(BSDXI,"-3~BSDX26: Fileman failure to file data into 9002018.4") QUIT
|
||||
;
|
||||
; Now file in file 44:
|
||||
N PTIEN S PTIEN=$$GET1^DIQ(9002018.4,BSDXAPTID,".05","I") ; Patient IEN
|
||||
N HLIEN S HLIEN=$$GET1^DIQ(9002018.4,BSDXAPTID,".07:.04","I") ; HL Location IEN pointed to by Resource ID
|
||||
N DATE S DATE=+^BSDXAPPT(BSDXAPTID,0) ; Date of APPT
|
||||
N BSDXRES S BSDXRES=0 ; Result
|
||||
; Update Note only if we have a linked hospital location.
|
||||
I HLIEN S BSDXRES=$$UPDATENT^BSDXAPI(PTIEN,HLIEN,DATE,BSDXNOTE(.5))
|
||||
; If we get an error (denoted by -1 in BSDXRES), return error to client
|
||||
I BSDXRES<0 D ERR(BSDXI,"-4~BSDX26: BSDXAPI reports an error: "_BSDXRES) QUIT
|
||||
;Return Recordset
|
||||
TCOMMIT
|
||||
S BSDXI=BSDXI+1
|
||||
S ^BSDXTMP($J,BSDXI)="-1"_$C(30)
|
||||
S BSDXI=BSDXI+1
|
||||
S ^BSDXTMP($J,BSDXI)=$C(31)
|
||||
QUIT
|
||||
;
|
||||
; Called by RPC: BSDX EDIT APPOINTMENT
|
||||
;
|
||||
; Edits Appointment Text in BSDX APPOINTMENT file & Hosp Location (44) file
|
||||
;
|
||||
; Parameters:
|
||||
; - BSDXY: Global Return (RPC must be set to Global Array)
|
||||
; - BSDXAPTID: Appointment IEN in BSDX APPOINTMENT
|
||||
; - BSDXNOTE: New note
|
||||
;
|
||||
; Return:
|
||||
; ADO.net Recordset having 1 field: ERRORID
|
||||
; If Okay: -1; otherwise, positive integer with message
|
||||
;
|
||||
; Return Array; set Return and clear array
|
||||
S BSDXY=$NA(^BSDXTMP($J))
|
||||
K ^BSDXTMP($J)
|
||||
; ET
|
||||
N $ET S $ET="G ETRAP^BSDX26"
|
||||
; Set up basic DUZ variables
|
||||
D ^XBKVAR
|
||||
; Counter
|
||||
N BSDXI S BSDXI=0
|
||||
; Header Node
|
||||
S ^BSDXTMP($J,BSDXI)="T00100ERRORID"_$C(30)
|
||||
;
|
||||
;;;test for error. See if %ZTER works
|
||||
I $G(BSDXDIE) S X=1/0
|
||||
;
|
||||
; Validate Appointment ID
|
||||
I '+BSDXAPTID D ERR(BSDXI,"-1~BSDX26: Invalid Appointment ID") QUIT
|
||||
I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR(BSDXI,"-2~BSDX26: Invalid Appointment ID") QUIT
|
||||
;
|
||||
; Put the WP in decendant fields from the root to file as a WP field
|
||||
S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE=""
|
||||
I $D(BSDXNOTE(0)) S BSDXNOTE(.5)=BSDXNOTE(0) K BSDXNOTE(0)
|
||||
;
|
||||
N BSDXMSG ; Message in case of error in filing.
|
||||
;
|
||||
; Save Before State in case we need it for rollback
|
||||
K ^TMP($J)
|
||||
M ^TMP($J,"BEFORE","BSDXAPPT")=^BSDXAPPT(BSDXAPTID)
|
||||
;
|
||||
I $D(BSDXNOTE(.5)) D
|
||||
. D WP^DIE(9002018.4,BSDXAPTID_",",1,"","BSDXNOTE","BSDXMSG")
|
||||
;
|
||||
; Error handling. No need for rollback since nothing else changed.
|
||||
I $D(BSDXMSG) D ERR(BSDXI,"-3~BSDX26: Fileman failure to file data into 9002018.4") QUIT
|
||||
;
|
||||
; Now file in file 44:
|
||||
N PTIEN S PTIEN=$$GET1^DIQ(9002018.4,BSDXAPTID,".05","I") ; Patient IEN
|
||||
N HLIEN S HLIEN=$$GET1^DIQ(9002018.4,BSDXAPTID,".07:.04","I") ; HL Location IEN pointed to by Resource ID
|
||||
N DATE S DATE=+^BSDXAPPT(BSDXAPTID,0) ; Date of APPT
|
||||
N BSDXRES S BSDXRES=0 ; Result
|
||||
; Update Note only if we have a linked hospital location.
|
||||
I HLIEN S BSDXRES=$$UPDATENT^BSDXAPI(PTIEN,HLIEN,DATE,BSDXNOTE(.5))
|
||||
; If we get an error (denoted by -1 in BSDXRES), return error to client
|
||||
; AND restore the original note
|
||||
I BSDXRES<0 D ERR(BSDXI,"-4~BSDX26: BSDXAPI reports an error: "_BSDXRES),ROLLBACK(BSDXAPTID) QUIT
|
||||
;
|
||||
;Return Recordset indicating success
|
||||
S BSDXI=BSDXI+1
|
||||
S ^BSDXTMP($J,BSDXI)="-1"_$C(30)
|
||||
S BSDXI=BSDXI+1
|
||||
S ^BSDXTMP($J,BSDXI)=$C(31)
|
||||
;
|
||||
K ^TMP($J) ; Done; remove TMP data
|
||||
QUIT
|
||||
;
|
||||
ROLLBACK(BSDXAPTID) ; Rollback note to original in ^BSDXAPPT
|
||||
M ^BSDXAPPT(BSDXAPTID)=^TMP($J,"BEFORE","BSDXAPPT")
|
||||
K ^TMP($J)
|
||||
QUIT
|
||||
;
|
||||
ERR(BSDXI,BSDXERR) ;Error processing
|
||||
S BSDXI=BSDXI+1
|
||||
S BSDXERR=$TR(BSDXERR,"^","~")
|
||||
I $TL>0 TROLLBACK
|
||||
S ^BSDXTMP($J,BSDXI)=BSDXERR_$C(30)
|
||||
S BSDXI=BSDXI+1
|
||||
S ^BSDXTMP($J,BSDXI)=$C(31)
|
||||
QUIT
|
||||
;
|
||||
S BSDXI=BSDXI+1
|
||||
S BSDXERR=$TR(BSDXERR,"^","~")
|
||||
S ^BSDXTMP($J,BSDXI)=BSDXERR_$C(30)
|
||||
S BSDXI=BSDXI+1
|
||||
S ^BSDXTMP($J,BSDXI)=$C(31)
|
||||
QUIT
|
||||
;
|
||||
ETRAP ;EP Error trap entry
|
||||
N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
|
||||
I $TL>0 TROLLBACK
|
||||
D ^%ZTER
|
||||
S $EC=""
|
||||
I '$D(BSDXI) N BSDXI S BSDXI=0
|
||||
D ERR(BSDXI,"-100~BSDX26 Error: "_$G(%ZTERZE))
|
||||
Q
|
||||
N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
|
||||
D ^%ZTER
|
||||
S $EC=""
|
||||
I '$D(BSDXI) N BSDXI S BSDXI=0
|
||||
D ERR(BSDXI,"-100~BSDX26 Error: "_$G(%ZTERZE))
|
||||
QUIT
|
||||
|
|
|
|||
74
m/BSDXAPI.m
74
m/BSDXAPI.m
|
|
@ -1,4 +1,4 @@
|
|||
BSDXAPI ; IHS/ANMC/LJF & VW/SMH - SCHEDULING APIs ; 6/22/12 4:25pm
|
||||
BSDXAPI ; IHS/ANMC/LJF & VW/SMH - SCHEDULING APIs ; 6/25/12 6:13pm
|
||||
;;1.7T1;BSDX;;Aug 31, 2011;Build 18
|
||||
; Licensed under LGPL
|
||||
;
|
||||
|
|
@ -43,6 +43,7 @@ MAKE1(DFN,CLIN,TYP,DATE,LEN,INFO) ; Simplified PEP w/ parameters for $$MAKE - ma
|
|||
; have 3 (scheduled) or 4 (walkin) appt at Dec 20, 2009 @ 10:11:59 for 30 minutes appt
|
||||
; for Baby foxes hallucinations.
|
||||
; S RESULT=$$MAKE1^BSDXAPI(23435,33,(3 or 4),3091220.221159,30,"I see Baby foxes")
|
||||
N BSDR
|
||||
S BSDR("PAT")=DFN ;DFN
|
||||
S BSDR("CLN")=CLIN ;Hosp Loc IEN
|
||||
S BSDR("TYP")=TYP ;3 sched or 4 walkin
|
||||
|
|
@ -107,7 +108,7 @@ MAKE(BSDR) ;PEP; call to store appt made
|
|||
Q:$G(BSDXSIMERR3) 1_U_$NA(BSDXSIMERR3) ; Unit Test line
|
||||
;
|
||||
; add appt to file 44. This adds it to the FIRST subfile (Appointment)
|
||||
N DIC,DA,Y,X,DD,DO,DLAYGO
|
||||
N DIC,DA,Y,X,DD,DO,DLAYGO,DINUM
|
||||
I '$D(^SC(BSDR("CLN"),"S",0)) S ^SC(BSDR("CLN"),"S",0)="^44.001DA^^"
|
||||
I '$D(^SC(BSDR("CLN"),"S",BSDR("ADT"),0)) D I Y<1 Q 1_U_"Error adding date to file 44: Clinic="_BSDR("CLN")_" Date="_BSDR("ADT")
|
||||
. S DIC="^SC("_BSDR("CLN")_",""S"",",DA(1)=BSDR("CLN"),(X,DINUM)=BSDR("ADT")
|
||||
|
|
@ -201,6 +202,7 @@ CHECKIN1(DFN,CLIN,APDATE) ; Simplified PEP w/ parameters for $$CHECKIN - Checkin
|
|||
; Call like this for DFN 23435 checking in now at Hospital Location 33
|
||||
; for appt at Dec 20, 2009 @ 10:11:59
|
||||
; S RESULT=$$CHECKIN1^BSDXAPI(23435,33,3091220.221159)
|
||||
N BSDR
|
||||
S BSDR("PAT")=DFN ;DFN
|
||||
S BSDR("CLN")=CLIN ;Hosp Loc IEN
|
||||
S BSDR("ADT")=APDATE ;Appt Date
|
||||
|
|
@ -237,7 +239,7 @@ CHECKIN(BSDR) ;EP; call to add checkin info to appt; IHS/ITSC/LJF 12/23/2004 PAT
|
|||
I 'IEN Q 1_U_"Error trying to find appointment for checkin: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
|
||||
;
|
||||
; remember before status
|
||||
NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL
|
||||
NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL,SDMODE
|
||||
S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN
|
||||
S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
|
||||
D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
|
||||
|
|
@ -263,6 +265,7 @@ CANCEL1(DFN,CLIN,TYP,APDATE,REASON,INFO) ; PEP w/ parameters for $$CANCEL - canc
|
|||
; cancelling appt at Dec 20, 2009 @ 10:11:59 because of reason 1 in file 409.2 IEN (weather)
|
||||
; because foxes come out during bad weather.
|
||||
; S RESULT=$$CANCEL1^BSDXAPI(23435,33,"PC",3091220.221159,1,"Afraid of foxes")
|
||||
N BSDR
|
||||
S BSDR("PAT")=DFN
|
||||
S BSDR("CLN")=CLIN
|
||||
S BSDR("TYP")=TYP
|
||||
|
|
@ -291,25 +294,22 @@ CANCEL(BSDR) ;PEP; called to cancel appt
|
|||
; = 0 or null: everything okay
|
||||
; = 1^message: error and reason
|
||||
;
|
||||
; Okay to Cancel? Call Cancel Check.
|
||||
N BSDXCANCK S BSDXCANCK=$$CANCELCK(.BSDR)
|
||||
I BSDXCANCK Q BSDXCANCK
|
||||
;
|
||||
; BSDX 1.5 3110125
|
||||
; UJO/SMH - Add ability to remove check-in if the patient is checked in
|
||||
; I $$CI(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"),IEN) Q 1_U_"Patient already checked in; cannot cancel until checkin deleted: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
|
||||
; Remove check-in if the patient is checked in.
|
||||
N BSDXRESULT S BSDXRESULT=0 ; Result; should be zero if success; -1 + message if failure
|
||||
NEW IEN S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
|
||||
I $$CI(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"),IEN) SET BSDXRESULT=$$RMCI(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
|
||||
I BSDXRESULT Q BSDXRESULT
|
||||
; NB: Failure point 1: we fail here nothing has happened yet
|
||||
; VEN/SMH on 3120625/v1.7 - PIMS doesn't care if patient is already checked in
|
||||
; Lets you remove appointment anyways! Not like RPMS.
|
||||
; Plus... deleting checkin affects S node on 44, which is DELETED anyways!
|
||||
;
|
||||
; remember before status
|
||||
NEW SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL
|
||||
NEW SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL,SDMODE
|
||||
S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN
|
||||
S SDCPHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
|
||||
D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL)
|
||||
; NB: Here only globals are set. Nothing else.
|
||||
; NB: Here only ^TMP globals are set with before values.
|
||||
;
|
||||
; get user who made appt and date appt made from ^SC
|
||||
; because data in ^SC will be deleted
|
||||
|
|
@ -317,28 +317,35 @@ CANCEL(BSDR) ;PEP; called to cancel appt
|
|||
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)
|
||||
;
|
||||
; update file 2 info
|
||||
NEW DIE,DA,DR
|
||||
S DIE="^DPT("_DFN_",""S"",",DA(1)=DFN,DA=SDT
|
||||
S DR="3///"_BSDR("TYP")_";14///`"_BSDR("USR")_";15///"_BSDR("CDT")_";16///`"_BSDR("CR")_";19///`"_USER_";20///"_DATE
|
||||
S:$G(BSDR("NOT"))]"" DR=DR_";17///"_$E(BSDR("NOT"),1,160)
|
||||
D ^DIE
|
||||
; Failure point 2: If we fail here, it means that the check-in was removed;
|
||||
; but the appointment wasn't cancelled.
|
||||
; To roll back, we should restore the check-in. However, I would rather not
|
||||
; do that. This code will only fail if there's something wrong in the DB.
|
||||
; (deleted field for example). If I try to restore the check-in, I just
|
||||
; may excercerbate the problem.
|
||||
; update file 2 info --old code
|
||||
;NEW DIE,DA,DR
|
||||
;S DIE="^DPT("_DFN_",""S"",",DA(1)=DFN,DA=SDT
|
||||
;S DR="3///"_BSDR("TYP")_";14///`"_BSDR("USR")_";15///"_BSDR("CDT")_";16///`"_BSDR("CR")_";19///`"_USER_";20///"_DATE
|
||||
;S:$G(BSDR("NOT"))]"" DR=DR_";17///"_$E(BSDR("NOT"),1,160)
|
||||
;D ^DIE
|
||||
N BSDXIENS S BSDXIENS=SDT_","_DFN_","
|
||||
N BSDXFDA
|
||||
S BSDXFDA(2.98,BSDXIENS,3)=BSDR("TYP")
|
||||
S BSDXFDA(2.98,BSDXIENS,14)=BSDR("USR")
|
||||
S BSDXFDA(2.98,BSDXIENS,15)=BSDR("CDT")
|
||||
S BSDXFDA(2.98,BSDXIENS,16)=BSDR("CR")
|
||||
S BSDXFDA(2.98,BSDXIENS,19)=USER
|
||||
S BSDXFDA(2.98,BSDXIENS,20)=DATE
|
||||
S:$G(BSDR("NOT"))]"" BSDXFDA(2.98,BSDXIENS,17)=$E(BSDR("NOT"),1,160)
|
||||
N BSDXERR
|
||||
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
|
||||
; delete data in ^SC -- this does not (typically) fail. Fileman won't stop
|
||||
NEW DIK,DA
|
||||
S DIK="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
|
||||
S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN
|
||||
D ^DIK
|
||||
; Failure point 3: If we fail here, we need to restore the cancel date,
|
||||
; and possibly, the check-in.
|
||||
; Failure point 2: not expected to happen here
|
||||
;
|
||||
; call event driver
|
||||
; call event driver -- point of no return
|
||||
D CANCEL^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDCPHDL)
|
||||
Q 0
|
||||
;
|
||||
|
|
@ -377,7 +384,7 @@ RMCI(PAT,CLINIC,DATE) ;PEP; -- Remove Check-in; $$
|
|||
; Call like this: $$RMCI(233,33,3110102.1130)
|
||||
;
|
||||
; Move my variables into the ones used by SDAPIs (just a convenience)
|
||||
NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL
|
||||
NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL,SDMODE
|
||||
S DFN=PAT,SDT=DATE,SDCL=CLINIC,SDMODE=2,SDDA=$$SCIEN(DFN,SDCL,SDT)
|
||||
;
|
||||
I SDDA<1 QUIT 0 ; Appt cancelled; cancelled appts rm'ed from file 44
|
||||
|
|
@ -388,6 +395,7 @@ RMCI(PAT,CLINIC,DATE) ;PEP; -- Remove Check-in; $$
|
|||
;
|
||||
; remove check-in using filer.
|
||||
N BSDXIENS S BSDXIENS=SDDA_","_DATE_","_CLINIC_","
|
||||
N BSDXFDA
|
||||
S BSDXFDA(44.003,BSDXIENS,309)="@" ; CHECKED-IN
|
||||
S BSDXFDA(44.003,BSDXIENS,302)="@" ; CHECK IN USER
|
||||
S BSDXFDA(44.003,BSDXIENS,305)="@" ; CHECK IN ENTERED
|
||||
|
|
@ -396,7 +404,7 @@ RMCI(PAT,CLINIC,DATE) ;PEP; -- Remove Check-in; $$
|
|||
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)
|
||||
;
|
||||
; set after status
|
||||
S SDDA=$$SCIEN(DFN,SDCL,SDT)
|
||||
; S SDDA=$$SCIEN(DFN,SDCL,SDT) ;smh -why is this here? SDDA won't change.
|
||||
S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
|
||||
D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
|
||||
;
|
||||
|
|
@ -436,10 +444,14 @@ UPDATENT(PAT,CLINIC,DATE,NOTE) ; PEP; Update Note in ^SC for patient's appointme
|
|||
; Returns:
|
||||
; 0 if okay
|
||||
; -1 if failure
|
||||
;
|
||||
; ERROR SIMULATION
|
||||
I $G(BSDXSIMERR1) QUIT "-1~Simulated Error"
|
||||
;
|
||||
N SCIEN S SCIEN=$$SCIEN(PAT,CLINIC,DATE) ; ien of appt in ^SC
|
||||
I SCIEN<1 QUIT 0 ; Appt cancelled; cancelled appts rm'ed from file 44
|
||||
N BSDXIENS S BSDXIENS=SCIEN_","_DATE_","_CLINIC_","
|
||||
S BSDXFDA(44.003,BSDXIENS,3)=$E(NOTE,1,150)
|
||||
N BSDXFDA S BSDXFDA(44.003,BSDXIENS,3)=$E(NOTE,1,150)
|
||||
N BSDXERR
|
||||
D FILE^DIE("","BSDXFDA","BSDXERR")
|
||||
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)
|
||||
|
|
|
|||
113
m/BSDXUT1.m
113
m/BSDXUT1.m
|
|
@ -1,4 +1,4 @@
|
|||
BSDXUT1 ; VEN/SMH - Unit Tests for Scheduling GUI - cont. ; 6/22/12 1:44pm
|
||||
BSDXUT1 ; VEN/SMH - Unit Tests for Scheduling GUI - cont. ; 6/25/12 4:13pm
|
||||
;;1.7T1;BSDX;;Aug 31, 2011;Build 18
|
||||
;
|
||||
;
|
||||
|
|
@ -85,3 +85,114 @@ UT29 ; Unit Test for BSDX29
|
|||
W ^BSDXTMP("BSDXCOPY",+^BSDXTMP($J,1)),!
|
||||
W "Last line should say 0",!
|
||||
QUIT
|
||||
;
|
||||
UT26 ; Unit Tests - BSDX26
|
||||
;
|
||||
; Test 1: Make sure this damn thing works
|
||||
; Set-up - Create Clinics
|
||||
N RESNAM S RESNAM="UTCLINIC"
|
||||
N HLRESIENS ; holds output of UTCR^BSDXUT - HL IEN^Resource IEN
|
||||
D
|
||||
. N $ET S $ET="D ^%ZTER B"
|
||||
. S HLRESIENS=$$UTCR^BSDXUT(RESNAM)
|
||||
. I HLRESIENS<0 S $EC=",U1," ; not supposed to happen - hard crash if so
|
||||
;
|
||||
N HLIEN,RESIEN
|
||||
S HLIEN=$P(HLRESIENS,U)
|
||||
S RESIEN=$P(HLRESIENS,U,2)
|
||||
;
|
||||
; Get start and end times
|
||||
N TIMES S TIMES=$$TIMES^BSDXUT ; appt time^end time
|
||||
N APPTTIME S APPTTIME=$P(TIMES,U)
|
||||
N ENDTIME S ENDTIME=$P(TIMES,U,2)
|
||||
;
|
||||
; Make appt
|
||||
N ZZZ,DFN
|
||||
S DFN=3
|
||||
D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1)
|
||||
N APPID S APPID=+$P(^BSDXTMP($J,1),U)
|
||||
;
|
||||
; Now edit the note - basic test
|
||||
N %H S %H=$H
|
||||
N NOTE S NOTE="New Note "_%H
|
||||
D EDITAPT^BSDX26(.ZZZ,APPID,NOTE)
|
||||
I ^BSDXAPPT(APPID,1,1,0)'=NOTE W "ERROR 1",!
|
||||
I $P(^SC(HLIEN,"S",APPTTIME,1,1,0),U,4)'=NOTE W "Error in HL Section",!
|
||||
;
|
||||
; Test 2: Test Error -1
|
||||
; -1 --> ApptID not a number
|
||||
N ZZZ
|
||||
N NOTE S NOTE="Nothing important"
|
||||
D EDITAPT^BSDX26(.ZZZ,"BLAHBLAH",NOTE)
|
||||
I +^BSDXTMP($J,1)'=-1 W "ERROR IN -1",!
|
||||
;
|
||||
; Test 3: Test Error -2
|
||||
; -2 --> ApptID not in ^BSDXAPPT
|
||||
D EDITAPT^BSDX26(.ZZZ,298734322,NOTE)
|
||||
I +^BSDXTMP($J,1)'=-2 W "ERROR IN -2",!
|
||||
;
|
||||
; Test 4: M Error
|
||||
N BSDXDIE S BSDXDIE=1
|
||||
D EDITAPT^BSDX26(.ZZZ,188,NOTE)
|
||||
I +^BSDXTMP($J,1)'=-100 W "ERROR IN -100",!
|
||||
K BSDXDIE
|
||||
; Test 5: Trestart -- retired in v1.7
|
||||
;
|
||||
; Test 6: UTs for an unlinked resource (not linked to PIMS)
|
||||
N RESNAM S RESNAM="UTCLINICUL" ; Unlinked Clinic
|
||||
N RESIEN
|
||||
D
|
||||
. N $ET S $ET="D ^%ZTER B"
|
||||
. S RESIEN=$$UTCRRES^BSDXUT(RESNAM)
|
||||
. I RESIEN<0 S $EC=",U1," ; not supposed to happen - hard crash if so
|
||||
;
|
||||
; Get start and end times
|
||||
N TIMES S TIMES=$$TIMES^BSDXUT ; appt time^end time
|
||||
N APPTTIME S APPTTIME=$P(TIMES,U)
|
||||
N ENDTIME S ENDTIME=$P(TIMES,U,2)
|
||||
;
|
||||
N ZZZ,DFN
|
||||
S DFN=3
|
||||
D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,"Sam's Note",1)
|
||||
N APPID S APPID=+$P(^BSDXTMP($J,1),U)
|
||||
; Now edit the note - basic test
|
||||
N %H S %H=$H
|
||||
N NOTE S NOTE="New Note "_%H
|
||||
D EDITAPT^BSDX26(.ZZZ,APPID,NOTE)
|
||||
I ^BSDXAPPT(APPID,1,1,0)'=NOTE W "ERROR 2",!
|
||||
;
|
||||
; Test 7: Simulated failure in BSDXAPI
|
||||
N RESNAM S RESNAM="UTCLINIC"
|
||||
N HLRESIENS ; holds output of UTCR^BSDXUT - HL IEN^Resource IEN
|
||||
D
|
||||
. N $ET S $ET="D ^%ZTER B"
|
||||
. S HLRESIENS=$$UTCR^BSDXUT(RESNAM)
|
||||
. I HLRESIENS<0 S $EC=",U1," ; not supposed to happen - hard crash if so
|
||||
;
|
||||
N HLIEN,RESIEN
|
||||
S HLIEN=$P(HLRESIENS,U)
|
||||
S RESIEN=$P(HLRESIENS,U,2)
|
||||
;
|
||||
; Get start and end times
|
||||
N TIMES S TIMES=$$TIMES^BSDXUT ; appt time^end time
|
||||
N APPTTIME S APPTTIME=$P(TIMES,U)
|
||||
N ENDTIME S ENDTIME=$P(TIMES,U,2)
|
||||
;
|
||||
; Make appt
|
||||
N ZZZ,DFN
|
||||
S DFN=3
|
||||
N ORIGNOTE S ORIGNOTE="Sam's Note"
|
||||
D APPADD^BSDX07(.ZZZ,APPTTIME,ENDTIME,DFN,RESNAM,30,ORIGNOTE,1)
|
||||
N APPID S APPID=+$P(^BSDXTMP($J,1),U)
|
||||
;
|
||||
; Create the error condition
|
||||
N BSDXSIMERR1 S BSDXSIMERR1=1
|
||||
;
|
||||
; Try to edit the note. Should still be "Sam's Note"
|
||||
N %H S %H=$H
|
||||
N NOTE S NOTE="New Note "_%H
|
||||
D EDITAPT^BSDX26(.ZZZ,APPID,NOTE)
|
||||
I +^BSDXTMP($J,1)'=-4 W "Simulated error not triggered",!
|
||||
I ^BSDXAPPT(APPID,1,1,0)'=ORIGNOTE ZWRITE ^(*) W "ERROR 3",!
|
||||
I $P(^SC(HLIEN,"S",APPTTIME,1,1,0),U,4)'=ORIGNOTE W "ERROR 4",!
|
||||
QUIT
|
||||
|
|
|
|||
Loading…
Reference in New Issue