iSharkFly-Open
/
VistA-Scheduling
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Updated version number on all routines to be 1.7T1. 

Minor fixes here and there for XINDEX errors.
This commit is contained in:
sam 2012-07-06 18:28:15 +00:00
parent 168a55df58
commit 3d5c4b11ca
41 changed files with 223 additions and 217 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

77
m/BSDX01.m
View File

@ -1,5 +1,5 @@
BSDX01 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 5/16/11 2:46pm
;;1.6T2;BSDX;;May 16, 2011
BSDX01 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/6/12 10:52am
;;1.7T1;BSDX;;Jul 06, 2012;Build 18
; Licensed under LGPL
;
SUINFOD(BSDXY,BSDXDUZ) ;EP Debugging entry point
@ -281,44 +281,43 @@ GP(BSDXY,PARAM) ; Get Param - EP
QUIT
;
INDIV(BSDXSC) ; PEP - Is ^SC clinic in the same DUZ(2) as user?
; Input: BSDXSC - Hospital Location IEN
; Output: True or False
I '+BSDXSC QUIT 1 ;If not tied to clinic, yes
I '$D(^SC(BSDXSC,0)) QUIT 1 ; If Clinic does not exist, yes
; Jump to Division:Medical Center Division:Inst File Pointer for
; Institution IEN (and get its internal value)
N DIV S DIV=$$GET1^DIQ(44,BSDXSC_",","3.5:.07","I")
I DIV="" Q 1 ; If clinic has no division, consider it avial to user.
I DIV=DUZ(2) Q 1 ; If same, then User is in same Div as Clinic
E Q 0 ; Otherwise, no
QUIT
; Input: BSDXSC - Hospital Location IEN
; Output: True or False
I '+BSDXSC QUIT 1 ;If not tied to clinic, yes
I '$D(^SC(BSDXSC,0)) QUIT 1 ; If Clinic does not exist, yes
; Jump to Division:Medical Center Division:Inst File Pointer for
; Institution IEN (and get its internal value)
N DIV S DIV=$$GET1^DIQ(44,BSDXSC_",","3.5:.07","I")
I DIV="" Q 1 ; If clinic has no division, consider it avial to user.
I DIV=DUZ(2) Q 1 ; If same, then User is in same Div as Clinic
E Q 0 ; Otherwise, no
INDIV2(BSDXRES) ; PEP - Is Resource in the same DUZ(2) as user?
; Input BSDXRES - BSDX RESOURCE IEN
; Output: True of False
Q $$INDIV($P($G(^BSDXRES(BSDXRES,0)),U,4)) ; Extract Hospital Location and send to $$INDIV
UnitTestINDIV
W "Testing if they are the same",!
S DUZ(2)=67
I '$$INDIV(1) W "ERROR",!
I '$$INDIV(2) W "ERROR",!
W "Testing if Div not defined in 44, should be true",!
I '$$INDIV(3) W "ERROR",!
W "Testing empty string. Should be true",!
I '$$INDIV("") W "ERROR",!
W "Testing if they are different",!
S DUZ(2)=899
I $$INDIV(1) W "ERROR",!
I $$INDIV(2) W "ERROR",!
QUIT
UnitTestINDIV2
W "Testing if they are the same",!
S DUZ(2)=69
I $$INDIV2(22)'=0 W "ERROR",!
I $$INDIV2(25)'=1 W "ERROR",!
I $$INDIV2(26)'=1 W "ERROR",!
I $$INDIV2(27)'=1 W "ERROR",!
QUIT
;
; Input BSDXRES - BSDX RESOURCE IEN
; Output: True of False
Q $$INDIV($P($G(^BSDXRES(BSDXRES,0)),U,4)) ; Extract Hospital Location and send to $$INDIV
UTINDIV ; Unit Test $$INDIV
W "Testing if they are the same",!
S DUZ(2)=67
I '$$INDIV(1) W "ERROR",!
I '$$INDIV(2) W "ERROR",!
W "Testing if Div not defined in 44, should be true",!
I '$$INDIV(3) W "ERROR",!
W "Testing empty string. Should be true",!
I '$$INDIV("") W "ERROR",!
W "Testing if they are different",!
S DUZ(2)=899
I $$INDIV(1) W "ERROR",!
I $$INDIV(2) W "ERROR",!
QUIT
UTINDIV2 ; Unit Test $$INDIV2
W "Testing if they are the same",!
S DUZ(2)=69
I $$INDIV2(22)'=0 W "ERROR",!
I $$INDIV2(25)'=1 W "ERROR",!
I $$INDIV2(26)'=1 W "ERROR",!
I $$INDIV2(27)'=1 W "ERROR",!
QUIT
;
GETRADEX(BSDXY,DFN,SCIEN) ; Get All Pending and On Hold Radiology Exams for Patient; RPC EP; UJO/SMH new in v 1.6
; RPC: BSDX GET RAD EXAM FOR PT; Return: Global Array
;

9
m/BSDX02.m
View File

@ -1,5 +1,5 @@
BSDX02 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 5/16/11 2:47pm
;;1.6T2;BSDX;;May 16, 2011
BSDX02 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/6/12 11:09am
;;1.7T1;BSDX;;Jul 06, 2012;Build 18
;Licensed under LGPL
; Change Log
; July 15 2010: UJO/SMH - Pass FM dates in instead of US dates for i18n
@ -29,14 +29,15 @@ CRSCH(BSDXY,BSDXRES,BSDXSTART,BSDXEND,BSDXWKIN) ;
K ^BSDXTMP($J)
S BSDXERR=""
S BSDXY="^BSDXTMP("_$J_")"
S ^BSDXTMP($J,0)="I00020APPOINTMENTID^D00030START_TIME^D00030END_TIME^D00030CHECKIN^D00030AUXTIME^I00020PATIENTID^T00030PATIENTNAME^T00030RESOURCENAME^I00005NOSHOW^T00020HRN^I00005ACCESSTYPEID^I00005WALKIN^T00250NOTE^T00006SEX^T00040PID^D00030DOB^I00020RADIOLOGY_EXAM"_$C(30)
S ^BSDXTMP($J,0)="I00020APPOINTMENTID^D00030START_TIME^D00030END_TIME^D00030CHECKIN^D00030AUXTIME^I00020PATIENTID^T00030PATIENTNAME^T00030RESOURCENAME"
S ^(0)=^(0)_"^I00005NOSHOW^T00020HRN^I00005ACCESSTYPEID^I00005WALKIN^T00250NOTE^T00006SEX^T00040PID^D00030DOB^I00020RADIOLOGY_EXAM"_$C(30)
D ^XBKVAR S X="ETRAP^BSDX02",@^%ZOSF("TRAP")
;
; S %DT="T",X=BSDXSTART D ^%DT S BSDXSTART=Y
; I BSDXSTART=-1 S ^BSDXTMP($J,1)=$C(31) Q
; S %DT="T",X=BSDXEND D ^%DT S BSDXEND=Y
; I BSDXEND=-1 S ^BSDXTMP($J,1)=$C(31) Q
;
;
S BSDXI=0
D STRES
;

