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

Two updates: Search by Primary ID now enabled; 

bug in make appointment code that causes storage of non-canonical 
appointment times (3091103.0900 e.g. rather than 3091103.09). causes a 
problem when retrieving appointments.
This commit is contained in:
sam 2010-07-14 12:08:39 +00:00
parent e14c157221
commit e4030b100d
2 changed files with 41 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
m/BSDX07.m
View File

@ -1,4 +1,4 @@
BSDX07 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; ; 7/6/10 6:13am
BSDX07 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; ; 7/6/10 4:28pm
;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
; v1.3 July 13 2010 - Add support i18n - Dates input as FM dates, not US.
;
@ -110,9 +110,11 @@ STRIP(BSDXZ) ;Replace control characters with spaces
BSDXADD(BSDXSTART,BSDXEND,BSDXPATID,BSDXRESD,BSDXATID) ;ADD BSDX APPOINTMENT ENTRY
;Returns ien in BSDXAPPT or 0 if failed
;Create entry in BSDX APPOINTMENT
; BSDXSTART and BSDXEND need to be stored as numeric, not string
; So 3090713.0900 is incorrect --> it should be 3090713.09
N BSDXAPPTID
S BSDXFDA(9002018.4,"+1,",.01)=BSDXSTART
S BSDXFDA(9002018.4,"+1,",.02)=BSDXEND
S BSDXFDA(9002018.4,"+1,",.01)=+BSDXSTART ; smh fix bug stores as string
S BSDXFDA(9002018.4,"+1,",.02)=+BSDXEND
S BSDXFDA(9002018.4,"+1,",.05)=BSDXPATID
S BSDXFDA(9002018.4,"+1,",.07)=BSDXRESD
S BSDXFDA(9002018.4,"+1,",.08)=$G(DUZ)

44
m/BSDX28.m
View File

