Changeset 888 for Scheduling


Ignore:
Timestamp:
Jul 18, 2010, 9:58:35 AM (14 years ago)
Author:
Sam Habiel
Message:

Updated version numbers

Location:
Scheduling/trunk/m
Files:
37 edited

Legend:

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

    r883 r888  
    11BSDX01  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/18/10 2:04pm
    2         ;;1.3;IHS WINDOWS SCHEDULING;;NOV 01, 2007
     2        ;;1.3T1;BSDX;;Jul 18, 2010
    33        ;
    44        ;
  • Scheduling/trunk/m/BSDX02.m

    r874 r888  
    11BSDX02  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/15/10 12:25pm
    2         ;;1.3;IHS WINDOWS SCHEDULING;;NOV 01, 2007
    3     ;
    4     ; Change Log
    5     ; July 15 2010: UJO/SMH - Pass FM dates in instead of US dates for i18n
     2        ;;1.3T1;BSDX;;Jul 18, 2010
     3           ;
     4           ; Change Log
     5           ; July 15 2010: UJO/SMH - Pass FM dates in instead of US dates for i18n
    66        ;
    77        ;
     
    3535        ; S %DT="T",X=BSDXEND D ^%DT S BSDXEND=Y
    3636        ; I BSDXEND=-1 S ^BSDXTMP($J,1)=$C(31) Q
    37     ;
     37           ;
    3838        S BSDXI=0
    3939        D STRES
  • Scheduling/trunk/m/BSDX03.m

    r614 r888  
    11BSDX03  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
    2         ;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
     2        ;;1.3T1;BSDX;;Jul 18, 2010
    33        ;
    44        ;
  • Scheduling/trunk/m/BSDX04.m

    r874 r888  
    11BSDX04  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;  ; 7/15/10 12:44pm
    2         ;;1.3;IHS WINDOWS SCHEDULING;;NOV 01, 2007
    3     ; Change Log:
    4     ; July 11 2010: Pass BSDXSTART and END as FM dates rather than US formatted dates
    5     ;       for i18n
     2        ;;1.3T1;BSDX;;Jul 18, 2010
     3           ; Change Log:
     4           ; July 11 2010: Pass BSDXSTART and END as FM dates rather than US formatted dates
     5           ;       for i18n
    66        ;
    77        ;
     
    2727        ;
    2828        ;BSDXRES is resource name
    29     ;
    30     ;//smh
    31     ; BSDXSTART and BSDXEND both passed in FM Format.
    32     ; BSDXSTART is the Date Portion of FM Date
    33     ; BSDXEND -- pass date and h,m,s as well
    34     ;//smh
     29           ;
     30           ;//smh
     31           ; BSDXSTART and BSDXEND both passed in FM Format.
     32           ; BSDXSTART is the Date Portion of FM Date
     33           ; BSDXEND -- pass date and h,m,s as well
     34           ;//smh
    3535        ;
    3636        ;BSDXTYPES is |-delimited list of Access Type Names
  • Scheduling/trunk/m/BSDX05.m

    r874 r888  
    11BSDX05  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/15/10 12:51pm
    2         ;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
     2        ;;1.3T1;BSDX;;Jul 18, 2010
    33        ;
    4     ; Change Log:
    5     ; UJO/SMH - July 11 2010: pass FM Dates for Start and End rather than US Dates
     4           ; Change Log:
     5           ; UJO/SMH - July 11 2010: pass FM Dates for Start and End rather than US Dates
    66        ;
    77APBLKOV(BSDXY,BSDXSTART,BSDXEND,BSDXRES)         ;EP
    88        ;Called by BSDX APPT BLOCKS OVERLAP
    9     ; July 11 2010 - pass FM Dates for Start and End rather than US Dates
     9           ; July 11 2010 - pass FM Dates for Start and End rather than US Dates
    1010        ;(Duplicates old qryAppointmentBlocksOverlapB)
    1111        ;BSDXRES is resource name
  • Scheduling/trunk/m/BSDX06.m

    r874 r888  
    11BSDX06  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/15/10 4:51pm
    2         ;;1.3;IHS WINDOWS SCHEDULING;;NOV 01, 2007
    3     ; Change Log:
    4     ; UJO/SMH: July 15 2010: Change in BSDXSTART and BSDXEND: get
    5     ; dates in FM format for i18n
     2        ;;1.3T1;BSDX;;Jul 18, 2010
     3           ; Change Log:
     4           ; UJO/SMH: July 15 2010: Change in BSDXSTART and BSDXEND: get
     5           ; dates in FM format for i18n
    66        ;
    77        ;
  • Scheduling/trunk/m/BSDX07.m

    r883 r888  
    11BSDX07  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;  ; 7/18/10 2:11pm
    2         ;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
    3     ;
    4     ; Change Log:
    5     ; UJO/SMH
    6     ; v1.3 July 13 2010 - Add support i18n - Dates input as FM dates, not US.
     2        ;;1.3T1;BSDX;;Jul 18, 2010
     3           ;
     4           ; Change Log:
     5           ; UJO/SMH
     6           ; v1.3 July 13 2010 - Add support i18n - Dates input as FM dates, not US.
    77        ;
    88        ;
     
    4545        ;
    4646        TSTART
    47     ; v1.3 - date passed in as FM Date, not US date.
     47           ; v1.3 - date passed in as FM Date, not US date.
    4848        ;Check input data for errors
    4949        ; S:BSDXSTART["@0000" BSDXSTART=$P(BSDXSTART,"@")
     
    5353        ; S %DT="T",X=BSDXEND D ^%DT S BSDXEND=Y
    5454        ; I BSDXEND=-1 D ERR(BSDXI+1,"BSDX07 Error: Invalid End Time") Q
    55     ;
    56     ; If C# sends the dates with extra zeros, remove them
     55           ;
     56           ; If C# sends the dates with extra zeros, remove them
    5757        S BSDXSTART=+BSDXSTART,BSDXEND=+BSDXEND
    58     ;
    59     I $L(BSDXEND,".")=1 D ERR(BSDXI+1,"BSDX07 Error: Invalid End Time") Q
     58           ;
     59           I $L(BSDXEND,".")=1 D ERR(BSDXI+1,"BSDX07 Error: Invalid End Time") Q
    6060        I BSDXSTART>BSDXEND S BSDXTMP=BSDXEND,BSDXEND=BSDXSTART,BSDXSTART=BSDXTMP
    6161        I '+BSDXPATID,'$D(^DPT(BSDXPATID,0)) D ERR(BSDXI+1,"BSDX07 Error: Invalid Patient ID") Q
     
    178178ERR(BSDXI,BSDXERR)      ;Error processing
    179179        D ^%ZTER ;XXX: remove after we figure out the cause of error
    180     S BSDXI=BSDXI+1
     180           S BSDXI=BSDXI+1
    181181        S BSDXERR=$TR(BSDXERR,"^","~")
    182182        TROLLBACK
  • Scheduling/trunk/m/BSDX08.m

    r614 r888  
    11BSDX08  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
    2         ;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
     2        ;;1.3T1;BSDX;;Jul 18, 2010
    33        ;
    44        ;
  • Scheduling/trunk/m/BSDX09.m

    r883 r888  
    11BSDX09  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;  ; 7/18/10 2:26pm
    2         ;;1.3;IHS WINDOWS SCHEDULING;;NOV 01, 2007
     2        ;;1.3T1;BSDX;;Jul 18, 2010
    33        ;
    4     ; Change Log:
    5     ; UJO/TH - v 1.3 on 3100714 - Extra Demographics:
    6     ; - Email
    7     ; - Cell Phone
    8     ; - Country
    9     ; - + refactoring of routine
     4           ; Change Log:
     5           ; UJO/TH - v 1.3 on 3100714 - Extra Demographics:
     6           ; - Email
     7           ; - Cell Phone
     8           ; - Country
     9           ; - + refactoring of routine
    1010        ;
    11     ; UJO/TH - v 1.3 on 3100715 - Change SSN to PID and get PID field instead
     11           ; UJO/TH - v 1.3 on 3100715 - Change SSN to PID and get PID field instead
    1212        ;
    1313GETREGA(BSDXRET,BSDXPAT)               ;EP
     
    1818        ;   20 DATAREVIEWED^
    1919        ;   21 RegistrationComments
    20     ;   22 EMAIL ADDRESS^PHONE NUMBER [CELLULAR]^COUNTRY
     20           ;   22 EMAIL ADDRESS^PHONE NUMBER [CELLULAR]^COUNTRY
    2121        ;
    2222        ;For patient with ien BSDXPAT
  • Scheduling/trunk/m/BSDX11.m

    r614 r888  
    11BSDX11  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
    2         ;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
     2        ;;1.3T1;BSDX;;Jul 18, 2010
    33        ;
    44ENV0100 ;EP Version 1.0 Environment check
  • Scheduling/trunk/m/BSDX12.m

    r883 r888  
    11BSDX12  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/18/10 2:14pm
    2         ;;1.3;IHS WINDOWS SCHEDULING;;NOV 01, 2007
    3     ;
    4     ; Change Log:
    5     ; v 1.3 - i18n support - 3100718
    6     ; BSDXSTART and BSDXEND passed in FM Dates, not US dates
     2        ;;1.3T1;BSDX;;Jul 18, 2010
     3           ;
     4           ; Change Log:
     5           ; v 1.3 - i18n support - 3100718
     6           ; BSDXSTART and BSDXEND passed in FM Dates, not US dates
    77        ;
    88        ;
     
    2626        S ^BSDXTMP($J,0)="I00020AVAILABILITYID^I00020ERRORID"_$C(30)
    2727        ;Check input data for errors
    28     ; i18n - FM Dates passed in
     28           ; i18n - FM Dates passed in
    2929        ; S:BSDXSTART["@0000" BSDXSTART=$P(BSDXSTART,"@")
    3030        ; S:BSDXEND["@0000" BSDXEND=$P(BSDXEND,"@")
     
    3333        ; S %DT="T",X=BSDXEND D ^%DT S BSDXEND=Y
    3434        ; I BSDXEND=-1 D ERR(70) Q
    35     ; Make sure dates are canonical and don't contain extra zeros
    36     S BSDXSTART=+BSDXSTART,BSDXEND=+BSDXEND
    37     ;
     35           ; Make sure dates are canonical and don't contain extra zeros
     36           S BSDXSTART=+BSDXSTART,BSDXEND=+BSDXEND
     37           ;
    3838        I $L(BSDXEND,".")=1 D ERR(70) Q
    3939        I BSDXSTART>BSDXEND S BSDXTMP=BSDXEND,BSDXEND=BSDXSTART,BSDXSTART=BSDXTMP
  • Scheduling/trunk/m/BSDX13.m

    r883 r888  
    11BSDX13  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/18/10 2:17pm
    2         ;;1.3;IHS WINDOWS SCHEDULING;;NOV 01, 2007
    3     ;
    4     ; Change Log:
    5     ; V 1.3 - i18n support - Dates passed to Routine as FM Date - WV/SMH
     2        ;;1.3T1;BSDX;;Jul 18, 2010
     3           ;
     4           ; Change Log:
     5           ; V 1.3 - i18n support - Dates passed to Routine as FM Date - WV/SMH
    66        Q
    77AVDELDTD(BSDXY,BSDXRESD,BSDXSTART,BSDXEND)      ;EP
  • Scheduling/trunk/m/BSDX14.m

    r614 r888  
    11BSDX14  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
    2         ;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
     2        ;;1.3T1;BSDX;;Jul 18, 2010
    33        ;
    44        ;
  • Scheduling/trunk/m/BSDX15.m

    r614 r888  
    11BSDX15  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
    2         ;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
     2        ;;1.3T1;BSDX;;Jul 18, 2010
    33        ;
    44        ;
  • Scheduling/trunk/m/BSDX16.m

    r614 r888  
    11BSDX16  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
    2         ;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
     2        ;;1.3T1;BSDX;;Jul 18, 2010
    33        ;
    44        ;
  • Scheduling/trunk/m/BSDX17.m

    r614 r888  
    11BSDX17  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
    2         ;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
     2        ;;1.3T1;BSDX;;Jul 18, 2010
    33        ;
    44        ;
  • Scheduling/trunk/m/BSDX18.m

    r614 r888  
    11BSDX18  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
    2         ;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
     2        ;;1.3T1;BSDX;;Jul 18, 2010
    33        ;
    44        ;
  • Scheduling/trunk/m/BSDX19.m

    r614 r888  
    11BSDX19  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
    2         ;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
     2        ;;1.3T1;BSDX;;Jul 18, 2010
    33        ;
    44        ;
  • Scheduling/trunk/m/BSDX20.m

    r614 r888  
    11BSDX20  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
    2         ;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
     2        ;;1.3T1;BSDX;;Jul 18, 2010
    33        ;
    44        ;
  • Scheduling/trunk/m/BSDX21.m

    r773 r888  
    11BSDX21  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 5/21/10 9:42pm
    2         ;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
     2        ;;1.3T1;BSDX;;Jul 18, 2010
    33        ;
    44        ;
  • Scheduling/trunk/m/BSDX22.m

    r614 r888  
    11BSDX22  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
    2         ;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
     2        ;;1.3T1;BSDX;;Jul 18, 2010
    33        ;
    44        ;
  • Scheduling/trunk/m/BSDX23.m

    r614 r888  
    11BSDX23  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
    2         ;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
     2        ;;1.3T1;BSDX;;Jul 18, 2010
    33        ;
    44        ;
  • Scheduling/trunk/m/BSDX24.m

    r614 r888  
    11BSDX24  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
    2         ;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
     2        ;;1.3T1;BSDX;;Jul 18, 2010
    33        ;
    44        ;
  • Scheduling/trunk/m/BSDX25.m

    r614 r888  
    11BSDX25  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
    2         ;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
     2        ;;1.3T1;BSDX;;Jul 18, 2010
    33        ;
    44        ;
  • Scheduling/trunk/m/BSDX26.m

    r614 r888  
    11BSDX26  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
    2         ;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
     2        ;;1.3T1;BSDX;;Jul 18, 2010
    33        ;
    44        ;
  • Scheduling/trunk/m/BSDX27.m

    r874 r888  
    11BSDX27  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/15/10 12:22pm
    2         ;;1.3;IHS WINDOWS SCHEDULING;;NOV 01, 2007
    3     ;
    4     ; Change Log: July 15, 2010
    5     ; UJO/SMH - i18n: FM Dates passed into routine for Clinic Letters - CLDISP tag
     2        ;;1.3T1;BSDX;;Jul 18, 2010
     3           ;
     4           ; Change Log: July 15, 2010
     5           ; UJO/SMH - i18n: FM Dates passed into routine for Clinic Letters - CLDISP tag
    66        ;
    77        ;
     
    185185        ;Called by BSDX CLINIC LETTERS
    186186        ;
    187     ; July 10, 2010 -- to support i18n, we pass dates from client in
    188     ; locale-neutral Fileman format. No need to convert it.
     187           ; July 10, 2010 -- to support i18n, we pass dates from client in
     188           ; locale-neutral Fileman format. No need to convert it.
    189189        N BSDXI,BSDXNOD,BSDXNAM,BSDXDOB,BSDXHRN,BSDXSEX,BSDXCID,BSDXCNOD,BSDXDT
    190190        N BSDXJ,BSDXAID,BSDXPAT,BSDXPNOD,BSDXCLN,BSDXCLRK,BSDXMADE,BSDXNOT,BSDXLIN
  • Scheduling/trunk/m/BSDX28.m

    r883 r888  
    11BSDX28  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/18/10 2:30pm
    2         ;;1.3;IHS WINDOWS SCHEDULING;;NOV 01, 2007
     2        ;;1.3T1;BSDX;;Jul 18, 2010
    33        ;
    4     ; Change Log:
     4           ; Change Log:
    55        ; HMW 3050721 Added test for inactivated record
    6     ; V1.3 WV/SMH 3100714
    7     ; - add PID search
    8     ; - return PID instead of SSN (change header and logic)
    9     ; - Change Error trap to new style.
     6           ; V1.3 WV/SMH 3100714
     7           ; - add PID search
     8           ; - return PID instead of SSN (change header and logic)
     9           ; - Change Error trap to new style.
    1010        ;
    1111PTLOOKRS(BSDXY,BSDXP,BSDXC)      ;EP Patient Lookup
     
    1515        ;
    1616        N $ET S $ET="G ERROR^BSDX28"
    17     ; rm ctrl chars
     17           ; rm ctrl chars
    1818        S BSDXP=$TR(BSDXP,$C(13),"")
    1919        S BSDXP=$TR(BSDXP,$C(10),"")
    2020        S BSDXP=$TR(BSDXP,$C(9),"")
    21     ; num of pts to find
     21           ; num of pts to find
    2222        S:BSDXC="" BSDXC=10
    2323        N BSDXHRN,BSDXZ,BSDXDLIM,BSDXRET,BSDXDPT,BSDXRET,BSDXIEN,BSDXFILE
     
    2828        I '+$G(DUZ) S BSDXY=BSDXRET_$C(31) Q
    2929        I '$D(DUZ(2)) S BSDXY=BSDXRET_$C(31) Q
    30 
    31 PID ;PID Lookup
    32     ; If this ID exists, go get it. If "UJOPID" index doesn't exist,
    33     ; won't work anyways.
    34     I $D(^DPT("UJOPID",BSDXP)) DO  SET BSDXY=BSDXRET_$C(31) QUIT
    35     . S BSDXIEN=$O(^DPT("UJOPID",BSDXP,""))
    36     . Q:'$D(^DPT(BSDXIEN,0))
    37     . S BSDXDPT=$G(^DPT(BSDXIEN,0))
    38     . S BSDXZ=$P(BSDXDPT,U) ;NAME
    39     . S BSDXHRN=$P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,2) ;CHART
    40     . I BSDXHRN="" Q  ;NO CHART AT THIS DUZ2
    41     . ; Inactivated Chart get an *
    42     . I $P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,3) S BSDXHRN=BSDXHRN_"(*)" Q
    43     . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN
    44     . S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID
    45     . S Y=$P(BSDXDPT,U,3) X ^DD("DD")
    46     . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB
    47     . S $P(BSDXZ,BSDXDLIM,5)=BSDXIEN
    48     . S BSDXRET=BSDXRET_BSDXZ_$C(30)
     30       
     31PID     ;PID Lookup
     32           ; If this ID exists, go get it. If "UJOPID" index doesn't exist,
     33           ; won't work anyways.
     34           I $D(^DPT("UJOPID",BSDXP)) DO  SET BSDXY=BSDXRET_$C(31) QUIT
     35           . S BSDXIEN=$O(^DPT("UJOPID",BSDXP,""))
     36           . Q:'$D(^DPT(BSDXIEN,0))
     37           . S BSDXDPT=$G(^DPT(BSDXIEN,0))
     38           . S BSDXZ=$P(BSDXDPT,U) ;NAME
     39           . S BSDXHRN=$P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,2) ;CHART
     40           . I BSDXHRN="" Q  ;NO CHART AT THIS DUZ2
     41           . ; Inactivated Chart get an *
     42           . I $P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,3) S BSDXHRN=BSDXHRN_"(*)" Q
     43           . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN
     44           . S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID
     45           . S Y=$P(BSDXDPT,U,3) X ^DD("DD")
     46           . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB
     47           . S $P(BSDXZ,BSDXDLIM,5)=BSDXIEN
     48           . S BSDXRET=BSDXRET_BSDXZ_$C(30)
    4949        ;
    5050DOB     ;DOB Lookup
     
    6060        . . I $P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,3) S BSDXHRN=BSDXHRN_"(*)" Q  ;HMW 20050721 Record Inactivated
    6161        . . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN
    62     . . S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID
     62           . . S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID
    6363        . . S Y=$P(BSDXDPT,U,3) X ^DD("DD")
    6464        . . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB
     
    6868        . Q
    6969        ;
    70 CHART
    71     ;Chart# Lookup
     70CHART   
     71           ;Chart# Lookup
    7272        I +DUZ(2),BSDXP]"",$D(^AUPNPAT("D",BSDXP)) D  S BSDXY=BSDXRET_$C(31) Q
    7373        . S BSDXIEN=0 F  S BSDXIEN=$O(^AUPNPAT("D",BSDXP,BSDXIEN)) Q:'+BSDXIEN  I $D(^AUPNPAT("D",BSDXP,BSDXIEN,DUZ(2))) D  Q
     
    7878        . . I $D(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),$P(^(0),U,3) S BSDXHRN=BSDXHRN_"(*)" Q  ;HMW 20050721 Record Inactivated
    7979        . . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN
    80     . . S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID
     80           . . S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID
    8181        . . S Y=$P(BSDXDPT,U,3) X ^DD("DD")
    8282        . . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB
     
    8585        . . Q
    8686        . Q
    87     ;
     87           ;
    8888SSN     ;SSN Lookup
    8989        I (BSDXP?9N)!(BSDXP?3N1"-"2N1"-"4N),$D(^DPT("SSN",BSDXP)) D  S BSDXY=BSDXRET_$C(31) Q
     
    9696        . . I $P($G(^AUPNPAT(BSDXIEN,41,DUZ(2),0)),U,3) S BSDXHRN=BSDXHRN_"(*)" Q  ;HMW 20050721 Record Inactivated
    9797        . . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN
    98     . . S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID
     98           . . S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID
    9999        . . S Y=$P(BSDXDPT,U,3) X ^DD("DD")
    100100        . . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB
     
    126126        . S $P(BSDXZ,BSDXDLIM,2)=BSDXHRN
    127127        . S BSDXDPT=$G(^DPT(BSDXIEN,0))
    128     . S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID
     128           . S $P(BSDXZ,BSDXDLIM,3)=$P(^DPT(BSDXIEN,.36),U,3) ;PID
    129129        . S Y=$P(BSDXDPT,U,3) X ^DD("DD")
    130130        . S $P(BSDXZ,BSDXDLIM,4)=Y ;DOB
  • Scheduling/trunk/m/BSDX29.m

    r883 r888  
    11BSDX29  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/18/10 2:03pm
    2         ;;1.3;IHS WINDOWS SCHEDULING;;NOV 01, 2007
    3     ;
    4     ; Change Log:
    5     ; v1.3 by WV/SMH on 3100713
     2        ;;1.3T1;BSDX;;Jul 18, 2010
     3           ;
     4           ; Change Log:
     5           ; v1.3 by WV/SMH on 3100713
    66        ; - Beginning and Ending dates passed as FM Dates
    77        ;
     
    1717        ;
    1818        ;Returns ADO Recordset formatted fields containing count of records copied and error message:
    19     ;
    20     ; July 13 2010: D dates (BEG and END) from US format to FM Dates for i18n
     19           ;
     20           ; July 13 2010: D dates (BEG and END) from US format to FM Dates for i18n
    2121        ;
    2222        ;
     
    2828        ;
    2929        ;Convert beginning and ending dates
    30     ;
    31     ;TODO:Validate FM Dates coming through
     30           ;
     31           ;TODO:Validate FM Dates coming through
    3232        ;
    3333        S BSDXBEG=BSDXBEG-1
  • Scheduling/trunk/m/BSDX2E.m

    r885 r888  
    11BSDX2E  ;IHS/OIT/MJL - ENVIRONMENT CHECK FOR WINDOWS SCHEDULING [7/18/10 4:30pm]
    2         ;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
     2        ;;1.3T1;BSDX;;Jul 18, 2010
    33        ;
    44        S LINE="",$P(LINE,"*",81)=""
     
    6060V0200   ;EP Version 1.3 PostInit
    6161        ;Add Protocol items to SDAM APPOINTMENT EVENTS protocol
    62     ;Remove protocols known to cause problems from SDAM APPOINTMENT EVENTS
     62           ;Remove protocols known to cause problems from SDAM APPOINTMENT EVENTS
    6363        ;
    6464        N BSDXDA,BSDXFDA,BSDXDA1,BSDXSEQ,BSDXDAT,BSDXNOD,BSDXIEN,BSDXMSG
    65     ;
    66     ; 1st, add the BSDX event protocols
    67     ; Get SDAM APPOINTMENT EVENTS IEN in 101
     65           ;
     66           ; 1st, add the BSDX event protocols
     67           ; Get SDAM APPOINTMENT EVENTS IEN in 101
    6868        S BSDXDA=$O(^ORD(101,"B","SDAM APPOINTMENT EVENTS",0))
    6969        Q:'+BSDXDA
    70     ; Add each of those protocols unless they already exist.
     70           ; Add each of those protocols unless they already exist.
    7171        S BSDXDAT="BSDX ADD APPOINTMENT;10.2^BSDX CANCEL APPOINTMENT;10.4^BSDX CHECKIN APPOINTMENT;10.6^BSDX NOSHOW APPOINTMENT;10.8"
    72     ; For each
    73     F J=1:1:$L(BSDXDAT,U) D
     72           ; For each
     73           F J=1:1:$L(BSDXDAT,U) D
    7474        . K BSDXIEN,BSDXMSG,BSDXFDA
    75     . ; Get Item
     75           . ; Get Item
    7676        . S BSDXNOD=$P(BSDXDAT,U,J)
    7777        . ; Get Item Name (BSDX ADD APPOINTMENT)
    78     . S BSDXDA1=$P(BSDXNOD,";")
    79     . ; Get Item Sequence (10.2)
     78           . S BSDXDA1=$P(BSDXNOD,";")
     79           . ; Get Item Sequence (10.2)
    8080        . S BSDXSEQ=$P(BSDXNOD,";",2)
    81     . ; Get Item Reference (Item is already in the protocol file)
     81           . ; Get Item Reference (Item is already in the protocol file)
    8282        . S BSDXDA1=$O(^ORD(101,"B",BSDXDA1,0))
    83     . ; Quit if not found
     83           . ; Quit if not found
    8484        . Q:'+BSDXDA1
    85     . ; Quit if already exists in the SDAM protocol
     85           . ; Quit if already exists in the SDAM protocol
    8686        . Q:$D(^ORD(101,BSDXDA,10,"B",BSDXDA1))
    87     . ; Go ahead and save it.
     87           . ; Go ahead and save it.
    8888        . S BSDXFDA(101.01,"+1,"_BSDXDA_",",".01")=BSDXDA1
    8989        . S BSDXFDA(101.01,"+1,"_BSDXDA_",","3")=BSDXSEQ
    9090        . D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
    91     . ; Error message
    92     . I $D(BSDXMSG) W $C(7),"Error: ",BSDXMSG("DIERR",1,"TEXT",1)
    93     ;
    94     ; Remove nassssty protocols ORU PATIENT MOVMT and DVBA C&P SCHD EVENT
    95     ; SDAM APPOINTMENT EVENTS IENS for use in FIND1^DIC
    96     N SDEVTIENS S SDEVTIENS=","_BSDXDA_","
    97     ; Subfile entry for ORU...
    98     N ORUIEN S ORUIEN=$$FIND1^DIC(101.01,SDEVTIENS,"","ORU PATIENT MOVMT")
    99     ; Subfile entry for DVBA...
    100     N DVBAIEN S DVBAIEN=$$FIND1^DIC(101.01,SDEVTIENS,"","DVBA C&P SCHD EVENT")
    101     ; Deletion code
    102     N BSDXFDA,BSDXMSG
    103     S:ORUIEN>0 BSDXFDA(101.01,ORUIEN_SDEVTIENS,.01)="@"
    104     S:DVBAIEN>0 BSDXFDA(101.01,DVBAIEN_SDEVTIENS,.01)="@"
    105     D:$D(BSDXFDA) FILE^DIE("","BSDXFDA","BSDXMSG")
    106     ; If error
    107     I $D(BSDXMSG) W $C(7),"Error: ",BSDXMSG("DIERR",1,"TEXT",1)
     91           . ; Error message
     92           . I $D(BSDXMSG) W $C(7),"Error: ",BSDXMSG("DIERR",1,"TEXT",1)
     93           ;
     94           ; Remove nassssty protocols ORU PATIENT MOVMT and DVBA C&P SCHD EVENT
     95           ; SDAM APPOINTMENT EVENTS IENS for use in FIND1^DIC
     96           N SDEVTIENS S SDEVTIENS=","_BSDXDA_","
     97           ; Subfile entry for ORU...
     98           N ORUIEN S ORUIEN=$$FIND1^DIC(101.01,SDEVTIENS,"","ORU PATIENT MOVMT")
     99           ; Subfile entry for DVBA...
     100           N DVBAIEN S DVBAIEN=$$FIND1^DIC(101.01,SDEVTIENS,"","DVBA C&P SCHD EVENT")
     101           ; Deletion code
     102           N BSDXFDA,BSDXMSG
     103           S:ORUIEN>0 BSDXFDA(101.01,ORUIEN_SDEVTIENS,.01)="@"
     104           S:DVBAIEN>0 BSDXFDA(101.01,DVBAIEN_SDEVTIENS,.01)="@"
     105           D:$D(BSDXFDA) FILE^DIE("","BSDXFDA","BSDXMSG")
     106           ; If error
     107           I $D(BSDXMSG) W $C(7),"Error: ",BSDXMSG("DIERR",1,"TEXT",1)
    108108        QUIT
    109109        ;
  • Scheduling/trunk/m/BSDX30.m

    r614 r888  
    11BSDX30  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; [ 09/12/2007  1:54 PM ]
    2         ;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
     2        ;;1.3T1;BSDX;;Jul 18, 2010
    33        ;
    44        ;
  • Scheduling/trunk/m/BSDX31.m

    r614 r888  
    11BSDX31  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
    2         ;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
     2        ;;1.3T1;BSDX;;Jul 18, 2010
    33        ;
    44        ;
  • Scheduling/trunk/m/BSDX32.m

    r614 r888  
    11BSDX32  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
    2         ;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
     2        ;;1.3T1;BSDX;;Jul 18, 2010
    33        ;
    44        ;
  • Scheduling/trunk/m/BSDX33.m

    r874 r888  
    11BSDX33  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/15/10 12:33pm
    2         ;;1.3;IHS WINDOWS SCHEDULING;;NOV 01, 2007
    3     ; Mods by WV/STAR
    4     ;
    5     ; Change Log:
    6     ; July 13, 2010
    7     ; v 1.3 adds fixes Rebooking behavior in application (see RBNEXT)
    8     ; also adds i18 support - Dates passed in FM format from application
    9     ; in tag SETRBK and RBNEXT
     2        ;;1.3T1;BSDX;;Jul 18, 2010
     3           ; Mods by WV/STAR
     4           ;
     5           ; Change Log:
     6           ; July 13, 2010
     7           ; v 1.3 adds fixes Rebooking behavior in application (see RBNEXT)
     8           ; also adds i18 support - Dates passed in FM format from application
     9           ; in tag SETRBK and RBNEXT
    1010        ;
    1111        ;
     
    3535        I '+BSDXRESD D ERR2("BSDX REBOOK NEXT BLOCK: Invalid resource name") Q
    3636        ;
    37     ; i18n fix
    38     ; S X=BSDXDATE,%DT="XT" D ^%DT
     37           ; i18n fix
     38           ; S X=BSDXDATE,%DT="XT" D ^%DT
    3939        ; I Y=-1 D ERR2(1,"BSDX REBOOK NEXT BLOCK: Invalid datetime") Q
    4040        ;
    41     ; S BSDXDATE=$P(Y,".")
     41           ; S BSDXDATE=$P(Y,".")
    4242        ;
    4343        S BSDXFND=0
     
    5353        E  S Y=BSDXFND X ^DD("DD") S BSDXFND=Y
    5454        S BSDXI=BSDXI+1
    55     ;//smh - bug (V 1.3): Need to replace @ in FM date for C# to recognize it
    56     S BSDXFND=$TR(BSDXFND,"@"," ")
    57     ;//smh end fix
     55           ;//smh - bug (V 1.3): Need to replace @ in FM date for C# to recognize it
     56           S BSDXFND=$TR(BSDXFND,"@"," ")
     57           ;//smh end fix
    5858        S ^BSDXTMP($J,BSDXI)="1^"_BSDXFND_"^"_$C(30)_$C(31)
    5959        Q
     
    8484        I '$D(^BSDXAPPT(BSDXAPPT,0)) D ERR(1,"BSDX REBOOK SET: Invalid appointment ID") Q
    8585        ; i18n (v 1.3)
    86     ;S X=BSDXDATE,%DT="XT" D ^%DT
     86           ;S X=BSDXDATE,%DT="XT" D ^%DT
    8787        ;I Y=-1 D ERR(1,"BSDX REBOOK SET: Invalid rebook datetime") Q
    8888        ;S BSDXDATE=Y
  • Scheduling/trunk/m/BSDX34.m

    r874 r888  
    11BSDX34  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/15/10 12:37pm
    2         ;;1.3;IHS WINDOWS SCHEDULING;;NOV 01, 2007
    3     ;
    4     ; Change Log:
    5     ; July 10 2010:
     2        ;;1.3T1;BSDX;;Jul 18, 2010
     3           ;
     4           ; Change Log:
     5           ; July 10 2010:
    66        ; CANCLIN AND RBCLIN: Dates passed in FM format for i18n
    77        ;
     
    2828        ;Used in generating cancellation letters for a clinic
    2929        ;BSDXCLST is a |-delimited list of BSDX RESOURCE iens.  (The last |-piece is null, so discard it.)
    30     ;v 1.3 BSDXBEG and BSDXEND are in fm format
     30           ;v 1.3 BSDXBEG and BSDXEND are in fm format
    3131        ;Called by BSDX CANCEL CLINIC LIST
    3232        N BSDXCAN
     
    4444        ;Called by BSDX REBOOK CLINIC LIST and BSDX CANCEL CLINIC LIST via entry point CANCLIN above
    4545        ;Jul 11 2010 (smh):
    46     ;for i18n, pass BSDXBEG and BSDXEND in FM format.
     46           ;for i18n, pass BSDXBEG and BSDXEND in FM format.
    4747        ;
    4848        S X="RBERR^BSDX34",@^%ZOSF("TRAP")
     
    5252        ;Convert beginning and ending dates
    5353        ;TODO: Validation of date to make sure it's a right FM Date
    54     S BSDXBEG=$P(BSDXBEG,".")
    55     S BSDXEND=$P(BSDXEND,".")
     54           S BSDXBEG=$P(BSDXBEG,".")
     55           S BSDXEND=$P(BSDXEND,".")
    5656        S BSDXBEG=BSDXBEG-1,BSDXBEG=BSDXBEG_".9999"
    5757        S BSDXEND=BSDXEND_".9999"
    58     ;
     58           ;
    5959        I BSDXCLST="" D RBERR Q
    6060        ;
  • Scheduling/trunk/m/BSDX35.m

    r614 r888  
    11BSDX35  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
    2         ;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
     2        ;;1.3T1;BSDX;;Jul 18, 2010
    33        ;
    44        ;
  • Scheduling/trunk/m/BSDXAPI.m

    r742 r888  
    1 BSDXAPI ; IHS/ANMC/LJF - SCHEDULING APIs ; 4/29/10 9:42pm
    2  ;;2.1;BSDX;;24JUL2009
    3  ;Orignal routine is BSDAPI by IHS/LJF, HMW, and MAW
    4  ;local mods (many) by WV/SMH
    5  ;Move to BSDX namespace as BSDXAPI from BSDAPI by WV/SMH
    6  ;
    7 MAKE1(DFN,CLIN,TYP,DATE,LEN,INFO) ; Simplified PEP w/ parameters for $$MAKE - making appointment
    8  ; Call like this for DFN 23435 having an appointment at Hospital Location 33
    9  ; have 3 (scheduled) or 4 (walkin) appt at Dec 20, 2009 @ 10:11:59 for 30 minutes appt
    10  ; for Baby foxes hallucinations.
    11  ; S RESULT=$$MAKE1^BSDXAPI(23435,33,(3 or 4),3091220.221159,30,"I see Baby foxes")
    12  S BSDR("PAT")=DFN       ;DFN
    13  S BSDR("CLN")=CLIN      ;Hosp Loc IEN
    14  S BSDR("TYP")=TYP       ;3 sched or 4 walkin
    15  S BSDR("ADT")=DATE      ;Appointment date in FM format
    16  S BSDR("LEN")=LEN       ;Appt len upto 240 (min)
    17  S BSDR("INFO")=INFO     ;Reason for appt - up to 150 char
    18  S BSDR("USR")=DUZ       ;Person who made appt - current user
    19  Q $$MAKE(.BSDR)
    20  ;
    21 MAKE(BSDR) ;PEP; call to store appt made
    22  ;
    23  ; Make call using: S ERR=$$MAKE^BSDXAPI(.ARRAY)
    24  ;
    25  ; Input Array -
    26  ; BSDR("PAT") = ien of patient in file 2
    27  ; BSDR("CLN") = ien of clinic in file 44
    28  ; BSDR("TYP") = 3 for scheduled appts, 4 for walkins
    29  ; BSDR("ADT") = appointment date and time
    30  ; BSDR("LEN") = appointment length in minutes (5-120)
    31  ; BSDR("OI")  = reason for appt - up to 150 characters
    32  ; BSDR("USR") = user who made appt
    33  ;
    34  ;Output: error status and message
    35  ;   = 0 or null:  everything okay
    36  ;   = 1^message:  error and reason
    37  ;
    38  I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
    39  I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
    40  I ($G(BSDR("TYP"))<3)!($G(BSDR("TYP"))>4) Q 1_U_"Appt Type error: "_$G(BSDR("TYP"))
    41  I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12)  ;remove seconds
    42  I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
    43  ;
    44  I ($G(BSDR("LEN"))<5)!($G(BSDR("LEN"))>240) Q 1_U_"Appt Length error: "_$G(BSDR("LEN"))
    45  I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR"))
    46  I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)'="C" Q 1_U_"Patient "_BSDR("PAT")_" already has appt at "_BSDR("ADT")
    47  ;
    48  NEW DIC,DA,Y,X,DD,DO,DLAYGO
    49  ;
    50  I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)="C" D
    51  . ; "un-cancel" existing appt in file 2
    52  . N BSDXFDA,BSDXIENS,BSDXMSG
    53  . S BSDXIENS=BSDR("ADT")_","_BSDR("PAT")_","
    54  . S BSDXFDA(2.98,BSDXIENS,".01")=BSDR("CLN")
    55  . S BSDXFDA(2.98,BSDXIENS,"3")=""
    56  . S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP")
    57  . S BSDXFDA(2.98,BSDXIENS,"9.5")=9
    58  . S BSDXFDA(2.98,BSDXIENS,"14")=""
    59  . S BSDXFDA(2.98,BSDXIENS,"15")=""
    60  . S BSDXFDA(2.98,BSDXIENS,"16")=""
    61  . S BSDXFDA(2.98,BSDXIENS,"19")=""
    62  . S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT
    63  . D FILE^DIE("","BSDXFDA","BSDXMSG")
    64  . N BSDXTEMP S BSDXTEMP=$G(BSDXMSG)
    65  E  D  I $G(BSDXERR(1)) Q 1_U_"FileMan add to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT") 
    66  . N BSDXFDA,BSDXIENS,BSDXMSG
    67  . S BSDXIENS="?+2,"_BSDR("PAT")_","
    68  . S BSDXIENS(2)=BSDR("ADT")
    69  . S BSDXFDA(2.98,BSDXIENS,.01)=BSDR("CLN")
    70  . S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP")
    71  . S BSDXFDA(2.98,BSDXIENS,"9.5")=9
    72  . S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT
    73  . D UPDATE^DIE("","BSDXFDA","BSDXIENS","BSDXERR(1)")
    74  ; add appt to file 44
    75  K DIC,DA,X,Y,DLAYGO,DD,DO
    76  I '$D(^SC(BSDR("CLN"),"S",0)) S ^SC(BSDR("CLN"),"S",0)="^44.001DA^^"
    77  I '$D(^SC(BSDR("CLN"),"S",BSDR("ADT"),0)) D  I Y<1 Q 1_U_"Error adding date to file 44: Clinic="_BSDR("CLN")_" Date="_BSDR("ADT")
    78  . S DIC="^SC("_BSDR("CLN")_",""S"",",DA(1)=BSDR("CLN"),(X,DINUM)=BSDR("ADT")
    79  . S DIC("P")="44.001DA",DIC(0)="L",DLAYGO=44.001
    80  . S Y=1 I '$D(@(DIC_X_")")) D FILE^DICN
    81  ;
    82  K DIC,DA,X,Y,DLAYGO,DD,DO,DINUM
    83  S DIC="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
    84  S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),X=BSDR("PAT")
    85  S DIC("DR")="1///"_BSDR("LEN")_";3///"_$E($G(BSDR("OI")),1,150)_";7///`"_BSDR("USR")_";8///"_$P($$NOW^XLFDT,".")
    86  S DIC("P")="44.003PA",DIC(0)="L",DLAYGO=44.003
    87  D FILE^DICN
    88  ;
    89  ; call event driver
    90  NEW DFN,SDT,SDCL,SDDA,SDMODE
    91  S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2
    92  S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
    93  D MAKE^SDAMEVT(DFN,SDT,SDCL,SDDA,SDMODE)
    94  Q 0
    95  ;
    96 CHECKIN1(DFN,CLIN,APDATE) ; Simplified PEP w/ parameters for $$CHECKIN - Checking in
    97  ; Call like this for DFN 23435 checking in now at Hospital Location 33
    98  ; for appt at Dec 20, 2009 @ 10:11:59
    99  ; S RESULT=$$CHECKIN1^BSDXAPI(23435,33,3091220.221159)
    100  S BSDR("PAT")=DFN          ;DFN
    101  S BSDR("CLN")=CLIN         ;Hosp Loc IEN
    102  S BSDR("ADT")=APDATE       ;Appt Date
    103  S BSDR("CDT")=$$NOW^XLFDT  ;Check-in date defaults to now
    104  S BSDR("USR")=DUZ          ;Check-in user defaults to current
    105  Q $$CHECKIN(.BSDR)
    106  ;
    107 CHECKIN(BSDR) ;EP; call to add checkin info to appt; IHS/ITSC/LJF 12/23/2004 PATCH 1002
    108  ;
    109  ; Make call by using:  S ERR=$$CHECKIN^BSDXAPI(.ARRAY)
    110  ;
    111  ; Input array -
    112  ;  BSDR("PAT") = ien of patient in file 2
    113  ;  BSDR("CLN") = ien of clinic in file 44
    114  ;  BSDR("ADT") = appt date/time
    115  ;  BSDR("CDT") = checkin date/time
    116  ;  BSDR("USR") = checkin user
    117  ;
    118  ; Output value -
    119  ;              = 0 means everything worked
    120  ;              = 1^message means error with reason message
    121  ;
    122  I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
    123  I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
    124  I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12)  ;remove seconds
    125  I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
    126  I $G(BSDR("CDT")) S BSDR("CDT")=+$E(BSDR("CDT"),1,12)  ;remove seconds
    127  I $G(BSDR("CDT"))'?7N1".".4N Q 1_U_"Checkin Date/Time error: "_$G(BSDR("CDT"))
    128  I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR"))
    129  ;
    130  ; find ien for appt in file 44
    131  NEW IEN,DIE,DA,DR
    132  S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
    133  I 'IEN Q 1_U_"Error trying to find appointment for checkin: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
    134  ;
    135  ; remember before status
    136  NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL
    137  S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN
    138  S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
    139  D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
    140  ;
    141  ; set checkin
    142  S DIE="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
    143  S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN
    144  S DR="309///"_BSDR("CDT")_";302///`"_BSDR("USR")_";305///"_$$NOW^XLFDT
    145  D ^DIE
    146  ;
    147  ; set after status
    148  S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
    149  S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
    150  D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
    151  ;
    152  ; call event driver
    153  D EVT^SDAMEVT(.SDATA,4,SDMODE,SDCIHDL)
    154  Q 0
    155  ;
    156 CANCEL1(DFN,CLIN,TYP,APDATE,REASON,INFO) ; PEP w/ parameters for $$CANCEL - cancelling appointment
    157  ; Call like this for DFN 23435 cancelling an appointment at Hospital Location 33,
    158  ; cancellation initiated by patient ("PC" rather than clinic "C"),
    159  ; cancelling appt at Dec 20, 2009 @ 10:11:59 because of reason 1 in file 409.2 IEN (weather)
    160  ; because foxes come out during bad weather.
    161  ; S RESULT=$$CANCEL1^BSDXAPI(23435,33,"PC",3091220.221159,1,"Afraid of foxes")
    162  S BSDR("PAT")=DFN
    163  S BSDR("CLN")=CLIN
    164  S BSDR("TYP")=TYP
    165  S BSDR("ADT")=APDATE
    166  S BSDR("CDT")=$$NOW^XLFDT
    167  S BSDR("USR")=DUZ
    168  S BSDR("CR")=REASON
    169  S BSDR("NOT")=INFO
    170  Q $$CANCEL(.BSDR)
    171  ;
    172 CANCEL(BSDR) ;PEP; called to cancel appt
    173  ;
    174  ; Make call using: S ERR=$$CANCEL^BSDXAPI(.ARRAY)
    175  ;
    176  ; Input Array -
    177  ; BSDR("PAT") = ien of patient in file 2
    178  ; BSDR("CLN") = ien of clinic in file 44
    179  ; BSDR("TYP") = C for canceled by clinic; PC for patient canceled
    180  ; BSDR("ADT") = appointment date and time
    181  ; BSDR("CDT") = cancel date and time
    182  ; BSDR("USR") = user who canceled appt
    183  ; BSDR("CR")  = cancel reason - pointer to file 409.2
    184  ; BSDR("NOT") = cancel remarks - optional notes to 160 characters
    185  ;
    186  ;Output: error status and message
    187  ;   = 0 or null:  everything okay
    188  ;   = 1^message:  error and reason
    189  ;
    190  I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
    191  I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
    192  I ($G(BSDR("TYP"))'="C"),($G(BSDR("TYP"))'="PC") Q 1_U_"Cancel Status error: "_$G(BSDR("TYP"))
    193  I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12)  ;remove seconds
    194  I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
    195  I $G(BSDR("CDT")) S BSDR("CDT")=+$E(BSDR("CDT"),1,12)  ;remove seconds
    196  I $G(BSDR("CDT"))'?7N1".".4N Q 1_U_"Cancel Date/Time error: "_$G(BSDR("CDT"))
    197  I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Canceled Appt Error: "_$G(BSDR("USR"))
    198  I '$D(^SD(409.2,+$G(BSDR("CR")))) Q 1_U_"Cancel Reason error: "_$G(BSDR("CR"))
    199  ;
    200  NEW IEN,DIE,DA,DR
    201  S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
    202  I 'IEN Q 1_U_"Error trying to find appointment for cancel: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
    203  ;
    204  I $$CI(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"),IEN) Q 1_U_"Patient already checked in; cannot cancel until checkin deleted: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
    205  ;
    206  ; remember before status
    207  NEW SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL
    208  S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN
    209  S SDCPHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
    210  D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL)
    211  ;
    212  ; get user who made appt and date appt made from ^SC
    213  ;    because data in ^SC will be deleted
    214  NEW USER,DATE
    215  S USER=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,6)
    216  S DATE=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,7)
    217  ;
    218  ; update file 2 info
    219  NEW DIE,DA,DR
    220  S DIE="^DPT("_DFN_",""S"",",DA(1)=DFN,DA=SDT
    221  S DR="3///"_BSDR("TYP")_";14///`"_BSDR("USR")_";15///"_BSDR("CDT")_";16///`"_BSDR("CR")_";19///`"_USER_";20///"_DATE
    222  S:$G(BSDR("NOT"))]"" DR=DR_";17///"_$E(BSDR("NOT"),1,160)
    223  D ^DIE
    224  ;
    225  ; delete data in ^SC
    226  NEW DIK,DA
    227  S DIK="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
    228  S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN
    229  D ^DIK
    230  ;
    231  ; call event driver
    232  D CANCEL^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDCPHDL)
    233  Q 0
    234  ;
    235 CI(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-in
    236  NEW X
    237  S X=$G(SDIEN)   ;ien sent in call
    238  I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0
    239  S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U)
    240  Q $S(X:1,1:0)
    241  ;
    242 SCIEN(PAT,CLINIC,DATE) ;PEP; returns ien for appt in ^SC
    243  NEW X,IEN
    244  S X=0 F  S X=$O(^SC(CLINIC,"S",DATE,1,X)) Q:'X  Q:$G(IEN)  D
    245  . Q:$P($G(^SC(CLINIC,"S",DATE,1,X,0)),U,9)="C"  ;cancelled
    246         . I +$G(^SC(CLINIC,"S",DATE,1,X,0))=PAT S IEN=X
    247  Q $G(IEN)
    248  ;
    249 APPTYP(PAT,DATE) ;PEP; -- returns type of appt (scheduled or walk-in)
    250  NEW X S X=$P($G(^DPT(PAT,"S",DATE,0)),U,7)
    251  Q $S(X=3:"SCHED",X=4:"WALK-IN",1:"??")
    252  ;
    253 CO(PAT,CLINIC,DATE,SDIEN) ;PEP; -- returns 1 if appt already checked-out
    254  NEW X
    255  S X=$G(SDIEN)   ;ien sent in call
    256  I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0
    257  S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U,3)
    258  Q $S(X:1,1:0)
    259  ;
    260 
     1BSDXAPI ; IHS/ANMC/LJF - SCHEDULING APIs ; 4/29/10 9:42pm
     2        ;;1.3T1;BSDX;;Jul 18, 2010
     3        ;Orignal routine is BSDAPI by IHS/LJF, HMW, and MAW
     4        ;local mods (many) by WV/SMH
     5        ;Move to BSDX namespace as BSDXAPI from BSDAPI by WV/SMH
     6        ;
     7MAKE1(DFN,CLIN,TYP,DATE,LEN,INFO)       ; Simplified PEP w/ parameters for $$MAKE - making appointment
     8        ; Call like this for DFN 23435 having an appointment at Hospital Location 33
     9        ; have 3 (scheduled) or 4 (walkin) appt at Dec 20, 2009 @ 10:11:59 for 30 minutes appt
     10        ; for Baby foxes hallucinations.
     11        ; S RESULT=$$MAKE1^BSDXAPI(23435,33,(3 or 4),3091220.221159,30,"I see Baby foxes")
     12        S BSDR("PAT")=DFN       ;DFN
     13        S BSDR("CLN")=CLIN      ;Hosp Loc IEN
     14        S BSDR("TYP")=TYP       ;3 sched or 4 walkin
     15        S BSDR("ADT")=DATE      ;Appointment date in FM format
     16        S BSDR("LEN")=LEN       ;Appt len upto 240 (min)
     17        S BSDR("INFO")=INFO     ;Reason for appt - up to 150 char
     18        S BSDR("USR")=DUZ       ;Person who made appt - current user
     19        Q $$MAKE(.BSDR)
     20        ;
     21MAKE(BSDR)      ;PEP; call to store appt made
     22        ;
     23        ; Make call using: S ERR=$$MAKE^BSDXAPI(.ARRAY)
     24        ;
     25        ; Input Array -
     26        ; BSDR("PAT") = ien of patient in file 2
     27        ; BSDR("CLN") = ien of clinic in file 44
     28        ; BSDR("TYP") = 3 for scheduled appts, 4 for walkins
     29        ; BSDR("ADT") = appointment date and time
     30        ; BSDR("LEN") = appointment length in minutes (5-120)
     31        ; BSDR("OI")  = reason for appt - up to 150 characters
     32        ; BSDR("USR") = user who made appt
     33        ;
     34        ;Output: error status and message
     35        ;   = 0 or null:  everything okay
     36        ;   = 1^message:  error and reason
     37        ;
     38        I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
     39        I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
     40        I ($G(BSDR("TYP"))<3)!($G(BSDR("TYP"))>4) Q 1_U_"Appt Type error: "_$G(BSDR("TYP"))
     41        I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12)  ;remove seconds
     42        I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
     43        ;
     44        I ($G(BSDR("LEN"))<5)!($G(BSDR("LEN"))>240) Q 1_U_"Appt Length error: "_$G(BSDR("LEN"))
     45        I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR"))
     46        I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)'="C" Q 1_U_"Patient "_BSDR("PAT")_" already has appt at "_BSDR("ADT")
     47        ;
     48        NEW DIC,DA,Y,X,DD,DO,DLAYGO
     49        ;
     50        I $D(^DPT(BSDR("PAT"),"S",BSDR("ADT"),0)),$P(^(0),U,2)="C" D
     51        . ; "un-cancel" existing appt in file 2
     52        . N BSDXFDA,BSDXIENS,BSDXMSG
     53        . S BSDXIENS=BSDR("ADT")_","_BSDR("PAT")_","
     54        . S BSDXFDA(2.98,BSDXIENS,".01")=BSDR("CLN")
     55        . S BSDXFDA(2.98,BSDXIENS,"3")=""
     56        . S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP")
     57        . S BSDXFDA(2.98,BSDXIENS,"9.5")=9
     58        . S BSDXFDA(2.98,BSDXIENS,"14")=""
     59        . S BSDXFDA(2.98,BSDXIENS,"15")=""
     60        . S BSDXFDA(2.98,BSDXIENS,"16")=""
     61        . S BSDXFDA(2.98,BSDXIENS,"19")=""
     62        . S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT
     63        . D FILE^DIE("","BSDXFDA","BSDXMSG")
     64        . N BSDXTEMP S BSDXTEMP=$G(BSDXMSG)
     65        E  D  I $G(BSDXERR(1)) Q 1_U_"FileMan add to DPT error: Patient="_BSDR("PAT")_" Appt="_BSDR("ADT") 
     66        . N BSDXFDA,BSDXIENS,BSDXMSG
     67        . S BSDXIENS="?+2,"_BSDR("PAT")_","
     68        . S BSDXIENS(2)=BSDR("ADT")
     69        . S BSDXFDA(2.98,BSDXIENS,.01)=BSDR("CLN")
     70        . S BSDXFDA(2.98,BSDXIENS,"9")=BSDR("TYP")
     71        . S BSDXFDA(2.98,BSDXIENS,"9.5")=9
     72        . S BSDXFDA(2.98,BSDXIENS,"20")=$$NOW^XLFDT
     73        . D UPDATE^DIE("","BSDXFDA","BSDXIENS","BSDXERR(1)")
     74        ; add appt to file 44
     75        K DIC,DA,X,Y,DLAYGO,DD,DO
     76        I '$D(^SC(BSDR("CLN"),"S",0)) S ^SC(BSDR("CLN"),"S",0)="^44.001DA^^"
     77        I '$D(^SC(BSDR("CLN"),"S",BSDR("ADT"),0)) D  I Y<1 Q 1_U_"Error adding date to file 44: Clinic="_BSDR("CLN")_" Date="_BSDR("ADT")
     78        . S DIC="^SC("_BSDR("CLN")_",""S"",",DA(1)=BSDR("CLN"),(X,DINUM)=BSDR("ADT")
     79        . S DIC("P")="44.001DA",DIC(0)="L",DLAYGO=44.001
     80        . S Y=1 I '$D(@(DIC_X_")")) D FILE^DICN
     81        ;
     82        K DIC,DA,X,Y,DLAYGO,DD,DO,DINUM
     83        S DIC="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
     84        S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),X=BSDR("PAT")
     85        S DIC("DR")="1///"_BSDR("LEN")_";3///"_$E($G(BSDR("OI")),1,150)_";7///`"_BSDR("USR")_";8///"_$P($$NOW^XLFDT,".")
     86        S DIC("P")="44.003PA",DIC(0)="L",DLAYGO=44.003
     87        D FILE^DICN
     88        ;
     89        ; call event driver
     90        NEW DFN,SDT,SDCL,SDDA,SDMODE
     91        S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2
     92        S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
     93        D MAKE^SDAMEVT(DFN,SDT,SDCL,SDDA,SDMODE)
     94        Q 0
     95        ;
     96CHECKIN1(DFN,CLIN,APDATE)       ; Simplified PEP w/ parameters for $$CHECKIN - Checking in
     97        ; Call like this for DFN 23435 checking in now at Hospital Location 33
     98        ; for appt at Dec 20, 2009 @ 10:11:59
     99        ; S RESULT=$$CHECKIN1^BSDXAPI(23435,33,3091220.221159)
     100        S BSDR("PAT")=DFN          ;DFN
     101        S BSDR("CLN")=CLIN         ;Hosp Loc IEN
     102        S BSDR("ADT")=APDATE       ;Appt Date
     103        S BSDR("CDT")=$$NOW^XLFDT  ;Check-in date defaults to now
     104        S BSDR("USR")=DUZ          ;Check-in user defaults to current
     105        Q $$CHECKIN(.BSDR)
     106        ;
     107CHECKIN(BSDR)   ;EP; call to add checkin info to appt; IHS/ITSC/LJF 12/23/2004 PATCH 1002
     108        ;
     109        ; Make call by using:  S ERR=$$CHECKIN^BSDXAPI(.ARRAY)
     110        ;
     111        ; Input array -
     112        ;  BSDR("PAT") = ien of patient in file 2
     113        ;  BSDR("CLN") = ien of clinic in file 44
     114        ;  BSDR("ADT") = appt date/time
     115        ;  BSDR("CDT") = checkin date/time
     116        ;  BSDR("USR") = checkin user
     117        ;
     118        ; Output value -
     119        ;              = 0 means everything worked
     120        ;              = 1^message means error with reason message
     121        ;
     122        I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
     123        I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
     124        I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12)  ;remove seconds
     125        I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
     126        I $G(BSDR("CDT")) S BSDR("CDT")=+$E(BSDR("CDT"),1,12)  ;remove seconds
     127        I $G(BSDR("CDT"))'?7N1".".4N Q 1_U_"Checkin Date/Time error: "_$G(BSDR("CDT"))
     128        I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR"))
     129        ;
     130        ; find ien for appt in file 44
     131        NEW IEN,DIE,DA,DR
     132        S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
     133        I 'IEN Q 1_U_"Error trying to find appointment for checkin: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
     134        ;
     135        ; remember before status
     136        NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL
     137        S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN
     138        S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
     139        D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
     140        ;
     141        ; set checkin
     142        S DIE="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
     143        S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN
     144        S DR="309///"_BSDR("CDT")_";302///`"_BSDR("USR")_";305///"_$$NOW^XLFDT
     145        D ^DIE
     146        ;
     147        ; set after status
     148        S SDDA=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
     149        S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
     150        D AFTER^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
     151        ;
     152        ; call event driver
     153        D EVT^SDAMEVT(.SDATA,4,SDMODE,SDCIHDL)
     154        Q 0
     155        ;
     156CANCEL1(DFN,CLIN,TYP,APDATE,REASON,INFO)        ; PEP w/ parameters for $$CANCEL - cancelling appointment
     157        ; Call like this for DFN 23435 cancelling an appointment at Hospital Location 33,
     158        ; cancellation initiated by patient ("PC" rather than clinic "C"),
     159        ; cancelling appt at Dec 20, 2009 @ 10:11:59 because of reason 1 in file 409.2 IEN (weather)
     160        ; because foxes come out during bad weather.
     161        ; S RESULT=$$CANCEL1^BSDXAPI(23435,33,"PC",3091220.221159,1,"Afraid of foxes")
     162        S BSDR("PAT")=DFN
     163        S BSDR("CLN")=CLIN
     164        S BSDR("TYP")=TYP
     165        S BSDR("ADT")=APDATE
     166        S BSDR("CDT")=$$NOW^XLFDT
     167        S BSDR("USR")=DUZ
     168        S BSDR("CR")=REASON
     169        S BSDR("NOT")=INFO
     170        Q $$CANCEL(.BSDR)
     171        ;
     172CANCEL(BSDR)    ;PEP; called to cancel appt
     173        ;
     174        ; Make call using: S ERR=$$CANCEL^BSDXAPI(.ARRAY)
     175        ;
     176        ; Input Array -
     177        ; BSDR("PAT") = ien of patient in file 2
     178        ; BSDR("CLN") = ien of clinic in file 44
     179        ; BSDR("TYP") = C for canceled by clinic; PC for patient canceled
     180        ; BSDR("ADT") = appointment date and time
     181        ; BSDR("CDT") = cancel date and time
     182        ; BSDR("USR") = user who canceled appt
     183        ; BSDR("CR")  = cancel reason - pointer to file 409.2
     184        ; BSDR("NOT") = cancel remarks - optional notes to 160 characters
     185        ;
     186        ;Output: error status and message
     187        ;   = 0 or null:  everything okay
     188        ;   = 1^message:  error and reason
     189        ;
     190        I '$D(^DPT(+$G(BSDR("PAT")),0)) Q 1_U_"Patient not on file: "_$G(BSDR("PAT"))
     191        I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
     192        I ($G(BSDR("TYP"))'="C"),($G(BSDR("TYP"))'="PC") Q 1_U_"Cancel Status error: "_$G(BSDR("TYP"))
     193        I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12)  ;remove seconds
     194        I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
     195        I $G(BSDR("CDT")) S BSDR("CDT")=+$E(BSDR("CDT"),1,12)  ;remove seconds
     196        I $G(BSDR("CDT"))'?7N1".".4N Q 1_U_"Cancel Date/Time error: "_$G(BSDR("CDT"))
     197        I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Canceled Appt Error: "_$G(BSDR("USR"))
     198        I '$D(^SD(409.2,+$G(BSDR("CR")))) Q 1_U_"Cancel Reason error: "_$G(BSDR("CR"))
     199        ;
     200        NEW IEN,DIE,DA,DR
     201        S IEN=$$SCIEN(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
     202        I 'IEN Q 1_U_"Error trying to find appointment for cancel: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
     203        ;
     204        I $$CI(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"),IEN) Q 1_U_"Patient already checked in; cannot cancel until checkin deleted: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
     205        ;
     206        ; remember before status
     207        NEW SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL
     208        S DFN=BSDR("PAT"),SDT=BSDR("ADT"),SDCL=BSDR("CLN"),SDMODE=2,SDDA=IEN
     209        S SDCPHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
     210        D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCPHDL)
     211        ;
     212        ; get user who made appt and date appt made from ^SC
     213        ;    because data in ^SC will be deleted
     214        NEW USER,DATE
     215        S USER=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,6)
     216        S DATE=$P($G(^SC(SDCL,"S",SDT,1,IEN,0)),U,7)
     217        ;
     218        ; update file 2 info
     219        NEW DIE,DA,DR
     220        S DIE="^DPT("_DFN_",""S"",",DA(1)=DFN,DA=SDT
     221        S DR="3///"_BSDR("TYP")_";14///`"_BSDR("USR")_";15///"_BSDR("CDT")_";16///`"_BSDR("CR")_";19///`"_USER_";20///"_DATE
     222        S:$G(BSDR("NOT"))]"" DR=DR_";17///"_$E(BSDR("NOT"),1,160)
     223        D ^DIE
     224        ;
     225        ; delete data in ^SC
     226        NEW DIK,DA
     227        S DIK="^SC("_BSDR("CLN")_",""S"","_BSDR("ADT")_",1,"
     228        S DA(2)=BSDR("CLN"),DA(1)=BSDR("ADT"),DA=IEN
     229        D ^DIK
     230        ;
     231        ; call event driver
     232        D CANCEL^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDMODE,SDCPHDL)
     233        Q 0
     234        ;
     235CI(PAT,CLINIC,DATE,SDIEN)       ;PEP; -- returns 1 if appt already checked-in
     236        NEW X
     237        S X=$G(SDIEN)   ;ien sent in call
     238        I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0
     239        S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U)
     240        Q $S(X:1,1:0)
     241        ;
     242SCIEN(PAT,CLINIC,DATE)  ;PEP; returns ien for appt in ^SC
     243        NEW X,IEN
     244        S X=0 F  S X=$O(^SC(CLINIC,"S",DATE,1,X)) Q:'X  Q:$G(IEN)  D
     245        . Q:$P($G(^SC(CLINIC,"S",DATE,1,X,0)),U,9)="C"  ;cancelled
     246         . I +$G(^SC(CLINIC,"S",DATE,1,X,0))=PAT S IEN=X
     247        Q $G(IEN)
     248        ;
     249APPTYP(PAT,DATE)        ;PEP; -- returns type of appt (scheduled or walk-in)
     250        NEW X S X=$P($G(^DPT(PAT,"S",DATE,0)),U,7)
     251        Q $S(X=3:"SCHED",X=4:"WALK-IN",1:"??")
     252        ;
     253CO(PAT,CLINIC,DATE,SDIEN)       ;PEP; -- returns 1 if appt already checked-out
     254        NEW X
     255        S X=$G(SDIEN)   ;ien sent in call
     256        I 'X S X=$$SCIEN(PAT,CLINIC,DATE) I 'X Q 0
     257        S X=$P($G(^SC(CLINIC,"S",DATE,1,X,"C")),U,3)
     258        Q $S(X:1,1:0)
     259        ;
     260       
  • Scheduling/trunk/m/BSDXGPRV.m

    r803 r888  
    11BSDXGPRV        ; WV/SMH - WINDOWS SCHEDULING RPCS ; 6/10/10 9:01pm
    2         ;;1.1;IHS WINDOWS SCHEDULING;;NOV 01, 2007
     2        ;;1.3T1;BSDX;;Jul 18, 2010
    33        ;
    44        ;
     
    88        ;
    99ERR(BSDXERR)    ;Error processing
    10     D ^%ZTER
     10           D ^%ZTER
    1111        S BSDXI=BSDXI+1
    12     S ^BSDXTMP($J,BSDXI)=BSDXERR
    13     S BSDXI=BSDXI+1
     12           S ^BSDXTMP($J,BSDXI)=BSDXERR
     13           S BSDXI=BSDXI+1
    1414        S ^BSDXTMP($J,BSDXI)=$C(31)
    1515        Q
     
    2121        Q
    2222        ;
    23 P(BSDXY,HLIEN) ; Public Entry point; Get Providers for Hosp Location
    24     ; Input: HLIEN - Hospital Location IEN
    25     ; Output: ADO Datatable with columns:
    26     ; - HOSPITAL_LOCATION_ID, BMXIEN, PROV_NAME, DEFAULT
    27     ; If there are providers in the PROVIDER multiple of file 44
    28     ; (Hospital Location) return them;
    29     ; If no providers in PROVIDER multiple of file 44, return nothing
     23P(BSDXY,HLIEN)  ; Public Entry point; Get Providers for Hosp Location
     24           ; Input: HLIEN - Hospital Location IEN
     25           ; Output: ADO Datatable with columns:
     26           ; - HOSPITAL_LOCATION_ID, BMXIEN, PROV_NAME, DEFAULT
     27           ; If there are providers in the PROVIDER multiple of file 44
     28           ; (Hospital Location) return them;
     29           ; If no providers in PROVIDER multiple of file 44, return nothing
    3030        ; Called by BSDX HOSP LOC PROVIDERS
    3131        ;
    3232        S BSDXI=0
    33     I '$D(^SC(HLIEN,0)) D ERR("HOSPITAL LOCATION NOT FOUND") QUIT
     33           I '$D(^SC(HLIEN,0)) D ERR("HOSPITAL LOCATION NOT FOUND") QUIT
    3434        D ^XBKVAR
    35     N $ET S $ET="G ERROR^BSDXGPRV"
     35           N $ET S $ET="G ERROR^BSDXGPRV"
    3636        K ^BSDXTMP($J)
    3737        S BSDXY=$NA(^BSDXTMP($J))
    3838        S $P(^BSDXTMP($J,BSDXI),U,1)="I00020HOSPITAL_LOCATION_ID"
    39     S $P(^BSDXTMP($J,BSDXI),U,2)="I00020BMXIEN"
    40     S $P(^BSDXTMP($J,BSDXI),U,3)="T00030NAME"
    41     S $P(^BSDXTMP($J,BSDXI),U,4)="T00005DEFAULT"
    42     S ^BSDXTMP($J,BSDXI)=^BSDXTMP($J,BSDXI)_$C(30)
     39           S $P(^BSDXTMP($J,BSDXI),U,2)="I00020BMXIEN"
     40           S $P(^BSDXTMP($J,BSDXI),U,3)="T00030NAME"
     41           S $P(^BSDXTMP($J,BSDXI),U,4)="T00005DEFAULT"
     42           S ^BSDXTMP($J,BSDXI)=^BSDXTMP($J,BSDXI)_$C(30)
    4343        ;
    44     N OUTPUT
    45     D GETS^DIQ(44,HLIEN_",","2600*","IE","OUTPUT") ; Provider Multiple
    46     ; No results
    47     I '$D(OUTPUT) S ^BSDXTMP($J,BSDXI+1)=$C(31) QUIT
    48     ; if results, get them
    49     N I S I=""
    50     F  S I=$O(OUTPUT(44.1,I)) Q:I=""  D
    51     . S BSDXI=BSDXI+1
    52     . S $P(^BSDXTMP($J,BSDXI),U,1)=HLIEN                  ; HL IEN
    53     . S $P(^BSDXTMP($J,BSDXI),U,2)=$P(OUTPUT(44.1,I,.01,"I"),",") ; PROV IEN
    54     . S $P(^BSDXTMP($J,BSDXI),U,3)=$E(OUTPUT(44.1,I,.01,"E"),1,30) ; PROV NAME
    55     . S $P(^BSDXTMP($J,BSDXI),U,4)=OUTPUT(44.1,I,.02,"E") ; Default - YES, NO
    56     . S ^BSDXTMP($J,BSDXI)=^BSDXTMP($J,BSDXI)_$C(30)
     44           N OUTPUT
     45           D GETS^DIQ(44,HLIEN_",","2600*","IE","OUTPUT") ; Provider Multiple
     46           ; No results
     47           I '$D(OUTPUT) S ^BSDXTMP($J,BSDXI+1)=$C(31) QUIT
     48           ; if results, get them
     49           N I S I=""
     50           F  S I=$O(OUTPUT(44.1,I)) Q:I=""  D
     51           . S BSDXI=BSDXI+1
     52           . S $P(^BSDXTMP($J,BSDXI),U,1)=HLIEN                  ; HL IEN
     53           . S $P(^BSDXTMP($J,BSDXI),U,2)=$P(OUTPUT(44.1,I,.01,"I"),",") ; PROV IEN
     54           . S $P(^BSDXTMP($J,BSDXI),U,3)=$E(OUTPUT(44.1,I,.01,"E"),1,30) ; PROV NAME
     55           . S $P(^BSDXTMP($J,BSDXI),U,4)=OUTPUT(44.1,I,.02,"E") ; Default - YES, NO
     56           . S ^BSDXTMP($J,BSDXI)=^BSDXTMP($J,BSDXI)_$C(30)
    5757        S BSDXI=BSDXI+1
    5858        S ^BSDXTMP($J,BSDXI)=$C(31)
Note: See TracChangeset for help on using the changeset viewer.