Changeset 867 for Scheduling

Timestamp:

Jul 14, 2010, 8:08:39 AM (14 years ago)

Author:

Sam Habiel

Message:

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.

Location:

Scheduling/trunk/m

Files:

• BSDX07.m (modified) (2 diffs)
• BSDX28.m (modified) (8 diffs)

Scheduling/trunk/m/BSDX07.m

@@ -1 @@
-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.
@@ -111 +111 @@
         ;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

Scheduling/trunk/m/BSDX28.m

@@ -1 @@
-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
@@ -18 +22 @@
         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
@@ -34 +57 @@
         . . 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
@@ -42 +65 @@
         . Q
         ;
-        ;Chart# Lookup
+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
@@ -51 +75 @@
         . . 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
@@ -58 +82 @@
         . . 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
@@ -69 +93 @@
         . . 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
@@ -99 +123 @@
         . 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