Changeset 1036 for Scheduling/trunk/m/BSDX31.m
- Timestamp:
- Dec 8, 2010, 1:44:40 AM (14 years ago)
- File:
-
- 1 edited
-
Scheduling/trunk/m/BSDX31.m (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
Scheduling/trunk/m/BSDX31.m
r968 r1036 1 BSDX31 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 2 ;;1.41;BSDX;;Sep 29, 2010 3 ; 4 ; 5 NOSHOWD(BSDXY,BSDXAPTID,BSDXNS) ;EP 6 ;Entry point for debugging 7 ; 8 ;D DEBUG^%Serenji("NOSHOW^BSDX31(.BSDXY,BSDXAPTID,BSDXNS)") 9 Q 10 ; 11 NOSHOW(BSDXY,BSDXAPTID,BSDXNS) ;EP 12 ;Called by BSDX NOSHOW 13 ;Sets appointment noshow flag in BSDX APPOINTMENT file 14 ;BSDXAPTID is entry number in BSDX APPOINTMENT file 15 ;BSDXNS = 1: NOSHOW, 0: CANCEL NOSHO 16 ;Calls CANCEL^BSDAPI to set noshow data in ^DPT 17 ;Returns error code in recordset field ERRORID 18 ; 19 N BSDXNOD,BSDXPATID,BSDXSTART,BSDXID,BSDXI,BSDXZ,BSDXERR,BSDXMSG,BSDXFDA,BSDXIENS 20 N BSDXNOEV 21 S BSDXNOEV=1 ;Don't execute protocol 22 ; 23 D ^XBKVAR S X="ETRAP^BSDX31",@^%ZOSF("TRAP") 24 S BSDXI=0 25 K ^BSDXTMP($J) 26 S BSDXY="^BSDXTMP("_$J_")" 27 S ^BSDXTMP($J,BSDXI)="I00020ERRORID^T00030ERRORTEXT"_$C(30) 28 S BSDXI=BSDXI+1 29 TSTART 30 I '+BSDXAPTID D ERR(0,"BSDX31: Invalid Appointment ID") Q 31 I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR(0,"BSDX31: Invalid Appointment ID") Q 32 S BSDXNS=+BSDXNS 33 I BSDXNS'=1&(BSDXNS'=0) D ERR(0,"BSDX31: Invalid No Show value") Q 34 ; 35 ;Edit BSDX APPOINTMENT entry NOSHOW field 36 S BSDXNOD=^BSDXAPPT(BSDXAPTID,0) 37 I BSDXNOD="" D ERR(0,"BSDX31: Invalid Appointment ID") Q 38 S BSDXPATID=$P(BSDXNOD,U,5) 39 S BSDXSTART=$P(BSDXNOD,U) 40 ; 41 D BSDXNOS(BSDXAPTID,BSDXNS) 42 I $D(BSDXMSG("DIERR")) S BSDXMSG=$G(BSDXMSG("DIERR",1,"TEXT",1)) D ERR(0,"BSDX31: "_BSDXMSG) Q 43 ; 44 S BSDXSC1=$P(BSDXNOD,U,7) ;RESOURCEID 45 I BSDXSC1]"",$D(^BSDXRES(BSDXSC1,0)) D I $G(BSDXZ)]"" S BSDXERR="BSDX31: APNOSHO Returned: "_BSDXZ D ERR(0,BSDXERR) Q 46 . S BSDXNOD=^BSDXRES(BSDXSC1,0) 47 . S BSDXSC1=$P(BSDXNOD,U,4) ;HOSPITAL LOCATION 48 . I BSDXSC1]"",$D(^SC(BSDXSC1,0)) D APNOSHO(.BSDXZ,BSDXSC1,BSDXPATID,BSDXSTART,BSDXNS) 49 ; 50 TCOMMIT 51 S BSDXI=BSDXI+1 52 S ^BSDXTMP($J,BSDXI)="1^"_$C(30) 53 S BSDXI=BSDXI+1 54 S ^BSDXTMP($J,BSDXI)=$C(31) 55 Q 56 ; 57 APNOSHO(BSDXZ,BSDXSC1,BSDXDFN,BSDXSD,BSDXNS) ; 58 ; update file 2 info 59 ;Set noshow for patient BSDXDFN in clinic BSDXSC1 60 ;at time BSDXSD 61 N BSDXC,%H,BSDXCDT,BSDXIEN 62 N BSDXIENS,BSDXFDA,BSDXMSG 63 S %H=$H D YMD^%DTC 64 S BSDXCDT=X+% 65 ; 66 S BSDXIENS=BSDXSD_","_BSDXDFN_"," 67 I +BSDXNS D 68 . S BSDXFDA(2.98,BSDXIENS,3)="N" 69 . S BSDXFDA(2.98,BSDXIENS,14)=DUZ 70 . S BSDXFDA(2.98,BSDXIENS,15)=BSDXCDT 71 E D 72 . S BSDXFDA(2.98,BSDXIENS,3)="" 73 . S BSDXFDA(2.98,BSDXIENS,14)="" 74 . S BSDXFDA(2.98,BSDXIENS,15)="" 75 K BSDXIEN 76 D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG") 77 S BSDXZ=$G(BSDXMSG("DIERR",1,"TEXT",1)) 78 Q 79 ; 80 BSDXNOS(BSDXAPTID,BSDXNS) ; 81 ; 82 N BSDXFDA,BSDXIENS 83 S BSDXIENS=BSDXAPTID_"," 84 S BSDXFDA(9002018.4,BSDXIENS,.1)=BSDXNS ;NOSHOW 85 D FILE^DIE("","BSDXFDA","BSDXMSG") 86 ; 87 Q 88 ; 89 NOSEVT(BSDXPAT,BSDXSTART,BSDXSC) ;EP Called by BSDX NOSHOW APPOINTMENT event 90 ;when appointments NOSHOW via PIMS interface. 91 ;Propagates NOSHOW to BSDXAPPT and raises refresh event to running GUI clients 92 ; 93 Q:+$G(BSDXNOEV) 94 Q:'+$G(BSDXSC) 95 Q:$G(SDATA("AFTER","STATUS"))["AUTO RE-BOOK" 96 N BSDXSTAT,BSDXFOUND,BSDXRES 97 S BSDXSTAT=1 98 S:$G(SDATA("BEFORE","STATUS"))["NO-SHOW" BSDXSTAT=0 99 S BSDXFOUND=0 100 I $D(^BSDXRES("ALOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ALOC",BSDXSC,0)) S BSDXFOUND=$$NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT) 101 I BSDXFOUND D NOSEVT3(BSDXRES) Q 102 I $D(^BXDXRES("ASSOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ASSOC",BSDXSC,0)) S BSDXFOUND=$$NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT) 103 I BSDXFOUND D NOSEVT3(BSDXRES) 104 Q 105 ; 106 NOSEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT) ; 107 ;Get appointment id in BSDXAPT 108 ;If found, call BSDXNOS(BSDXAPPT) and return 1 109 ;else return 0 110 N BSDXFOUND,BSDXAPPT 111 S BSDXFOUND=0 112 Q:'+$G(BSDXRES) BSDXFOUND 113 Q:'$D(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART)) BSDXFOUND 114 S BSDXAPPT=0 F S BSDXAPPT=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART,BSDXAPPT)) Q:'+BSDXAPPT D Q:BSDXFOUND 115 . S BSDXNOD=$G(^BSDXAPPT(BSDXAPPT,0)) Q:BSDXNOD="" 116 . I $P(BSDXNOD,U,5)=BSDXPAT,$P(BSDXNOD,U,12)="" S BSDXFOUND=1 Q 117 I BSDXFOUND,+$G(BSDXAPPT) D BSDXNOS(BSDXAPPT,BSDXSTAT) 118 Q BSDXFOUND 119 ; 120 NOSEVT3(BSDXRES) ; 121 ;Call RaiseEvent to notify GUI clients 122 ; 123 N BSDXRESN 124 S BSDXRESN=$G(^BSDXRES(BSDXRES,0)) 125 Q:BSDXRESN="" 126 S BSDXRESN=$P(BSDXRESN,"^") 127 D EVENT^BMXMEVN("BSDX SCHEDULE",BSDXRESN) 128 Q 129 ; 130 ; 131 ERR(BSDXERID,ERRTXT) ;Error processing 132 S:'+$G(BSDXI) BSDXI=999999 133 S BSDXI=BSDXI+1 134 TROLLBACK 135 S ^BSDXTMP($J,BSDXI)=BSDXERID_"^"_ERRTXT_$C(30) 136 S BSDXI=BSDXI+1 137 S ^BSDXTMP($J,BSDXI)=$C(31) 138 Q 139 ; 140 ETRAP ;EP Error trap entry 141 D ^%ZTER 142 I '$D(BSDXI) N BSDXI S BSDXI=999999 143 S BSDXI=BSDXI+1 144 D ERR(0,"BSDX31 Error: "_$G(%ZTERROR)) 145 Q 146 ; 147 IMHERE(BSDXRES) ;EP 148 ;Entry point for BSDX IM HERE remote procedure 149 S BSDXRES=1 150 Q 151 ; 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 ;
Note:
See TracChangeset
for help on using the changeset viewer.
