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

more changes

This commit is contained in:
sam 2012-06-19 00:08:50 +00:00
parent 5cf0d57720
commit ab78c286b4
3 changed files with 84 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
m/BSDX07.m
View File

@ -1,4 +1,4 @@
BSDX07 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 6/18/12 2:27pm
BSDX07 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 6/18/12 5:12pm
;;1.7T1;BSDX;;Aug 31, 2011;Build 18
; Licensed under LGPL
;
@ -24,7 +24,7 @@ BSDX07 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 6/18/12 2:27pm
; -9: Couldn't add appointment to BSDX APPOINTMENT
; -10: Couldn't add appointment to files 2 and/or 44
; -100: Mumps Error
;
APPADDD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID) ;EP
;Entry point for debugging
D DEBUG^%Serenji("APPADD^BSDX07(.BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID)")
@ -37,7 +37,7 @@ UT ; Unit Tests
D
. N $ET S $ET="D ^%ZTER B"
. S HLRESIENS=$$UTCR^BSDX35(RESNAM)
. I %<0 S $EC=",U1," ; not supposed to happen
. I HLRESIENS<0 S $EC=",U1," ; not supposed to happen
;
N HLIEN,RESIEN
S HLIEN=$P(HLRESIENS,U)
@ -57,6 +57,14 @@ UT ; Unit Tests
I +^BSDXAPPT(APPID,0)'=APPTTIME W "Error Making Appt-2"
I '$D(^DPT(3,"S",APPTTIME)) W "Error Making Appt-3"
I '$D(^SC(HLIEN,"S",APPTTIME)) W "Error Making Appt-4"
;
; Do it again for a different patient
D APPADD(.ZZZ,APPTTIME,ENDTIME,2,RESNAM,30,"Sam's Note",1)
N APPID S APPID=+$P(^BSDXTMP($J,1),U) B
I 'APPID W "Error Making Appt-5" QUIT
I +^BSDXAPPT(APPID,0)'=APPTTIME W "Error Making Appt-6"
I '$D(^DPT(2,"S",APPTTIME)) W "Error Making Appt-7"
I '$D(^SC(HLIEN,"S",APPTTIME)) W "Error Making Appt-8"
;
; Test for bad start date
D APPADD(.ZZZ,2100123,3100123.3,2,RESNAM,30,"Sam's Note",1)
@ -68,15 +76,15 @@ UT ; Unit Tests
; D APPADD(.ZZZ,3100123.1,3100123,2,RESNAM,30,"Sam's Note",1)
; I +$P(^BSDXTMP($J,1),U,2)'=-4 W "Error in -4",!
; Test for mumps error
S bsdxdie=1
D APPADD(.ZZZ,APPTTIME,ENDTIME,2,RESNAM,30,"Sam's Note",1)
S BSDXDIE=1
D APPADD(.ZZZ,APPTTIME,ENDTIME,1,RESNAM,30,"Sam's Note",1)
I +$P(^BSDXTMP($J,1),U,2)'=-100 W "Error in -100: M Error",!
K bsdxdie
K BSDXDIE
; Test for TRESTART
s bsdxrestart=1
s BSDXRESTART=1
D APPADD(.ZZZ,APPTTIME,ENDTIME,3,RESNAM,30,"Sam's Note",1)
I +$P(^BSDXTMP($J,1),U,2)'=0&(+$P(^BSDXTMP($J,1),U,2)'=-10) W "Error in TRESTART",!
k bsdxrestart
k BSDXRESTART
; Test for non-numeric patient
D APPADD(.ZZZ,APPTTIME,ENDTIME,"CAT,DOG",RESNAM,30,"Sam's Note",1)
I +$P(^BSDXTMP($J,1),U,2)'=-5 W "Error in -5",!
@ -157,10 +165,10 @@ APPADD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID,BSDXR
N BSDXERR S BSDXERR=0
;
;;;test for error inside transaction. See if %ZTER works
I $G(bsdxdie) S X=1/0
I $G(BSDXDIE) S X=1/0
;;;test
;;;test for TRESTART
I $G(bsdxrestart) K bsdxrestart TRESTART
I $G(BSDXRESTART) K BSDXRESTART TRESTART
;;;test
;
; -- Start and End Date Processing --
@ -255,7 +263,7 @@ BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRESD,BSDXATID,BSDXRADEXAM) ;ADD BSDX AP
S BSDXFDA(9002018.4,"+1,",.09)=$$NOW^XLFDT
S:BSDXATID="WALKIN" BSDXFDA(9002018.4,"+1,",.13)="y"
S:BSDXATID?.N BSDXFDA(9002018.4,"+1,",.06)=BSDXATID
S BSDXFDA(9002018.4,"+1,",.14)=BSDXRADEXAM
S BSDXFDA(9002018.4,"+1,",.14)=$G(BSDXRADEXAM)
N BSDXIEN,BSDXMSG
D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
S BSDXAPPTID=+$G(BSDXIEN(1))

6
m/BSDX26.m
View File