@ -1,25 +1,48 @@
BSDX28 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
BSDX28 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/6/10 3:55pm
;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
;
;HMW 20050721 Added test for inactivated record
; HMW 3050721 Added test for inactivated record
; SMH 3100714 add PID search, return PID instead of SSN
; Change Error trap to new style.
;
PTLOOKRS(BSDXY,BSDXP,BSDXC) ;EP Patient Lookup
;
;Find up to BSDXC patients matching BSDXP*
;Supports DOB Lookup, SSN Lookup
;Supports DOB Lookup, Primary Long ID lookup
;
S X="ERROR^BSDX28",@^%ZOSF("TRAP")
N $ET S $ET="G ERROR^BSDX28"
; rm ctrl chars
S BSDXP=$TR(BSDXP,$C(13),"")
S BSDXP=$TR(BSDXP,$C(10),"")
S BSDXP=$TR(BSDXP,$C(9),"")
; num of pts to find
S:BSDXC="" BSDXC=10
N BSDXHRN,BSDXZ,BSDXDLIM,BSDXRET,BSDXDPT,BSDXRET,BSDXIEN,BSDXFILE
N BSDXIENS,BSDXFIELDS,BSDXFLAGS,BSDXVALUE,BSDXNUMBER,BSDXINDEXES,BSDXSCREEN
N BSDXTARG,BSDXMSG,BSDXRSLT
S BSDXDLIM="^"
S BSDXRET="T00030NAME^T00030HRN^T00030SSN^D00030DOB^T00030IEN"_$C(30)
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
PID ;PID Lookup
; If this ID exists, go get it. If "UJOPID" index doesn't exist,
; won't work anyways.
I $D(^DPT("UJOPID",BSDXP)) DO SET BSDXY=BSDXRET_$C(31) QUIT
. S BSDXIEN=$O(^DPT("UJOPID",BSDXP,""))
. Q:'$D(^DPT(BSDXIEN,0))
. S BSDXDPT=$G(^DPT(BSDXIEN,0))
. S BSDXZ=$P(BSDXDPT,U) ;NAME
. S BSDXHRN=$P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,2) ;CHART
. I BSDXHRN="" Q ;NO CHART AT THIS DUZ2
. ; Inactivated Chart get an *
. I $P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,3) S BSDXHRN=BSDXHRN_"(*)" Q
. S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN
. S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID
. S Y=$P(BSDXDPT,U,3) X ^DD("DD")
. S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB
. S $P(BSDXZ,BSDXDLIM,5)=BSDXIEN
. S BSDXRET=BSDXRET_BSDXZ_$C(30)
;
DOB ;DOB Lookup
I +DUZ(2),((BSDXP?1.2N1"/"1.2N1"/"1.4N)!(BSDXP?1.2N1" "1.2N1" "1.4N)!(BSDXP?1.2N1"-"1.2N1"-"1.4N)) D S BSDXY=BSDXRET_$C(31) Q
@ -33,7 +56,7 @@ DOB ;DOB Lookup
. . I BSDXHRN="" Q ;NO CHART AT THIS DUZ2
. . I $P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,3) S BSDXHRN=BSDXHRN_"(*)" Q ;HMW 20050721 Record Inactivated
. . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN
. . S $P(BSDXZ,BSDXDLIM,3)=$P(BSDXDPT,U,9) ;SSN
. . S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID
. . S Y=$P(BSDXDPT,U,3) X ^DD("DD")
. . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB
. . S $P(BSDXZ,BSDXDLIM,5)=BSDXIEN
@ -41,6 +64,7 @@ DOB ;DOB Lookup
. . Q
. Q
;
CHART
;Chart# Lookup
I +DUZ(2),BSDXP]"",$D(^AUPNPAT("D",BSDXP)) D S BSDXY=BSDXRET_$C(31) Q
. S BSDXIEN=0 F S BSDXIEN=$O(^AUPNPAT("D",BSDXP,BSDXIEN)) Q:'+BSDXIEN I $D(^AUPNPAT("D",BSDXP,BSDXIEN,DUZ(2))) D Q
@ -50,7 +74,7 @@ DOB ;DOB Lookup
. . S BSDXHRN=BSDXP ;CHART
. . I $D(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),$P(^(0),U,3) S BSDXHRN=BSDXHRN_"(*)" Q ;HMW 20050721 Record Inactivated
. . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN
. . S $P(BSDXZ,BSDXDLIM,3)=$P(BSDXDPT,U,9) ;SSN
. . S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID
. . S Y=$P(BSDXDPT,U,3) X ^DD("DD")
. . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB
. . S $P(BSDXZ,BSDXDLIM,5)=BSDXIEN
@ -58,7 +82,7 @@ DOB ;DOB Lookup
. . Q
. Q
;
;SSN Lookup
SSN ;SSN Lookup
I (BSDXP?9N)!(BSDXP?3N1"-"2N1"-"4N),$D(^DPT("SSN",BSDXP)) D S BSDXY=BSDXRET_$C(31) Q
. S BSDXIEN=0 F S BSDXIEN=$O(^DPT("SSN",BSDXP,BSDXIEN)) Q:'+BSDXIEN D Q
. . Q:'$D(^DPT(BSDXIEN,0))
@ -68,7 +92,7 @@ DOB ;DOB Lookup
. . I BSDXHRN="" Q ;NO CHART AT THIS DUZ2
. . I $P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,3) S BSDXHRN=BSDXHRN_"(*)" Q ;HMW 20050721 Record Inactivated
. . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN
. . S $P(BSDXZ,BSDXDLIM,3)=$P(BSDXDPT,U,9) ;SSN
. . S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID
. . S Y=$P(BSDXDPT,U,3) X ^DD("DD")
. . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB
. . S $P(BSDXZ,BSDXDLIM,5)=BSDXIEN
@ -98,7 +122,7 @@ DOB ;DOB Lookup
. I $P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,3) S BSDXHRN=BSDXHRN_"(*)" Q ;HMW 20050721 Record Inactivated
. S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN
. S BSDXDPT=$G(^DPT(BSDXIEN,0))
. S $P(BSDXZ,BSDXDLIM,3)=$P(BSDXDPT,U,9) ;SSN
. S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID
. S Y=$P(BSDXDPT,U,3) X ^DD("DD")
. S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB
. S $P(BSDXZ,BSDXDLIM,5)=BSDXIEN