Changeset 1141 for Scheduling/branches/Radiology-Support/m
- Timestamp:
- Apr 13, 2011, 2:38:19 AM (14 years ago)
- Location:
- Scheduling/branches/Radiology-Support/m
- Files:
-
- 5 edited
Legend:
- Unmodified
- Added
- Removed
-
Scheduling/branches/Radiology-Support/m/BSDX01.m
r1116 r1141 1 BSDX01 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 3/16/11 7:08am1 BSDX01 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/10/11 4:50pm 2 2 ;;1.5V3;BSDX;;Mar 16, 2011 3 3 ; … … 318 318 I $$INDIV2(27)'=1 W "ERROR",! 319 319 QUIT 320 GETRADEX(BSDXY,DFN,SCIEN) 321 S BSDXY=$NA(^BMXTEMP($J)) 322 K @BSDXY 323 N BSDXRLIEN S BSDXRLIEN=$ORDER(^RA(79.1,"B",SCIEN,"")) ; IEN of HL in file 79.1, to get Radiology Imaging IEN 324 I 'BSDXRLIEN QUIT ; This will crash the client. Intentionally!!!! 325 N BSDXI S BSDXI=0 326 S @BSDXY@(BSDXI)="I00015BMXIEN^T00015STATUS^T00100PROCEDURE^D00030REQUEST_DATE"_$C(30) 327 N BSDXOUT,BSDXERR ; Out, Error 328 D LIST^DIC(75.1,"","@;5;2;16","P","","","","B","I $P(^(0),U)=DFN&(35[$P(^(0),U,5))&($P(^(0),U,20)=BSDXRLIEN)","","BSDXOUT","BSDXERR") 329 ;TODO: do something about BSDXERR 330 I +BSDXOUT("DILIST",0)>0 FOR BSDXI=1:1:+BSDXOUT("DILIST",0) DO 331 . N BMXIEN,BMXSTAUS,BMXPROC,BMXDATE ; Proc IEN, Proc Status, Proc Name 332 . S BMXIEN=$P(BSDXOUT("DILIST",BSDXI,0),U) 333 . S BMXSTATUS=$P(BSDXOUT("DILIST",BSDXI,0),U,2) 334 . S BMXPROC=$P(BSDXOUT("DILIST",BSDXI,0),U,3) 335 . S BMXDATE=$TR($P(BSDXOUT("DILIST",BSDXI,0),U,4),"@"," ") 336 . S @BSDXY@(BSDXI)=BMXIEN_U_BMXSTATUS_U_BMXPROC_U_BMXDATE_$C(30) 337 S @BSDXY@(BSDXI+1)=$C(31) 338 QUIT 339 ; 340 SCHRAEX(BSDXY,RADFN,RAOIFN) ; Schedule a Radiology Exam 341 N RAOSTS S RAOSTS=8 ; Status of Scheduled 342 D ^RAORDU ; API in Rad expects RADFN, RAOIFN, and RAOSTS 343 S BSDXY=1 ; Success 344 QUIT 345 HOLDRAEX(BSDXY,RADFN,RAOIFN) ; Hold a Radiology Exam 346 N RAOSTS S RAOSTS=3 ; Status of Hold 347 N RAOREA S RAOREA=20 ; Reason: Exam Cancelled 348 D ^RAORDU 349 S BSDXY=1 ; Success 350 QUIT -
Scheduling/branches/Radiology-Support/m/BSDX02.m
r1116 r1141 1 BSDX02 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 3/21/11 11:49am1 BSDX02 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/11/11 12:21pm 2 2 ;;1.5V3;BSDX;;Mar 16, 2011 3 4 5 3 ; 4 ; Change Log 5 ; July 15 2010: UJO/SMH - Pass FM dates in instead of US dates for i18n 6 6 ; March 21 2011: UJO/SMH (v 1.5) - Return new fields: Patient SEX, PID, and DOB 7 ; April 11 2011: UJO/SMH (v 1.6) - Added Radiology Exam Field, to retrieve Radiology Exam associated with appt 7 8 ; 8 9 ; … … 29 30 S BSDXERR="" 30 31 S BSDXY="^BSDXTMP("_$J_")" 31 S ^BSDXTMP($J,0)="I00020APPOINTMENTID^D00030START_TIME^D00030END_TIME^D00030CHECKIN^D00030AUXTIME^I00020PATIENTID^T00030PATIENTNAME^T00030RESOURCENAME^I00005NOSHOW^T00020HRN^I00005ACCESSTYPEID^I00005WALKIN^T00250NOTE^T00006SEX^T00040PID^D00030DOB "_$C(30)32 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) 32 33 D ^XBKVAR S X="ETRAP^BSDX02",@^%ZOSF("TRAP") 33 34 ; … … 99 100 ; Outputs it in MM/DD/YYYY format, which is ambigous for C#. 100 101 N DOB S DOB=$$FMTE^XLFDT($$GET1^DIQ(2,BSDXPATD,.03,"I")) ; DOB 101 S ^BSDXTMP($J,BSDXI)=SEX_U_PID_U_DOB_$C(30) 102 N RADEX S RADEX=$P(BSDXNOD,U,14) 103 S ^BSDXTMP($J,BSDXI)=SEX_U_PID_U_DOB_U_RADEX_$C(30) 102 104 ; end new code 103 105 Q -
Scheduling/branches/Radiology-Support/m/BSDX07.m
r1116 r1141 1 BSDX07 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 3/15/11 11:50am2 ;;1. 5V3;BSDX;;Mar 16, 20111 BSDX07 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/11/11 12:12pm 2 ;;1.6;BSDX;;Mar 16, 2011 3 3 ; 4 4 ; Change Log: … … 10 10 ; v1.5 Mar 15 2011 - End time does not have to have time anymore. 11 11 ; It could be midnight of the next day 12 ; v1.6 Apr 11 2011 - Support for Scheduling Radiology Exams... 12 13 ; 13 14 ; Error Reference: … … 78 79 QUIT 79 80 ; 80 APPADD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID) ;EP 81 APPADD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID,BSDXRADEXAM) ;EP 82 ; 81 83 ;Called by RPC: BSDX ADD NEW APPOINTMENT 82 84 ; … … 97 99 ; if BSDXATID = "WALKIN" then BSDAPI is called to create a walkin appt. 98 100 ; if BSDXATID = a number, then it is the access type id (used for rebooking) 101 ;BSDXRADEXAM is used to store the Radiology Exam to which this appointment is tied to (optional) 99 102 ; 100 103 ;Return: … … 105 108 ;BSDX ADD NEW APPOINTMENT^3091122.0930^3091122.1000^370^Dr Office^30^EXAM^WALKIN 106 109 ; 110 ; Deal with optional arguments 111 S BSDXRADEXAM=$G(BSDXRADEXAM) 107 112 ; Return Array; set Return and clear array 108 113 S BSDXY=$NA(^BSDXTMP($J)) … … 172 177 ; Done with all checks, let's make appointment in BSDX APPOINTMENT 173 178 N BSDXAPPTID 174 S BSDXAPPTID=$$BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRESD,BSDXATID )179 S BSDXAPPTID=$$BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRESD,BSDXATID,BSDXRADEXAM) 175 180 I 'BSDXAPPTID D ERR(BSDXI,"-9~BSDX07 Error: Unable to add appointment to BSDX APPOINTMENT file.") Q 176 181 I BSDXNOTE]"" D BSDXWP(BSDXAPPTID,BSDXNOTE) … … 216 221 Q BSDXZ 217 222 ; 218 BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRESD,BSDXATID ) ;ADD BSDX APPOINTMENT ENTRY223 BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRESD,BSDXATID,BSDXRADEXAM) ;ADD BSDX APPOINTMENT ENTRY 219 224 ;Returns ien in BSDXAPPT or 0 if failed 220 225 ;Create entry in BSDX APPOINTMENT … … 228 233 S:BSDXATID="WALKIN" BSDXFDA(9002018.4,"+1,",.13)="y" 229 234 S:BSDXATID?.N BSDXFDA(9002018.4,"+1,",.06)=BSDXATID 235 S BSDXFDA(9002018.4,"+1,",.14)=BSDXRADEXAM 230 236 N BSDXIEN,BSDXMSG 231 237 D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG") -
Scheduling/branches/Radiology-Support/m/BSDX28.m
r1116 r1141 1 BSDX28 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/18/10 2:30pm1 BSDX28 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/10/11 2:34pm 2 2 ;;1.5V3;BSDX;;Mar 16, 2011 3 3 ; … … 28 28 I '+$G(DUZ) S BSDXY=BSDXRET_$C(31) Q 29 29 I '$D(DUZ(2)) S BSDXY=BSDXRET_$C(31) Q 30 30 DFN ;If DFN is passed as `nnnn, just return that patient 31 I $E(BSDXP)="`" DO SET BSDXY=BSDXRET_$C(31) QUIT 32 . N BSDXIEN S BSDXIEN=$E(BSDXP,2,99) 33 . I BSDXIEN'=+BSDXIEN QUIT ; BSDXIEN must be numeric 34 . N NAME S NAME=$P(^DPT(BSDXIEN,0),U) 35 . N HRN S HRN=$P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,2) 36 . N PID S PID=$P(^DPT(BSDXIEN,.36),U,3) 37 . N DOB S DOB=$$FMTE^XLFDT($P(^DPT(BSDXIEN,0),U,3)) 38 . S BSDXRET=BSDXRET_NAME_U_HRN_U_PID_U_DOB_U_BSDXIEN_$C(30) 31 39 PID ;PID Lookup 32 40 ; If this ID exists, go get it. If "UJOPID" index doesn't exist, -
Scheduling/branches/Radiology-Support/m/BSDX32.m
r1116 r1141 1 BSDX32 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 9/29/10 10:21am1 BSDX32 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/7/11 12:30pm 2 2 ;;1.5V3;BSDX;;Mar 16, 2011 3 3 ; … … 28 28 S BSDXI=0 29 29 ;"SELECT BSDXIEN 'HOSPITAL_LOCATION_ID', NAME 'HOSPITAL_LOCATION', DEFAULT_PROVIDER, STOP_CODE_NUMBER, INACTIVATE_DATE, REACTIVATE_DATE FROM HOSPITAL_LOCATION"; 30 S ^BSDXTMP($J,BSDXI)="I00020HOSPITAL_LOCATION_ID^T00040HOSPITAL_LOCATION^T00030DEFAULT_PROVIDER^T00030STOP_CODE_NUMBER^D00020INACTIVATE_DATE^D00020REACTIVATE_DATE "_$C(30)30 S ^BSDXTMP($J,BSDXI)="I00020HOSPITAL_LOCATION_ID^T00040HOSPITAL_LOCATION^T00030DEFAULT_PROVIDER^T00030STOP_CODE_NUMBER^D00020INACTIVATE_DATE^D00020REACTIVATE_DATE^T00001IS_RADIOLOGY_LOCATION"_$C(30) 31 31 ; 32 32 S BSDXNAM="" F S BSDXNAM=$O(^SC("B",BSDXNAM)) Q:BSDXNAM="" D … … 49 49 . . . Q 50 50 . . Q 51 . ; Decide if this is a radiology location - Check "B" index of ^RA(79.1 global to see if HL is there 52 . N BSDXISRAD S BSDXISRAD=''$DATA(^RA(79.1,"B",BSDXIEN)) 51 53 . S BSDXI=BSDXI+1 52 . S ^BSDXTMP($J,BSDXI)=BSDXIEN_U_BSDXNAM_U_BSDXPRV_U_BSDXSCOD_U_BSDXINA_U_BSDXREA_ $C(30)54 . S ^BSDXTMP($J,BSDXI)=BSDXIEN_U_BSDXNAM_U_BSDXPRV_U_BSDXSCOD_U_BSDXINA_U_BSDXREA_U_BSDXISRAD_$C(30) 53 55 . Q 54 56 S BSDXI=BSDXI+1
Note:
See TracChangeset
for help on using the changeset viewer.