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.

File:
1 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
Note: See TracChangeset for help on using the changeset viewer.