@ -1,5 +1,5 @@
BSDX26 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:24am
;;1.6T2;BSDX;;May 16, 2011
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.
@ -103,7 +103,7 @@ EDITAPT(BSDXY,BSDXAPTID,BSDXNOTE) ;EP Edit appointment (only note text can be
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=$$UPDATENOTE^BSDXAPI(PTIEN,HLIEN,DATE,BSDXNOTE(.5))
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

93
m/BSDXAPI.m
View File

@ -1,5 +1,5 @@
BSDXAPI ; IHS/ANMC/LJF & VW/SMH - SCHEDULING APIs ; 4/28/11 10:30am
;;1.6T2;BSDX;;May 16, 2011;Build 7
BSDXAPI ; IHS/ANMC/LJF & VW/SMH - SCHEDULING APIs ; 6/18/12 5:31pm
;;1.6;BSDX;;Aug 31, 2011;Build 18
; Licensed under LGPL
;
;Orignal routine is BSDAPI by IHS/LJF, HMW, and MAW
@ -31,7 +31,10 @@ BSDXAPI ; IHS/ANMC/LJF & VW/SMH - SCHEDULING APIs ; 4/28/11 10:30am
; 2011-01-26 (v.1.5)
; More user friendly message if patient already has appointment in $$MAKE:
; Spits out pt name and user friendly date.
;
; 2012-06-18 (v 1.7)
; Removing transacions. Means that code SHOULD NOT fail. Took all checks
; out for making an appointment to MAKECK. We call this first to make sure
; that the appointment is okay to make before committing to make it.
;
MAKE1(DFN,CLIN,TYP,DATE,LEN,INFO) ; Simplified PEP w/ parameters for $$MAKE - making appointment
; Call like this for DFN 23435 having an appointment at Hospital Location 33
@ -64,29 +67,9 @@ MAKE(BSDR) ;PEP; call to store appt made
; = 0 or null: everything okay
; = 1^message: error and reason
;
I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
I ($G(BSDR("TYP"))<3)!($G(BSDR("TYP"))>4) Q 1_U_"Appt Type error: "_$G(BSDR("TYP"))
I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds
I $G(BSDR("ADT"))'?7N.1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
;
;I ($G(BSDR("LEN"))<5)!($G(BSDR("LEN"))>240) Q 1_U_"Appt Length error: "_$G(BSDR("LEN")) ; v 1.42 - no check on length is done anymore. see top comments for details.
I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR"))
;I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)'["C" Q 1_U_"Patient "_BSDR("PAT")_" already has appt at "_BSDR("ADT") ; v.1.5 more user friendly err msg
;
; Following block to give an error message to user if there is already an appointment for patient. More verbose than others.
N BSDXERR ; place to store error message
I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)'["C" DO QUIT BSDXERR ; If there's an appt in the "S" node of file 2 and it's not cancelled
. S BSDXERR=1_U_"Patient "_$P(^DPT(BSDR("PAT"),0),U)_" ("_BSDR("PAT")_") "
. S BSDXERR=BSDXERR_"already has appt at "_$$FMTE^XLFDT(BSDR("ADT"))
. N BSDXSCIEN S BSDXSCIEN=$P(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0),U) ; Clinic IEN in ^SC (0 piece of 0 node of "S" multiple in file 2)
. N BSDXSCNAM S BSDXSCNAM=$P(^SC(BSDXSCIEN,0),U) ; PIMS Name of Clinic
. S BSDXERR=BSDXERR_$C(13,10)_"PIMS clinic: "_BSDXSCNAM ; tell the user of the PIMS clinic
. I $D(^BSDXRES("ALOC",BSDXSCIEN)) DO ; if the Clinic is linked to a BSDX Resource (we find out using the index ALOC in the BSDX RESOURCE file)
. . N BSDXRESIEN S BSDXRESIEN=$O(^BSDXRES("ALOC",BSDXSCIEN,""))
. . QUIT:'BSDXRESIEN ; Safeguard if index is corrupt
. . N BSDXRESNAM S BSDXRESNAM=$P(^BSDXRES(BSDXRESIEN,0),U)
. . S BSDXERR=BSDXERR_$C(13,10)_"Scheduling GUI clinic: "_BSDXRESNAM ; tell the user of the BSDX clinic
N BSDXMKCK S BSDXMKCK=$$MAKECK(.BSDR) ; Check if we can make appointment
I BSDXMKCK Q BSDXMKCK ; If we can't, quit with the reason why.
; Otherwise, we continue
;
NEW DIC,DA,Y,X,DD,DO,DLAYGO
;
@ -105,7 +88,7 @@ MAKE(BSDR) ;PEP; call to store appt made
. S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT
. D FILE^DIE("","BSDXFDA","BSDXMSG")
. N BSDXTEMP S BSDXTEMP=$G(BSDXMSG)
E D I $G(BSDXERR(1)) Q 1_U_"FileMan add to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT")
E D
. N BSDXFDA,BSDXIENS,BSDXMSG
. S BSDXIENS="?+2,"_BSDR("PAT")_","
. S BSDXIENS(2)=BSDR("ADT")
@ -114,13 +97,15 @@ MAKE(BSDR) ;PEP; call to store appt made
. S BSDXFDA(2.98,BSDXIENS,"9.5")=9
. S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT
. D UPDATE^DIE("","BSDXFDA","BSDXIENS","BSDXERR(1)")
; add appt to file 44
I $G(BSDXERR(1)) Q 1_U_"FileMan add to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT")
; add appt to file 44
K DIC,DA,X,Y,DLAYGO,DD,DO
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")
. S DIC("P")="44.001DA",DIC(0)="L",DLAYGO=44.001
. S Y=1 I '$D(@(DIC_X_")")) D FILE^DICN
;
; Sep 28 2010: Changed old style API to new style API. Keep for reference //smh
;K DIC,DA,X,Y,DLAYGO,DD,DO,DINUM
@ -149,6 +134,50 @@ 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
I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
I ($G(BSDR("TYP"))<3)!($G(BSDR("TYP"))>4) Q 1_U_"Appt Type error: "_$G(BSDR("TYP"))
I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12) ;remove seconds
I $G(BSDR("ADT"))'?7N.1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
;
; Appt Length check removed in v 1.5
;
I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR"))
; More verbose error message in v1.5
; Following block to give an error message to user if there is already an appointment for patient. More verbose than others.
N BSDXERR ; place to store error message
I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)'["C" DO QUIT BSDXERR ; If there's an appt in the "S" node of file 2 and it's not cancelled
. S BSDXERR=1_U_"Patient "_$P(^DPT(BSDR("PAT"),0),U)_" ("_BSDR("PAT")_") "
. S BSDXERR=BSDXERR_"already has appt at "_$$FMTE^XLFDT(BSDR("ADT"))
. N BSDXSCIEN S BSDXSCIEN=$P(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0),U) ; Clinic IEN in ^SC (0 piece of 0 node of "S" multiple in file 2)
. N BSDXSCNAM S BSDXSCNAM=$P(^SC(BSDXSCIEN,0),U) ; PIMS Name of Clinic
. S BSDXERR=BSDXERR_$C(13,10)_"PIMS clinic: "_BSDXSCNAM ; tell the user of the PIMS clinic
. I $D(^BSDXRES("ALOC",BSDXSCIEN)) DO ; if the Clinic is linked to a BSDX Resource (we find out using the index ALOC in the BSDX RESOURCE file)
. . N BSDXRESIEN S BSDXRESIEN=$O(^BSDXRES("ALOC",BSDXSCIEN,""))
. . QUIT:'BSDXRESIEN ; Safeguard if index is corrupt
. . N BSDXRESNAM S BSDXRESNAM=$P(^BSDXRES(BSDXRESIEN,0),U)
. . S BSDXERR=BSDXERR_$C(13,10)_"Scheduling GUI clinic: "_BSDXRESNAM ; tell the user of the BSDX clinic
Q 0
;
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.
N BSDXFDA,BSDXIENS
S BSDXIENS=BSDR("ADT")_","_BSDR("PAT")_","
S BSDXFDA(2.98,BSDXIENS,".01")="@"
;
I '$D(^SC(BSDR("CLN"),"S",BSDR("ADT"),1)) QUIT 0 ; No stuff in HL file
N X S X=0 F S X=$O(^SC(BSDR("CLN"),"S",BSDR("ADT"),1,X)) Q:'X Q:+^(X,0)=BSDR("PAT")
;
I 'X QUIT 0 ; Patient doesn't have appointment
;
S BSDXIENS=X_","_BSDR("ADT")_","_BSDR("CLN")_","
S BSDXFDA(44.003,BSDXIENS,.01)="@"
N BSDXMSG
D FILE^DIE("","BSDXFDA","BSDXMSG")
I $D(BSDXMSG) S $EC=",U1," ; If we get an error here, we are REALLY out of control
QUIT 0
CHECKIN1(DFN,CLIN,APDATE) ; Simplified PEP w/ parameters for $$CHECKIN - Checking in
; Call like this for DFN 23435 checking in now at Hospital Location 33
; for appt at Dec 20, 2009 @ 10:11:59
@ -324,9 +353,9 @@ RMCI(PAT,CLINIC,DATE) ;PEP; -- Remove Check-in; $$
;
; remove check-in using filer.
N BSDXIENS S BSDXIENS=SDDA_","_DATE_","_CLINIC_","
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
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
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)
@ -358,7 +387,7 @@ CO(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-out
S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U,3)
Q $S(X:1,1:0)
;
UPDATENOTE(PAT,CLINIC,DATE,NOTE) ; PEP; Update Note in ^SC for patient's appointment @ DATE
UPDATENT(PAT,CLINIC,DATE,NOTE) ; PEP; Update Note in ^SC for patient's appointment @ DATE
; PAT = DFN
; CLINIC = SC IEN
; DATE = FM Date/Time of Appointment