Changeset 867 for Scheduling


Ignore:
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:
2 edited

Legend:

Unmodified
Added
Removed
  • Scheduling/trunk/m/BSDX07.m

    r863 r867  
    1 BSDX07  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;  ; 7/6/10 6:13am
     1BSDX07  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;  ; 7/6/10 4:28pm
    22        ;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
    33    ; v1.3 July 13 2010 - Add support i18n - Dates input as FM dates, not US.
     
    111111        ;Returns ien in BSDXAPPT or 0 if failed
    112112        ;Create entry in BSDX APPOINTMENT
     113    ; BSDXSTART and BSDXEND need to be stored as numeric, not string
     114    ; So 3090713.0900 is incorrect --> it should be 3090713.09
    113115        N BSDXAPPTID
    114         S BSDXFDA(9002018.4,"+1,",.01)=BSDXSTART
    115         S BSDXFDA(9002018.4,"+1,",.02)=BSDXEND
     116        S BSDXFDA(9002018.4,"+1,",.01)=+BSDXSTART  ; smh fix bug stores as string
     117        S BSDXFDA(9002018.4,"+1,",.02)=+BSDXEND
    116118        S BSDXFDA(9002018.4,"+1,",.05)=BSDXPATID
    117119        S BSDXFDA(9002018.4,"+1,",.07)=BSDXRESD
  • Scheduling/trunk/m/BSDX28.m

    r614 r867  
    1 BSDX28  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
     1BSDX28  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/6/10 3:55pm
    22        ;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
    33        ;
    4         ;HMW 20050721 Added test for inactivated record
     4        ; HMW 3050721 Added test for inactivated record
     5    ; SMH 3100714 add PID search, return PID instead of SSN
     6    ; Change Error trap to new style.
    57        ;
    68PTLOOKRS(BSDXY,BSDXP,BSDXC)      ;EP Patient Lookup
    79        ;
    810        ;Find up to BSDXC patients matching BSDXP*
    9         ;Supports DOB Lookup, SSN Lookup
     11        ;Supports DOB Lookup, Primary Long ID lookup
    1012        ;
    11         S X="ERROR^BSDX28",@^%ZOSF("TRAP")
     13        N $ET S $ET="G ERROR^BSDX28"
     14    ; rm ctrl chars
    1215        S BSDXP=$TR(BSDXP,$C(13),"")
    1316        S BSDXP=$TR(BSDXP,$C(10),"")
    1417        S BSDXP=$TR(BSDXP,$C(9),"")
     18    ; num of pts to find
    1519        S:BSDXC="" BSDXC=10
    1620        N BSDXHRN,BSDXZ,BSDXDLIM,BSDXRET,BSDXDPT,BSDXRET,BSDXIEN,BSDXFILE
     
    1822        N BSDXTARG,BSDXMSG,BSDXRSLT
    1923        S BSDXDLIM="^"
    20         S BSDXRET="T00030NAME^T00030HRN^T00030SSN^D00030DOB^T00030IEN"_$C(30)
     24        S BSDXRET="T00030NAME^T00030HRN^T00030PID^D00030DOB^T00030IEN"_$C(30)
    2125        I '+$G(DUZ) S BSDXY=BSDXRET_$C(31) Q
    2226        I '$D(DUZ(2)) S BSDXY=BSDXRET_$C(31) Q
     27
     28PID ;PID Lookup
     29    ; If this ID exists, go get it. If "UJOPID" index doesn't exist,
     30    ; won't work anyways.
     31    I $D(^DPT("UJOPID",BSDXP)) DO  SET BSDXY=BSDXRET_$C(31) QUIT
     32    . S BSDXIEN=$O(^DPT("UJOPID",BSDXP,""))
     33    . Q:'$D(^DPT(BSDXIEN,0))
     34    . S BSDXDPT=$G(^DPT(BSDXIEN,0))
     35    . S BSDXZ=$P(BSDXDPT,U) ;NAME
     36    . S BSDXHRN=$P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,2) ;CHART
     37    . I BSDXHRN="" Q  ;NO CHART AT THIS DUZ2
     38    . ; Inactivated Chart get an *
     39    . I $P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,3) S BSDXHRN=BSDXHRN_"(*)" Q
     40    . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN
     41    . S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID
     42    . S Y=$P(BSDXDPT,U,3) X ^DD("DD")
     43    . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB
     44    . S $P(BSDXZ,BSDXDLIM,5)=BSDXIEN
     45    . S BSDXRET=BSDXRET_BSDXZ_$C(30)
    2346        ;
    2447DOB     ;DOB Lookup
     
    3457        . . I $P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,3) S BSDXHRN=BSDXHRN_"(*)" Q  ;HMW 20050721 Record Inactivated
    3558        . . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN
    36         . . S $P(BSDXZ,BSDXDLIM,3)=$P(BSDXDPT,U,9) ;SSN
     59    . . S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID
    3760        . . S Y=$P(BSDXDPT,U,3) X ^DD("DD")
    3861        . . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB
     
    4265        . Q
    4366        ;
    44         ;Chart# Lookup
     67CHART
     68    ;Chart# Lookup
    4569        I +DUZ(2),BSDXP]"",$D(^AUPNPAT("D",BSDXP)) D  S BSDXY=BSDXRET_$C(31) Q
    4670        . S BSDXIEN=0 F  S BSDXIEN=$O(^AUPNPAT("D",BSDXP,BSDXIEN)) Q:'+BSDXIEN  I $D(^AUPNPAT("D",BSDXP,BSDXIEN,DUZ(2))) D  Q
     
    5175        . . I $D(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),$P(^(0),U,3) S BSDXHRN=BSDXHRN_"(*)" Q  ;HMW 20050721 Record Inactivated
    5276        . . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN
    53         . . S $P(BSDXZ,BSDXDLIM,3)=$P(BSDXDPT,U,9) ;SSN
     77    . . S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID
    5478        . . S Y=$P(BSDXDPT,U,3) X ^DD("DD")
    5579        . . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB
     
    5882        . . Q
    5983        . Q
    60         ;
    61         ;SSN Lookup
     84    ;
     85SSN     ;SSN Lookup
    6286        I (BSDXP?9N)!(BSDXP?3N1"-"2N1"-"4N),$D(^DPT("SSN",BSDXP)) D  S BSDXY=BSDXRET_$C(31) Q
    6387        . S BSDXIEN=0 F  S BSDXIEN=$O(^DPT("SSN",BSDXP,BSDXIEN)) Q:'+BSDXIEN  D  Q
     
    6993        . . I $P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,3) S BSDXHRN=BSDXHRN_"(*)" Q  ;HMW 20050721 Record Inactivated
    7094        . . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN
    71         . . S $P(BSDXZ,BSDXDLIM,3)=$P(BSDXDPT,U,9) ;SSN
     95    . . S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID
    7296        . . S Y=$P(BSDXDPT,U,3) X ^DD("DD")
    7397        . . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB
     
    99123        . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN
    100124        . S BSDXDPT=$G(^DPT(BSDXIEN,0))
    101         . S $P(BSDXZ,BSDXDLIM,3)=$P(BSDXDPT,U,9) ;SSN
     125    . S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID
    102126        . S Y=$P(BSDXDPT,U,3) X ^DD("DD")
    103127        . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB
Note: See TracChangeset for help on using the changeset viewer.