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

Merging Radiology Support branch back to trunk.

This commit is contained in:
sam 2011-05-08 08:11:34 +00:00
parent 112b97b8cb
commit 3a4ce73bf6
5 changed files with 95 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

69
m/BSDX01.m
View File

@ -318,3 +318,72 @@ UnitTestINDIV2
I $$INDIV2(26)'=1 W "ERROR",!
I $$INDIV2(27)'=1 W "ERROR",!
QUIT
;
GETRADEX(BSDXY,DFN,SCIEN) ; Get All Pending and On Hold Radiology Exams for Patient; RPC EP; UJO/SMH new in v 1.6
; RPC: BSDX GET RAD EXAM FOR PT; Return: Global Array
;
; Input: DFN - you should know; SCIEN - IEN of Hospital Location
; Output: ADO Datatable with the following columns:
; - BMXIEN: Radiology Exam IEN in file 75.1 (RAD/NUC MED ORDERS)
; - STATUS: Pending Or Hold Status
; - PROCEDURE: Text Procedure Name
; - REQUEST_DATE: Date Procedure was requested
;
; Error Processing: Silent failure.
;
S BSDXY=$NA(^BMXTEMP($J))
K @BSDXY
;
N BSDXI S BSDXI=0
S @BSDXY@(BSDXI)="I00015BMXIEN^T00015STATUS^T00100PROCEDURE^D00030REQUEST_DATE"_$C(30)
;
N BSDXRLIEN S BSDXRLIEN=$ORDER(^RA(79.1,"B",SCIEN,"")) ; IEN of HL in file 79.1, to get Radiology Imaging IEN
I 'BSDXRLIEN GOTO END
;
N BSDXOUT,BSDXERR ; Out, Error
;
; File 75.1 = RAD/NUC MED ORDERS
; Fields 5 = Request Status; 2 = Procedure; 16 = Requested Entered Date Time
; Filter Field: First piece is DFN, 5th piece is 3 or 5 (Status of Pending Or Hold); 20th piece is Radiology Location requested
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")
;
IF $DATA(BSDXERR) GOTO END
;
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
. N BMXIEN,BMXSTAUS,BMXPROC,BMXDATE ; Proc IEN, Proc Status, Proc Name
. S BMXIEN=$P(BSDXOUT("DILIST",BSDXI,0),U) ; IEN
. S BMXSTATUS=$P(BSDXOUT("DILIST",BSDXI,0),U,2) ; Status
. S BMXPROC=$P(BSDXOUT("DILIST",BSDXI,0),U,3) ; Procedure Name
. S BMXDATE=$TR($P(BSDXOUT("DILIST",BSDXI,0),U,4),"@"," ") ; Request Entered Date Time
. S @BSDXY@(BSDXI)=BMXIEN_U_BMXSTATUS_U_BMXPROC_U_BMXDATE_$C(30)
END ; Errors Jump Here...
S @BSDXY@(BSDXI+1)=$C(31)
QUIT
;
SCHRAEX(BSDXY,RADFN,RAOIFN,RAOSCH) ; Schedule a Radiology Exam; RPC EP; UJO/SMH new in v 1.6
; RPC: BSDX SCHEDULE RAD EXAM; Return: Single Value
;
; Input:
; - RADFN -> DFN
; - RAOIFN -> Radiology Order IEN in file 75.1
; - RAOSCH -> Scheduled Time for Exam
; Output: Always "1"
;
S RAOSCH=+RAOSCH ; Strip the trailing zeros from the Fileman Date produced by C#
N RAOSTS S RAOSTS=8 ; Status of Scheduled
D ^RAORDU ; API in Rad expects RADFN, RAOIFN, RAOSCH, and RAOSTS
S BSDXY=1 ; Success
QUIT
;
HOLDRAEX(BSDXY,RADFN,RAOIFN) ; Hold a Radiology Exam; RPC EP; UJO/SMH new in v 1.6
; RPC: BSDX HOLD RAD EXAM; Return: Single Vale
;
; Input:
; - RADFN -> DFN
; - RAOIFN -> Radiology Order IEN in file 75.1
; Output: Always "1"
N RAOSTS S RAOSTS=3 ; Status of Hold
N RAOREA S RAOREA=20 ; Reason: Exam Cancelled
D ^RAORDU
S BSDXY=1 ; Success
QUIT

6
m/BSDX02.m
View File

