Changeset 1461 for Scheduling/trunk/m/BSDX31.m
- Timestamp:
- Jun 26, 2012, 8:01:30 PM (12 years ago)
- File:
-
- 1 edited
-
Scheduling/trunk/m/BSDX31.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
Scheduling/trunk/m/BSDX31.m
r1187 r1461 1 BSDX31 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:28am 2 ;;1.6T2;BSDX;;May 16, 2011 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 ; 6/26/12 4:35pm 2 ;;1.7T1;BSDX;;Aug 31, 2011;Build 18 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 ; 13 ; Error Reference: 14 ; -1: zero or null Appt ID 15 ; -2: Invalid APPT ID (doesn't exist in ^BSDXAPPT) 16 ; -3: No-show flag is invalid 17 ; -4: Filing of No-show in ^BSDXAPPT failed 18 ; -5: Filing of No-show in ^DPT failed (BSDXAPI error) 19 ; -6: Invalid Resource ID 20 ; -100: M Error 21 ; 22 ; 19 23 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 24 ;Entry point for debugging 25 ; 26 ; D DEBUG^%Serenji("NOSHOW^BSDX31(.BSDXY,BSDXAPTID,BSDXNS)") 27 Q 28 ; 58 29 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 ; 30 ; Called by RPC: BSDX NOSHOW 31 ; Sets appointment noshow flag in BSDX APPOINTMENT file and "S" node in File 2 32 ; 33 ; Parameters: 34 ; BSDXY: Global Return 35 ; BSDXAPTID is entry number in BSDX APPOINTMENT file 36 ; BSDXNS = 1: NOSHOW, 0: CANCEL NOSHO 37 ; 38 ; Returns ADO.net record set with fields 39 ; - ERRORID; ERRORTEXT 40 ; ERRORID of 1 is okay 41 ; Anything else is an error. 42 ; 43 ; Return Array; set and clear 44 S BSDXY=$NA(^BSDXTMP($J)) 45 K ^BSDXTMP($J) 46 ; 47 ; $ET 48 N $ET S $ET="G ETRAP^BSDX31" 49 ; 50 ; Basline vars 51 D ^XBKVAR ; Set up baseline variables (DUZ, DUZ(2)) if they don't exist 52 ; 53 ; Counter 54 N BSDXI S BSDXI=0 55 ; 56 ; Header Node 57 S ^BSDXTMP($J,BSDXI)="I00100ERRORID^T00030ERRORTEXT"_$C(30) 58 ; 59 ;;;test for error. See if %ZTER works 60 I $G(BSDXDIE) N X S X=1/0 61 ;;;TEST 62 ; 63 ; Turn off SDAM APPT PROTOCOL BSDX Entries 64 N BSDXNOEV S BSDXNOEV=1 ;Don't execute protocol 65 ; 66 ; Appointment ID check 67 I '+BSDXAPTID D ERR(-1,"BSDX31: Invalid Appointment ID") Q 68 I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR(-2,"BSDX31: Invalid Appointment ID") Q 69 ; 70 ; Noshow value check - Must be 1 or 0 71 S BSDXNS=+BSDXNS 72 I BSDXNS'=1&(BSDXNS'=0) D ERR(-3,"BSDX31: Invalid No Show value") Q 73 ; 74 ; Get Some data 75 N BSDXNOD S BSDXNOD=^BSDXAPPT(BSDXAPTID,0) ; Node 76 N BSDXPATID S BSDXPATID=$P(BSDXNOD,U,5) ; DFN 77 N BSDXSTART S BSDXSTART=$P(BSDXNOD,U) ; Start Date/Time 78 N BSDXRES S BSDXRES=$P(BSDXNOD,U,7) ; Resource ID 79 ; 80 ; Check if Resource ID is missing or invalid 81 I BSDXRES="" D ERR(-6,"BSDX31: Invalid Resource") QUIT 82 I '$D(^BSDXRES(BSDXRES,0)) D ERR(-6,"BSDX31: Invalid Resource") QUIT 83 ; 84 ; Get the Hospital Location 85 N BSDXRESNOD S BSDXRESNOD=^BSDXRES(BSDXRES,0) 86 N BSDXLOC S BSDXLOC=$P(BSDXRESNOD,U,4) ;HOSPITAL LOCATION 87 I '$D(^SC(BSDXLOC,0)) S BSDXLOC="" ; Unlink it if it doesn't exist 88 ; I can go and then delete it from BSDXLOC like Mailman code which tries 89 ; to be too helpful... but I will postpone that until this is need it. 90 ; 91 ; Edit BSDX APPOINTMENT entry 92 N BSDXMSG S BSDXMSG=$$BSDXNOS(BSDXAPTID,BSDXNS) ;Edit BSDX APPOINTMENT entry NOSHOW field 93 I BSDXMSG D ERR(-4,"BSDX31: "_$P(BSDXMSG,U,2)) QUIT 94 ; 95 ; Edit File 2 "S" node entry 96 N BSDXERR ; Error variable 97 ; If HL exist, (resource is linked to PIMS), file no show in File 2 98 I BSDXLOC S BSDXERR=$$NOSHOW^BSDXAPI1(BSDXPATID,BSDXLOC,BSDXSTART,BSDXNS) 99 I BSDXERR D ERR(-5,"BSDX31: "_$P(BSDXERR,U,2)) QUIT 100 ; 101 S BSDXI=BSDXI+1 102 S ^BSDXTMP($J,BSDXI)="1^"_$C(30) ; 1 means everything okay 103 S BSDXI=BSDXI+1 104 S ^BSDXTMP($J,BSDXI)=$C(31) 105 QUIT 106 ; 107 BSDXNOS(BSDXAPTID,BSDXNS) ; $$ Private; File/unfile noshow in ^BSDXAPPT 108 N BSDXFDA,BSDXIENS,BSDXMSG 109 S BSDXIENS=BSDXAPTID_"," 110 S BSDXFDA(9002018.4,BSDXIENS,.1)=BSDXNS ;NOSHOW 111 D FILE^DIE("","BSDXFDA","BSDXMSG") 112 QUIT:$D(BSDXMSG) -1_U_BSDXMSG("DIERR",1,"TEXT",1) 113 QUIT 0 114 ; 154 115 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 116 ;when appointments NOSHOW via PIMS interface. 117 ;Propagates NOSHOW to BSDXAPPT and raises refresh event to running GUI clients 118 ; 119 Q:+$G(BSDXNOEV) 120 Q:'+$G(BSDXSC) 121 Q:$G(SDATA("AFTER","STATUS"))["AUTO RE-BOOK" 122 N BSDXSTAT,BSDXFOUND,BSDXRES 123 S BSDXSTAT=1 124 S:$G(SDATA("BEFORE","STATUS"))["NO-SHOW" BSDXSTAT=0 125 S BSDXFOUND=0 126 I $D(^BSDXRES("ALOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ALOC",BSDXSC,0)) S BSDXFOUND=$$NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT) 127 I BSDXFOUND D NOSEVT3(BSDXRES) Q 128 I $D(^BXDXRES("ASSOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ASSOC",BSDXSC,0)) S BSDXFOUND=$$NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT) 129 I BSDXFOUND D NOSEVT3(BSDXRES) 130 Q 131 ; 171 132 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 ; 133 ;Get appointment id in BSDXAPT 134 ;If found, call BSDXNOS(BSDXAPPT) and return 1 135 ;else return 0 136 N BSDXFOUND,BSDXAPPT,BSDXNOD 137 S BSDXFOUND=0 138 Q:'+$G(BSDXRES) BSDXFOUND 139 Q:'$D(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART)) BSDXFOUND 140 S BSDXAPPT=0 F S BSDXAPPT=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART,BSDXAPPT)) Q:'+BSDXAPPT D Q:BSDXFOUND 141 . S BSDXNOD=$G(^BSDXAPPT(BSDXAPPT,0)) Q:BSDXNOD="" 142 . I $P(BSDXNOD,U,5)=BSDXPAT,$P(BSDXNOD,U,12)="" S BSDXFOUND=1 Q 143 I BSDXFOUND,+$G(BSDXAPPT) N BSDXMSG S BSDXMSG=$$BSDXNOS(BSDXAPPT,BSDXSTAT) 144 I BSDXMSG D ^%ZTER ; Last ditch error handling. This is supposed to be silently called from the protocol file. 145 Q BSDXFOUND 146 ; 185 147 NOSEVT3(BSDXRES) ; 186 187 188 189 190 191 192 193 194 195 148 ;Call RaiseEvent to notify GUI clients 149 ; 150 N BSDXRESN 151 S BSDXRESN=$G(^BSDXRES(BSDXRES,0)) 152 Q:BSDXRESN="" 153 S BSDXRESN=$P(BSDXRESN,"^") 154 D EVENT^BMXMEVN("BSDX SCHEDULE",BSDXRESN) 155 Q 156 ; 157 ; 196 158 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 ; 159 S BSDXI=BSDXI+1 160 S ERRTXT=$TR(ERRTXT,"^","~") 161 S ^BSDXTMP($J,BSDXI)=BSDXERID_"^"_ERRTXT_$C(30) 162 S BSDXI=BSDXI+1 163 S ^BSDXTMP($J,BSDXI)=$C(31) 164 QUIT 165 ; 205 166 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 ; 167 N $ET S $ET="D ^%ZTER HALT" ; Emergency Error Trap 168 I $G(BSDXAPTID),$D(BSDXNS) N % S %=$$BSDXNOS(BSDXAPTID,'BSDXNS) ; Reverse No-Show status (whatever it was) 169 D ^%ZTER 170 S $EC="" ; Clear Error 171 ; Send to client 172 I '$D(BSDXI) N BSDXI S BSDXI=0 173 D ERR(-100,"BSDX31 Error: "_$G(%ZTERZE)) 174 QUIT 175 ; 216 176 IMHERE(BSDXRES) ;EP 217 218 219 220 177 ;Entry point for BSDX IM HERE remote procedure 178 S BSDXRES=1 179 Q 180 ;
Note:
See TracChangeset
for help on using the changeset viewer.
