Changeset 1464 for Scheduling/trunk
- Timestamp:
- Jun 29, 2012, 7:09:55 PM (12 years ago)
- Location:
- Scheduling/trunk/m
- Files:
-
- 6 edited
Legend:
- Unmodified
- Added
- Removed
-
Scheduling/trunk/m/BSDX25.m
r1463 r1464 1 BSDX25 ; V W/UJO/SMH - WINDOWS SCHEDULING RPCS ; 6/28/12 11:45am2 ;;1. 6;BSDX;;Aug 31, 2011;Build 181 BSDX25 ; VEN/SMH - WINDOWS SCHEDULING RPCS ; 6/29/12 12:04pm 2 ;;1.7T1;BSDX;;Aug 31, 2011;Build 18 3 3 ; Licensed under LGPL 4 4 ; … … 7 7 ; 8 8 ; 9 CHECKIND(BSDXY,BSDXAP TID,BSDXCDT,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG) ;EP9 CHECKIND(BSDXY,BSDXAPPTID,BSDXCDT,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG) ;EP 10 10 ;Entry point for debugging 11 11 ; 12 ;I +$G(^BSDXDBUG("BREAK","CHECKIN")),+$G(^BSDXDBUG("BREAK"))=DUZ D DEBUG^%Serenji("CHECKIN^BSDX25(.BSDXY,BSDXAP TID,BSDXCDT,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG)",$P(^BSDXDBUG("BREAK"),U,2))13 Q 14 ; 15 CHECKIN(BSDXY,BSDXAP TID,BSDXCDT) ;Private EP Check in appointment12 ;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)) 13 Q 14 ; 15 CHECKIN(BSDXY,BSDXAPPTID,BSDXCDT) ;Private EP Check in appointment 16 16 ; Old additional vars: ,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG) 17 ; Called by RPC: BSDX CHECKIN APPOINTMENT 18 ; 17 19 ; Private to GUI; use BSDXAPI for general API to checkin patients 18 20 ; Parameters: 19 21 ; BSDXY: Global Out 20 ; BSDXAP TID: Appointment ID in ^BSDXAPPT22 ; BSDXAPPTID: Appointment ID in ^BSDXAPPT 21 23 ; BSDXCDT: Checkin Date --> Changed 22 24 ; BSDXCC: Clinic Stop IEN (not used) … … 25 27 ; BSDXVCL: PCC+ Clinic IEN (not used) 26 28 ; BSDXVFM: PCC+ Form IEN (not used) 27 ; BSDXOG: PCC+ Outguide (true or false) 29 ; BSDXOG: PCC+ Outguide (true or false) (not used) 28 30 ; 29 31 ; Output: … … 32 34 ; - Another number or text if not 33 35 ; 34 N BSDXNOD,BSDXPATID,BSDXSTART,DIK,DA,BSDXID,BSDXZ,BSDXIENS,BSDXVEN35 ;36 36 ; Turn off SDAM Appointment Events BSDX Protocol Processing 37 37 N BSDXNOEV … … 39 39 ; 40 40 ; Set min DUZ vars 41 D ^XBKVAR 41 D ^XBKVAR 42 42 ; 43 43 ; $ET … … 45 45 ; 46 46 N BSDXI S BSDXI=0 47 K ^BSDXTMP($J) 48 S BSDXY="^BSDXTMP("_$J_")" 47 ; 48 S BSDXY=$NAME(^BSDXTMP($J)) 49 K @BSDXY 50 ; 49 51 S ^BSDXTMP($J,0)="T00020ERRORID"_$C(30) 50 I '+BSDXAPTID D ERR("BSDX25: Invalid Appointment ID") Q 51 I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR("BSDX08: Invalid Appointment ID") Q 52 ; 53 I '+BSDXAPPTID D ERR("Invalid Appointment ID") QUIT 54 I '$D(^BSDXAPPT(BSDXAPPTID,0)) D ERR("Invalid Appointment ID") QUIT 55 ; 56 ; Lock the node for synchronizing access to appointment 57 LOCK +^BSDXAPPT(BSDXAPPTID):1 58 ELSE DO ERR("-7~Lock not acquired") QUIT 59 ; 52 60 ; Remove Date formatting v.1.5. Client will send date as FM Date. 53 61 ;S:BSDXCDT["@0000" BSDXCDT=$P(BSDXCDT,"@") … … 56 64 I BSDXCDT=-1 D ERR(70) Q 57 65 I BSDXCDT>$$NOW^XLFDT S BSDXCDT=$$NOW^XLFDT 66 ; 58 67 ;Checkin BSDX APPOINTMENT entry 59 D BSDXCHK(BSDXAPTID,BSDXCDT) 60 S BSDXNOD=^BSDXAPPT(BSDXAPTID,0) 61 S BSDXPATID=$P(BSDXNOD,U,5) 62 S BSDXSTART=$P(BSDXNOD,U) 63 ; 64 S BSDXSC1=$P(BSDXNOD,U,7) ;RESOURCEID 65 I BSDXSC1]"",$D(^BSDXRES(BSDXSC1,0)) D I +$G(BSDXZ) D ERR($P(BSDXZ,U,2)) Q 66 . S BSDXNOD=^BSDXRES(BSDXSC1,0) 67 . S BSDXSC1=$P(BSDXNOD,U,4) ;HOSPITAL LOCATION 68 . I BSDXSC1]"",$D(^SC(BSDXSC1,0)) D APCHK(.BSDXZ,BSDXSC1,BSDXPATID,BSDXCDT,BSDXSTART) 68 N BSDXERR S BSDXERR=$$BSDXCHK(BSDXAPPTID,BSDXCDT) 69 I BSDXERR D ERR("BSDX08: Fileman Filer failed to check-in appt") QUIT 70 ; 71 N BSDXNOD S BSDXNOD=^BSDXAPPT(BSDXAPPTID,0) 72 N BSDXPATID S BSDXPATID=$P(BSDXNOD,U,5) 73 N BSDXSTART S BSDXSTART=$P(BSDXNOD,U) 74 ; 75 ; Get Hospital Location IEN from BSDXAPPT to BSDXRES (RESOUCE:HOSPITAL LOCATION) 76 N BSDXSC1 S BSDXSC1=$$GET1^DIQ(9002018.4,BSDXAPPTID_",",".07:.04","I") 77 I BSDXSC1,'$D(^SC(BSDXSC1,0)) S BSDXSC1="" ; Null it off if it doesn't exist 78 ; 79 ; File check-in using BSDXAPI 80 N BSDXERR S BSDXERR=0 81 I BSDXSC1 S BSDXERR=$$CHECKIN1^BSDXAPI(BSDXPATID,BSDXSC1,BSDXSTART) 82 I BSDXERR D ERR($P(BSDXZ,U,2)) QUIT 83 ; 84 ; Unlock 85 LOCK -^BSDXAPPT(BSDXAPPTID) 69 86 ; 70 87 S BSDXI=BSDXI+1 … … 74 91 Q 75 92 ; 76 BSDXCHK(BSDXAPTID,BSDXCDT) ; 77 ; 78 S BSDXIENS=BSDXAPTID_"," 93 BSDXCHK(BSDXAPPTID,BSDXCDT) ; $$ Private Entry Point. File or delete check-in to 94 ; BSDX Appointment 95 ; Input: BSDXAPPTID -> Appointment ID 96 ; BSDXCDT -> Check-in date, or "@" to remove check-in. 97 ; 98 ; Output: 1^Error for error 99 ; 0 for success 100 ; 101 N BSDXIENS,BSDXMSG,BSDXFDA ; Filer variables 102 S BSDXIENS=BSDXAPPTID_"," 79 103 S BSDXFDA(9002018.4,BSDXIENS,.03)=BSDXCDT 80 104 D FILE^DIE("","BSDXFDA","BSDXMSG") 81 Q 82 ; 83 APCHK(BSDXZ,BSDXSC1,BSDXDFN,BSDXCDT,BSDXSTART) ; 84 ;Checkin appointment for patient BSDXDFN in clinic BSDXSC1 85 ;at time BSDXSTART 86 S BSDXZ=$$CHECKIN1^BSDXAPI(BSDXDFN,BSDXSC1,BSDXSTART) 87 Q 105 Q:$D(BSDXMSG) 1_U_BSDXMSG("DIERR",1,"TEXT",1) 106 Q 0 88 107 ; 89 108 RMCI(BSDXY,BSDXAPPTID) ; EP - Remove Check-in from BSDX APPT and 2/44 90 ; Called by RPC [Fill in later]109 ; Called by RPC BSDX REMOVE CHECK-IN 91 110 ; 92 111 ; Parameters to pass: … … 103 122 ; -4~DB has corruption. Call Tech Support. (Resource ID in BSDXAPPT doesnt exist in BSDXRES) 104 123 ; -5~BSDXAPI Error. Message depends on error. 124 ; -6~Data Filing Error in BSDXCHK 125 ; -7~Lock not acquired 105 126 ; -100~Mumps Error 106 127 ; … … 117 138 S ^BSDXTMP($J,BSDXI)="T00020ERRORID"_$C(30) ; Header of ADO recordset 118 139 ; 119 TSTART (BSDXI):SERIAL ; Perform Autolocking120 ;121 140 ;;;test 122 I $g(bsdxdie) S X=8/0 123 ;;; 124 I $g(bsdxrestart) k bsdxrestart TRESTART 125 ;;;test 141 I $G(BSDXDIE) N X S X=8/0 126 142 ; 127 143 ; Check for Appointment ID (passed and exists in file) … … 129 145 I '$D(^BSDXAPPT(BSDXAPPTID,0)) D ERR("-2~Invalid Appointment ID") QUIT 130 146 ; 147 ; Lock the node for synchronizing access to appointment 148 LOCK +^BSDXAPPT(BSDXAPPTID):1 149 ELSE DO ERR("-7~Lock not acquired") QUIT 150 ; 131 151 ; Remove checkin from BSDX APPOINTMENT entry 132 D BSDXCHK(BSDXAPPTID,"@") 152 N BSDXERR S BSDXERR=$$BSDXCHK(BSDXAPPTID,"@") 153 I BSDXERR D ERR("-6~Cannot file data in $$BSDXCHK") QUIT 133 154 ; 134 155 ; Now, remove checkin from PIMS files 2/44 … … 149 170 I +$G(BSDXZ) D ERR("-5~"_$P(BSDXZ,U,2)) QUIT 150 171 ; 151 TCOMMIT ; Save Data into Globals 172 ; Unlock 173 LOCK -^BSDXAPPT(BSDXAPPTID) 152 174 ; 153 175 ; Return ADO recordset … … 183 205 Q:'$D(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART)) BSDXFOUND 184 206 S BSDXAPPT=0 F S BSDXAPPT=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART,BSDXAPPT)) Q:'+BSDXAPPT D Q:BSDXFOUND 185 . S BSDXNOD=$G(^BSDXAPPT(BSDXAPPT,0)) Q:BSDXNOD=""207 . N BSDXNOD S BSDXNOD=$G(^BSDXAPPT(BSDXAPPT,0)) Q:BSDXNOD="" 186 208 . I $P(BSDXNOD,U,5)=BSDXPAT,$P(BSDXNOD,U,12)="" S BSDXFOUND=1 Q 187 I BSDXFOUND,+$G(BSDXAPPT) D BSDXCHK(BSDXAPPT,BSDXSTAT) 209 I BSDXFOUND,+$G(BSDXAPPT) D 210 . N BSDXERR S BSDXERR=$$BSDXCHK(BSDXAPPT,BSDXSTAT) 211 . I BSDXERR D ^%ZTER ; VEN/SMH - This is silent. This is a last resort 188 212 Q BSDXFOUND 189 213 ; … … 200 224 ERROR ; 201 225 S $ETRAP="D ^%ZTER HALT" ; Emergency Error Trap for the wise 202 ; Rollback, otherwise ^XTER will be empty from future rollback203 I $TL>0 TROLLBACK204 226 D ^%ZTER 205 227 S $EC="" ; Clear Error … … 209 231 ; 210 232 ERR(BSDXERR) ;Error processing 211 I $ TLEVEL>0 TROLLBACK233 I $G(BSDXAPPTID) LOCK -^BSDXAPPT(BSDXAPPTID) 212 234 S BSDXERR=$G(BSDXERR) 213 235 S BSDXERR=$P(BSDXERR,"~")_"~"_$TEXT(+0)_":"_$P(BSDXERR,"~",2) ; Append Routine Name -
Scheduling/trunk/m/BSDXAPI.m
r1461 r1464 1 BSDXAPI ; IHS/ANMC/LJF & VW/SMH - SCHEDULING APIs ; 6/2 6/12 4:55pm1 BSDXAPI ; IHS/ANMC/LJF & VW/SMH - SCHEDULING APIs ; 6/29/12 12:19pm 2 2 ;;1.7T1;BSDX;;Aug 31, 2011;Build 18 3 3 ; Licensed under LGPL -
Scheduling/trunk/m/BSDXAPI1.m
r1462 r1464 1 BSDXAPI1 ; VEN/SMH - SCHEDULING APIs - Continued!!! ; 6/2 7/12 4:45pm1 BSDXAPI1 ; VEN/SMH - SCHEDULING APIs - Continued!!! ; 6/29/12 11:52am 2 2 ;;1.7T1;BSDX;;Aug 31, 2011;Build 18 3 3 ; Licensed under LGPL … … 56 56 ; Q:'$$CHK ; Checks $D(^SD(409.63,"ANS",1,+SDSTB)) 57 57 QUIT 0 58 ; 59 RMCI(PAT,CLINIC,DATE) ;PEP; -- Remove Check-in; $$ 60 ; PAT = DFN 61 ; CLINIC = SC IEN 62 ; DATE = FM Date/Time of Appointment 63 ; 64 ; Returns: 65 ; 0 if okay 66 ; -1 if failure 67 ; 68 ; Call like this: $$RMCI(233,33,3110102.1130) 69 ; 70 ; Move my variables into the ones used by SDAPIs (just a convenience) 71 NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL,SDMODE 72 S DFN=PAT,SDT=DATE,SDCL=CLINIC,SDMODE=2,SDDA=$$SCIEN^BSDXAPI(DFN,SDCL,SDT) 73 ; 74 I SDDA<1 QUIT 0 ; Appt cancelled; cancelled appts rm'ed from file 44 75 ; 76 ; remember before status 77 S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL 78 D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL) 79 ; 80 ; remove check-in using filer. 81 N BSDXIENS S BSDXIENS=SDDA_","_DATE_","_CLINIC_"," 82 N BSDXFDA 83 S BSDXFDA(44.003,BSDXIENS,309)="@" ; CHECKED-IN 84 S BSDXFDA(44.003,BSDXIENS,302)="@" ; CHECK IN USER 85 S BSDXFDA(44.003,BSDXIENS,305)="@" ; CHECK IN ENTERED 86 N BSDXERR 87 D FILE^DIE("","BSDXFDA","BSDXERR") 88 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) 89 ; 90 ; set after status 91 ; S SDDA=$$SCIEN(DFN,SDCL,SDT) ;smh -why is this here? SDDA won't change. 92 S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL 93 D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL) 94 ; 95 ; call event driver 96 D EVT^SDAMEVT(.SDATA,4,SDMODE,SDCIHDL) 97 QUIT 0 98 ; 99 UPDATENT(PAT,CLINIC,DATE,NOTE) ; PEP; Update Note in ^SC for patient's appointment @ DATE 100 ; PAT = DFN 101 ; CLINIC = SC IEN 102 ; DATE = FM Date/Time of Appointment 103 ; 104 ; Returns: 105 ; 0 if okay 106 ; -1 if failure 107 ; 108 ; ERROR SIMULATION 109 I $G(BSDXSIMERR1) QUIT "-1~Simulated Error" 110 ; 111 N SCIEN S SCIEN=$$SCIEN^BSDXAPI(PAT,CLINIC,DATE) ; ien of appt in ^SC 112 I SCIEN<1 QUIT 0 ; Appt cancelled; cancelled appts rm'ed from file 44 113 N BSDXIENS S BSDXIENS=SCIEN_","_DATE_","_CLINIC_"," 114 N BSDXFDA S BSDXFDA(44.003,BSDXIENS,3)=$E(NOTE,1,150) 115 N BSDXERR 116 D FILE^DIE("","BSDXFDA","BSDXERR") 117 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) 118 QUIT 0 119 ; -
Scheduling/trunk/m/BSDXUT.m
r1463 r1464 1 BSDXUT ; VEN/SMH - Unit Tests for Scheduling GUI ; 6/2 8/12 10:14am1 BSDXUT ; VEN/SMH - Unit Tests for Scheduling GUI ; 6/29/12 12:20pm 2 2 ;;1.7T1;BSDX;;Aug 31, 2011;Build 18 3 3 ; Licensed under LGPL … … 6 6 ; June 21 2012: Initial Version 7 7 ; 8 EN ; Run all Unit Tests 9 D UT07 10 QUIT 8 11 UT07 ; Unit Tests for BSDX07 - Assumes you have Patients with DFNs 1,2,3,4,5 9 12 ; HLs/Resources are created as part of the UT -
Scheduling/trunk/m/BSDXUT1.m
r1463 r1464 1 BSDXUT1 ; VEN/SMH - Unit Tests for Scheduling GUI - cont. ; 6/2 8/12 10:17am1 BSDXUT1 ; VEN/SMH - Unit Tests for Scheduling GUI - cont. ; 6/29/12 12:32pm 2 2 ;;1.7T1;BSDX;;Aug 31, 2011;Build 18 3 3 ; 4 ; 5 EN ; Run All Unit Tests in this routine 6 D UT08,UT29,UT26,UT31 7 QUIT 4 8 ; 5 9 UT08 ; Unit Tests for BSDX08; Must have patients 1,2,3,4,5 defined in system … … 221 225 ; 222 226 W "Waiting for 5 seconds for it to finish",! HANG 5 223 W ^BSDXTMP("BSDXCOPY",+^BSDXTMP($J,1)),! 224 W "Last line should say 0",! 227 W:^BSDXTMP("BSDXCOPY",+^BSDXTMP($J,1))'[" 0 records" "Copy failed",! 225 228 QUIT 226 229 ; -
Scheduling/trunk/m/BSDXUT2.m
r1463 r1464 1 BSDXUT2 ; VEN/SMH - Unit Tests for Scheduling GUI - cont. ; 6/2 8/12 11:55am1 BSDXUT2 ; VEN/SMH - Unit Tests for Scheduling GUI - cont. ; 6/29/12 12:23pm 2 2 ;;1.7T1;BSDX;;Aug 31, 2011;Build 18 3 ; 4 EN ; Run all unit tests in this routine 5 D UT25 6 QUIT 3 7 ; 4 8 UT25 ; Unit Tests for BSDX25 … … 46 50 ; Tests for 3 to 5 difficult to produce 47 51 ; Error tests follow: Mumps error test; Transaction restartability 48 N bsdxdie S bsdxdie=152 N BSDXDIE S BSDXDIE=1 49 53 D RMCI^BSDX25(.ZZZ,APPTID) 50 54 IF +^BSDXTMP($J,1)'=-100 WRITE "ERROR IN Etest 3",! 51 K bsdxdie 52 N bsdxrestart S bsdxrestart=1 53 D RMCI^BSDX25(.ZZZ,APPTID) 54 IF +^BSDXTMP($J,1)'=0 WRITE "Error in Etest 4",! 55 K BSDXDIE 55 56 ; 56 57 ; Unlinked Clinic Tests … … 91 92 ; Tests for 3 to 5 difficult to produce 92 93 ; Error tests follow: Mumps error test; Transaction restartability 93 N bsdxdie S bsdxdie=194 N BSDXDIE S BSDXDIE=1 94 95 D RMCI^BSDX25(.ZZZ,APPTID) 95 96 IF +^BSDXTMP($J,1)'=-100 WRITE "ERROR IN Etest 7",! 96 K bsdxdie 97 N bsdxrestart S bsdxrestart=1 98 D RMCI^BSDX25(.ZZZ,APPTID) 99 IF +^BSDXTMP($J,1)'=0 WRITE "Error in Etest 8",! 97 K BSDXDIE 100 98 ; 101 99 ; Tests for running PIMS by itself. … … 113 111 IF '+$G(^SC(HLIEN,"S",APPTTIME,1,1,"C")) WRITE "ERROR IN CHECKIN 10",! 114 112 IF '$P(^BSDXAPPT(APPTID,0),U,3) WRITE "ERROR IN CHECKIN 11",! 115 N % S %=$$RMCI^BSDXAPI (DFN,HLIEN,APPTTIME)113 N % S %=$$RMCI^BSDXAPI1(DFN,HLIEN,APPTTIME) 116 114 I % W "Error removing Check-in via PIMS",! 117 115 I +$G(^SC(HLIEN,"S",APPTTIME,1,1,"C")) WRITE "ERROR IN UNCHECKIN 12",!
Note:
See TracChangeset
for help on using the changeset viewer.
