Changeset 1113 for Scheduling/trunk/m/BSDX25.m
- Timestamp:
- Mar 27, 2011, 1:33:30 AM (14 years ago)
- 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:57pm1 BSDX25 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 3/15/11 8:15pm 2 2 ;;1.5V2;BSDX;;Mar 03, 2011 3 3 ; … … 10 10 ; 11 11 ;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 ENDBG13 12 Q 14 13 ; … … 30 29 ; - 0 if all okay 31 30 ; - Another number or text if not 32 ENDBG ; 31 33 32 N BSDXNOD,BSDXPATID,BSDXSTART,DIK,DA,BSDXID,BSDXI,BSDXZ,BSDXIENS,BSDXVEN 34 33 N BSDXNOEV … … 80 79 Q 81 80 ; 81 RMCI(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 ; 82 138 CHKEVT(BSDXPAT,BSDXSTART,BSDXSC) ;EP Called by BSDX CHECKIN APPOINTMENT event 83 139 ;when appointments CHECKIN via PIMS interface. … … 122 178 ; 123 179 ERROR ; 124 D ERR(" RPMSError")180 D ERR("-20~Mumps Error") 125 181 Q 126 182 ; 127 ERR( ERRNO) ;Error processing128 I +ERRNO S BSDXERR=ERRNO+134234112 ;vbObjectError129 E S BSDXERR=ERRNO183 ERR(BSDXERR) ;Error processing 184 I $TLEVEL>0 TROLLBACK 185 S BSDXERR=$TEXT(+0)_":"_$GET(BSDXERR) ; Append Routine Name 130 186 S BSDXI=BSDXI+1 131 187 S ^BSDXTMP($J,BSDXI)=BSDXERR_$C(30) 132 188 S BSDXI=BSDXI+1 133 189 S ^BSDXTMP($J,BSDXI)=$C(31) 134 Q 190 QUIT
Note:
See TracChangeset
for help on using the changeset viewer.