source: Scheduling/trunk/m/BSDX25.m@ 963

Last change on this file since 963 was 951, checked in by Sam Habiel, 14 years ago

Change version to 1.4 on all routines
BSDX08 has fix for drag and drop because it referenced a non existent cancellation reason

File size: 3.7 KB
Line 
1BSDX25 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
2 ;;1.4;BSDX;;Sep 07, 2010
3 ;
4 ;
5CHECKIND(BSDXY,BSDXAPTID,BSDXCDT,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG) ;EP
6 ;Entry point for debugging
7 ;
8 ;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))
9 ;E G ENDBG
10 Q
11 ;
12CHECKIN(BSDXY,BSDXAPTID,BSDXCDT,BSDXCC,BSDXPRV,BSDXROU,BSDXVCL,BSDXVFM,BSDXOG) ;EP Check in appointment
13 ;
14ENDBG ;
15 N BSDXNOD,BSDXPATID,BSDXSTART,DIK,DA,BSDXID,BSDXI,BSDXZ,BSDXIENS,BSDXVEN
16 N BSDXNOEV
17 S BSDXNOEV=1 ;Don't execute protocol
18 ;
19 D ^XBKVAR S X="ERROR^BSDX25",@^%ZOSF("TRAP")
20 S BSDXI=0
21 K ^BSDXTMP($J)
22 S BSDXY="^BSDXTMP("_$J_")"
23 S ^BSDXTMP($J,0)="T00020ERRORID"_$C(30)
24 I '+BSDXAPTID D ERR("BSDX25: Invalid Appointment ID") Q
25 I '$D(^BSDXAPPT(BSDXAPTID,0)) D ERR("BSDX08: Invalid Appointment ID") Q
26 ;
27 S:BSDXCDT["@0000" BSDXCDT=$P(BSDXCDT,"@")
28 S %DT="T",X=BSDXCDT D ^%DT S BSDXCDT=Y
29 I BSDXCDT=-1 D ERR(70) Q
30 I BSDXCDT>$$NOW^XLFDT S BSDXCDT=$$NOW^XLFDT
31 ;Checkin BSDX APPOINTMENT entry
32 D BSDXCHK(BSDXAPTID,BSDXCDT)
33 S BSDXNOD=^BSDXAPPT(BSDXAPTID,0)
34 S BSDXPATID=$P(BSDXNOD,U,5)
35 S BSDXSTART=$P(BSDXNOD,U)
36 ;
37 S BSDXSC1=$P(BSDXNOD,U,7) ;RESOURCEID
38 I BSDXSC1]"",$D(^BSDXRES(BSDXSC1,0)) D I +$G(BSDXZ) D ERR($P(BSDXZ,U,2)) Q
39 . S BSDXNOD=^BSDXRES(BSDXSC1,0)
40 . S BSDXSC1=$P(BSDXNOD,U,4) ;HOSPITAL LOCATION
41 . I BSDXSC1]"",$D(^SC(BSDXSC1,0)) D APCHK(.BSDXZ,BSDXSC1,BSDXPATID,BSDXCDT,BSDXSTART)
42 ;
43 S BSDXI=BSDXI+1
44 ;S ^BSDXTMP($J,BSDXI)="-1"_$C(30)
45 S ^BSDXTMP($J,BSDXI)="0"_$C(30)
46 S BSDXI=BSDXI+1
47 S ^BSDXTMP($J,BSDXI)=$C(31)
48 Q
49 ;
50BSDXCHK(BSDXAPTID,BSDXCDT) ;
51 ;
52 S BSDXIENS=BSDXAPTID_","
53 S BSDXFDA(9002018.4,BSDXIENS,.03)=BSDXCDT
54 D FILE^DIE("","BSDXFDA","BSDXMSG")
55 Q
56 ;
57APCHK(BSDXZ,BSDXSC1,BSDXDFN,BSDXCDT,BSDXSTART) ;
58 ;Checkin appointment for patient BSDXDFN in clinic BSDXSC1
59 ;at time BSDXSTART
60 S BSDXZ=$$CHECKIN1^BSDXAPI(BSDXDFN,BSDXSC1,BSDXSTART)
61 Q
62 ;
63CHKEVT(BSDXPAT,BSDXSTART,BSDXSC) ;EP Called by BSDX CHECKIN APPOINTMENT event
64 ;when appointments CHECKIN via PIMS interface.
65 ;Propagates CHECKIN to BSDXAPPT and raises refresh event to running GUI clients
66 ;
67 Q:+$G(BSDXNOEV)
68 Q:'+$G(BSDXSC)
69 N BSDXSTAT,BSDXFOUND,BSDXRES
70 S BSDXSTAT=""
71 S:$G(SDATA("AFTER","STATUS"))["CHECKED IN" BSDXSTAT=$P(SDATA("AFTER","STATUS"),"^",4)
72 S BSDXFOUND=0
73 I $D(^BSDXRES("ALOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ALOC",BSDXSC,0)) S BSDXFOUND=$$CHKEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT)
74 I BSDXFOUND D CHKEVT3(BSDXRES) Q
75 I $D(^BXDXRES("ASSOC",BSDXSC)) S BSDXRES=$O(^BSDXRES("ASSOC",BSDXSC,0)) S BSDXFOUND=$$CHKEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT)
76 I BSDXFOUND D CHKEVT3(BSDXRES)
77 Q
78 ;
79CHKEVT1(BSDXRES,BSDXSTART,BSDXPAT,BSDXSTAT) ;
80 ;Get appointment id in BSDXAPT
81 ;If found, call BSDXNOS(BSDXAPPT) and return 1
82 ;else return 0
83 N BSDXFOUND,BSDXAPPT
84 S BSDXFOUND=0
85 Q:'+$G(BSDXRES) BSDXFOUND
86 Q:'$D(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART)) BSDXFOUND
87 S BSDXAPPT=0 F S BSDXAPPT=$O(^BSDXAPPT("ARSRC",BSDXRES,BSDXSTART,BSDXAPPT)) Q:'+BSDXAPPT D Q:BSDXFOUND
88 . S BSDXNOD=$G(^BSDXAPPT(BSDXAPPT,0)) Q:BSDXNOD=""
89 . I $P(BSDXNOD,U,5)=BSDXPAT,$P(BSDXNOD,U,12)="" S BSDXFOUND=1 Q
90 I BSDXFOUND,+$G(BSDXAPPT) D BSDXCHK(BSDXAPPT,BSDXSTAT)
91 Q BSDXFOUND
92 ;
93CHKEVT3(BSDXRES) ;
94 ;Call RaiseEvent to notify GUI clients
95 ;
96 N BSDXRESN
97 S BSDXRESN=$G(^BSDXRES(BSDXRES,0))
98 Q:BSDXRESN=""
99 S BSDXRESN=$P(BSDXRESN,"^")
100 ;D EVENT^BSDX23("SCHEDULE-"_BSDXRESN,"","","")
101 D EVENT^BMXMEVN("BSDX SCHEDULE",BSDXRESN)
102 Q
103 ;
104ERROR ;
105 D ERR("RPMS Error")
106 Q
107 ;
108ERR(ERRNO) ;Error processing
109 I +ERRNO S BSDXERR=ERRNO+134234112 ;vbObjectError
110 E S BSDXERR=ERRNO
111 S BSDXI=BSDXI+1
112 S ^BSDXTMP($J,BSDXI)=BSDXERR_$C(30)
113 S BSDXI=BSDXI+1
114 S ^BSDXTMP($J,BSDXI)=$C(31)
115 Q
Note: See TracBrowser for help on using the repository browser.