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