2
m/BSDX03.m
View File

@ -1,5 +1,5 @@
BSDX03 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:14am
;;1.6T2;BSDX;;May 16, 2011
;;1.7T1;BSDX;;Jul 06, 2012;Build 18
;Licensed under LGPL
;
;

4
m/BSDX04.m
View File

@ -1,5 +1,5 @@
BSDX04 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; ; 4/28/11 10:15am
;;1.6T2;BSDX;;May 16, 2011
BSDX04 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; ; 7/6/12 10:55am
;;1.7T1;BSDX;;Jul 06, 2012;Build 18
; Licensed under LGPL
; Change Log:
; July 11 2010: Pass BSDXSTART and END as FM dates rather than US formatted dates

2
m/BSDX05.m
View File

@ -1,5 +1,5 @@
BSDX05 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:16am
;;1.6T2;BSDX;;May 16, 2011
;;1.7T1;BSDX;;Jul 06, 2012;Build 18
; Licensed under LGPL
;
; Change Log:

2
m/BSDX06.m
View File

@ -1,5 +1,5 @@
BSDX06 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:16am
;;1.6T2;BSDX;;May 16, 2011
;;1.7T1;BSDX;;Jul 06, 2012;Build 18
; Licensed under LGPL
; Change Log:
; UJO/SMH: July 15 2010: Change in BSDXSTART and BSDXEND: get

8
m/BSDX07.m
View File

@ -1,5 +1,5 @@
BSDX07 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 7/5/12 12:57pm
;;1.7T1;BSDX;;Aug 31, 2011;Build 18
;;1.7T1;BSDX;;Jul 06, 2012;Build 18
; Licensed under LGPL
;
; Change Log:
@ -65,11 +65,11 @@ APPADD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID,BSDXR
;
; Deal with optional arguments
S BSDXRADEXAM=$G(BSDXRADEXAM)
;
;
; Return Array; set Return and clear array
S BSDXY=$NA(^BSDXTMP($J))
K ^BSDXTMP($J)
;
;
; $ET
N $ET S $ET="G ETRAP^BSDX07"
;
@ -237,7 +237,7 @@ ADDEVT3(BSDXRES) ;
D EVENT^BMXMEVN("BSDX SCHEDULE",BSDXRESN)
Q
;
ROLLBACK(BSDXAPPTID,BSDXC) ; Private EP; Roll back appointment set
ROLLBACK(BSDXAPPTID,BSDXC) ; Private EP; Roll back appointment set
; DO NOT USE except as an emergency measure - only if unforseen error occurs
; Input:
; Appointment ID to remove from ^BSDXAPPT

4
m/BSDX08.m
View File

@ -1,5 +1,5 @@
BSDX08 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 7/5/12 12:39pm
;;1.7T1;BSDX;;Aug 31, 2011;Build 18
;;1.7T1;BSDX;;Jul 06, 2012;Build 18
;
; Original by HMW. New Written by Sam Habiel. Licensed under LGPL.
;
@ -151,7 +151,7 @@ BSDXCAN(BSDXAPTID) ; $$; Private; Cancel BSDX APPOINTMENT entry
I $D(BSDXMSG) Q 1_U_BSDXMSG("DIERR",1,"TEXT",1)
QUIT 0
;
ROLLBACK(BSDXAPTID) ; Proc; Private; Rollback cancellation
ROLLBACK(BSDXAPTID) ; Proc; Private; Rollback cancellation
; Input same as $$BSDXCAN
N BSDXIENS S BSDXIENS=BSDXAPTID_","
N BSDXFDA S BSDXFDA(9002018.4,BSDXIENS,.12)="@"

4
m/BSDX09.m
View File

@ -1,5 +1,5 @@
BSDX09 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; ; 4/28/11 10:18am
;;1.6;BSDX;;Aug 31, 2011;Build 18
BSDX09 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; ; 6/21/12 11:03am
;;1.7T1;BSDX;;Jul 06, 2012;Build 18
; Licensed under LGPL
;
; Change Log:

2
m/BSDX11.m
View File

@ -1,5 +1,5 @@
BSDX11 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:18am
;;1.6T2;BSDX;;May 16, 2011
;;1.7T1;BSDX;;Jul 06, 2012;Build 18
; Licensed under LGPL
;
ENV0100 ;EP Version 1.0 Environment check

2
m/BSDX12.m
View File

@ -1,5 +1,5 @@
BSDX12 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:18am
;;1.6T2;BSDX;;May 16, 2011
;;1.7T1;BSDX;;Jul 06, 2012;Build 18
; Licensed under LGPL
;
; Change Log:

2
m/BSDX13.m
View File

@ -1,5 +1,5 @@
BSDX13 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:19am
;;1.6T2;BSDX;;May 16, 2011
;;1.7T1;BSDX;;Jul 06, 2012;Build 18
; Licensed under LGPL
;
; Change Log:

2
m/BSDX14.m
View File

