Changeset 1041 for Scheduling/trunk/m/BSDX31.m
- Timestamp:
- Dec 12, 2010, 11:11:57 AM (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
Scheduling/trunk/m/BSDX31.m
r1036 r1041 1 BSDX31 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 12/6/10 8:25am 2 ;;1.42;BSDX;;Sep 29, 2010 3 ; Change Log: 4 ; v1.42 Oct 23 2010 WV/SMH 5 ; - Change transaction to restartable. Thanks to Zach Gonzalez 6 ; --> and Rick Marshall for their help. 7 ; v1.42 Dec 6 2010: Extensive refactoring 8 ; 9 ; Error Reference: 10 ; -1: zero or null Appt ID 11 ; -2: Invalid APPT ID (doesn't exist in ^BSDXAPPT) 12 ; -3: No-show flag is invalid 13 ; -100: M Error 14 ; 15 ; 16 NOSHOWD(BSDXY,BSDXAPTID,BSDXNS) ;EP 17 ;Entry point for debugging 18 ; 19 D DEBUG^%Serenji("NOSHOW^BSDX31(.BSDXY,BSDXAPTID,BSDXNS)") 20 Q 21 ; 22 UT ; Unit Tests 23 ; Test 1: Sanity Check 24 N ZZZ ; Garbage return variable 25 N DATE S DATE=$$NOW^XLFDT() 26 S DATE=$E(DATE,1,12) ; Just get minutes b/c of HL file input transform 27 D APPADD^BSDX07(.ZZZ,DATE,DATE+.0001,3,"Dr Office",30,"Old Note",1) 28 N APPID S APPID=+$P(^BSDXTMP($J,1),U) 29 D NOSHOW(.ZZZ,APPID,1) 30 I $P(^BSDXAPPT(APPID,0),U,10)'=1 W "ERROR T1",! B 31 I $P(^DPT(3,"S",DATE,0),U,2)'="N" W "ERROR T1",! B 32 ; Test 2: Undo noshow 33 D NOSHOW(.ZZZ,APPID,0) 34 I $P(^BSDXAPPT(APPID,0),U,10)'="0" W "ERROR T2",! B 35 I $P(^DPT(3,"S",DATE,0),U,2)'="" W "ERROR T2",! B 36 ; Test 3: -1 37 D NOSHOW(.ZZZ,"",0) 38 I $P(^BSDXTMP($J,1),U)'=-1 W "ERROR T3",! B 39 ; Test 4: -2 40 D NOSHOW(.ZZZ,2938748233,0) 41 I $P(^BSDXTMP($J,1),U)'=-2 W "ERROR T4",! B 42 QUIT 43 NOSHOW(BSDXY,BSDXAPTID,BSDXNS) ;EP - No show a patient 44 ; Called by RPC: BSDX NOSHOW 45 ; Sets appointment noshow flag in BSDX APPOINTMENT file and "S" node in File 2 46 ; 47 ; Parameters: 48 ; BSDXY: Global Return 49 ; BSDXAPTID is entry number in BSDX APPOINTMENT file 50 ; BSDXNS = 1: NOSHOW, 0: CANCEL NOSHO 51 ; 52 ; Returns ADO.net record set with fields 53 ; - ERRORID; ERRORTEXT 54 ; ERRORID of 1 is okay 55 ; Anything else is an error. 56 ; 57 ; Return Array; set and clear 58 S BSDXY=$NA(^BSDXTMP($J)) 59 K ^BSDXTMP($J) 60 ; $ET 61 N $ET S $ET="G ETRAP^BSDX31" 62 ; Basline vars 63 D ^XBKVAR ; Set up baseline variables (DUZ, DUZ(2)) if they don't exist 64 ; Counter 65 N BSDXI S BSDXI=0 66 ; Header Node 67 S ^BSDXTMP($J,BSDXI)="I00020ERRORID^T00030ERRORTEXT"_$C(30) 68 ; Begin transaction 69 TSTART (BSDXI,BSDXY,BSDXAPTID,BSDXNS):T="BSDX NOSHOW CANCEL^BSDX29" 70 ; Turn off SDAM APPT PROTOCOL BSDX Entries 71 N BSDXNOEV S BSDXNOEV=1 ;Don't execute protocol 72 ; Appointment ID check 73 I '+BSDXAPTID D ERR(-1,"BSDX31: Invalid Appointment ID") Q 74 I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR(-2,"BSDX31: Invalid Appointment ID") Q 75 ; Noshow value check - Must be 1 or 0 76 S BSDXNS=+BSDXNS 77 I BSDXNS'=1&(BSDXNS'=0) D ERR(-3,"BSDX31: Invalid No Show value") Q 78 ; Get Some data 79 N BSDXNOD S BSDXNOD=^BSDXAPPT(BSDXAPTID,0) ; Node 80 N BSDXPATID S BSDXPATID=$P(BSDXNOD,U,5) ; DFN 81 N BSDXSTART S BSDXSTART=$P(BSDXNOD,U) ; Start Date/Time 82 ; Edit BSDX APPOINTMENT entry 83 N BSDXMSG ; 84 D BSDXNOS(BSDXAPTID,BSDXNS,.BSDXMSG) ;Edit BSDX APPOINTMENT entry NOSHOW field 85 I $D(BSDXMSG("DIERR")) S BSDXMSG=$G(BSDXMSG("DIERR",1,"TEXT",1)) D ERR(-4,"BSDX31: "_BSDXMSG) Q 86 ; Edit File 2 "S" node entry 87 N BSDXZ,BSDXERR ; Error variables to control looping 88 S BSDXSC1=$P(BSDXNOD,U,7) ;RESOURCEID 89 ; If Resource ID exists, and HL exists (means that Resource is linked), No show in File 2 90 I BSDXSC1]"",$D(^BSDXRES(BSDXSC1,0)) D I $G(BSDXZ)]"" S BSDXERR="BSDX31: APNOSHO Returned: "_BSDXZ D ERR(-5,BSDXERR) Q 91 . S BSDXNOD=^BSDXRES(BSDXSC1,0) 92 . S BSDXSC1=$P(BSDXNOD,U,4) ;HOSPITAL LOCATION 93 . I BSDXSC1]"",$D(^SC(BSDXSC1,0)) D APNOSHO(.BSDXZ,BSDXSC1,BSDXPATID,BSDXSTART,BSDXNS) 94 ; 95 TCOMMIT 96 S BSDXI=BSDXI+1 97 S ^BSDXTMP($J,BSDXI)="1^"_$C(30) ; 1 means everything okay 98 S BSDXI=BSDXI+1 99 S ^BSDXTMP($J,BSDXI)=$C(31) 100 QUIT 101 ; 102 APNOSHO(BSDXZ,BSDXSC1,BSDXDFN,BSDXSD,BSDXNS) ; 103 ; update file 2 info 104 ;Set noshow for patient BSDXDFN in clinic BSDXSC1 105 ;at time BSDXSD 106 N BSDXC,%H,BSDXCDT,BSDXIEN 107 N BSDXIENS,BSDXFDA,BSDXMSG 108 S %H=$H D YMD^%DTC 109 S BSDXCDT=X+% 110 ; 111 S BSDXIENS=BSDXSD_","_BSDXDFN_"," 112 I +BSDXNS D 113 . S BSDXFDA(2.98,BSDXIENS,3)="N" 114 . S BSDXFDA(2.98,BSDXIENS,14)=DUZ 115 . S BSDXFDA(2.98,BSDXIENS,15)=BSDXCDT 116 E D 117 . S BSDXFDA(2.98,BSDXIENS,3)="" 118 . S BSDXFDA(2.98,BSDXIENS,14)="" 119 . S BSDXFDA(2.98,BSDXIENS,15)="" 120 K BSDXIEN 121 D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG") 122 S BSDXZ=$G(BSDXMSG("DIERR",1,"TEXT",1)) 123 Q 124 ; 125 BSDXNOS(BSDXAPTID,BSDXNS,BSDXMSG) ; 126 ; 127 N BSDXFDA,BSDXIENS 128 S BSDXIENS=BSDXAPTID_"," 129 S BSDXFDA(9002018.4,BSDXIENS,.1)=BSDXNS ;NOSHOW 130 D FILE^DIE("","BSDXFDA","BSDXMSG") 131 QUIT 132 ; 133 NOSEVT(BSDXPAT,BSDXSTART,BSDXSC) ;EP Called by BSDX NOSHOW APPOINTMENT event 134 ;when appointments NOSHOW via PIMS interface. 135 ;Propagates NOSHOW to BSDXAPPT and raises refresh event to running GUI clients 136 ; 137 Q:+$G(BSDXNOEV) 138 Q:'+$G(BSDXSC) 139 Q:$G(SDATA("AFTER","STATUS"))["AUTO RE-BOOK" 140 N BSDXSTAT,BSDXFOUND,BSDXRES 141 S BSDXSTAT=1 142 S:$G(SDATA("BEFORE","STATUS"))["NO-SHOW" BSDXSTAT=0 143 S BSDXFOUND=0 144 I $D(^BSDXRES("ALOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ALOC",BSDXSC,0)) S BSDXFOUND=$$NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT) 145 I BSDXFOUND D NOSEVT3(BSDXRES) Q 146 I $D(^BXDXRES("ASSOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ASSOC",BSDXSC,0)) S BSDXFOUND=$$NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT) 147 I BSDXFOUND D NOSEVT3(BSDXRES) 148 Q 149 ; 150 NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT) ; 151 ;Get appointment id in BSDXAPT 152 ;If found, call BSDXNOS(BSDXAPPT) and return 1 153 ;else return 0 154 N BSDXFOUND,BSDXAPPT 155 S BSDXFOUND=0 156 Q:'+$G(BSDXRES) BSDXFOUND 157 Q:'$D(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART)) BSDXFOUND 158 S BSDXAPPT=0 F S BSDXAPPT=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART,BSDXAPPT)) Q:'+BSDXAPPT D Q:BSDXFOUND 159 . S BSDXNOD=$G(^BSDXAPPT(BSDXAPPT,0)) Q:BSDXNOD="" 160 . I $P(BSDXNOD,U,5)=BSDXPAT,$P(BSDXNOD,U,12)="" S BSDXFOUND=1 Q 161 I BSDXFOUND,+$G(BSDXAPPT) D BSDXNOS(BSDXAPPT,BSDXSTAT) 162 Q BSDXFOUND 163 ; 164 NOSEVT3(BSDXRES) ; 165 ;Call RaiseEvent to notify GUI clients 166 ; 167 N BSDXRESN 168 S BSDXRESN=$G(^BSDXRES(BSDXRES,0)) 169 Q:BSDXRESN="" 170 S BSDXRESN=$P(BSDXRESN,"^") 171 D EVENT^BMXMEVN("BSDX SCHEDULE",BSDXRESN) 172 Q 173 ; 174 ; 175 ERR(BSDXERID,ERRTXT) ;Error processing 176 S BSDXI=BSDXI+1 177 TROLLBACK 178 S ^BSDXTMP($J,BSDXI)=BSDXERID_"^"_ERRTXT_$C(30) 179 S BSDXI=BSDXI+1 180 S ^BSDXTMP($J,BSDXI)=$C(31) 181 Q 182 ; 183 ETRAP ;EP Error trap entry 184 D ^%ZTER 185 I '$D(BSDXI) N BSDXI S BSDXI=999999 186 S BSDXI=BSDXI+1 187 D ERR(0,"BSDX31 Error: "_$G(%ZTERROR)) 188 Q 189 ; 190 IMHERE(BSDXRES) ;EP 191 ;Entry point for BSDX IM HERE remote procedure 192 S BSDXRES=1 193 Q 194 ; 1 BSDX31 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 12/6/10 12:39pm 2 ;;1.42;BSDX;;Dec 07, 2010 3 ; Change Log: 4 ; v1.42 Oct 23 2010 WV/SMH 5 ; - Change transaction to restartable. Thanks to Zach Gonzalez 6 ; --> and Rick Marshall for their help. 7 ; v1.42 Dec 6 2010: Extensive refactoring 8 ; 9 ; Error Reference: 10 ; -1: zero or null Appt ID 11 ; -2: Invalid APPT ID (doesn't exist in ^BSDXAPPT) 12 ; -3: No-show flag is invalid 13 ; -4: Filing of No-show in ^BSDXAPPT failed 14 ; -5: Filing of No-show in ^DPT failed (BSDXAPI error) 15 ; -100: M Error 16 ; 17 ; 18 NOSHOWD(BSDXY,BSDXAPTID,BSDXNS) ;EP 19 ;Entry point for debugging 20 ; 21 D DEBUG^%Serenji("NOSHOW^BSDX31(.BSDXY,BSDXAPTID,BSDXNS)") 22 Q 23 ; 24 UT ; Unit Tests 25 ; Test 1: Sanity Check 26 N ZZZ ; Garbage return variable 27 N DATE S DATE=$$NOW^XLFDT() 28 S DATE=$E(DATE,1,12) ; Just get minutes b/c of HL file input transform 29 D APPADD^BSDX07(.ZZZ,DATE,DATE+.0001,3,"Dr Office",30,"Old Note",1) 30 N APPID S APPID=+$P(^BSDXTMP($J,1),U) 31 D NOSHOW(.ZZZ,APPID,1) 32 I $P(^BSDXAPPT(APPID,0),U,10)'=1 W "ERROR T1",! B 33 I $P(^DPT(3,"S",DATE,0),U,2)'="N" W "ERROR T1",! B 34 ; Test 2: Undo noshow 35 D NOSHOW(.ZZZ,APPID,0) 36 I $P(^BSDXAPPT(APPID,0),U,10)'="0" W "ERROR T2",! B 37 I $P(^DPT(3,"S",DATE,0),U,2)'="" W "ERROR T2",! B 38 ; Test 3: -1 39 D NOSHOW(.ZZZ,"",0) 40 I $P(^BSDXTMP($J,1),U)'=-1 W "ERROR T3",! B 41 ; Test 4: -2 42 D NOSHOW(.ZZZ,2938748233,0) 43 I $P(^BSDXTMP($J,1),U)'=-2 W "ERROR T4",! B 44 ; Test 5: -3 45 D NOSHOW(.ZZZ,APPID,3) 46 I $P(^BSDXTMP($J,1),U)'=-3 W "ERROR T5",! B 47 ; Test 6: Mumps error (-100) 48 s bsdxdie=1 49 D NOSHOW(.ZZZ,APPID,1) 50 I $P(^BSDXTMP($J,1),U)'=-100 W "ERROR T6",! B 51 k bsdxdie 52 ; Test 7: Restartable transaction 53 s bsdxrestart=1 54 D NOSHOW(.ZZZ,APPID,1) 55 I $P(^BSDXAPPT(APPID,0),U,10)'=1 W "ERROR T7",! B 56 QUIT 57 NOSHOW(BSDXY,BSDXAPTID,BSDXNS) ;EP - No show a patient 58 ; Called by RPC: BSDX NOSHOW 59 ; Sets appointment noshow flag in BSDX APPOINTMENT file and "S" node in File 2 60 ; 61 ; Parameters: 62 ; BSDXY: Global Return 63 ; BSDXAPTID is entry number in BSDX APPOINTMENT file 64 ; BSDXNS = 1: NOSHOW, 0: CANCEL NOSHO 65 ; 66 ; Returns ADO.net record set with fields 67 ; - ERRORID; ERRORTEXT 68 ; ERRORID of 1 is okay 69 ; Anything else is an error. 70 ; 71 ; Return Array; set and clear 72 S BSDXY=$NA(^BSDXTMP($J)) 73 K ^BSDXTMP($J) 74 ; $ET 75 N $ET S $ET="G ETRAP^BSDX31" 76 ; Basline vars 77 D ^XBKVAR ; Set up baseline variables (DUZ, DUZ(2)) if they don't exist 78 ; Counter 79 N BSDXI S BSDXI=0 80 ; Header Node 81 S ^BSDXTMP($J,BSDXI)="I00100ERRORID^T00030ERRORTEXT"_$C(30) 82 ; Begin transaction 83 TSTART (BSDXI,BSDXY,BSDXAPTID,BSDXNS):T="BSDX NOSHOW CANCEL^BSDX29" 84 ;;;test for error inside transaction. See if %ZTER works 85 I $G(bsdxdie) S X=1/0 86 ;;;TEST 87 ;;;test for TRESTART 88 I $G(bsdxrestart) K bsdxrestart TRESTART 89 ;;;test 90 ; Turn off SDAM APPT PROTOCOL BSDX Entries 91 N BSDXNOEV S BSDXNOEV=1 ;Don't execute protocol 92 ; Appointment ID check 93 I '+BSDXAPTID D ERR(-1,"BSDX31: Invalid Appointment ID") Q 94 I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR(-2,"BSDX31: Invalid Appointment ID") Q 95 ; Noshow value check - Must be 1 or 0 96 S BSDXNS=+BSDXNS 97 I BSDXNS'=1&(BSDXNS'=0) D ERR(-3,"BSDX31: Invalid No Show value") Q 98 ; Get Some data 99 N BSDXNOD S BSDXNOD=^BSDXAPPT(BSDXAPTID,0) ; Node 100 N BSDXPATID S BSDXPATID=$P(BSDXNOD,U,5) ; DFN 101 N BSDXSTART S BSDXSTART=$P(BSDXNOD,U) ; Start Date/Time 102 ; Edit BSDX APPOINTMENT entry 103 N BSDXMSG ; 104 D BSDXNOS(BSDXAPTID,BSDXNS,.BSDXMSG) ;Edit BSDX APPOINTMENT entry NOSHOW field 105 I $D(BSDXMSG("DIERR")) S BSDXMSG=$G(BSDXMSG("DIERR",1,"TEXT",1)) D ERR(-4,"BSDX31: "_BSDXMSG) Q 106 ; Edit File 2 "S" node entry 107 N BSDXZ,BSDXERR ; Error variables to control looping 108 S BSDXSC1=$P(BSDXNOD,U,7) ;RESOURCEID 109 ; If Resource ID exists, and HL exists (means that Resource is linked), No show in File 2 110 I BSDXSC1]"",$D(^BSDXRES(BSDXSC1,0)) D I $G(BSDXZ)]"" S BSDXERR="BSDX31: APNOSHO Returned: "_BSDXZ D ERR(-5,BSDXERR) Q 111 . S BSDXNOD=^BSDXRES(BSDXSC1,0) 112 . S BSDXSC1=$P(BSDXNOD,U,4) ;HOSPITAL LOCATION 113 . I BSDXSC1]"",$D(^SC(BSDXSC1,0)) D APNOSHO(.BSDXZ,BSDXSC1,BSDXPATID,BSDXSTART,BSDXNS) 114 ; 115 TCOMMIT 116 S BSDXI=BSDXI+1 117 S ^BSDXTMP($J,BSDXI)="1^"_$C(30) ; 1 means everything okay 118 S BSDXI=BSDXI+1 119 S ^BSDXTMP($J,BSDXI)=$C(31) 120 QUIT 121 ; 122 APNOSHO(BSDXZ,BSDXSC1,BSDXDFN,BSDXSD,BSDXNS) ; 123 ; update file 2 info 124 ;Set noshow for patient BSDXDFN in clinic BSDXSC1 125 ;at time BSDXSD 126 N BSDXC,%H,BSDXCDT,BSDXIEN 127 N BSDXIENS,BSDXFDA,BSDXMSG 128 S %H=$H D YMD^%DTC 129 S BSDXCDT=X+% 130 ; 131 S BSDXIENS=BSDXSD_","_BSDXDFN_"," 132 I +BSDXNS D 133 . S BSDXFDA(2.98,BSDXIENS,3)="N" 134 . S BSDXFDA(2.98,BSDXIENS,14)=DUZ 135 . S BSDXFDA(2.98,BSDXIENS,15)=BSDXCDT 136 E D 137 . S BSDXFDA(2.98,BSDXIENS,3)="" 138 . S BSDXFDA(2.98,BSDXIENS,14)="" 139 . S BSDXFDA(2.98,BSDXIENS,15)="" 140 K BSDXIEN 141 D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG") 142 S BSDXZ=$G(BSDXMSG("DIERR",1,"TEXT",1)) 143 Q 144 ; 145 BSDXNOS(BSDXAPTID,BSDXNS,BSDXMSG) ; 146 ; 147 N BSDXFDA,BSDXIENS 148 S BSDXIENS=BSDXAPTID_"," 149 S BSDXFDA(9002018.4,BSDXIENS,.1)=BSDXNS ;NOSHOW 150 D FILE^DIE("","BSDXFDA","BSDXMSG") 151 QUIT 152 ; 153 NOSEVT(BSDXPAT,BSDXSTART,BSDXSC) ;EP Called by BSDX NOSHOW APPOINTMENT event 154 ;when appointments NOSHOW via PIMS interface. 155 ;Propagates NOSHOW to BSDXAPPT and raises refresh event to running GUI clients 156 ; 157 Q:+$G(BSDXNOEV) 158 Q:'+$G(BSDXSC) 159 Q:$G(SDATA("AFTER","STATUS"))["AUTO RE-BOOK" 160 N BSDXSTAT,BSDXFOUND,BSDXRES 161 S BSDXSTAT=1 162 S:$G(SDATA("BEFORE","STATUS"))["NO-SHOW" BSDXSTAT=0 163 S BSDXFOUND=0 164 I $D(^BSDXRES("ALOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ALOC",BSDXSC,0)) S BSDXFOUND=$$NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT) 165 I BSDXFOUND D NOSEVT3(BSDXRES) Q 166 I $D(^BXDXRES("ASSOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ASSOC",BSDXSC,0)) S BSDXFOUND=$$NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT) 167 I BSDXFOUND D NOSEVT3(BSDXRES) 168 Q 169 ; 170 NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT) ; 171 ;Get appointment id in BSDXAPT 172 ;If found, call BSDXNOS(BSDXAPPT) and return 1 173 ;else return 0 174 N BSDXFOUND,BSDXAPPT 175 S BSDXFOUND=0 176 Q:'+$G(BSDXRES) BSDXFOUND 177 Q:'$D(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART)) BSDXFOUND 178 S BSDXAPPT=0 F S BSDXAPPT=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART,BSDXAPPT)) Q:'+BSDXAPPT D Q:BSDXFOUND 179 . S BSDXNOD=$G(^BSDXAPPT(BSDXAPPT,0)) Q:BSDXNOD="" 180 . I $P(BSDXNOD,U,5)=BSDXPAT,$P(BSDXNOD,U,12)="" S BSDXFOUND=1 Q 181 I BSDXFOUND,+$G(BSDXAPPT) D BSDXNOS(BSDXAPPT,BSDXSTAT) 182 Q BSDXFOUND 183 ; 184 NOSEVT3(BSDXRES) ; 185 ;Call RaiseEvent to notify GUI clients 186 ; 187 N BSDXRESN 188 S BSDXRESN=$G(^BSDXRES(BSDXRES,0)) 189 Q:BSDXRESN="" 190 S BSDXRESN=$P(BSDXRESN,"^") 191 D EVENT^BMXMEVN("BSDX SCHEDULE",BSDXRESN) 192 Q 193 ; 194 ; 195 ERR(BSDXERID,ERRTXT) ;Error processing 196 S BSDXI=BSDXI+1 197 S ERRTXT=$TR(ERRTXT,"^","~") 198 I $TL>0 TROLLBACK 199 S ^BSDXTMP($J,BSDXI)=BSDXERID_"^"_ERRTXT_$C(30) 200 S BSDXI=BSDXI+1 201 S ^BSDXTMP($J,BSDXI)=$C(31) 202 QUIT 203 ; 204 ETRAP ;EP Error trap entry 205 N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap 206 ; Rollback, otherwise ^XTER will be empty from future rollback 207 I $TL>0 TROLLBACK 208 D ^%ZTER 209 S $EC="" ; Clear Error 210 ; Send to client 211 I '$D(BSDXI) N BSDXI S BSDXI=0 212 D ERR(-100,"BSDX31 Error: "_$G(%ZTERZE)) 213 QUIT 214 ; 215 IMHERE(BSDXRES) ;EP 216 ;Entry point for BSDX IM HERE remote procedure 217 S BSDXRES=1 218 Q 219 ;
Note:
See TracChangeset
for help on using the changeset viewer.