@ -4,6 +4,7 @@ BSDX02 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:14am
; Change Log
; July 15 2010: UJO/SMH - Pass FM dates in instead of US dates for i18n
; March 21 2011: UJO/SMH (v 1.5) - Return new fields: Patient SEX, PID, and DOB
; April 11 2011: UJO/SMH (v 1.6) - Added Radiology Exam Field, to retrieve Radiology Exam associated with appt
;
;
CRSCHD(BSDXY,BSDXRES,BSDXSTART,BSDXEND) ;EP
@ -28,7 +29,7 @@ CRSCH(BSDXY,BSDXRES,BSDXSTART,BSDXEND,BSDXWKIN) ;
K ^BSDXTMP($J)
S BSDXERR=""
S BSDXY="^BSDXTMP("_$J_")"
S ^BSDXTMP($J,0)="I00020APPOINTMENTID^D00030START_TIME^D00030END_TIME^D00030CHECKIN^D00030AUXTIME^I00020PATIENTID^T00030PATIENTNAME^T00030RESOURCENAME^I00005NOSHOW^T00020HRN^I00005ACCESSTYPEID^I00005WALKIN^T00250NOTE^T00006SEX^T00040PID^D00030DOB"_$C(30)
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)
D ^XBKVAR S X="ETRAP^BSDX02",@^%ZOSF("TRAP")
;
; S %DT="T",X=BSDXSTART D ^%DT S BSDXSTART=Y
@ -98,7 +99,8 @@ STCOMM(BSDXAD,BSDXRESN) ;
; Note strange way I retrieve the value. B/c DOB Output Transform
; Outputs it in MM/DD/YYYY format, which is ambigous for C#.
N DOB S DOB=$$FMTE^XLFDT($$GET1^DIQ(2,BSDXPATD,.03,"I")) ; DOB
S ^BSDXTMP($J,BSDXI)=SEX_U_PID_U_DOB_$C(30)
N RADEX S RADEX=$P(BSDXNOD,U,14)
S ^BSDXTMP($J,BSDXI)=SEX_U_PID_U_DOB_U_RADEX_$C(30)
; end new code
Q
;

12
m/BSDX07.m
View File

@ -10,6 +10,7 @@ BSDX07 ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 4/28/11 10:17am
; v1.42 Oct 30 2010 - Extensive refactoring.
; v1.5 Mar 15 2011 - End time does not have to have time anymore.
; It could be midnight of the next day
; v1.6 Apr 11 2011 - Support for Scheduling Radiology Exams...
;
; Error Reference:
; -1: Patient Record is locked. This means something is wrong!!!!
@ -78,7 +79,8 @@ UT ; Unit Tests
I '$D(^SC(2,"S",3110123.09)) W "Error Making Appt-4"
QUIT
;
APPADD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID) ;EP
APPADD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID,BSDXRADEXAM) ;EP
;
;Called by RPC: BSDX ADD NEW APPOINTMENT
;
;Add new appointment to 3 files
@ -97,6 +99,7 @@ APPADD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID) ;EP
;BSDXATID is used for 2 purposes:
; if BSDXATID = "WALKIN" then BSDAPI is called to create a walkin appt.
; if BSDXATID = a number, then it is the access type id (used for rebooking)
;BSDXRADEXAM is used to store the Radiology Exam to which this appointment is tied to (optional)
;
;Return:
; ADO.net Recordset having fields:
@ -105,6 +108,8 @@ APPADD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID) ;EP
;Test lines:
;BSDX ADD NEW APPOINTMENT^3091122.0930^3091122.1000^370^Dr Office^30^EXAM^WALKIN
;
; Deal with optional arguments
S BSDXRADEXAM=$G(BSDXRADEXAM)
; Return Array; set Return and clear array
S BSDXY=$NA(^BSDXTMP($J))
K ^BSDXTMP($J)
@ -172,7 +177,7 @@ APPADD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID) ;EP
;
; Done with all checks, let's make appointment in BSDX APPOINTMENT
N BSDXAPPTID
S BSDXAPPTID=$$BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRESD,BSDXATID)
S BSDXAPPTID=$$BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRESD,BSDXATID,BSDXRADEXAM)
I 'BSDXAPPTID D ERR(BSDXI,"-9~BSDX07 Error: Unable to add appointment to BSDX APPOINTMENT file.") Q
I BSDXNOTE]"" D BSDXWP(BSDXAPPTID,BSDXNOTE)
;
@ -216,7 +221,7 @@ STRIP(BSDXZ) ;Replace control characters with spaces
F BSDXI=1:1:$L(BSDXZ) I (32>$A($E(BSDXZ,BSDXI))) S BSDXZ=$E(BSDXZ,1,BSDXI-1)_" "_$E(BSDXZ,BSDXI+1,999)
Q BSDXZ
;
BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRESD,BSDXATID) ;ADD BSDX APPOINTMENT ENTRY
BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRESD,BSDXATID,BSDXRADEXAM) ;ADD BSDX APPOINTMENT ENTRY
;Returns ien in BSDXAPPT or 0 if failed
;Create entry in BSDX APPOINTMENT
N BSDXAPPTID
@ -228,6 +233,7 @@ BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRESD,BSDXATID) ;ADD BSDX APPOINTMENT EN
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
N BSDXIEN,BSDXMSG
D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
S BSDXAPPTID=+$G(BSDXIEN(1))