@ -1,5 +1,5 @@
BSDX14 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:19am
;;1.6T2;BSDX;;May 16, 2011
;;1.7T1;BSDX;;Jul 06, 2012;Build 18
; Licensed under LGPL
;
;

2
m/BSDX15.m
View File

@ -1,5 +1,5 @@
BSDX15 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:19am
;;1.6T2;BSDX;;May 16, 2011
;;1.7T1;BSDX;;Jul 06, 2012;Build 18
; Licensed under LGPL
;
;

2
m/BSDX16.m
View File

@ -1,5 +1,5 @@
BSDX16 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; ; 4/28/11 10:20am
;;1.6T2;BSDX;;May 16, 2011
;;1.7T1;BSDX;;Jul 06, 2012;Build 18
; Licensed under LGPL
;
;

2
m/BSDX17.m
View File

@ -1,5 +1,5 @@
BSDX17 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:20am
;;1.6T2;BSDX;;May 16, 2011
;;1.7T1;BSDX;;Jul 06, 2012;Build 18
; Licensed under LGPL
;
;

2
m/BSDX18.m
View File

@ -1,5 +1,5 @@
BSDX18 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:20am
;;1.6T2;BSDX;;May 16, 2011
;;1.7T1;BSDX;;Jul 06, 2012;Build 18
; Licensed under LGPL
;
;

2
m/BSDX19.m
View File

@ -1,5 +1,5 @@
BSDX19 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:21am
;;1.6T2;BSDX;;May 16, 2011
;;1.7T1;BSDX;;Jul 06, 2012;Build 18
; Licensed under LGPL
;
;

2
m/BSDX20.m
View File

@ -1,5 +1,5 @@
BSDX20 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:21am
;;1.6T2;BSDX;;May 16, 2011
;;1.7T1;BSDX;;Jul 06, 2012;Build 18
; Licensed under LGPL
;
;

2
m/BSDX21.m
View File

@ -1,5 +1,5 @@
BSDX21 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:22am
;;1.6T2;BSDX;;May 16, 2011
;;1.7T1;BSDX;;Jul 06, 2012;Build 18
; Licensed under LGPL
;
;

2
m/BSDX22.m
View File

@ -1,5 +1,5 @@
BSDX22 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:22am
;;1.6T2;BSDX;;May 16, 2011
;;1.7T1;BSDX;;Jul 06, 2012;Build 18
; Licensed under LGPL
;
;

2
m/BSDX23.m
View File

@ -1,5 +1,5 @@
BSDX23 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:22am
;;1.6T2;BSDX;;May 16, 2011
;;1.7T1;BSDX;;Jul 06, 2012;Build 18
; Licensed under LGPL
;
;

2
m/BSDX24.m
View File

@ -1,5 +1,5 @@
BSDX24 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:22am
;;1.6T2;BSDX;;May 16, 2011
;;1.7T1;BSDX;;Jul 06, 2012;Build 18
; Licensed under LGPL
;
;

4
m/BSDX25.m
View File

@ -1,5 +1,5 @@
BSDX25 ; VEN/SMH - WINDOWS SCHEDULING RPCS ; 7/5/12 11:55am
;;1.7T1;BSDX;;Aug 31, 2011;Build 18
;;1.7T1;BSDX;;Jul 06, 2012;Build 18
; Licensed under LGPL
;
; Change Log:
@ -15,7 +15,7 @@ CHECKIND(BSDXY,BSDXAPPTID,BSDXCDT,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG)
;I +$G(^BSDXDBUG("BREAK","CHECKIN")),+$G(^BSDXDBUG("BREAK"))=DUZ D DEBUG^%Serenji("CHECKIN^BSDX25(.BSDXY,BSDXAPPTID,BSDXCDT,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG)",$P(^BSDXDBUG("BREAK"),U,2))
Q
;
CHECKIN(BSDXY,BSDXAPPTID,BSDXCDT) ;Private EP Check in appointment
CHECKIN(BSDXY,BSDXAPPTID,BSDXCDT) ;Private EP Check in appointment
; Old additional vars: ,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG)
; Called by RPC: BSDX CHECKIN APPOINTMENT
;

4
m/BSDX26.m
View File

