Changeset 1479


Ignore:
Timestamp:
Jul 9, 2012, 7:43:46 PM (12 years ago)
Author:
Sam Habiel
Message:

Added/fixed the following:

  • Unit Tests for running everything through PIMS
  • Checks for end of message for error handling ((31))
  • All routines previously using transactions use locks now
Location:
Scheduling/trunk/m
Files:
10 edited

Legend:

Unmodified
Added
Removed

  • Scheduling/trunk/m/BSDX07.m

    r1472 r1479  
    1 BSDX07  ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS  ; 7/5/12 12:57pm
     1BSDX07  ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS  ; 7/9/12 4:02pm
    22        ;;1.7T1;BSDX;;Jul 06, 2012;Build 18
    33        ; Licensed under LGPL
    … …  
    3232        Q
    3333        ;
    34 APPADD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID,BSDXRADEXAM) ;EP
     34APPADD(BSDXY,BSDXSTART,BSDXEND,BSDXPATID,BSDXRES,BSDXLEN,BSDXNOTE,BSDXATID,BSDXRADEXAM) ;Private EP
    3535        ;
    3636        ;Called by RPC: BSDX ADD NEW APPOINTMENT
    … …  
    5858        ; AppointmentID and ErrorNumber
    5959        ;
    60         ; NB: Specifying BSDXLEN and BSDXEND is redundant. For future programmers
     60        ; TODO: Specifying BSDXLEN and BSDXEND is redundant. For future programmers
    6161        ; to sort out. Needs changes on client.
    6262        ;
    … …  
    6666        ; Deal with optional arguments
    6767        S BSDXRADEXAM=$G(BSDXRADEXAM)
    68            ;
     68        ;
    6969        ; Return Array; set Return and clear array
    7070        S BSDXY=$NA(^BSDXTMP($J))
    7171        K ^BSDXTMP($J)
    72            ;
     72        ;
    7373        ; $ET
    7474        N $ET S $ET="G ETRAP^BSDX07"
    … …  
    8080        ; It's not expected that the error will ever happen as no filing
    8181        ; is supposed to take 5 seconds.
    82         L +^BSDXAPPT(BSDXPATID):5 I '$T D ERR(BSDXI,"-1~Patient record is locked. Please contact technical support.") Q
     82        L +^BSDXPAT(BSDXPATID):5 I '$T D ERR(BSDXI,"-1~Patient record is locked. Please contact technical support.") Q
    8383        ;
    8484        ; Header Node
    … …  
    9292        N BSDXERR S BSDXERR=0
    9393        ;
    94         ;;;test for error inside transaction. See if %ZTER works
    95         I $G(BSDXDIE) S X=1/0
     94        ;;;test for error. See if %ZTER works
     95        I $G(BSDXDIE) N X S X=1/0
    9696        ;;;test
    9797        ;
    … …  
    132132        ; Now, check if PIMS has any issues with us making the appt using MAKECK
    133133        N BSDXSCD S BSDXSCD=$P(BSDXRNOD,U,4)  ; Hosp Location IEN
    134         N BSDXERR ; Variable to hold value of $$MAKE and $$MAKECK
     134        N BSDXERR S BSDXERR=0 ; Variable to hold value of $$MAKE and $$MAKECK
    135135        N BSDXC ; Array to send to MAKE and MAKECK APIs
    136136        ; Only if we have a valid Hosp Location
    137         I +BSDXSCD,$D(^SC(BSDXSCD,0)) D  I +BSDXERR D ERR(BSDXI,"-10~BSDX07 Error: MAKECK^BSDXAPI returned error code: "_BSDXERR) Q  ; no need for roll back
     137        I +BSDXSCD,$D(^SC(BSDXSCD,0)) D
    138138        . S BSDXC("PAT")=BSDXPATID
    139139        . S BSDXC("CLN")=BSDXSCD
    … …  
    147147        . S BSDXC("USR")=DUZ
    148148        . S BSDXERR=$$MAKECK^BSDXAPI(.BSDXC)
     149        I BSDXERR D ERR(BSDXI,"-10~BSDX07 Error: MAKECK^BSDXAPI returned error code: "_BSDXERR) Q  ; no need for roll back
    149150        ;
    150151        ; Done with all checks, let's make appointment in BSDX APPOINTMENT
    … …  
    160161        ; Only if we have a valid Hosp Loc can we make an appointment in 2/44
    161162        ; Use BSDXC array from before.
    162         ; NB: $$MAKE itself calls $$MAKECK to check again for being okay.
    163         I +BSDXSCD,$D(^SC(BSDXSCD,0)) D  I +BSDXERR D ERR(BSDXI,"-10~BSDX07 Error: MAKE^BSDXAPI returned error code: "_BSDXERR),ROLLBACK(BSDXAPPTID,.BSDXC) Q
    164         . S BSDXERR=$$MAKE^BSDXAPI(.BSDXC)
     163        ; FYI: $$MAKE itself calls $$MAKECK to check again for being okay.
     164        ; If an error happens here, we roll back both ^BSDXAPPT and 2/44 by deleting
     165        N BSDXERR S BSDXERR=0 ; Variable to hold value of $$MAKE and $$MAKECK
     166        I +BSDXSCD,$D(^SC(BSDXSCD,0)) S BSDXERR=$$MAKE^BSDXAPI(.BSDXC)
     167        I BSDXERR D ERR(BSDXI,"-10~BSDX07 Error: MAKE^BSDXAPI returned error code: "_BSDXERR),ROLLBACK(BSDXAPPTID,.BSDXC) Q
     168        ;
     169        ; Unlock
     170        L -^BSDXPAT(BSDXPATID)
    165171        ;
    166172        ;Return Recordset
    167         L -^BSDXAPPT(BSDXPATID)
    168173        S BSDXI=BSDXI+1
    169174        S ^BSDXTMP($J,BSDXI)=BSDXAPPTID_"^"_$C(30)
    … …  
    179184        ;Returns ien in BSDXAPPT or 0 if failed
    180185        ;Create entry in BSDX APPOINTMENT
    181         N BSDXAPPTID
     186        N BSDXAPPTID,BSDXFDA
    182187        S BSDXFDA(9002018.4,"+1,",.01)=BSDXSTART
    183188        S BSDXFDA(9002018.4,"+1,",.02)=BSDXEND
    … …  
    208213        ;BSDXSCDA=IEN for ^SC(BSDXSC,"S",BSDXSTART,1,BSDXSCDA). Use to get Length & Note
    209214        ;
    210         N BSDXNOD,BSDXLEN,BSDXAPPTID,BSDXNODP,BSDXWKIN,BSDXRES
     215        N BSDXNOD,BSDXLEN,BSDXAPPTID,BSDXNODP,BSDXWKIN,BSDXRES,BSDXNOTE,BSDXEND
    211216        Q:+$G(BSDXNOEV)
    212217        I $D(^BSDXRES("ALOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ALOC",BSDXSC,0))
    … …  
    243248        ; Appointment ID to remove from ^BSDXAPPT
    244249        ; BSDXC array (see array format in $$MAKE^BSDXAPI)
    245         ; NB: I am not sure whether I want to do $G to protect against undefs?
    246         ; I send the variables to this EP from the Symbol Table in ETRAP
     250        N %
    247251        D BSDXDEL^BSDX07(BSDXAPPTID)
    248252        S:$D(BSDXC) %=$$UNMAKE^BSDXAPI(.BSDXC) ; rtn value always 0
    … …  
    257261        ;
    258262ERR(BSDXI,BSDXERR)       ;Error processing - different from error trap.
     263        ; Unlock first
     264        L -^BSDXPAT(BSDXPATID)
     265        ; If last line is $C(31), we are done. No more errors to send to client.
     266        I ^BSDXTMP($J,$O(^BSDXTMP($J," "),-1))=$C(31) QUIT
    259267        S BSDXI=BSDXI+1
    260268        S BSDXERR=$TR(BSDXERR,"^","~")
    … …  
    262270        S BSDXI=BSDXI+1
    263271        S ^BSDXTMP($J,BSDXI)=$C(31)
    264         L -^BSDXAPPT(BSDXPATID)
    265272        Q
    266273        ;
    … …  
    268275        N $ET S $ET="D ^%ZTER HALT"  ; Emergency Error Trap
    269276        D ^%ZTER
    270         S $EC=""  ; Clear Error
     277        ;
    271278        I +$G(BSDXAPPTID) D ROLLBACK(BSDXAPPTID,.BSDXC) ; Rollback if BSDXAPPTID exists
     279        ;
    272280        ; Log error message and send to client
    273281        I '$D(BSDXI) N BSDXI S BSDXI=0

  • Scheduling/trunk/m/BSDX08.m

    r1472 r1479  
    1 BSDX08  ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 7/5/12 12:39pm
     1BSDX08  ; VW/UJO/SMH - WINDOWS SCHEDULING RPCS ; 7/9/12 4:22pm
    22        ;;1.7T1;BSDX;;Jul 06, 2012;Build 18
    33        ;
    … …  
    3737        Q
    3838        ;
    39 APPDEL(BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT)         ;EP
     39APPDEL(BSDXY,BSDXAPTID,BSDXTYP,BSDXCR,BSDXNOT)         ; Private EP
    4040        ;Called by RPC: BSDX CANCEL APPOINTMENT
    4141        ;Cancels existing appointment in BSDX APPOINTMENT and 44/2 subfiles
    … …  
    6565        S ^BSDXTMP($J,BSDXI)="T00100ERRORID"_$C(30)
    6666        ;
     67        ; Turn off SDAM APPT PROTOCOL BSDX Entries
     68        N BSDXNOEV
     69        S BSDXNOEV=1 ;Don't execute BSDX CANCEL APPOINTMENT protocol
     70        ;
     71        ;;;test for error inside transaction. See if %ZTER works
     72        I $G(BSDXDIE1) N X S X=1/0
     73        ;
     74        ; Check appointment ID and whether it exists
     75        I '+BSDXAPTID D ERR(BSDXI,"-2~BSDX08: Invalid Appointment ID") Q
     76        I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR(BSDXI,"-3~BSDX08: Invalid Appointment ID") Q
     77        ;
    6778        ; Lock BSDX node, only to synchronize access to the globals.
    6879        ; It's not expected that the error will ever happen as no filing
    6980        ; is supposed to take 5 seconds.
    70         L +^BSDXAPPT(BSDXAPTID):5 I '$T D ERR(BSDXI,"-1~BSDX08: Appt record is locked. Please contact technical support.") Q
    71         ;
    72         ; Turn off SDAM APPT PROTOCOL BSDX Entries
    73         N BSDXNOEV
    74         S BSDXNOEV=1 ;Don't execute BSDX CANCEL APPOINTMENT protocol
    75         ;
    76         ;;;test for error inside transaction. See if %ZTER works
    77         I $G(BSDXDIE1) N X S X=1/0
    78         ;
    79         ; Check appointment ID and whether it exists
    80         I '+BSDXAPTID D ERR(BSDXI,"-2~BSDX08: Invalid Appointment ID") Q
    81         I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR(BSDXI,"-3~BSDX08: Invalid Appointment ID") Q
    82         ;
     81        L +^BSDXAPPT(BSDXAPTID):5 E  D ERR(BSDXI,"-1~BSDX08: Appt record is locked. Please contact technical support.") Q
     82        ;
    8383        ; Start Processing:
    8484        ; First, get data
    … …  
    124124        ; BSDXAPPT First; no need for rollback if error occured.
    125125        N BSDXERR S BSDXERR=$$BSDXCAN(BSDXAPTID)  ; Add a cancellation date in BSDX APPOINTMENT
    126         I BSDXERR D ERR(BSDXI,"$$BSDXCAN failed (Fileman filing error): "_$P(BSDXERR,U,2)) QUIT
     126        I BSDXERR D ERR(BSDXI,"-10~BSDX08: $$BSDXCAN failed (Fileman filing error): "_$P(BSDXERR,U,2)) QUIT
    127127        ;
    128128        ; Then PIMS:
    129129        ; cancel appt in "S" nodes in file 2 and 44, then update Legacy PIMS Availability
    130130        ; If error happens, must rollback ^BSDXAPPT
    131         I BSDXLOC D  QUIT:BSDXERR
    132         . S BSDXERR=$$CANCEL^BSDXAPI(.BSDXC) ; Cancel through BSDXAPI
    133         . ; Rollback BSDXAPPT if error occurs
    134         . I BSDXERR D ERR(BSDXI,"-9^BSDX08: BSDXAPI returned an error: "_$P(BSDXERR,U,2)),ROLLBACK(BSDXAPTID)  QUIT
     131        I BSDXLOC S BSDXERR=$$CANCEL^BSDXAPI(.BSDXC) ; Cancel through BSDXAPI
     132        ; Rollback BSDXAPPT if error occurs
     133        I BSDXERR D ERR(BSDXI,"-9^BSDX08: BSDXAPI returned an error: "_$P(BSDXERR,U,2)),ROLLBACK(BSDXAPTID)  QUIT
    135134        ;
    136135        L -^BSDXAPPT(BSDXAPTID)
    … …  
    186185        . S BSDXNOD=$G(^BSDXAPPT(BSDXAPPT,0)) Q:BSDXNOD=""
    187186        . I $P(BSDXNOD,U,5)=BSDXPAT,$P(BSDXNOD,U,12)="" S BSDXFOUND=1 Q
    188         I BSDXFOUND,+$G(BSDXAPPT) D BSDXCAN(BSDXAPPT)
     187        I BSDXFOUND,+$G(BSDXAPPT) N % S %=$$BSDXCAN(BSDXAPPT) I % D ^%ZTER
    189188        Q BSDXFOUND
    190189        ;
    … …  
    201200        ;
    202201ERR(BSDXI,BSDXERR)      ;Error processing
     202        ; Unlock first
     203        L:$D(BSDXAPTID) -^BSDXAPPT(BSDXAPTID)
    203204        ; If last line is $C(31), we are done. No more errors to send to client.
    204205        I ^BSDXTMP($J,$O(^BSDXTMP($J," "),-1))=$C(31) QUIT
    … …  
    208209        S BSDXI=BSDXI+1
    209210        S ^BSDXTMP($J,BSDXI)=$C(31)
    210         L -^BSDXAPPT(BSDXAPTID)
    211211        QUIT
    212212        ;
    … …  
    214214        N $ET S $ET="D ^%ZTER HALT"  ; Emergency Error Trap
    215215        D ^%ZTER
     216        ;
    216217        ; Roll back BSDXAPPT;
    217218        ; NB: What if a Mumps error happens inside fileman in BSDXAPI?
    218219        ; I have decided the M errors are out of scope for me to handle.
    219220        D:$G(BSDXAPTID) ROLLBACK(BSDXAPTID)
     221        ;
    220222        ; Log error message and send to client
    221223        I '$D(BSDXI) N BSDXI S BSDXI=0

  • Scheduling/trunk/m/BSDX25.m

    r1472 r1479  
    1 BSDX25  ; VEN/SMH - WINDOWS SCHEDULING RPCS ; 7/5/12 11:55am
     1BSDX25  ; VEN/SMH - WINDOWS SCHEDULING RPCS ; 7/9/12 5:00pm
    22        ;;1.7T1;BSDX;;Jul 06, 2012;Build 18
    33        ; Licensed under LGPL
    … …  
    4141        ; -2 -> Invalid Check-in Date
    4242        ; -3 -> Cannot check-in due to Fileman Filer failure
     43        ; -4 -> Cannot lock ^BSDXAPPT(APPTID)
    4344        ; -10 -> BSDXAPI error
    4445        ; -100 -> Mumps Error
    … …  
    6667        I '+BSDXAPPTID D ERR("-1~Invalid Appointment ID") QUIT
    6768        I '$D(^BSDXAPPT(BSDXAPPTID,0)) D ERR("-1~Invalid Appointment ID") QUIT
     69        ;
     70        ; Lock BSDX node, only to synchronize access to the globals.
     71        ; It's not expected that the error will ever happen as no filing
     72        ; is supposed to take 5 seconds.
     73        L +^BSDXAPPT(BSDXAPPTID):5 E  D ERR("-4~Appt record is locked. Please contact technical support.") QUIT
    6874        ;
    6975        ; Remove Date formatting v.1.5. Client will send date as FM Date.
    … …  
    101107        . D ERR(-10_"~"_$P(BSDXERR,U,2)) ; Send error message to client
    102108        ;
     109        L -^BSDXAPPT(BSDXAPPTID)
    103110        S BSDXI=BSDXI+1
    104111        S ^BSDXTMP($J,BSDXI)="0"_$C(30)
    … …  
    124131        Q 0
    125132        ;
    126 RMCI(BSDXY,BSDXAPPTID)  ; EP - Remove Check-in from BSDX APPT and 2/44
     133RMCI(BSDXY,BSDXAPPTID)  ; Private EP - Remove Check-in from BSDX APPT and 2/44
    127134        ; Called by RPC BSDX REMOVE CHECK-IN
    128135        ;
    … …  
    163170        I '$D(^BSDXAPPT(BSDXAPPTID,0)) D ERR("-2~Invalid Appointment ID") QUIT
    164171        ;
     172        ; Lock
     173        ; Timeout not expected to happen except in error conditions.
     174        L +^BSDXAPPT(BSDXAPPTID):5 E  D ERR("-7~Appt record is locked. Please contact technical support.") QUIT
     175        ;
    165176        ; Get appointment Data
    166177        N BSDXNOD S BSDXNOD=^BSDXAPPT(BSDXAPPTID,0)
    … …  
    199210        . N % S %=$$BSDXCHK(BSDXAPPTID,BSDXCDT) ; No error checking here.
    200211        . D ERR("-5~"_$P(BSDXERR,U,2)) ; Send error message to client
    201         ;
     212        ;
     213        ; Unlock
     214        L -^BSDXAPPT(BSDXAPPTID)
     215        ;
    202216        ; Return ADO recordset
    203217        S BSDXI=BSDXI+1
    … …  
    264278        ;
    265279ERR(BSDXERR)    ;Error processing
     280        ; Unlock first
     281        L:$D(BSDXAPPTID) -^BSDXAPPT(BSDXAPPTID)
    266282        ; If last line is $C(31), we are done. No more errors to send to client.
    267283        I ^BSDXTMP($J,$O(^BSDXTMP($J," "),-1))=$C(31) QUIT

  • Scheduling/trunk/m/BSDX26.m

    r1472 r1479  
    1 BSDX26   ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 6/25/12 4:29pm
     1BSDX26   ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/9/12 2:19pm
    22        ;;1.7T1;BSDX;;Jul 06, 2012;Build 18
    33        ; Licensed under LGPL
    … …  
    88        ;
    99        ; Error Reference:
    10         ; -1: Appt ID is not a number
    11         ; -2: Appt IEN is not in ^BSDXAPPT
    12         ; -3: FM Failure to file WP field in ^BSDXAPPT
    13         ; -4: BSDXAPI reports failure to change note field in ^SC
     10        ; 1: Appt ID is not a number
     11        ; 2: Appt IEN is not in ^BSDXAPPT
     12        ; 3: FM Failure to file WP field in ^BSDXAPPT
     13        ; 4: BSDXAPI reports failure to change note field in ^SC
     14        ; 5: Failure to acquire lock on ^BSDXAPPT(APPTID)
     15        ; 100: Mumps Error
     16        ;
     17        ; NB: Normally I use negative numbers for errors; this routine returns
     18        ;     -1 as a successful result! So I needed to use +ve numbers.
    1419        ;
    1520EDITAPTD(BSDXY,BSDXAPTID,BSDXNOTE)       ;EP
    … …  
    4853        ;
    4954        ; Validate Appointment ID
    50         I '+BSDXAPTID D ERR(BSDXI,"-1~BSDX26: Invalid Appointment ID") QUIT
    51         I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR(BSDXI,"-2~BSDX26: Invalid Appointment ID") QUIT
     55        I '+BSDXAPTID D ERR(BSDXI,"1~BSDX26: Invalid Appointment ID") QUIT
     56        I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR(BSDXI,"2~BSDX26: Invalid Appointment ID") QUIT
     57        ;
     58        ; Lock BSDX node, only to synchronize access to the globals.
     59        ; It's not expected that the error will ever happen as no filing
     60        ; is supposed to take 5 seconds.
     61        L +^BSDXAPPT(BSDXAPTID):5 E  D ERR(BSDXI,"5~BSDX08: Appt record is locked. Please contact technical support.") QUIT
    5262        ;
    5363        ; Put the WP in decendant fields from the root to file as a WP field
    … …  
    6575        ;
    6676        ; Error handling. No need for rollback since nothing else changed.
    67         I $D(BSDXMSG) D ERR(BSDXI,"-3~BSDX26: Fileman failure to file data into 9002018.4") QUIT
     77        I $D(BSDXMSG) D ERR(BSDXI,"3~BSDX26: Fileman failure to file data into 9002018.4") QUIT
    6878        ;
    6979        ; Now file in file 44:
    … …  
    7383        N BSDXRES S BSDXRES=0 ; Result
    7484        ; Update Note only if we have a linked hospital location.
    75         I HLIEN S BSDXRES=$$UPDATENT^BSDXAPI(PTIEN,HLIEN,DATE,BSDXNOTE(.5))
     85        I HLIEN S BSDXRES=$$UPDATENT^BSDXAPI1(PTIEN,HLIEN,DATE,BSDXNOTE(.5))
    7686        ; If we get an error (denoted by -1 in BSDXRES), return error to client
    7787        ; AND restore the original note
    78         I BSDXRES<0 D ERR(BSDXI,"-4~BSDX26: BSDXAPI reports an error: "_BSDXRES),ROLLBACK(BSDXAPTID) QUIT
     88        I BSDXRES<0 D ERR(BSDXI,"4~BSDX26: BSDXAPI reports an error: "_BSDXRES),ROLLBACK(BSDXAPTID) QUIT
    7989        ;
    8090        ;Return Recordset indicating success
     91        L -^BSDXAPPT(BSDXAPTID)
    8192        S BSDXI=BSDXI+1
    8293        S ^BSDXTMP($J,BSDXI)="-1"_$C(30)
    … …  
    93104        ;
    94105ERR(BSDXI,BSDXERR)       ;Error processing
     106        ; Unlock first
     107        L:$D(BSDXAPTID) -^BSDXAPPT(BSDXAPTID)
     108        ; If last line is $C(31), we are done. No more errors to send to client.
     109        I ^BSDXTMP($J,$O(^BSDXTMP($J," "),-1))=$C(31) QUIT
    95110        S BSDXI=BSDXI+1
    96111        S BSDXERR=$TR(BSDXERR,"^","~")
    … …  
    103118        N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
    104119        D ^%ZTER
    105         S $EC=""
     120        ;
    106121        I '$D(BSDXI) N BSDXI S BSDXI=0
    107         D ERR(BSDXI,"-100~BSDX26 Error: "_$G(%ZTERZE))
     122        D ERR(BSDXI,"100~BSDX26 Error: "_$G(%ZTERZE))
    108123        QUIT

  • Scheduling/trunk/m/BSDX29.m

    r1472 r1479  
    1 BSDX29  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 6/22/12 1:46pm
     1BSDX29  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/9/12 11:50am
    22        ;;1.7T1;BSDX;;Jul 06, 2012;Build 18
    33        ; Licensed under LGPL
    … …  
    102102        N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap
    103103        D ^%ZTER
    104         S $EC="" ; Clear Error
    105104        QUIT
    106105        ;
    … …  
    153152        ;
    154153ERR(BSDXI,BSDXCNT,BSDXERR)      ;Error processing
     154        ; If last line is $C(31), we are done. No more errors to send to client.
     155        I ^BSDXTMP($J,$O(^BSDXTMP($J," "),-1))=$C(31) QUIT
    155156        S BSDXI=BSDXI+1
    156157        S BSDXERR=$TR(BSDXERR,"^","~")

  • Scheduling/trunk/m/BSDX31.m

    r1472 r1479  
    1 BSDX31   ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 6/27/12 4:57pm
     1BSDX31   ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/9/12 12:57pm
    22        ;;1.7T1;BSDX;;Jul 06, 2012;Build 18
    33        ; Licensed under LGPL
    … …  
    2020        ; -5: Filing of No-show in ^DPT failed (BSDXAPI error)
    2121        ; -6: Invalid Resource ID
     22        ; -7: Lock not acquired on ^BSDXAPPT(BSDXAPTID)
    2223        ; -100: M Error
    2324        ;
    … …  
    7071        I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR(-2,"BSDX31: Invalid Appointment ID") Q
    7172        ;
     73        ; Lock BSDX node, only to synchronize access to the globals.
     74        ; It's not expected that the error will ever happen as no filing
     75        ; is supposed to take 5 seconds.
     76        L +^BSDXAPPT(BSDXAPTID):5 E  D ERR(-7,"BSDX31: Appt record is locked. Please contact technical support.") Q
     77        ;
    7278        ; Noshow value check - Must be 1 or 0
    7379        S BSDXNS=+BSDXNS
    … …  
    113119        . D ERR(-5,"BSDX31: "_$P(BSDXERR,U,2))
    114120        . N % S %=$$BSDXNOS(BSDXAPTID,'BSDXNS) ; no error checking for filer
     121        ;
     122        ; Unlock
     123        L -^BSDXAPPT(BSDXAPTID)
    115124        ;
    116125        ; Return data in ADO.net table
    … …  
    177186        ;
    178187ERR(BSDXERID,ERRTXT)       ;Error processing
     188        ; Unlock first
     189        L:$D(BSDXAPTID) -^BSDXAPPT(BSDXAPTID)
    179190        ; If last line is $C(31), we are done. No more errors to send to client.
    180191        I ^BSDXTMP($J,$O(^BSDXTMP($J," "),-1))=$C(31) QUIT
    … …  
    189200        N $ET S $ET="D ^%ZTER HALT"  ; Emergency Error Trap
    190201        D ^%ZTER
    191         S $EC="" ; Clear Error
     202        ;
    192203        I $G(BSDXAPTID),$D(BSDXNS) N % S %=$$BSDXNOS(BSDXAPTID,'BSDXNS) ; Reverse No-Show status (whatever it was)
    193204        ; Send to client

  • Scheduling/trunk/m/BSDXAPI.m

    r1472 r1479  
    1 BSDXAPI ; IHS/LJF,HMW,MAW & VEN/SMH - SCHEDULING APIs ; 7/6/12 10:24am
     1BSDXAPI ; IHS/LJF,HMW,MAW & VEN/SMH - SCHEDULING APIs ; 7/9/12 4:00pm
    22        ;;1.7T1;BSDX;;Jul 06, 2012;Build 18
    33        ; Licensed under LGPL 
    … …  
    155155        ; If previous data exists, which caused an error, it's destroyed.
    156156        ; NB: ^DIK stops for nobody
     157        ; TODO: If Patient Appointment previously existed as cancelled, it's removed.
     158        ; How can I tell if one previously existed when data is in an intermediate
     159        ; State? Can I restore it if the other file failed? Restoration can cause
     160        ; another error. If I restore the global, there will be cross-references
     161        ; missing (ASDCN specifically).
     162        ;
    157163        ; Input: Same array as $$MAKE
    158164        ; Output: Always 0
    … …  
    422428        Q $S(X=3:"SCHED",X=4:"WALK-IN",1:"??")
    423429        ;
    424 UPDATENT(PAT,CLINIC,DATE,NOTE)  ; PEP; Update Note in ^SC for patient's appointment @ DATE
    425         ; PAT = DFN
    426         ; CLINIC = SC IEN
    427         ; DATE = FM Date/Time of Appointment
    428         ;
    429         ; Returns:
    430         ; 0 if okay
    431         ; -1 if failure
    432         ;
    433         ; ERROR SIMULATION
    434         I $G(BSDXSIMERR1) QUIT "-1~Simulated Error"
    435         ;
    436         N SCIEN S SCIEN=$$SCIEN(PAT,CLINIC,DATE) ; ien of appt in ^SC
    437         I SCIEN<1 QUIT 0    ; Appt cancelled; cancelled appts rm'ed from file 44
    438         N BSDXIENS S BSDXIENS=SCIEN_","_DATE_","_CLINIC_","
    439         N BSDXFDA S BSDXFDA(44.003,BSDXIENS,3)=$E(NOTE,1,150)
    440         N BSDXERR
    441         D FILE^DIE("","BSDXFDA","BSDXERR")
    442         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)
    443         QUIT 0

  • Scheduling/trunk/m/BSDXAPI1.m

    r1472 r1479  
    1 BSDXAPI1        ; VEN/SMH - SCHEDULING APIs - Continued!!! ; 7/6/12 10:23am
     1BSDXAPI1        ; VEN/SMH - SCHEDULING APIs - Continued!!! ; 7/9/12 2:22pm
    22        ;;1.7T1;BSDX;;Jul 06, 2012;Build 18
    33        ; Licensed under LGPL 
    … …  
    4949        ; belong to PIMS, not to the Scheduling GUI. $$MAKE and $$CANCEL now
    5050        ; call the EPs here.
     51        ; Cancel and Remove-Check-in now check to see if the patient is checked-out
     52        ; If the patient is checked out, then we fail to cancel/no-show.
     53        ; UPDATENOTE was renamed to UPDATENT and moved to BSDXAPI1.
    5154        ;
    5255NOSHOW(PAT,CLINIC,DATE,NSFLAG)  ; $$ PEP; No-show Patient at appt date (new in v1.7)

  • Scheduling/trunk/m/BSDXUT1.m

    r1472 r1479  
    1 BSDXUT1 ; VEN/SMH - Unit Tests for Scheduling GUI - cont. ; 7/3/12 12:28pm
     1BSDXUT1 ; VEN/SMH - Unit Tests for Scheduling GUI - cont. ; 7/9/12 12:31pm
    22        ;;1.7T1;BSDX;;Jul 06, 2012;Build 18
    33        ;
    … …  
    266266        N NOTE S NOTE="Nothing important"
    267267        D EDITAPT^BSDX26(.ZZZ,"BLAHBLAH",NOTE)
    268         I +^BSDXTMP($J,1)'=-1 W "ERROR IN -1",!
     268        I +^BSDXTMP($J,1)'=1 W "ERROR IN -1",!
    269269        ;
    270270        ; Test 3: Test Error -2
    271271        ; -2 --> ApptID not in ^BSDXAPPT
    272272        D EDITAPT^BSDX26(.ZZZ,298734322,NOTE)
    273         I +^BSDXTMP($J,1)'=-2 W "ERROR IN -2",!
     273        I +^BSDXTMP($J,1)'=2 W "ERROR IN -2",!
    274274        ;
    275275        ; Test 4: M Error
    276276        N BSDXDIE S BSDXDIE=1
    277277        D EDITAPT^BSDX26(.ZZZ,188,NOTE)
    278         I +^BSDXTMP($J,1)'=-100 W "ERROR IN -100",!
     278        I +^BSDXTMP($J,1)'=100 W "ERROR IN -100",!
    279279        K BSDXDIE
    280280        ; Test 5: Trestart -- retired in v1.7
    … …  
    334334        N NOTE S NOTE="New Note "_%H
    335335        D EDITAPT^BSDX26(.ZZZ,APPID,NOTE)
    336         I +^BSDXTMP($J,1)'=-4 W "Simulated error not triggered",!
     336        I +^BSDXTMP($J,1)'=4 W "Simulated error not triggered",!
    337337        I ^BSDXAPPT(APPID,1,1,0)'=ORIGNOTE W "ERROR 3",!
    338338        I $P(^SC(HLIEN,"S",APPTTIME,1,1,0),U,4)'=ORIGNOTE W "ERROR 4",!

  • Scheduling/trunk/m/BSDXUT2.m

    r1472 r1479  
    1 BSDXUT2 ; VEN/SMH - Unit Tests for Scheduling GUI - cont. ; 7/5/12 11:39am
     1BSDXUT2 ; VEN/SMH - Unit Tests for Scheduling GUI - cont. ; 7/9/12 3:18pm
    22        ;;1.7T1;BSDX;;Jul 06, 2012;Build 18
    33        ;
    44EN      ; Run all unit tests in this routine
    5         D UT25
     5        D UT25,PIMS
    66        QUIT
    77        ;
    … …  
    177177        IF +^BSDXTMP($J,1)'=-100 WRITE "ERROR IN Etest 7",!
    178178        K BSDXDIE
    179         ;
    180         ; Tests for running PIMS by itself.
     179        QUIT
     180        ;
     181PIMS ; Tests for running PIMS by itself.
     182        N $ET S $ET="W ""An Error Occured. Breaking."",! BREAK"
     183        N RESNAM S RESNAM="UTCLINIC"
     184        N HLRESIENS ; holds output of UTCR^BSDXUT - HL IEN^Resource IEN
     185        D
     186        . N $ET S $ET="D ^%ZTER B"
     187        . S HLRESIENS=$$UTCR^BSDXUT(RESNAM)
     188        . I HLRESIENS<0 S $EC=",U1," ; not supposed to happen - hard crash if so
     189        ;
     190        N HLIEN,RESIEN
     191        S HLIEN=$P(HLRESIENS,U)
     192        S RESIEN=$P(HLRESIENS,U,2)
     193        ;
     194        ;
    181195        N APPTTIME S APPTTIME=$$TIMEHL^BSDXUT(HLIEN) ; appt time
    182196        N DFN S DFN=2
     197        ;
     198        ; TEST $$MAKE1^BSDXAPI
    183199        N % S %=$$MAKE1^BSDXAPI(DFN,HLIEN,3,APPTTIME,15,"Sam Test Appt"_DFN)
    184200        I % W "Error in $$MAKE1^BSDXAPI for TIME "_APPTTIME_" for DFN "_DFN,!,%,!
    185201        I '$D(^BSDXAPPT("APAT",DFN,APPTTIME)) W "No BSDX Appointment Created",!
    186         ;TODO: Index doesn't include resource.
    187         N APPTID S APPTID=$O(^(APPTTIME,""))
     202        N RESID S RESID=$O(^(APPTTIME,""))
     203        N APPTID S APPTID=$O(^(RESID,""))
    188204        I 'APPTID W "Can't get appointment",!
    189205        IF $P(^BSDXAPPT(APPTID,0),U,3) WRITE "ERROR IN CHECKIN 3",!
     206        ;
     207        ; TEST CHECKIN1 AND RMCI ^BSDXAPI[1]
    190208        N % S %=$$CHECKIN1^BSDXAPI(DFN,HLIEN,APPTTIME) ; Checkin via PIMS
    191209        I % W "Error in Checking in via BSDXAPI",!
    … …  
    200218        IF '+$G(^SC(HLIEN,"S",APPTTIME,1,1,"C")) WRITE "ERROR IN CHECKIN 14",!
    201219        IF '$P(^BSDXAPPT(APPTID,0),U,3) WRITE "ERROR IN CHECKIN 15",!
     220        ;
     221        ; TEST CANCEL1^BSDXAPI
     222        N APPTTIME S APPTTIME=$$TIMEHL^BSDXUT(HLIEN) ; appt time
     223        N DFN S DFN=2
     224        N % S %=$$MAKE1^BSDXAPI(DFN,HLIEN,3,APPTTIME,15,"Sam Test Appt"_DFN)
     225        I % W "Error in $$MAKE1^BSDXAPI for TIME "_APPTTIME_" for DFN "_DFN,!,%,!
     226        I '$D(^BSDXAPPT("APAT",DFN,APPTTIME)) W "No BSDX Appointment Created",!
     227        N RESID S RESID=$O(^(APPTTIME,""))
     228        N APPTID S APPTID=$O(^(RESID,""))
     229        I 'APPTID W "Can't get appointment",!
     230        N % S %=$$CANCEL1^BSDXAPI(DFN,HLIEN,"PC",APPTTIME,1,"Afraid of Baby Foxes")
     231        I % W "Error cancelling via $$CANCEL1^BSDXAPI",!
     232        I ^BSDXAPPT(APPTID,0) ; Change $R
     233        I '$P(^(0),U,12) W "No cancel date found in BSDXAPPT",!
     234        ; Make same appointment again!
     235        ; NB: Index APAT will have two identical entries, one for the cancelled
     236        ; appointment, and one for the new one. I won't check it for that reason.
     237        N % S %=$$MAKE1^BSDXAPI(DFN,HLIEN,3,APPTTIME,15,"Sam Test Appt"_DFN)
     238        I % W "Error in $$MAKE1^BSDXAPI for TIME "_APPTTIME_" for DFN "_DFN,!,%,!
     239        ;
     240        ; TEST NOSHOW^BSDXAPI1
     241        N APPTTIME S APPTTIME=$$TIMEHL^BSDXUT(HLIEN) ; appt time
     242        N DFN S DFN=3
     243        N % S %=$$MAKE1^BSDXAPI(DFN,HLIEN,3,APPTTIME,15,"Sam Test Appt"_DFN)
     244        I % W "Error in $$MAKE1^BSDXAPI for TIME "_APPTTIME_" for DFN "_DFN,!,%,!
     245        I '$D(^BSDXAPPT("APAT",DFN,APPTTIME)) W "No BSDX Appointment Created",!
     246        N RESID S RESID=$O(^(APPTTIME,""))
     247        N APPTID S APPTID=$O(^(RESID,""))
     248        I 'APPTID W "Can't get appointment",!
     249        ; No show via PIMS
     250        N % S %=$$NOSHOW^BSDXAPI1(DFN,HLIEN,APPTTIME,1)
     251        I % W "Error no-showing via $$NOSHOW^BSDXAPI1",!
     252        I ^BSDXAPPT(APPTID,0) ; Change $R
     253        I '$P(^(0),U,10) W "No-show not present in ^BSDXAPPT",!
     254        ; un-noshow via PIMS
     255        N % S %=$$NOSHOW^BSDXAPI1(DFN,HLIEN,APPTTIME,0)
     256        I % W "Error no-showing via $$NOSHOW^BSDXAPI1",!
     257        I ^BSDXAPPT(APPTID,0) ; Change $R
     258        I $P(^(0),U,10) W "No-show present in ^BSDXAPPT when it shouldn't",!
     259        ;
     260        ; NB: UPDATENT^BSDXAPI is updates the note. Right now, we don't have any
     261        ; way to update the note from BSDXAPI back to ^BSDXAPPT as the protocol
     262        ; file is currently not involved. Right now I can't even find the code
     263        ; that lets you change an appointment note in PIMS.
     264        ;
    202265        QUIT
Note: See TracChangeset for help on using the changeset viewer.