Changeset 1172


Ignore:
Timestamp:
May 8, 2011, 4:11:34 AM (14 years ago)
Author:
Sam Habiel
Message:

Merging Radiology Support branch back to trunk.

Location:
Scheduling/trunk/m
Files:
6 edited

Legend:

Unmodified
Added
Removed
  • Scheduling/trunk/m

  • Scheduling/trunk/m/BSDX01.m

    r1161 r1172  
    319319           I $$INDIV2(27)'=1 W "ERROR",!
    320320           QUIT
     321           ;
     322GETRADEX(BSDXY,DFN,SCIEN) ; Get All Pending and On Hold Radiology Exams for Patient; RPC EP; UJO/SMH new in v 1.6
     323 ; RPC: BSDX GET RAD EXAM FOR PT; Return: Global Array
     324 ;
     325 ; Input: DFN - you should know; SCIEN - IEN of Hospital Location
     326 ; Output: ADO Datatable with the following columns:
     327 ; - BMXIEN: Radiology Exam IEN in file 75.1 (RAD/NUC MED ORDERS)
     328 ; - STATUS: Pending Or Hold Status
     329 ; - PROCEDURE: Text Procedure Name
     330 ; - REQUEST_DATE: Date Procedure was requested
     331 ;
     332 ; Error Processing: Silent failure.
     333 ;
     334 S BSDXY=$NA(^BMXTEMP($J))
     335 K @BSDXY
     336 ;
     337 N BSDXI S BSDXI=0
     338 S @BSDXY@(BSDXI)="I00015BMXIEN^T00015STATUS^T00100PROCEDURE^D00030REQUEST_DATE"_$C(30)
     339 ;
     340 N BSDXRLIEN S BSDXRLIEN=$ORDER(^RA(79.1,"B",SCIEN,""))  ; IEN of HL in file 79.1, to get Radiology Imaging IEN
     341 I 'BSDXRLIEN GOTO END
     342 ;
     343 N BSDXOUT,BSDXERR ; Out, Error
     344 ;
     345 ; File 75.1 = RAD/NUC MED ORDERS
     346 ; Fields 5 = Request Status; 2 = Procedure; 16 = Requested Entered Date Time
     347 ; Filter Field: First piece is DFN, 5th piece is 3 or 5 (Status of Pending Or Hold); 20th piece is Radiology Location requested
     348 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")
     349 ;
     350 IF $DATA(BSDXERR) GOTO END
     351 ;
     352 I +BSDXOUT("DILIST",0)>0 FOR BSDXI=1:1:+BSDXOUT("DILIST",0) DO  ; if we have data, fetch the data in each row and store it in the return variable
     353 . N BMXIEN,BMXSTAUS,BMXPROC,BMXDATE ; Proc IEN, Proc Status, Proc Name
     354 . S BMXIEN=$P(BSDXOUT("DILIST",BSDXI,0),U) ; IEN
     355 . S BMXSTATUS=$P(BSDXOUT("DILIST",BSDXI,0),U,2) ; Status
     356 . S BMXPROC=$P(BSDXOUT("DILIST",BSDXI,0),U,3) ; Procedure Name
     357 . S BMXDATE=$TR($P(BSDXOUT("DILIST",BSDXI,0),U,4),"@"," ") ; Request Entered Date Time
     358 . S @BSDXY@(BSDXI)=BMXIEN_U_BMXSTATUS_U_BMXPROC_U_BMXDATE_$C(30)
     359END ; Errors Jump Here...
     360 S @BSDXY@(BSDXI+1)=$C(31)
     361 QUIT
     362 ;
     363SCHRAEX(BSDXY,RADFN,RAOIFN,RAOSCH) ; Schedule a Radiology Exam; RPC EP; UJO/SMH new in v 1.6
     364 ; RPC: BSDX SCHEDULE RAD EXAM; Return: Single Value
     365 ;
     366 ; Input:
     367 ; - RADFN -> DFN
     368 ; - RAOIFN -> Radiology Order IEN in file 75.1
     369 ; - RAOSCH -> Scheduled Time for Exam
     370 ; Output: Always "1"
     371 ;
     372 S RAOSCH=+RAOSCH ; Strip the trailing zeros from the Fileman Date produced by C#
     373 N RAOSTS S RAOSTS=8  ; Status of Scheduled
     374 D ^RAORDU  ; API in Rad expects RADFN, RAOIFN, RAOSCH, and RAOSTS
     375 S BSDXY=1 ; Success
     376 QUIT
     377 ;
     378HOLDRAEX(BSDXY,RADFN,RAOIFN) ; Hold a Radiology Exam; RPC EP; UJO/SMH new in v 1.6
     379 ; RPC: BSDX HOLD RAD EXAM; Return: Single Vale
     380 ;
     381 ; Input:
     382 ; - RADFN -> DFN
     383 ; - RAOIFN -> Radiology Order IEN in file 75.1
     384 ; Output: Always "1"
     385 N RAOSTS S RAOSTS=3  ; Status of Hold
     386 N RAOREA S RAOREA=20 ; Reason: Exam Cancelled
     387 D ^RAORDU
     388 S BSDXY=1 ; Success
     389 QUIT
  • Scheduling/trunk/m/BSDX02.m

    r1161 r1172  
    55        ; July 15 2010: UJO/SMH - Pass FM dates in instead of US dates for i18n
    66        ; 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
    78        ;
    89        ;
     
    2930        S BSDXERR=""
    3031        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)
    3233        D ^XBKVAR S X="ETRAP^BSDX02",@^%ZOSF("TRAP")
    3334        ;
     
    99100        ; Outputs it in MM/DD/YYYY format, which is ambigous for C#.
    100101        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)
    102104        ; end new code
    103105        Q
  • Scheduling/trunk/m/BSDX07.m

    r1161 r1172  
    1111           ; v1.5  Mar 15 2011 - End time does not have to have time anymore.
    1212           ;      It could be midnight of the next day
     13           ; v1.6 Apr 11 2011 - Support for Scheduling Radiology Exams...
    1314           ;
    1415           ; Error Reference:
     
    7980           QUIT
    8081           ;
    81 APPADD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID)     ;EP
     82APPADD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID,BSDXRADEXAM) ;EP
     83           ;
    8284           ;Called by RPC: BSDX ADD NEW APPOINTMENT
    8385           ;
     
    98100           ; if BSDXATID = "WALKIN" then BSDAPI is called to create a walkin appt.
    99101           ; if BSDXATID = a number, then it is the access type id (used for rebooking)
     102           ;BSDXRADEXAM is used to store the Radiology Exam to which this appointment is tied to (optional)
    100103           ;
    101104           ;Return:
     
    106109           ;BSDX ADD NEW APPOINTMENT^3091122.0930^3091122.1000^370^Dr Office^30^EXAM^WALKIN
    107110           ;
     111           ; Deal with optional arguments
     112           S BSDXRADEXAM=$G(BSDXRADEXAM)
    108113           ; Return Array; set Return and clear array
    109114           S BSDXY=$NA(^BSDXTMP($J))
     
    173178           ; Done with all checks, let's make appointment in BSDX APPOINTMENT
    174179           N BSDXAPPTID
    175            S BSDXAPPTID=$$BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRESD,BSDXATID)
     180           S BSDXAPPTID=$$BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRESD,BSDXATID,BSDXRADEXAM)
    176181           I 'BSDXAPPTID D ERR(BSDXI,"-9~BSDX07 Error: Unable to add appointment to BSDX APPOINTMENT file.") Q
    177182           I BSDXNOTE]"" D BSDXWP(BSDXAPPTID,BSDXNOTE)
     
    217222           Q BSDXZ
    218223           ;
    219 BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRESD,BSDXATID)   ;ADD BSDX APPOINTMENT ENTRY
     224BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRESD,BSDXATID,BSDXRADEXAM)       ;ADD BSDX APPOINTMENT ENTRY
    220225           ;Returns ien in BSDXAPPT or 0 if failed
    221226           ;Create entry in BSDX APPOINTMENT
     
    229234           S:BSDXATID="WALKIN" BSDXFDA(9002018.4,"+1,",.13)="y"
    230235           S:BSDXATID?.N BSDXFDA(9002018.4,"+1,",.06)=BSDXATID
     236           S BSDXFDA(9002018.4,"+1,",.14)=BSDXRADEXAM
    231237           N BSDXIEN,BSDXMSG
    232238           D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
  • Scheduling/trunk/m/BSDX28.m

    r1161 r1172  
    2828        I '+$G(DUZ) S BSDXY=BSDXRET_$C(31) Q
    2929        I '$D(DUZ(2)) S BSDXY=BSDXRET_$C(31) Q
    30        
     30DFN ;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)
    3139PID     ;PID Lookup
    3240           ; If this ID exists, go get it. If "UJOPID" index doesn't exist,
  • Scheduling/trunk/m/BSDX32.m

    r1161 r1172  
    2929        S BSDXI=0
    3030        ;"SELECT BSDXIEN 'HOSPITAL_LOCATION_ID', NAME 'HOSPITAL_LOCATION', DEFAULT_PROVIDER, STOP_CODE_NUMBER, INACTIVATE_DATE, REACTIVATE_DATE FROM HOSPITAL_LOCATION";
    31         S ^BSDXTMP($J,BSDXI)="I00020HOSPITAL_LOCATION_ID^T00040HOSPITAL_LOCATION^T00030DEFAULT_PROVIDER^T00030STOP_CODE_NUMBER^D00020INACTIVATE_DATE^D00020REACTIVATE_DATE"_$C(30)
     31        S ^BSDXTMP($J,BSDXI)="I00020HOSPITAL_LOCATION_ID^T00040HOSPITAL_LOCATION^T00030DEFAULT_PROVIDER^T00030STOP_CODE_NUMBER^D00020INACTIVATE_DATE^D00020REACTIVATE_DATE^T00001IS_RADIOLOGY_LOCATION"_$C(30)
    3232        ;
    3333        S BSDXNAM="" F  S BSDXNAM=$O(^SC("B",BSDXNAM)) Q:BSDXNAM=""  D
     
    5050        . . . Q
    5151        . . Q
     52        . ; Decide if this is a radiology location - Check "B" index of ^RA(79.1 global to see if HL is there
     53        . N BSDXISRAD S BSDXISRAD=''$DATA(^RA(79.1,"B",BSDXIEN))
    5254        . S BSDXI=BSDXI+1
    53         . S ^BSDXTMP($J,BSDXI)=BSDXIEN_U_BSDXNAM_U_BSDXPRV_U_BSDXSCOD_U_BSDXINA_U_BSDXREA_$C(30)
     55        . S ^BSDXTMP($J,BSDXI)=BSDXIEN_U_BSDXNAM_U_BSDXPRV_U_BSDXSCOD_U_BSDXINA_U_BSDXREA_U_BSDXISRAD_$C(30)
    5456        . Q
    5557        S BSDXI=BSDXI+1
Note: See TracChangeset for help on using the changeset viewer.