Ignore:
Timestamp:
Mar 27, 2011, 1:33:30 AM (14 years ago)
Author:
Sam Habiel
Message:

Added EP for RPC to remove check-in

File:
1 edited

Legend:

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

    r1100 r1113  
    1 BSDX25  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 1/6/11 1:57pm
     1BSDX25  ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 3/15/11 8:15pm
    22        ;;1.5V2;BSDX;;Mar 03, 2011
    33           ;
     
    1010        ;
    1111        ;I +$G(^BSDXDBUG("BREAK","CHECKIN")),+$G(^BSDXDBUG("BREAK"))=DUZ D DEBUG^%Serenji("CHECKIN^BSDX25(.BSDXY,BSDXAPTID,BSDXCDT,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG)",$P(^BSDXDBUG("BREAK"),U,2))
    12         ;E  G ENDBG
    1312        Q
    1413        ;
     
    3029           ; - 0 if all okay
    3130           ; - Another number or text if not
    32 ENDBG   ;
     31       
    3332        N BSDXNOD,BSDXPATID,BSDXSTART,DIK,DA,BSDXID,BSDXI,BSDXZ,BSDXIENS,BSDXVEN
    3433        N BSDXNOEV
     
    8079        Q
    8180        ;
     81RMCI(BSDXY,BSDXAPPTID) ; EP - Remove Check-in from BSDX APPT and 2/44
     82        ; Called by RPC [Fill in later]
     83        ;
     84        ; Parameters to pass:
     85        ; APPTID: IEN in file BSDX APPOINTMENT
     86        ;
     87        ; Return in global array:
     88        ; Record set with Column ERRORID; value of 0 AOK; other value
     89        ;  --> means that something went wrong
     90        ;
     91        N BSDXNOEV S BSDXNOEV=1 ;Don't execute protocol
     92        ;
     93        N $ET S $ET="G ERROR^BSDX25" ; Error Trap
     94        ;
     95        ; Set return variable and kill contents
     96        N BSDXY S BSDXY=$NAME(^BSDXTMP($J))
     97        K @BSDXY
     98        ;
     99        N BSDXI S BSDXI=0 ; Initialize Counter
     100        ;
     101        S ^BSDXTMP($J,BSDXI)="T00020ERRORID"_$C(30) ; Header of ADO recordset
     102        ;
     103        TSTART ():SERIAL ; Perform Autolocking
     104        ;
     105        ; Check for Appointment ID (passed and exists in file)
     106        I '+BSDXAPTID D ERR("1~Invalid Appointment ID") QUIT
     107        I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR("2~Invalid Appointment ID") QUIT
     108        ;
     109        ; Remove checkin from BSDX APPOINTMENT entry
     110        D BSDXCHK(BSDXAPTID,"@")
     111        ;
     112        ; Now, remove checkin from PIMS files 2/44
     113        N BSDXNOD S BSDXNOD=^BSDXAPPT(BSDXAPTID,0)
     114        N BSDXPATID S BSDXPATID=$P(BSDXNOD,U,5) ; DFN
     115        N BSDXSTART S BSDXSTART=$P(BSDXNOD,U)   ; Start Date
     116        N BSDXSC1 S BSDXSC1=$P(BSDXNOD,U,7) ; Resource ID
     117        ;
     118        ; If the resource doesn't exist, error out. DB is corrupt.
     119        I BSDXSC1]"" D ERR("3~DB has corruption. Call Tech Support.") QUIT
     120        I $D(^BSDXRES(BSDXSC1,0)) D ERR("4~DB has corruption. Call Tech Support.") QUIT
     121        ;
     122        N BSDXNOD S BSDXNOD=^BSDXRES(BSDXSC1,0) ; Resource 0 node
     123        S BSDXSC1=$P(BSDXNOD,U,4) ;HOSPITAL LOCATION
     124        ;
     125        N BSDXZ ; Scratch variable to hold error message
     126        I BSDXSC1]"",$D(^SC(BSDXSC1,0)) S BSDXZ=$$RMCI^BSDXAPI(BSDXPAT,BSDXSC1,BSDXSTART)
     127        I +$G(BSDXZ) D ERR("5~"_$P(BSDXZ,U,2)) QUIT
     128        ;
     129        TCOMMIT  ; Save Data into Globals
     130        ;
     131        ; Return ADO recordset
     132        S BSDXI=BSDXI+1
     133        S ^BSDXTMP($J,BSDXI)="0"_$C(30)
     134        S BSDXI=BSDXI+1
     135        S ^BSDXTMP($J,BSDXI)=$C(31)
     136        Q
     137        ;
    82138CHKEVT(BSDXPAT,BSDXSTART,BSDXSC)        ;EP Called by BSDX CHECKIN APPOINTMENT event
    83139        ;when appointments CHECKIN via PIMS interface.
     
    122178        ;
    123179ERROR   ;
    124         D ERR("RPMS Error")
     180        D ERR("-20~Mumps Error")
    125181        Q
    126182        ;
    127 ERR(ERRNO)      ;Error processing
    128         I +ERRNO S BSDXERR=ERRNO+134234112 ;vbObjectError
    129         E  S BSDXERR=ERRNO
     183ERR(BSDXERR)    ;Error processing
     184        I $TLEVEL>0 TROLLBACK
     185        S BSDXERR=$TEXT(+0)_":"_$GET(BSDXERR) ; Append Routine Name
    130186        S BSDXI=BSDXI+1
    131187        S ^BSDXTMP($J,BSDXI)=BSDXERR_$C(30)
    132188        S BSDXI=BSDXI+1
    133189        S ^BSDXTMP($J,BSDXI)=$C(31)
    134         Q
     190        QUIT
Note: See TracChangeset for help on using the changeset viewer.