10
m/BSDX28.m
View File

@ -27,7 +27,15 @@ PTLOOKRS(BSDXY,BSDXP,BSDXC) ;EP Patient Lookup
S BSDXRET="T00030NAME^T00030HRN^T00030PID^D00030DOB^T00030IEN"_$C(30)
I '+$G(DUZ) S BSDXY=BSDXRET_$C(31) Q
I '$D(DUZ(2)) S BSDXY=BSDXRET_$C(31) Q
DFN ;If DFN is passed as `nnnn, just return that patient
I $E(BSDXP)="`" DO SET BSDXY=BSDXRET_$C(31) QUIT
. N BSDXIEN S BSDXIEN=$E(BSDXP,2,99)
. I BSDXIEN'=+BSDXIEN QUIT ; BSDXIEN must be numeric
. N NAME S NAME=$P(^DPT(BSDXIEN,0),U)
. N HRN S HRN=$P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,2)
. N PID S PID=$P(^DPT(BSDXIEN,.36),U,3)
. N DOB S DOB=$$FMTE^XLFDT($P(^DPT(BSDXIEN,0),U,3))
. S BSDXRET=BSDXRET_NAME_U_HRN_U_PID_U_DOB_U_BSDXIEN_$C(30)
PID ;PID Lookup
; If this ID exists, go get it. If "UJOPID" index doesn't exist,
; won't work anyways.

6
m/BSDX32.m
View File

@ -28,7 +28,7 @@ HOSPLOC(BSDXY) ;EP
S BSDXY="^BSDXTMP("_$J_")"
S BSDXI=0
;"SELECT BSDXIEN 'HOSPITAL_LOCATION_ID', NAME 'HOSPITAL_LOCATION', DEFAULT_PROVIDER, STOP_CODE_NUMBER, INACTIVATE_DATE, REACTIVATE_DATE FROM HOSPITAL_LOCATION";
S ^BSDXTMP($J,BSDXI)="I00020HOSPITAL_LOCATION_ID^T00040HOSPITAL_LOCATION^T00030DEFAULT_PROVIDER^T00030STOP_CODE_NUMBER^D00020INACTIVATE_DATE^D00020REACTIVATE_DATE"_$C(30)
S ^BSDXTMP($J,BSDXI)="I00020HOSPITAL_LOCATION_ID^T00040HOSPITAL_LOCATION^T00030DEFAULT_PROVIDER^T00030STOP_CODE_NUMBER^D00020INACTIVATE_DATE^D00020REACTIVATE_DATE^T00001IS_RADIOLOGY_LOCATION"_$C(30)
;
S BSDXNAM="" F S BSDXNAM=$O(^SC("B",BSDXNAM)) Q:BSDXNAM="" D
. S BSDXIEN=$O(^SC("B",BSDXNAM,0))
@ -49,8 +49,10 @@ HOSPLOC(BSDXY) ;EP
. . . S:$P(BSDXNOD1,U,2)="1" BSDXPRV=$$GET1^DIQ(200,$P(BSDXNOD1,U),.01)
. . . Q
. . Q
. ; Decide if this is a radiology location - Check "B" index of ^RA(79.1 global to see if HL is there
. N BSDXISRAD S BSDXISRAD=''$DATA(^RA(79.1,"B",BSDXIEN))
. S BSDXI=BSDXI+1
. S ^BSDXTMP($J,BSDXI)=BSDXIEN_U_BSDXNAM_U_BSDXPRV_U_BSDXSCOD_U_BSDXINA_U_BSDXREA_$C(30)
. S ^BSDXTMP($J,BSDXI)=BSDXIEN_U_BSDXNAM_U_BSDXPRV_U_BSDXSCOD_U_BSDXINA_U_BSDXREA_U_BSDXISRAD_$C(30)
. Q
S BSDXI=BSDXI+1
S ^BSDXTMP($J,BSDXI)=$C(31)