Changeset 1449 for Scheduling/trunk/m
- Timestamp:
- Jun 18, 2012, 5:08:29 PM (13 years ago)
- Location:
- Scheduling/trunk/m
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
Scheduling/trunk/m/BSDX07.m
r1187 r1449 1 BSDX07 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 4/28/11 10:17am2 ;;1.6T2;BSDX;;May 16, 20113 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 1 BSDX07 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 6/18/12 2:27pm 2 ;;1.7T1;BSDX;;Aug 31, 2011;Build 18 3 ; Licensed under LGPL 4 ; 5 ; Change Log: 6 ; UJO/SMH 7 ; v1.3 July 13 2010 - Add support i18n - Dates input as FM dates, not US. 8 ; v1.42 Oct 22 2010 - Transaction now restartable by providing arguments 9 ; thanks to Rick Marshall and Zach Gonzalez at Oroville. 10 ; v1.42 Oct 30 2010 - Extensive refactoring. 11 ; v1.5 Mar 15 2011 - End time does not have to have time anymore. 12 ; It could be midnight of the next day 13 ; v1.6 Apr 11 2011 - Support for Scheduling Radiology Exams... 14 ; 15 ; Error Reference: 16 ; -1: Patient Record is locked. This means something is wrong!!!! 17 ; -2: Start Time is not a valid Fileman date 18 ; -3: End Time is not a valid Fileman date 19 ; v1.5:obsolete::-4: End Time does not have time inside of it. 20 ; -5: BSDXPATID is not numeric 21 ; -6: Patient Does not exist in ^DPT 22 ; -7: Resource Name does not exist in B index of BSDX RESOURCE 23 ; -8: Resouce doesn't exist in ^BSDXRES 24 ; -9: Couldn't add appointment to BSDX APPOINTMENT 25 ; -10: Couldn't add appointment to files 2 and/or 44 26 ; -100: Mumps Error 27 27 28 28 APPADDD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID) ;EP 29 30 31 32 29 ;Entry point for debugging 30 D DEBUG^%Serenji("APPADD^BSDX07(.BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID)") 31 Q 32 ; 33 33 UT ; Unit Tests 34 N ZZZ 35 ; Test for bad start date 36 D APPADD(.ZZZ,2100123,3100123.3,2,"Dr Office",30,"Sam's Note",1) 37 I +$P(^BSDXTMP($J,1),U,2)'=-2 W "Error in -2",! 38 ; Test for bad end date 39 D APPADD(.ZZZ,3100123,2100123.3,2,"Dr Office",30,"Sam's Note",1) 40 I +$P(^BSDXTMP($J,1),U,2)'=-3 W "Error in -3",! 41 ; Test for end date without time 42 D APPADD(.ZZZ,3100123.1,3100123,2,"Dr Office",30,"Sam's Note",1) 43 I +$P(^BSDXTMP($J,1),U,2)'=-4 W "Error in -4",! 44 ; Test for mumps error 45 S bsdxdie=1 46 D APPADD(.ZZZ,3100123.09,3100123.093,2,"Dr Office",30,"Sam's Note",1) 47 I +$P(^BSDXTMP($J,1),U,2)'=-100 W "Error in -100: M Error",! 48 K bsdxdie 49 ; Test for TRESTART 50 s bsdxrestart=1 51 D APPADD(.ZZZ,3100123.09,3100123.093,3,"Dr Office",30,"Sam's Note",1) 52 I +$P(^BSDXTMP($J,1),U,2)'=0&(+$P(^BSDXTMP($J,1),U,2)'=-10) W "Error in TRESTART",! 53 k bsdxrestart 54 ; Test for non-numeric patient 55 D APPADD(.ZZZ,3100123.09,3100123.093,"CAT,DOG","Dr Office",30,"Sam's Note",1) 56 I +$P(^BSDXTMP($J,1),U,2)'=-5 W "Error in -5",! 57 ; Test for a non-existent patient 58 D APPADD(.ZZZ,3100123.09,3100123.093,8989898989,"Dr Office",30,"Sam's Note",1) 59 I +$P(^BSDXTMP($J,1),U,2)'=-6 W "Error in -6",! 60 ; Test for a non-existent resource name 61 D APPADD(.ZZZ,3100123.09,3100123.093,3,"lkajsflkjsadf",30,"Sam's Note",1) 62 I +$P(^BSDXTMP($J,1),U,2)'=-7 W "Error in -7",! 63 ; Test for corrupted resource 64 ; Can't test for -8 since it requires DB corruption 65 ; Test for inability to add appointment to BSDX Appointment 66 ; Also requires something wrong in the DB 67 ; Test for inability to add appointment to 2,44 68 ; Test by creating a duplicate appointment 69 D APPADD(.ZZZ,3100123.09,3100123.093,3,"Dr Office",30,"Sam's Note",1) 70 D APPADD(.ZZZ,3100123.09,3100123.093,3,"Dr Office",30,"Sam's Note",1) 71 I +$P(^BSDXTMP($J,1),U,2)'=-10 W "Error in -10",! 72 ; Test for normality: 73 D APPADD(.ZZZ,3110123.09,3110123.093,3,"Dr Office",30,"Sam's Note",1) 74 ; Does Appt exist? 75 N APPID S APPID=+$P(^BSDXTMP($J,1),U) 76 I 'APPID W "Error Making Appt-1" QUIT 77 I +^BSDXAPPT(APPID,0)'=3110123.09 W "Error Making Appt-2" 78 I '$D(^DPT(3,"S",3110123.09)) W "Error Making Appt-3" 79 I '$D(^SC(2,"S",3110123.09)) W "Error Making Appt-4" 80 QUIT 81 ; 34 ; Set-up - Create Clinics 35 N RESNAM S RESNAM="UTCLINIC" 36 N HLRESIENS ; holds output of UTCR^BSDX35 - HL IEN^Resource IEN 37 D 38 . N $ET S $ET="D ^%ZTER B" 39 . S HLRESIENS=$$UTCR^BSDX35(RESNAM) 40 . I %<0 S $EC=",U1," ; not supposed to happen 41 ; 42 N HLIEN,RESIEN 43 S HLIEN=$P(HLRESIENS,U) 44 S RESIEN=$P(HLRESIENS,U,2) 45 ; 46 ; Get start and end times 47 N TIMES S TIMES=$$TIMES^BSDX35 ; appt time^end time 48 N APPTTIME S APPTTIME=$P(TIMES,U) 49 N ENDTIME S ENDTIME=$P(TIMES,U,2) 50 ; 51 N ZZZ 52 ; Test for normality: 53 D APPADD(.ZZZ,APPTTIME,ENDTIME,3,RESNAM,30,"Sam's Note",1) 54 ; Does Appt exist? 55 N APPID S APPID=+$P(^BSDXTMP($J,1),U) 56 I 'APPID W "Error Making Appt-1" QUIT 57 I +^BSDXAPPT(APPID,0)'=APPTTIME W "Error Making Appt-2" 58 I '$D(^DPT(3,"S",APPTTIME)) W "Error Making Appt-3" 59 I '$D(^SC(HLIEN,"S",APPTTIME)) W "Error Making Appt-4" 60 ; 61 ; Test for bad start date 62 D APPADD(.ZZZ,2100123,3100123.3,2,RESNAM,30,"Sam's Note",1) 63 I +$P(^BSDXTMP($J,1),U,2)'=-2 W "Error in -2",! 64 ; Test for bad end date 65 D APPADD(.ZZZ,3100123,2100123.3,2,RESNAM,30,"Sam's Note",1) 66 I +$P(^BSDXTMP($J,1),U,2)'=-3 W "Error in -3",! 67 ; Test for end date without time - obsolete 68 ; D APPADD(.ZZZ,3100123.1,3100123,2,RESNAM,30,"Sam's Note",1) 69 ; I +$P(^BSDXTMP($J,1),U,2)'=-4 W "Error in -4",! 70 ; Test for mumps error 71 S bsdxdie=1 72 D APPADD(.ZZZ,APPTTIME,ENDTIME,2,RESNAM,30,"Sam's Note",1) 73 I +$P(^BSDXTMP($J,1),U,2)'=-100 W "Error in -100: M Error",! 74 K bsdxdie 75 ; Test for TRESTART 76 s bsdxrestart=1 77 D APPADD(.ZZZ,APPTTIME,ENDTIME,3,RESNAM,30,"Sam's Note",1) 78 I +$P(^BSDXTMP($J,1),U,2)'=0&(+$P(^BSDXTMP($J,1),U,2)'=-10) W "Error in TRESTART",! 79 k bsdxrestart 80 ; Test for non-numeric patient 81 D APPADD(.ZZZ,APPTTIME,ENDTIME,"CAT,DOG",RESNAM,30,"Sam's Note",1) 82 I +$P(^BSDXTMP($J,1),U,2)'=-5 W "Error in -5",! 83 ; Test for a non-existent patient 84 D APPADD(.ZZZ,APPTTIME,ENDTIME,8989898989,RESNAM,30,"Sam's Note",1) 85 I +$P(^BSDXTMP($J,1),U,2)'=-6 W "Error in -6",! 86 ; Test for a non-existent resource name 87 D APPADD(.ZZZ,APPTTIME,ENDTIME,3,"lkajsflkjsadf",30,"Sam's Note",1) 88 I +$P(^BSDXTMP($J,1),U,2)'=-7 W "Error in -7",! 89 ; Test for corrupted resource 90 ; Can't test for -8 since it requires DB corruption 91 ; Test for inability to add appointment to BSDX Appointment 92 ; Also requires something wrong in the DB 93 ; Test for inability to add appointment to 2,44 94 ; Test by creating a duplicate appointment 95 ; Get start and end times 96 N TIMES S TIMES=$$TIMES^BSDX35 ; appt time^end time 97 N APPTTIME S APPTTIME=$P(TIMES,U) 98 N ENDTIME S ENDTIME=$P(TIMES,U,2) 99 D APPADD(.ZZZ,APPTTIME,ENDTIME,3,RESNAM,30,"Sam's Note",1) 100 D APPADD(.ZZZ,APPTTIME,ENDTIME,3,RESNAM,30,"Sam's Note",1) 101 I +$P(^BSDXTMP($J,1),U,2)'=-10 W "Error in -10",! 102 QUIT 103 ; 82 104 APPADD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID,BSDXRADEXAM) ;EP 83 105 ; -
Scheduling/trunk/m/BSDX35.m
r1187 r1449 1 BSDX35 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:29am2 ;;1. 6T2;BSDX;;May 16, 20111 BSDX35 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 6/18/12 2:27pm 2 ;;1.7T1;BSDX;;Aug 31, 2011;Build 18 3 3 ; Licensed under LGPL 4 4 ; … … 74 74 S ^BSDXTMP($J,BSDXI)=$C(31) 75 75 Q 76 UTCR(RESNAM) ; $$ - Create Unit Test Clinic and Resource Pair ; Private 77 ; Input: Resource Name By Value 78 ; Output: -1^Error or HLIEN^RESIEN for Success (file 44 IEN^file 9002018.1 IEN) 79 ; DO NOT USE IN A PRODUCTION ENVIRONTMENT. INTENDED FOR TESTING ONLY 80 N HLIEN S HLIEN=$$UTCR44(RESNAM) 81 I +HLIEN=-1 QUIT HLIEN 82 ; 83 N RESIEN S RESIEN=$$UTCRRES(RESNAM,HLIEN) 84 I +RESIEN=-1 QUIT RESIEN 85 E QUIT HLIEN_U_RESIEN 86 ; 87 UTCR44(HLNAME) ; $$ - Create Unit Test Clinic in File 44; Private ; TESTING ONLY CODE 88 ; Output: -1^Error or IEN for Success 89 ; Input: Hosp Location Name by Value 90 ; DO NOT USE IN A PRODUCTION ENVIRONTMENT. INTENDED FOR TESTING ONLY 91 ; 92 I $D(^SC("B",HLNAME)) Q $O(^(HLNAME,"")) 93 ; 94 N SAM 95 S SAM(44,"?+1,",.01)=HLNAME ; Name 96 S SAM(44,"?+1,",2)="C" ; Type = Clinic 97 S SAM(44,"?+1,",2.1)=1 ; Type Extension (not used) 98 S SAM(44,"?+1,",3.5)=$O(^DG(40.8,0)) ; Division (not yet used) 99 S SAM(44,"?+1,",8)=295 ; Stop Code Number (not used) 100 S SAM(44,"?+1,",9)="M" ; Service (not used) 101 S SAM(44,"?+1,",1912)=15 ; Length of Appt (not used) 102 S SAM(44,"?+1,",1917)=4 ; Display increments per hour (not used) 103 S SAM(44,"?+1,",1918)=8 ; Overbooks/day max (not used) 104 S SAM(44,"?+1,",2000.5)=0 ; Require Action Profiles: Yes (not used) 105 S SAM(44,"?+1,",2001)=999 ; Allowable consecutive no-shows (not used) 106 S SAM(44,"?+1,",2002)=999 ; Max # days for Future Booking (not used) 107 S SAM(44,"?+1,",2005)=365 ; Max # days for Auto Rebook (not used) 108 S SAM(44,"?+1,",2502)="N" ; Non-Count Clinic (not used) 109 S SAM(44,"?+1,",2504)="Y" ; Clinic meets at this Facility? (not used) 110 S SAM(44,"?+1,",2507)=9 ; Appointment Type (not used) 111 ; 112 N BSDXERR,BSDXIEN 113 D UPDATE^DIE("",$NA(SAM),$NA(BSDXIEN),$NA(BSDXERR)) 114 Q $S($D(BSDXERR):-1_U_BSDXERR("DIERR",1,"TEXT",1),1:BSDXIEN(1)) 115 ; 116 UTCRRES(NAME,HLIEN) ; $$ - Create Unit Test Resource in 9002018.1 (BSDX RESOURCE); Private 117 ; Input: Hospital Location IEN 118 ; Output: -1^Error or IEN for Success 119 ; DO NOT USE IN A PRODUCTION ENVIRONTMENT. INTENDED FOR TESTING ONLY 120 I $D(^BSDXRES("B",NAME)) Q $O(^(NAME,"")) 121 D RSRC^BSDX16(.RES,"|"_NAME_"||"_HLIEN) 122 N RTN S RTN=@$Q(^BSDXTMP($J,0)) ; return array next value 123 Q $S(RTN=0:-1_U_RTN,1:+RTN) ; 0 means an error has occurred; 1 means IEN returned 124 ; 125 TIMES() ; $$ - Create a next available appointment time^ending time; Private 126 N NOW S NOW=$$NOW^XLFDT() ; Now time 127 N LAST S LAST=$O(^BSDXAPPT("B"," "),-1) ; highest time in file 128 N TIME2USE S TIME2USE=$S(NOW>LAST:NOW,1:LAST) ; Which time to use? 129 S TIME2USE=$E(TIME2USE,1,12) ; Strip away seconds 130 N APPTIME S APPTIME=$$FMADD^XLFDT(TIME2USE,0,0,15,0) ; Add 15 min 131 N ENDTIME S ENDTIME=$$FMADD^XLFDT(APPTIME,0,0,15,0) ; Add 15 more min 132 Q APPTIME_U_ENDTIME ; quit with apptime^endtime
Note:
See TracChangeset
for help on using the changeset viewer.