@ -1,5 +1,5 @@
BSDX26 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 6/25/12 4:29pm
;;1.7T1;BSDX;;Aug 31, 2011;Build 18
;;1.7T1;BSDX;;Jul 06, 2012;Build 18
; Licensed under LGPL
; Change History:
; 3101023 - UJO/SMH - Addition of restartable transaction; relocation of tx.
@ -86,7 +86,7 @@ EDITAPT(BSDXY,BSDXAPTID,BSDXNOTE) ;EP Edit appointment (only note text can be
K ^TMP($J) ; Done; remove TMP data
QUIT
;
ROLLBACK(BSDXAPTID) ; Rollback note to original in ^BSDXAPPT
ROLLBACK(BSDXAPTID) ; Rollback note to original in ^BSDXAPPT
M ^BSDXAPPT(BSDXAPTID)=^TMP($J,"BEFORE","BSDXAPPT")
K ^TMP($J)
QUIT

2
m/BSDX27.m
View File

@ -1,5 +1,5 @@
BSDX27 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:24am
;;1.6T2;BSDX;;May 16, 2011
;;1.7T1;BSDX;;Jul 06, 2012;Build 18
; Licensed under LGPL
;
; Change Log: July 15, 2010

41
m/BSDX28.m
View File

@ -1,5 +1,5 @@
BSDX28 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:25am
;;1.6T2;BSDX;;May 16, 2011
BSDX28 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/6/12 10:57am
;;1.7T1;BSDX;;Jul 06, 2012;Build 18
; Licensed under LGPL
; Change Log:
; HMW 3050721 Added test for inactivated record
@ -37,23 +37,23 @@ DFN ;If DFN is passed as `nnnn, just return that patient
. N DOB S DOB=$$FMTE^XLFDT($P(^DPT(BSDXIEN,0),U,3))
. S BSDXRET=BSDXRET_NAME_U_HRN_U_PID_U_DOB_U_BSDXIEN_$C(30)
PID ;PID Lookup
; If this ID exists, go get it. If "UJOPID" index doesn't exist,
; won't work anyways.
I $D(^DPT("UJOPID",BSDXP)) DO SET BSDXY=BSDXRET_$C(31) QUIT
. S BSDXIEN=$O(^DPT("UJOPID",BSDXP,""))
. Q:'$D(^DPT(BSDXIEN,0))
. S BSDXDPT=$G(^DPT(BSDXIEN,0))
. S BSDXZ=$P(BSDXDPT,U) ;NAME
. S BSDXHRN=$P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,2) ;CHART
. I BSDXHRN="" Q ;NO CHART AT THIS DUZ2
. ; Inactivated Chart get an *
. I $P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,3) S BSDXHRN=BSDXHRN_"(*)" Q
. S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN
. S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID
. S Y=$P(BSDXDPT,U,3) X ^DD("DD")
. S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB
. S $P(BSDXZ,BSDXDLIM,5)=BSDXIEN
. S BSDXRET=BSDXRET_BSDXZ_$C(30)
; If this ID exists, go get it. If "UJOPID" index doesn't exist,
; won't work anyways.
I $D(^DPT("UJOPID",BSDXP)) DO SET BSDXY=BSDXRET_$C(31) QUIT
. S BSDXIEN=$O(^DPT("UJOPID",BSDXP,""))
. Q:'$D(^DPT(BSDXIEN,0))
. S BSDXDPT=$G(^DPT(BSDXIEN,0))
. S BSDXZ=$P(BSDXDPT,U) ;NAME
. S BSDXHRN=$P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,2) ;CHART
. I BSDXHRN="" Q ;NO CHART AT THIS DUZ2
. ; Inactivated Chart get an *
. I $P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,3) S BSDXHRN=BSDXHRN_"(*)" Q
. S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN
. S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID
. S Y=$P(BSDXDPT,U,3) X ^DD("DD")
. S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB
. S $P(BSDXZ,BSDXDLIM,5)=BSDXIEN
. S BSDXRET=BSDXRET_BSDXZ_$C(30)
;
DOB ;DOB Lookup
I +DUZ(2),((BSDXP?1.2N1"/"1.2N1"/"1.4N)!(BSDXP?1.2N1" "1.2N1" "1.4N)!(BSDXP?1.2N1"-"1.2N1"-"1.4N)) D S BSDXY=BSDXRET_$C(31) Q
@ -75,8 +75,7 @@ DOB ;DOB Lookup
. . Q
. Q
;
CHART
;Chart# Lookup
CHART ;Chart# Lookup
I +DUZ(2),BSDXP]"",$D(^AUPNPAT("D",BSDXP)) D S BSDXY=BSDXRET_$C(31) Q
. S BSDXIEN=0 F S BSDXIEN=$O(^AUPNPAT("D",BSDXP,BSDXIEN)) Q:'+BSDXIEN I $D(^AUPNPAT("D",BSDXP,BSDXIEN,DUZ(2))) D Q
. . Q:'$D(^DPT(BSDXIEN,0))

2
m/BSDX29.m
View File

@ -1,5 +1,5 @@
BSDX29 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 6/22/12 1:46pm
;;1.7T1;BSDX;;Aug 31, 2011;Build 18
;;1.7T1;BSDX;;Jul 06, 2012;Build 18
; Licensed under LGPL
;
; Change Log:

2
m/BSDX2E.m
View File

@ -1,5 +1,5 @@
BSDX2E ;IHS/OIT/MJL - ENVIRONMENT CHECK FOR WINDOWS SCHEDULING [4/28/11 10:28am]
;;1.6T2;BSDX;;May 16, 2011
;;1.7T1;BSDX;;Jul 06, 2012;Build 18
; Licensed under LGPL
;
S LINE="",$P(LINE,"*",81)=""

27
m/BSDX30.m
View File

@ -1,12 +1,12 @@
BSDX30 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; [4/28/11 10:28am]
;;1.6T2;BSDX;;May 16, 2011
BSDX30 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; [7/6/12 11:03am]
;;1.7T1;BSDX;;Jul 06, 2012;Build 18
; Licensed under LGPL
;
;
SPACED(BSDXY,BSDXDIC,BSDXVAL) ;EP
;Entry point for debugging
;
D DEBUG^%Serenji("SPACE^BSDX30(.BSDXY,BSDXDIC,BSDXVAL)")
; D DEBUG^%Serenji("SPACE^BSDX30(.BSDXY,BSDXDIC,BSDXVAL)")
Q
;
SPACE(BSDXY,BSDXDIC,BSDXVAL) ;EP
@ -48,7 +48,7 @@ ETRAP ;EP Error trap entry
;
EHRPTD(BSDXY,BSDXWID,BSDXDFN) ;
;
D DEBUG^%Serenji("EHRPT^BSDX30(.BSDXY,BSDXWID,BSDXDFN)")
; D DEBUG^%Serenji("EHRPT^BSDX30(.BSDXY,BSDXWID,BSDXDFN)")
Q
;
EHRPT(BSDXY,BSDXWID,BSDXDFN) ;
@ -69,6 +69,9 @@ EHRPT(BSDXY,BSDXWID,BSDXDFN) ;
Q
;
PEVENT(BSDXWID,DFN) ;EP - Raise patient selection event to EHR
; VEN/SMH v1.7 3120706 - Not used in VISTA.
; No way right now to synchronize with CPRS.
; Code commented out for now.
;
;Change patient context to patient DFN
;on all EHR client sessions associated with user DUZ
@ -77,14 +80,14 @@ PEVENT(BSDXWID,DFN) ;EP - Raise patient selection event to EHR
;If BSDXWID is "", the context change is sent to
;all EHR client sessions belonging to user DUZ.
;
Q:'$G(DUZ)
;Q:'$G(DUZ)
;N X
;S X="CIANBUTL" X ^%ZOSF("TEST") Q:'$T
;S X="CIANBEVT" X ^%ZOSF("TEST") Q:'$T
N UID,BRET
S BRET=0,UID=0
F S BRET=$$NXTUID^CIANBUTL(.UID,1) Q:'UID D
. Q:DUZ'=$$GETVAR^CIANBUTL("DUZ",,,UID)
. I BSDXWID'="" Q:BSDXWID'=$TR($$GETVAR^CIANBUTL("WID",,,UID),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
. D QUEUE^CIANBEVT("CONTEXT.PATIENT",+DFN,UID)
Q
;N UID,BRET
;S BRET=0,UID=0
;F S BRET=$$NXTUID^CIANBUTL(.UID,1) Q:'UID D
;. Q:DUZ'=$$GETVAR^CIANBUTL("DUZ",,,UID)
;. I BSDXWID'="" Q:BSDXWID'=$TR($$GETVAR^CIANBUTL("WID",,,UID),"abcdefghijklmnopqrstuvwxyz","ABCDEFGHIJKLMNOPQRSTUVWXYZ")
;. D QUEUE^CIANBEVT("CONTEXT.PATIENT",+DFN,UID)
;Q

4
m/BSDX31.m
View File

@ -1,5 +1,5 @@
BSDX31 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 6/27/12 4:57pm
;;1.7T1;BSDX;;Aug 31, 2011;Build 18
;;1.7T1;BSDX;;Jul 06, 2012;Build 18
; Licensed under LGPL
; Change Log:
; v1.42 3101023 WV/SMH - Change transaction to restartable.
@ -120,7 +120,7 @@ NOSHOW(BSDXY,BSDXAPTID,BSDXNS) ;EP - No show a patient
S ^BSDXTMP($J,BSDXI)=$C(31)
QUIT
;
BSDXNOS(BSDXAPTID,BSDXNS) ; $$ Private; File/unfile noshow in ^BSDXAPPT
BSDXNOS(BSDXAPTID,BSDXNS) ; $$ Private; File/unfile noshow in ^BSDXAPPT
; in v1.7 I delete the no-show value rather than file zero
N BSDXFDA,BSDXIENS,BSDXMSG
N BSDXVALUE ; What to file: 1 or delete it.

2
m/BSDX32.m
View File

@ -1,5 +1,5 @@
BSDX32 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 5/11/11 10:39am
;;1.6T2;BSDX;;May 16, 2011
;;1.7T1;BSDX;;Jul 06, 2012;Build 18
; Licensed under LGPL
;
; Change Log:

2
m/BSDX33.m
View File

@ -1,5 +1,5 @@
BSDX33 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:29am
;;1.6T2;BSDX;;May 16, 2011
;;1.7T1;BSDX;;Jul 06, 2012;Build 18
; Licensed under LGPL
; Mods by WV/STAR
;

2
m/BSDX34.m
View File

@ -1,5 +1,5 @@
BSDX34 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:29am
;;1.6T2;BSDX;;May 16, 2011
;;1.7T1;BSDX;;Jul 06, 2012;Build 18
; Licensed under LGPL
;
; Change Log:

2
m/BSDX35.m
View File

@ -1,5 +1,5 @@
BSDX35 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 6/21/12 3:57pm
;;1.7T1;BSDX;;Aug 31, 2011;Build 18
;;1.7T1;BSDX;;Jul 06, 2012;Build 18
; Licensed under LGPL
;
;

34
m/BSDXAPI.m
View File

@ -1,5 +1,5 @@
BSDXAPI ; IHS/LJF,HMW,MAW & VEN/SMH - SCHEDULING APIs ; 7/5/12 12:52pm
;;1.7T1;BSDX;;Aug 31, 2011;Build 18
BSDXAPI ; IHS/LJF,HMW,MAW & VEN/SMH - SCHEDULING APIs ; 7/6/12 10:24am
;;1.7T1;BSDX;;Jul 06, 2012;Build 18
; Licensed under LGPL
;
; Orignal routine is BSDAPI by IHS/LJF, HMW, and MAW
@ -111,7 +111,7 @@ MAKE(BSDR) ;PEP; call to store appt made
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"))
D AVUPDTMK^BSDXAPI1(BSDR("CLN"),BSDR("ADT"),BSDR("LEN"),BSDR("PAT"))
;
; call event driver
NEW DFN,SDT,SDCL,SDDA,SDMODE
@ -120,7 +120,7 @@ MAKE(BSDR) ;PEP; call to store appt made
D MAKE^SDAMEVT(DFN,SDT,SDCL,SDDA,SDMODE)
Q 0
;
MAKECK(BSDR) ; $$ - Is it okay to make an appointment? ; PEP
MAKECK(BSDR) ; $$ - Is it okay to make an appointment? ; PEP
; Input: Same as $$MAKE
; Output: 1^error or 0 for success
; NB: This subroutine saves no data. Only checks whether it's okay.
@ -150,7 +150,7 @@ MAKECK(BSDR) ; $$ - Is it okay to make an appointment? ; PEP
. . S BSDXERR=BSDXERR_$C(13,10)_"Scheduling GUI clinic: "_BSDXRESNAM ; tell the user of the BSDX clinic
Q 0
;
UNMAKE(BSDR) ; Reverse Make - Private $$
UNMAKE(BSDR) ; Reverse Make - Private $$
; Only used in Emergiencies where Fileman data filing fails.
; If previous data exists, which caused an error, it's destroyed.
; NB: ^DIK stops for nobody
@ -255,7 +255,7 @@ CHECKIC1(DFN,CLIN,APDATE) ; Simplified PEP w/ parameters for $$CHECKICK -
S BSDR("USR")=DUZ ;Check-in user defaults to current
Q $$CHECKICK(.BSDR)
;
CHECKICK(BSDR) ; $$ PEP; - Is it okay to check-in patient?
CHECKICK(BSDR) ; $$ PEP; - Is it okay to check-in patient?
; Input: Same as $$CHECKIN
; Output: 0 if okay or 1^message if error
;
@ -370,7 +370,7 @@ CANCEL(BSDR) ;PEP; called to cancel appt
;
Q 0
;
CANCELCK(BSDR) ; $$ PEP; Okay to Cancel Appointment?
CANCELCK(BSDR) ; $$ PEP; Okay to Cancel Appointment?
; Input: .BSDR array as documented in $$CANCEL
; Output: 0 or 1^Error message
I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
@ -385,7 +385,11 @@ CANCELCK(BSDR) ; $$ PEP; Okay to Cancel Appointment?
;
NEW IEN S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
I 'IEN Q 1_U_"Error trying to find appointment for cancel: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
;
; Check-out check. New in v1.7
I $$CO(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"),IEN) Q 1_U_"Cannot delete. Appointment has already been checked-out!"
Q 0
;
CI(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-in
NEW X
S X=$G(SDIEN) ;ien sent in call
@ -393,6 +397,13 @@ CI(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-in
S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U)
Q $S(X:1,1:0)
;
CO(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-out
NEW X
S X=$G(SDIEN) ;ien sent in call
I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0
S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U,3)
Q $S(X:1,1:0)
;
SCIEN(PAT,CLINIC,DATE) ;PEP; returns ien for appt in ^SC
NEW X,IEN
S X=0 F S X=$O(^SC(CLINIC,"S",DATE,1,X)) Q:'X Q:$G(IEN) D
@ -400,7 +411,7 @@ SCIEN(PAT,CLINIC,DATE) ;PEP; returns ien for appt in ^SC
. I +$G(^SC(CLINIC,"S",DATE,1,X,0))=PAT S IEN=X
Q $G(IEN)
;
APPLEN(PAT,CLINIC,DATE) ; $$ PEP; returns an appointment's length
APPLEN(PAT,CLINIC,DATE) ; $$ PEP; returns an appointment's length
; Get either the appointment length or zero
; TODO: Test
N SCIEN S SCIEN=$$SCIEN(PAT,CLINIC,DATE)
@ -410,13 +421,6 @@ APPTYP(PAT,DATE) ;PEP; -- returns type of appt (scheduled or walk-in)
NEW X S X=$P($G(^DPT(PAT,"S",DATE,0)),U,7)
Q $S(X=3:"SCHED",X=4:"WALK-IN",1:"??")
;
CO(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-out
NEW X
S X=$G(SDIEN) ;ien sent in call
I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0
S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U,3)
Q $S(X:1,1:0)
;
UPDATENT(PAT,CLINIC,DATE,NOTE) ; PEP; Update Note in ^SC for patient's appointment @ DATE
; PAT = DFN
; CLINIC = SC IEN

12
m/BSDXAPI1.m
View File

@ -1,5 +1,5 @@
BSDXAPI1 ; VEN/SMH - SCHEDULING APIs - Continued!!! ; 7/5/12 12:55pm
;;1.7T1;BSDX;;Aug 31, 2011;Build 18
BSDXAPI1 ; VEN/SMH - SCHEDULING APIs - Continued!!! ; 7/6/12 10:23am
;;1.7T1;BSDX;;Jul 06, 2012;Build 18
; Licensed under LGPL
;
; Change History (BSDXAPI and BSDXAPI1)
@ -49,7 +49,7 @@ BSDXAPI1 ; VEN/SMH - SCHEDULING APIs - Continued!!! ; 7/5/12 12:55pm
; 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)
NOSHOW(PAT,CLINIC,DATE,NSFLAG) ; $$ PEP; No-show Patient at appt date (new in v1.7)
; PAT = DFN
; CLINIC = SC IEN
; DATE = FM Date/Time of Appointment
@ -96,7 +96,7 @@ NOSHOW(PAT,CLINIC,DATE,NSFLAG) ; $$ PEP; No-show Patient at appt date (new in v1
D NOSHOW^SDAMEVT(.SDATA,PAT,DATE,CLINIC,SDDA,0,SDNSHDL)
Q 0
;
NOSHOWCK(PAT,CLINIC,DATE,NSFLAG) ; $$ PEP; No-show Check
NOSHOWCK(PAT,CLINIC,DATE,NSFLAG) ; $$ PEP; No-show Check
; TODO: Not all appointments can be no showed.
; Check the code in SDAMN
; S SDSTB=$$STATUS^SDAM1(DFN,SDT,SDCL,$G(^DPT(DFN,"S",SDT,0))) ; before status
@ -242,7 +242,7 @@ AVUPDTCN(BSDXSCD,BSDXSTART,BSDXLEN) ;Update PIMS Clinic availability for cancel
S ^SC(BSDXSCD,"ST",SD\1,1)=S ; new pattern; global set
Q
;
AVUPDTMK(BSDXSCD,BSDXSTART,BSDXLEN) ; Update RPMS Clinic availability for Make
AVUPDTMK(BSDXSCD,BSDXSTART,BSDXLEN,BSDXPATID) ; 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
@ -254,7 +254,7 @@ AVUPDTMK(BSDXSCD,BSDXSTART,BSDXLEN) ; Update RPMS Clinic availability for Make
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
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

6
m/BSDXGPRV.m
View File

@ -1,5 +1,5 @@
BSDXGPRV ; WV/SMH - WINDOWS SCHEDULING RPCS ; 4/28/11 10:31am
;;1.6T2;BSDX;;May 16, 2011
BSDXGPRV ; WV/SMH - WINDOWS SCHEDULING RPCS ; 7/6/12 11:07am
;;1.7T1;BSDX;;Jul 06, 2012;Build 18
; Licensed under LGPL
;
;
@ -17,7 +17,7 @@ ERR(BSDXERR) ;Error processing
;
PD(BSDXY,HLIEN) ;EP Debugging entry point
;
D DEBUG^%Serenji("P^BSDXGPRV(.BSDXY,HLIEN)","192.168.254.130")
;D DEBUG^%Serenji("P^BSDXGPRV(.BSDXY,HLIEN)","192.168.254.130")
;
Q
;

136
m/BSDXUT.m
View File

@ -1,5 +1,5 @@
BSDXUT ; VEN/SMH - Unit Tests for Scheduling GUI ; 6/29/12 12:20pm
;;1.7T1;BSDX;;Aug 31, 2011;Build 18
BSDXUT ; VEN/SMH - Unit Tests for Scheduling GUI ; 6/29/12 12:20pm
;;1.7T1;BSDX;;Jul 06, 2012;Build 18
; Licensed under LGPL
;
; Change Log:
@ -241,69 +241,69 @@ UT07 ; Unit Tests for BSDX07 - Assumes you have Patients with DFNs 1,2,3,4,5
I '+APPID W "Error in deleting appointment-104",!
QUIT
;
UTCR(RESNAM) ; $$ - Create Unit Test Clinic and Resource Pair ; Private
; Input: Resource Name By Value
; Output: -1^Error or HLIEN^RESIEN for Success (file 44 IEN^file 9002018.1 IEN)
; DO NOT USE IN A PRODUCTION ENVIRONTMENT. INTENDED FOR TESTING ONLY
N HLIEN S HLIEN=$$UTCR44(RESNAM)
I +HLIEN=-1 QUIT HLIEN
;
N RESIEN S RESIEN=$$UTCRRES(RESNAM,HLIEN)
I +RESIEN=-1 QUIT RESIEN
E QUIT HLIEN_U_RESIEN
;
UTCR44(HLNAME) ; $$ - Create Unit Test Clinic in File 44; Private ; TESTING ONLY CODE
; Output: -1^Error or IEN for Success
; Input: Hosp Location Name by Value
; DO NOT USE IN A PRODUCTION ENVIRONTMENT. INTENDED FOR TESTING ONLY
;
I $D(^SC("B",HLNAME)) Q $O(^(HLNAME,""))
;
N SAM
S SAM(44,"?+1,",.01)=HLNAME ; Name
S SAM(44,"?+1,",2)="C" ; Type = Clinic
S SAM(44,"?+1,",2.1)=1 ; Type Extension (not used)
S SAM(44,"?+1,",3.5)=$O(^DG(40.8,0)) ; Division (not yet used)
S SAM(44,"?+1,",8)=295 ; Stop Code Number (not used)
S SAM(44,"?+1,",9)="M" ; Service (not used)
S SAM(44,"?+1,",1912)=15 ; Length of Appt (not used)
S SAM(44,"?+1,",1917)=4 ; Display increments per hour (not used)
S SAM(44,"?+1,",1918)=8 ; Overbooks/day max (not used)
S SAM(44,"?+1,",2000.5)=0 ; Require Action Profiles: Yes (not used)
S SAM(44,"?+1,",2001)=999 ; Allowable consecutive no-shows (not used)
S SAM(44,"?+1,",2002)=999 ; Max # days for Future Booking (not used)
S SAM(44,"?+1,",2005)=365 ; Max # days for Auto Rebook (not used)
S SAM(44,"?+1,",2502)="N" ; Non-Count Clinic (not used)
S SAM(44,"?+1,",2504)="Y" ; Clinic meets at this Facility? (not used)
S SAM(44,"?+1,",2507)=9 ; Appointment Type (not used)
;
N BSDXERR,BSDXIEN
D UPDATE^DIE("",$NA(SAM),$NA(BSDXIEN),$NA(BSDXERR))
Q $S($D(BSDXERR):-1_U_BSDXERR("DIERR",1,"TEXT",1),1:BSDXIEN(1))
;
UTCRRES(NAME,HLIEN) ; $$ - Create Unit Test Resource in 9002018.1 (BSDX RESOURCE); Private
; Input: Hospital Location IEN
; Output: -1^Error or IEN for Success
; DO NOT USE IN A PRODUCTION ENVIRONTMENT. INTENDED FOR TESTING ONLY
I $D(^BSDXRES("B",NAME)) Q $O(^(NAME,""))
S HLIEN=$G(HLIEN) ; If we don't send one in
N RES ; garbage variable
D RSRC^BSDX16(.RES,"|"_NAME_"||"_HLIEN)
N RTN S RTN=@$Q(^BSDXTMP($J,0)) ; return array next value
Q $S(RTN=0:-1_U_RTN,1:+RTN) ; 0 means an error has occurred; 1 means IEN returned
;
TIMES() ; $$ - Create a next available appointment time^ending time; Private
; Output: appttime^endtime
N NOW S NOW=$$NOW^XLFDT() ; Now time
N LAST S LAST=$O(^BSDXAPPT("B"," "),-1) ; highest time in file
N TIME2USE S TIME2USE=$S(NOW>LAST:NOW,1:LAST) ; Which time to use?
S TIME2USE=$E(TIME2USE,1,12) ; Strip away seconds
N APPTIME S APPTIME=$$FMADD^XLFDT(TIME2USE,0,0,15,0) ; Add 15 min
N ENDTIME S ENDTIME=$$FMADD^XLFDT(APPTIME,0,0,15,0) ; Add 15 more min
Q APPTIME_U_ENDTIME ; quit with apptime^endtime
;
TIMEHL(HLIEN) ; $$ - Create a next available appointment time^ending time by HL; Private
; Input: HLIEN
; Output: Next available appointment time for the HLIEN
N LAST S LAST=$O(^SC(HLIEN,"S",""),-1)
Q $$FMADD^XLFDT(LAST,1,0,15,0) ; Add 1 day and 15 minutes
UTCR(RESNAM) ; $$ - Create Unit Test Clinic and Resource Pair ; Private
; Input: Resource Name By Value
; Output: -1^Error or HLIEN^RESIEN for Success (file 44 IEN^file 9002018.1 IEN)
; DO NOT USE IN A PRODUCTION ENVIRONTMENT. INTENDED FOR TESTING ONLY
N HLIEN S HLIEN=$$UTCR44(RESNAM)
I +HLIEN=-1 QUIT HLIEN
;
N RESIEN S RESIEN=$$UTCRRES(RESNAM,HLIEN)
I +RESIEN=-1 QUIT RESIEN
E QUIT HLIEN_U_RESIEN
;
UTCR44(HLNAME) ; $$ - Create Unit Test Clinic in File 44; Private ; TESTING ONLY CODE
; Output: -1^Error or IEN for Success
; Input: Hosp Location Name by Value
; DO NOT USE IN A PRODUCTION ENVIRONTMENT. INTENDED FOR TESTING ONLY
;
I $D(^SC("B",HLNAME)) Q $O(^(HLNAME,""))
;
N SAM
S SAM(44,"?+1,",.01)=HLNAME ; Name
S SAM(44,"?+1,",2)="C" ; Type = Clinic
S SAM(44,"?+1,",2.1)=1 ; Type Extension (not used)
S SAM(44,"?+1,",3.5)=$O(^DG(40.8,0)) ; Division (not yet used)
S SAM(44,"?+1,",8)=295 ; Stop Code Number (not used)
S SAM(44,"?+1,",9)="M" ; Service (not used)
S SAM(44,"?+1,",1912)=15 ; Length of Appt (not used)
S SAM(44,"?+1,",1917)=4 ; Display increments per hour (not used)
S SAM(44,"?+1,",1918)=8 ; Overbooks/day max (not used)
S SAM(44,"?+1,",2000.5)=0 ; Require Action Profiles: Yes (not used)
S SAM(44,"?+1,",2001)=999 ; Allowable consecutive no-shows (not used)
S SAM(44,"?+1,",2002)=999 ; Max # days for Future Booking (not used)
S SAM(44,"?+1,",2005)=365 ; Max # days for Auto Rebook (not used)
S SAM(44,"?+1,",2502)="N" ; Non-Count Clinic (not used)
S SAM(44,"?+1,",2504)="Y" ; Clinic meets at this Facility? (not used)
S SAM(44,"?+1,",2507)=9 ; Appointment Type (not used)
;
N BSDXERR,BSDXIEN
D UPDATE^DIE("",$NA(SAM),$NA(BSDXIEN),$NA(BSDXERR))
Q $S($D(BSDXERR):-1_U_BSDXERR("DIERR",1,"TEXT",1),1:BSDXIEN(1))
;
UTCRRES(NAME,HLIEN) ; $$ - Create Unit Test Resource in 9002018.1 (BSDX RESOURCE); Private
; Input: Hospital Location IEN
; Output: -1^Error or IEN for Success
; DO NOT USE IN A PRODUCTION ENVIRONTMENT. INTENDED FOR TESTING ONLY
I $D(^BSDXRES("B",NAME)) Q $O(^(NAME,""))
S HLIEN=$G(HLIEN) ; If we don't send one in
N RES ; garbage variable
D RSRC^BSDX16(.RES,"|"_NAME_"||"_HLIEN)
N RTN S RTN=@$Q(^BSDXTMP($J,0)) ; return array next value
Q $S(RTN=0:-1_U_RTN,1:+RTN) ; 0 means an error has occurred; 1 means IEN returned
;
TIMES() ; $$ - Create a next available appointment time^ending time; Private
; Output: appttime^endtime
N NOW S NOW=$$NOW^XLFDT() ; Now time
N LAST S LAST=$O(^BSDXAPPT("B"," "),-1) ; highest time in file
N TIME2USE S TIME2USE=$S(NOW>LAST:NOW,1:LAST) ; Which time to use?
S TIME2USE=$E(TIME2USE,1,12) ; Strip away seconds
N APPTIME S APPTIME=$$FMADD^XLFDT(TIME2USE,0,0,15,0) ; Add 15 min
N ENDTIME S ENDTIME=$$FMADD^XLFDT(APPTIME,0,0,15,0) ; Add 15 more min
Q APPTIME_U_ENDTIME ; quit with apptime^endtime
;
TIMEHL(HLIEN) ; $$ - Create a next available appointment time^ending time by HL; Private
; Input: HLIEN
; Output: Next available appointment time for the HLIEN
N LAST S LAST=$O(^SC(HLIEN,"S",""),-1)
Q $$FMADD^XLFDT(LAST,1,0,15,0) ; Add 1 day and 15 minutes

8
m/BSDXUT1.m
View File

@ -1,5 +1,5 @@
BSDXUT1 ; VEN/SMH - Unit Tests for Scheduling GUI - cont. ; 7/3/12 12:28pm
;;1.7T1;BSDX;;Aug 31, 2011;Build 18
BSDXUT1 ; VEN/SMH - Unit Tests for Scheduling GUI - cont. ; 7/3/12 12:28pm
;;1.7T1;BSDX;;Jul 06, 2012;Build 18
;
;
EN ; Run All Unit Tests in this routine
@ -144,7 +144,7 @@ UT08 ; Unit Tests for BSDX08; Must have patients 1,2,3,4,5 defined in system
I $P(^BSDXTMP($J,1),$C(30))'="" W "Error in test 6",!
QUIT
;
UT29 ; Unit Test for BSDX29
UT29 ; Unit Test for BSDX29
; HLs/Resources are created as part of the UT
; Patients 1,2,3,4,5 must exist
;
@ -338,7 +338,7 @@ UT26 ; Unit Tests - BSDX26
I $P(^SC(HLIEN,"S",APPTTIME,1,1,0),U,4)'=ORIGNOTE W "ERROR 4",!
QUIT
;
UT31 ; Unit Tests for BSDX31
UT31 ; Unit Tests for BSDX31
; Set-up - Create Clinics
N RESNAM S RESNAM="UTCLINIC"
N HLRESIENS ; holds output of UTCR^BSDXUT - HL IEN^Resource IEN

6
m/BSDXUT2.m
View File

@ -1,11 +1,11 @@
BSDXUT2 ; VEN/SMH - Unit Tests for Scheduling GUI - cont. ; 7/5/12 11:39am
;;1.7T1;BSDX;;Aug 31, 2011;Build 18
BSDXUT2 ; VEN/SMH - Unit Tests for Scheduling GUI - cont. ; 7/5/12 11:39am
;;1.7T1;BSDX;;Jul 06, 2012;Build 18
;
EN ; Run all unit tests in this routine
D UT25
QUIT
;
UT25 ; Unit Tests for BSDX25
UT25 ; Unit Tests for BSDX25
; Make appointment, checkin, then uncheckin
N $ET S $ET="W ""An Error Occured. Breaking."",! BREAK"
N RESNAM S RESNAM="UTCLINIC"