Changeset 1080 for Scheduling/trunk/m


Ignore:
Timestamp:
Jan 25, 2011, 5:58:58 AM (14 years ago)
Author:
Sam Habiel
Message:

Final checkin. Completed ability to be able to remove appointments that have been checked in. Also, fixed not being able to make an appointment at midnight issue.

Location:
Scheduling/trunk/m
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • Scheduling/trunk/m/BSDX08.m

    r1077 r1080  
    1 BSDX08  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 12/6/10 12:35pm
     1BSDX08  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 1/25/11 12:39pm
    22        ;;1.42;BSDX;;Dec 07, 2010
    33        ;
    … …  
    1616        ;  - Refactored all of APPDEL.
    1717        ;
     18        ; 3111125 UJO/SMH v1.5
     19        ;  - Added ability to remove checked in appointments. Added a couple
     20        ;    of units tests for that under UT2.
     21        ;  - Minor reformatting because of how KIDS adds tabs.
     22        ;
    1823        ; Error Reference:
    1924        ;  -1~BSDX08: Appt record is locked. Please contact technical support.
    … …  
    7277        D APPDEL^BSDX08(.ZZZ,999999,"PC",1,"Reasons")
    7378        I $P(^BSDXTMP($J,1),"~")'=-3 W "Error in -3",!
    74         ;
    75         ; Test 6: for Cancelling walkin and checked-in appointments (should fail).
     79UT2     ; More unit Tests
     80        ;
     81        ; Test 6: for Cancelling walkin and checked-in appointments
    7682        S BSDXSTART=$E($$NOW^XLFDT,1,12),BSDXEND=BSDXSTART+.0001
    77         D APPADD^BSDX07(.ZZZ,BSDXSTART,BSDXEND,4,"Dr Office",10,"Sam's Note",1)
    78         S APPID=+$P(^BSDXTMP($J,1),U)
    79         B
    80         D CHECKIN^BSDX25(.ZZZ,APPID,$$NOW^XLFDT)
    81         B
    82         D APPDEL^BSDX08(.ZZZ,APPID,"PC",10,"Cancel Note")
    83         B
    84         ;
    85         ; Test 7: for cancelling walkin and checked-in appointments (this should pass)
     83        D APPADD^BSDX07(.ZZZ,BSDXSTART,BSDXEND,4,"Dr Office",10,"Sam's Note",1) ; Add appt
     84        S APPID=+$P(^BSDXTMP($J,1),U)
     85        I APPID=0 W "Error in test 6",!
     86        D CHECKIN^BSDX25(.ZZZ,APPID,$$NOW^XLFDT) ; check-in
     87        D APPDEL^BSDX08(.ZZZ,APPID,"PC",10,"Cancel Note") ; Delete appt
     88        I $P(^BSDXTMP($J,1),$C(30))'="" W "Error in test 6",!
     89        ;
     90        ; Test 7: for cancelling walkin and checked-in appointments
    8691        S BSDXSTART=$E($$NOW^XLFDT,1,12)+.0001,BSDXEND=BSDXSTART+.0001
    87         D APPADD^BSDX07(.ZZZ,BSDXSTART,BSDXEND,4,"Dr Office",10,"Sam's Note",1)
    88         S APPID=+$P(^BSDXTMP($J,1),U)
    89         B
    90         D CHECKIN^BSDX25(.ZZZ,APPID,$$NOW^XLFDT)
     92        D APPADD^BSDX07(.ZZZ,BSDXSTART,BSDXEND,4,"Dr Office",10,"Sam's Note",1) ; Add appt
     93        S APPID=+$P(^BSDXTMP($J,1),U)
     94        I APPID=0 W "Error in test 6",!
     95        D CHECKIN^BSDX25(.ZZZ,APPID,$$NOW^XLFDT) ; Checkin
    9196        S BSDXRES=$O(^BSDXRES("B","Dr Office",""))
    9297        S BSDXCLN=$P(^BSDXRES(BSDXRES,0),U,4)
    93         B
    94         S BSDXRESULT=$$RMCI^BSDXAPI(4,BSDXCLN,BSDXSTART)
    95         B
    96         D APPDEL^BSDX08(.ZZZ,APPID,"PC",10,"Cancel Note")
    97         ;
    98        
     98        S BSDXRESULT=$$RMCI^BSDXAPI(4,BSDXCLN,BSDXSTART) ; remove checkin
     99        D APPDEL^BSDX08(.ZZZ,APPID,"PC",10,"Cancel Note") ; delete appt
     100        I $P(^BSDXTMP($J,1),$C(30))'="" W "Error in test 6",!
    99101        QUIT
    100            ; Lock the node in another job for testing.
    101 UTL(APPID)      L +^BSDXAPPT(APPID) HANG 10 QUIT
    102            ;
    103102APPDEL(BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT)         ;EP
    104103        ;Called by RPC: BSDX CANCEL APPOINTMENT
    105104        ;Cancels existing appointment in BSDX APPOINTMENT and 44/2 subfiles
    106            ;Input Parameters:
     105        ;Input Parameters:
    107106        ; - BSDXAPTID is entry number in BSDX APPOINTMENT file
    108107        ; - BSDXTYP is C for clinic-cancelled and PC for patient cancelled
    … …  
    110109        ; - BSDXNOT is user note
    111110        ;
    112            ; Returns error code in recordset field ERRORID. Zero is success.
    113            ; Returns Global Array. Must use this type in RPC.
    114         ;
    115            ; Return Array: set Return and clear array
     111        ; Returns error code in recordset field ERRORID. Empty string is success.
     112        ; Returns Global Array. Must use this type in RPC.
     113        ;
     114        ; Return Array: set Return and clear array
    116115        S BSDXY=$NA(^BSDXTMP($J))
    117            K ^BSDXTMP($J)
    118         ;
    119            ; Set min DUZ vars if they don't exist
    120            D ^XBKVAR
    121            ;
    122            ; $ET
    123            N $ET S $ET="G ETRAP^BSDX08"
    124         ;
    125            ; Counter
     116        K ^BSDXTMP($J)
     117        ;
     118        ; Set min DUZ vars if they don't exist
     119        D ^XBKVAR
     120        ;
     121        ; $ET
     122        N $ET S $ET="G ETRAP^BSDX08"
     123        ;
     124        ; Counter
    126125        N BSDXI S BSDXI=0
    127            ; Header Node
     126        ; Header Node
    128127        S ^BSDXTMP($J,BSDXI)="T00100ERRORID"_$C(30)
    129128        ;
    130            ; Lock BSDX node, only to synchronize access to the globals.
    131            ; It's not expected that the error will ever happen as no filing
    132            ; is supposed to take 5 seconds.
    133            L +^BSDXAPPT(BSDXAPTID):5 I '$T D ERR(BSDXI,"-1~BSDX08: Appt record is locked. Please contact technical support.") Q
    134         ;
    135            ;Restartable Transaction; restore paramters when starting.
    136            ; (Params restored are what's passed here + BSDXI)
    137            TSTART (BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT,BSDXI):T="BSDX CANCEL APPOINTEMENT^BSDX08"
    138         ;
    139            ; Turn off SDAM APPT PROTOCOL BSDX Entries
     129        ; Lock BSDX node, only to synchronize access to the globals.
     130        ; It's not expected that the error will ever happen as no filing
     131        ; is supposed to take 5 seconds.
     132        L +^BSDXAPPT(BSDXAPTID):5 I '$T D ERR(BSDXI,"-1~BSDX08: Appt record is locked. Please contact technical support.") Q
     133        ;
     134        ;Restartable Transaction; restore paramters when starting.
     135        ; (Params restored are what's passed here + BSDXI)
     136        TSTART (BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT,BSDXI):T="BSDX CANCEL APPOINTEMENT^BSDX08"
     137        ;
     138        ; Turn off SDAM APPT PROTOCOL BSDX Entries
    140139        N BSDXNOEV
    141140        S BSDXNOEV=1 ;Don't execute BSDX CANCEL APPOINTMENT protocol
    142141        ;
    143            ;;;test for error inside transaction. See if %ZTER works
    144            I $G(bsdxdie) S X=1/0
    145            ;;;test
    146            ;;;test for TRESTART
    147            I $G(bsdxrestart) K bsdxrestart TRESTART
    148            ;;;test
    149            ;
    150            ; Check appointment ID and whether it exists
    151            I '+BSDXAPTID D ERR(BSDXI,"-2~BSDX08: Invalid Appointment ID") Q
     142        ;;;test for error inside transaction. See if %ZTER works
     143        I $G(bsdxdie) S X=1/0
     144        ;;;test
     145        ;;;test for TRESTART
     146        I $G(bsdxrestart) K bsdxrestart TRESTART
     147        ;;;test
     148        ;
     149        ; Check appointment ID and whether it exists
     150        I '+BSDXAPTID D ERR(BSDXI,"-2~BSDX08: Invalid Appointment ID") Q
    152151        I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR(BSDXI,"-3~BSDX08: Invalid Appointment ID") Q
    153152        ;
    154153        ; Start Processing:
    155            ; First, add cancellation date to appt entry in BSDX APPOINTMENT
     154        ; First, add cancellation date to appt entry in BSDX APPOINTMENT
    156155        N BSDXNOD S BSDXNOD=^BSDXAPPT(BSDXAPTID,0) ; BSDX Appt Node
    157156        N BSDXPATID S BSDXPATID=$P(BSDXNOD,U,5) ; Patient ID
    … …  
    159158        D BSDXCAN(BSDXAPTID)  ; Add a cancellation date in BSDX APPOINTMENT
    160159        ;
    161            ; Second, cancel appt in "S" nodes in file 2 and 44, then update Legacy PIMS Availability
     160        ; Second, cancel appt in "S" nodes in file 2 and 44, then update Legacy PIMS Availability
    162161        N BSDXSC1 S BSDXSC1=$P(BSDXNOD,U,7) ;RESOURCEID
    163            ; If the resouce id doesn't exist...
     162        ; If the resouce id doesn't exist...
    164163        I BSDXSC1="" D ERR(BSDXI,"-4~BSDX08: Cancelled appointment does not have a Resouce ID") QUIT
    165            I '$D(^BSDXRES(BSDXSC1,0)) D ERR(BSDXI,"-5~BSDX08: Resouce ID does not exist in BSDX RESOURCE") QUIT
     164        I '$D(^BSDXRES(BSDXSC1,0)) D ERR(BSDXI,"-5~BSDX08: Resouce ID does not exist in BSDX RESOURCE") QUIT
    166165        ; Get zero node of resouce
    167            S BSDXNOD=^BSDXRES(BSDXSC1,0)
    168            ; Get Hosp location
     166        S BSDXNOD=^BSDXRES(BSDXSC1,0)
     167        ; Get Hosp location
    169168        N BSDXLOC S BSDXLOC=$P(BSDXNOD,U,4)
    170            ; Error indicator for Hosp Location filing for getting out of routine
    171            N BSDXERR S BSDXERR=0
    172            ; Only file in 2/44 if there is an associated hospital location
    173            I BSDXLOC D  QUIT:BSDXERR 
     169        ; Error indicator for Hosp Location filing for getting out of routine
     170        N BSDXERR S BSDXERR=0
     171        ; Only file in 2/44 if there is an associated hospital location
     172        I BSDXLOC D  QUIT:BSDXERR 
    174173        . I '$D(^SC(BSDXLOC,0)) S BSDXERR=1 D ERR(BSDXI,"-6~BSDX08: Invalid Hosp Location stored in Database") QUIT
    175            . ; Get the IEN of the appointment in the "S" node of ^SC
    176            . N BSDXSCIEN
     174        . ; Get the IEN of the appointment in the "S" node of ^SC
     175        . N BSDXSCIEN
    177176        . S BSDXSCIEN=$$SCIEN^BSDXAPI(BSDXPATID,BSDXLOC,BSDXSTART)
    178            . I BSDXSCIEN="" S BSDXERR=1 D ERR(BSDXI,"-7~BSDX08: Patient does not have an appointment in PIMS Clinic") QUIT
     177        . I BSDXSCIEN="" S BSDXERR=1 D ERR(BSDXI,"-7~BSDX08: Patient does not have an appointment in PIMS Clinic") QUIT
    179178        . ; Get the appointment node
    180            . S BSDXNOD=$G(^SC(BSDXLOC,"S",BSDXSTART,1,BSDXSCIEN,0))
     179        . S BSDXNOD=$G(^SC(BSDXLOC,"S",BSDXSTART,1,BSDXSCIEN,0))
    181180        . I BSDXNOD="" S BSDXERR=1 D ERR(BSDXI,"-8^BSDX08: Unable to find associated PIMS appointment for this patient") QUIT
    182181        . N BSDXLEN S BSDXLEN=$P(BSDXNOD,U,2)
    183182        . ; Cancel through BSDXAPI
    184            . N BSDXZ
    185            . D APCAN(.BSDXZ,BSDXLOC,BSDXPATID,BSDXSTART)
    186            . I +BSDXZ>0 S BSDXERR=1 D ERR(BSDXI,"-9^BSDX08: BSDXAPI returned an error: "_$P(BSDXZ,U,2)) QUIT
     183        . N BSDXZ
     184        . D APCAN(.BSDXZ,BSDXLOC,BSDXPATID,BSDXSTART)
     185        . I +BSDXZ>0 S BSDXERR=1 D ERR(BSDXI,"-9^BSDX08: BSDXAPI returned an error: "_$P(BSDXZ,U,2)) QUIT
    187186        . ; Update Legacy PIMS clinic Availability
    188187        . D AVUPDT(BSDXLOC,BSDXSTART,BSDXLEN)
    … …  
    199198        ;See SDCNP0
    200199        N SD,S  ; Start Date
    201            S (SD,S)=BSDXSTART
    202            N I ; Clinic IEN in 44
     200        S (SD,S)=BSDXSTART
     201        N I ; Clinic IEN in 44
    203202        S I=BSDXSCD
    204            ; if day has no schedule in legacy PIMS, forget about this update.
     203        ; if day has no schedule in legacy PIMS, forget about this update.
    205204        Q:'$D(^SC(I,"ST",SD\1,1))
    206            N SL ; Clinic characteristics node (length of appt, when appts start etc)
     205        N SL ; Clinic characteristics node (length of appt, when appts start etc)
    207206        S SL=^SC(I,"SL")
    208            N X ; Hour Clinic Display Begins
    209            S X=$P(SL,U,3)
    210            N STARTDAY ; When does the day start?
    211            S STARTDAY=$S($L(X):X,1:8) ; If defined, use it; otherwise, 8am
    212            N SB ; ?? Who knows? Day Start - 1 divided by 100.
    213            S SB=STARTDAY-1/100
    214            S X=$P(SL,U,6) ; Now X is Display increments per hour
    215            N HSI ; Slots per hour, try 1
    216            S HSI=$S(X:X,1:4) ; if defined, use it; otherwise, 4
    217            N SI ; Slots per hour, try 2
    218            S SI=$S(X="":4,X<3:4,X:X,1:4) ; If slots "", or less than 3, then 4
    219            N STR ; ??
    220            S STR="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz"
    221            N SDDIF ; Slots per hour diff??
    222            S SDDIF=$S(HSI<3:8/HSI,1:2)
     207        N X ; Hour Clinic Display Begins
     208        S X=$P(SL,U,3)
     209        N STARTDAY ; When does the day start?
     210        S STARTDAY=$S($L(X):X,1:8) ; If defined, use it; otherwise, 8am
     211        N SB ; ?? Who knows? Day Start - 1 divided by 100.
     212        S SB=STARTDAY-1/100
     213        S X=$P(SL,U,6) ; Now X is Display increments per hour
     214        N HSI ; Slots per hour, try 1
     215        S HSI=$S(X:X,1:4) ; if defined, use it; otherwise, 4
     216        N SI ; Slots per hour, try 2
     217        S SI=$S(X="":4,X<3:4,X:X,1:4) ; If slots "", or less than 3, then 4
     218        N STR ; ??
     219        S STR="#@!$* XXWVUTSRQPONMLKJIHGFEDCBA0123456789jklmnopqrstuvwxyz"
     220        N SDDIF ; Slots per hour diff??
     221        S SDDIF=$S(HSI<3:8/HSI,1:2)
    223222        S SL=BSDXLEN ; Dammit, reusing variable; SL now Appt Length from GUI
    224223        S S=^SC(I,"ST",SD\1,1) ; reusing var again; S now Day Pattern from PIMS
    225            N Y ; Hours since start of Date
    226            S Y=SD#1-SB*100 ;SD#1=FM Time portion; -SB minus start of day; conv to hrs
    227            N ST  ; ??
    228            ; Y#1 -> Minutes; *SI -> * Slots per hour; \.6 trunc min to hour
    229            ; Y\1 -> Hours since start of day; * SI: * slots
    230            S ST=Y#1*SI\.6+(Y\1*SI)
    231            N SS ; how many slots are supposed to be taken by appointment
    232            S SS=SL*HSI/60 ; (nb: try SL: 30 min; HSI: 4 slots)
     224        N Y ; Hours since start of Date
     225        S Y=SD#1-SB*100 ;SD#1=FM Time portion; -SB minus start of day; conv to hrs
     226        N ST  ; ??
     227        ; Y#1 -> Minutes; *SI -> * Slots per hour; \.6 trunc min to hour
     228        ; Y\1 -> Hours since start of day; * SI: * slots
     229        S ST=Y#1*SI\.6+(Y\1*SI)
     230        N SS ; how many slots are supposed to be taken by appointment
     231        S SS=SL*HSI/60 ; (nb: try SL: 30 min; HSI: 4 slots)
    233232        N I
    234            I Y'<1 D  ; If Hours since start of Date is greater than 1
    235            . ; loop through pattern. Tired of documenting.
    236            . F I=ST+ST:SDDIF D  Q:Y=""  Q:SS'>0
    237            . . S Y=$E(STR,$F(STR,$E(S,I+1))) Q:Y="" 
    238            . . S S=$E(S,1,I)_Y_$E(S,I+2,999)
    239            . . S SS=SS-1
    240            . . Q:SS'>0
     233        I Y'<1 D  ; If Hours since start of Date is greater than 1
     234        . ; loop through pattern. Tired of documenting.
     235        . F I=ST+ST:SDDIF D  Q:Y=""  Q:SS'>0
     236        . . S Y=$E(STR,$F(STR,$E(S,I+1))) Q:Y="" 
     237        . . S S=$E(S,1,I)_Y_$E(S,I+2,999)
     238        . . S SS=SS-1
     239        . . Q:SS'>0
    241240        S ^SC(BSDXSCD,"ST",SD\1,1)=S  ; new pattern; global set
    242241        Q
    … …  
    321320ETRAP   ;EP Error trap entry
    322321        N $ET S $ET="D ^%ZTER HALT"  ; Emergency Error Trap
    323            ; Rollback, otherwise ^XTER will be empty from future rollback
    324            I $TL>0 TROLLBACK
    325            D ^%ZTER
    326            S $EC=""  ; Clear Error
     322        ; Rollback, otherwise ^XTER will be empty from future rollback
     323        I $TL>0 TROLLBACK
     324        D ^%ZTER
     325        S $EC=""  ; Clear Error
    327326        ; Log error message and send to client
    328            I '$D(BSDXI) N BSDXI S BSDXI=0
     327        I '$D(BSDXI) N BSDXI S BSDXI=0
    329328        D ERR(BSDXI,"-100~BSDX08 Error: "_$G(%ZTERZE))
    330329        QUIT
    331            ;
    332            ;;;NB: This is code that is unused in both original and port.
    333            ; ; If not appt in the "S" node is found in ^SC then check associated RPMS Clinic Multiple
    334            ; I BSDXSCIEN="" D  I 'BSDXZ Q  ;Q:BSDXZ
     330        ;
     331        ;;;NB: This is code that is unused in both original and port.
     332        ; ; If not appt in the "S" node is found in ^SC then check associated RPMS Clinic Multiple
     333        ; I BSDXSCIEN="" D  I 'BSDXZ Q  ;Q:BSDXZ
    335334        ; . S BSDXERR="BSDX08: Unable to find associated RPMS appointment for this patient. "
    336335        ; . S BSDXZ=1
    337            ; . ; Check if there are associated RPMS clinics. (not currently used) Does the multiple exist? No, then quit
     336        ; . ; Check if there are associated RPMS clinics. (not currently used) Does the multiple exist? No, then quit
    338337        ; . I '$D(^BSDXRES(BSDXSC1,20)) S BSDXZ=0 QUIT
    339            ; . ; Loop through the multiple. Get Location and then the ^SC "S" node IEN.
     338        ; . ; Loop through the multiple. Get Location and then the ^SC "S" node IEN.
    340339        ; . N BSDX1 S BSDX1=0
    341340        ; . F  S BSDX1=$O(^BSDXRES(BSDXSC1,20,BSDX1)) Q:'+BSDX1  Q:BSDXZ=0  D
    342341        ; . . Q:'$D(^BSDXRES(BSDXSC1,20,BSDX1,0))
    343342        ; . . S BSDXLOC=$P(^BSDXRES(BSDXSC1,20,BSDX1,0),U)
    344         . ; . . S BSDXSCIEN=$$SCIEN^BSDXAPI(BSDXPATID,BSDXLOC,BSDXSTART) I +BSDXSCIEN S BSDXZ=0 Q
     343        ; . . S BSDXSCIEN=$$SCIEN^BSDXAPI(BSDXPATID,BSDXLOC,BSDXSTART) I +BSDXSCIEN S BSDXZ=0 Q

  • Scheduling/trunk/m/BSDXAPI.m

    r1076 r1080  
    1 BSDXAPI ; IHS/ANMC/LJF - SCHEDULING APIs ; 12/6/10 5:50pm
     1BSDXAPI ; IHS/ANMC/LJF - SCHEDULING APIs ; 1/25/11 1:00pm
    22        ;;1.42;BSDX;;Dec 07, 2010;Build 7
    33        ;Orignal routine is BSDAPI by IHS/LJF, HMW, and MAW
    … …  
    55        ;Move to BSDX namespace as BSDXAPI from BSDAPI by WV/SMH
    66        ; Change History:
    7         ; 2010-11-5:
     7        ; 2010-11-5: (1.42)
    88        ; - Fixed errors having to do uncanceling patient appointments if it was a patient cancelled appointment.
    99        ; - Use new style Fileman API for storing appointments in file 44 in $$MAKE due to problems with legacy API.
    10         ; 2010-11-12:
     10        ; 2010-11-12: (1.42)
    1111        ; - Changed ="C" to ["C" in SCIEN. Cancelled appointments can be "PC" as well.
    12         ; 2010-12-5
     12        ; 2010-12-5 (1.42)
    1313        ; Added an entry point to update the patient note in file 44.
    14         ; 2010-12-6
     14        ; 2010-12-6 (1.42)
    1515        ; MAKE1 incorrectly put info field in BSDR("INFO") rather than BSDR("OI")
    16         ; 2010-12-8
     16        ; 2010-12-8 (1.42)
    1717        ; Removed restriction on max appt length. Even though this restriction
    1818        ; exists in fileman (120 minutes), PIMS ignores it. Therefore, I
    1919        ; will ignore it here too.
     20        ; 2011-01-25 (v.1.5)
     21        ; Added entry point $$RMCI to remove checked in appointments.
     22        ; In $$CANCEL, if the appointment is checked in, delete check-in rather than
     23        ;  spitting an error message to the user saying 'Delete the check-in'
     24        ; Changed all lines that look like this:
     25        ;  I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
     26        ; to:
     27        ;  I $G(BSDR("ADT"))'?7N.1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
     28        ; to allow for date at midnight which does not have a dot at the end.
     29        ; 
    2030        ;
    2131MAKE1(DFN,CLIN,TYP,DATE,LEN,INFO)       ; Simplified PEP w/ parameters for $$MAKE - making appointment
    … …  
    5464        I ($G(BSDR("TYP"))<3)!($G(BSDR("TYP"))>4) Q 1_U_"Appt Type error: "_$G(BSDR("TYP"))
    5565        I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12)  ;remove seconds
    56         I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
     66        I $G(BSDR("ADT"))'?7N.1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
    5767        ;
    5868        ;I ($G(BSDR("LEN"))<5)!($G(BSDR("LEN"))>240) Q 1_U_"Appt Length error: "_$G(BSDR("LEN")) ; v 1.42 - no check on length is done anymore. see top comments for details.
    … …  
    150160        I '$D(^SC(+$G(BSDR("CLN")),0)) Q 1_U_"Clinic not on file: "_$G(BSDR("CLN"))
    151161        I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12)  ;remove seconds
    152         I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
     162        I $G(BSDR("ADT"))'?7N.1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
    153163        I $G(BSDR("CDT")) S BSDR("CDT")=+$E(BSDR("CDT"),1,12)  ;remove seconds
    154         I $G(BSDR("CDT"))'?7N1".".4N Q 1_U_"Checkin Date/Time error: "_$G(BSDR("CDT"))
     164        I $G(BSDR("CDT"))'?7N.1".".4N Q 1_U_"Checkin Date/Time error: "_$G(BSDR("CDT"))
    155165        I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Made Appt Error: "_$G(BSDR("USR"))
    156166        ;
    … …  
    219229        I ($G(BSDR("TYP"))'="C"),($G(BSDR("TYP"))'="PC") Q 1_U_"Cancel Status error: "_$G(BSDR("TYP"))
    220230        I $G(BSDR("ADT")) S BSDR("ADT")=+$E(BSDR("ADT"),1,12)  ;remove seconds
    221         I $G(BSDR("ADT"))'?7N1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
     231        I $G(BSDR("ADT"))'?7N.1".".4N Q 1_U_"Appt Date/Time error: "_$G(BSDR("ADT"))
    222232        I $G(BSDR("CDT")) S BSDR("CDT")=+$E(BSDR("CDT"),1,12)  ;remove seconds
    223         I $G(BSDR("CDT"))'?7N1".".4N Q 1_U_"Cancel Date/Time error: "_$G(BSDR("CDT"))
     233        I $G(BSDR("CDT"))'?7N.1".".4N Q 1_U_"Cancel Date/Time error: "_$G(BSDR("CDT"))
    224234        I '$D(^VA(200,+$G(BSDR("USR")),0)) Q 1_U_"User Who Canceled Appt Error: "_$G(BSDR("USR"))
    225235        I '$D(^SD(409.2,+$G(BSDR("CR")))) Q 1_U_"Cancel Reason error: "_$G(BSDR("CR"))
    … …  
    229239        I 'IEN Q 1_U_"Error trying to find appointment for cancel: Patient="_BSDR("PAT")_" Clinic="_BSDR("CLN")_" Appt="_BSDR("ADT")
    230240        ;
    231         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")
     241        ; BSDX 1.5 3110125
     242        ; UJO/SMH - Add ability to remove check-in if the patient is checked in
     243        ; 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")
     244        ; Remove check-in if the patient is checked in.
     245        N BSDXRESULT S BSDXRESULT=0 ; Result; should be zero if success; -1 + message if failure
     246        I $$CI(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"),IEN) SET BSDXRESULT=$$RMCI(BSDR("PAT"),BSDR("CLN"),BSDR("ADT"))
     247        I BSDXRESULT Q BSDXRESULT
    232248        ;
    233249        ; remember before status
    … …  
    276292        ; -1 if failure
    277293        ;
    278         ; remember before status
     294        ; Call like this: $$RMCI(233,33,3110102.1130)
     295        ;
     296        ; Move my variables into the ones used by SDAPIs (just a convenience)
    279297        NEW SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL
    280298        S DFN=PAT,SDT=DATE,SDCL=CLINIC,SDMODE=2,SDDA=$$SCIEN(DFN,SDCL,SDT)
    … …  
    282300        I SDDA<1 QUIT 0    ; Appt cancelled; cancelled appts rm'ed from file 44
    283301        ;
     302        ; remember before status
    284303        S SDCIHDL=$$HANDLE^SDAMEVT(1),SDATA=SDDA_U_DFN_U_SDT_U_SDCL
    285304        D BEFORE^SDAMEVT(.SDATA,DFN,SDT,SDCL,SDDA,SDCIHDL)
    … …  
    322341        ;
    323342UPDATENOTE(PAT,CLINIC,DATE,NOTE)        ; PEP; Update Note in ^SC for patient's appointment @ DATE
    324            ; PAT = DFN
    325            ; CLINIC = SC IEN
    326            ; DATE = FM Date/Time of Appointment
    327            ;
    328            ; Returns:
    329            ; 0 if okay
    330            ; -1 if failure
    331            N SCIEN S SCIEN=$$SCIEN(PAT,CLINIC,DATE) ; ien of appt in ^SC
    332            I SCIEN<1 QUIT 0    ; Appt cancelled; cancelled appts rm'ed from file 44
    333            N BSDXIENS S BSDXIENS=SCIEN_","_DATE_","_CLINIC_","
    334            S BSDXFDA(44.003,BSDXIENS,3)=$E(NOTE,1,150)
    335            N BSDXERR
    336            D FILE^DIE("","BSDXFDA","BSDXERR")
    337            I $D(BSDXERR) QUIT "-1~Can't file for Pat "_PAT_" in Clinic "_CLINIC_" at "_DATE_". Fileman reported an error: "_BSDXERR("DIERR",1,"TEXT",1)
    338            QUIT 0
     343        ; PAT = DFN
     344        ; CLINIC = SC IEN
     345        ; DATE = FM Date/Time of Appointment
     346        ;
     347        ; Returns:
     348        ; 0 if okay
     349        ; -1 if failure
     350        N SCIEN S SCIEN=$$SCIEN(PAT,CLINIC,DATE) ; ien of appt in ^SC
     351        I SCIEN<1 QUIT 0    ; Appt cancelled; cancelled appts rm'ed from file 44
     352        N BSDXIENS S BSDXIENS=SCIEN_","_DATE_","_CLINIC_","
     353        S BSDXFDA(44.003,BSDXIENS,3)=$E(NOTE,1,150)
     354        N BSDXERR
     355        D FILE^DIE("","BSDXFDA","BSDXERR")
     356        I $D(BSDXERR) QUIT "-1~Can't file for Pat "_PAT_" in Clinic "_CLINIC_" at "_DATE_". Fileman reported an error: "_BSDXERR("DIERR",1,"TEXT",1)
     357        QUIT 0
Note: See TracChangeset for help on using the changeset viewer.