source: Scheduling/trunk/m/BSDX24.m@ 1295

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

Changes to BSDX01 to prevent Scheduled,dc'ed,completed radiology appointments from being cancelled. Updated files to T2.

File size: 3.8 KB
Line 
1BSDX24 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:22am
2 ;;1.6T2;BSDX;;May 16, 2011
3 ; Licensed under LGPL
4 ;
5 ;
6 Q
7CRCONTXT(RESULT,OPTION) ;EP
8 ;Entry point for debugging XWBSEC
9 ;
10 ;D DEBUG^%Serenji("CRCONTXT^XWBSEC(.RESULT,OPTION)")
11 ;;H .5
12 ;;D CRCONTXT^XWBSEC(.RESULT,OPTION)
13 ;;S BSDX="^BSDXTMP($J,"
14 ;;S ^BSDXTMP($J,0)=RESULT
15 ;;S RESULT=1
16 Q
17TEST0(BSDX) ;EP Delete user from 200
18 S DIK="^VA(200,"
19 S DA=BSDX
20 D ^DIK
21 ;
22 Q
23KILLM ;EP Delete BMXMENU entry
24 S DIK="^DIC(19,"
25 S DA=$O(^DIC(19,"B","BMXMENU",0))
26 Q:'+DA
27 D ^DIK
28 Q
29 ;
30TEST1 ;EP Adding an entry to 200
31 ;
32 S BSDXFDA(200,"+1,",.01)="BMXNET,APPLICATION"
33 K BSDXIEN,BSDXMSG
34 S DIC(0)=""
35 D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
36 ;
37 Q
38TEST2 ;EP
39 ;How to change the ACCESS CODE, VERIFY CODE, DATE VERIFY CODE LAST CHANGED field
40 ;ACCESS CODE BSDXXX1^1_(a>yr}:3x3ja9\8vbH
41 ;VERIFY CODE BSDXXX2^$;HOSs|:3w25lLD}Be=
42 N BSDXFDA
43 S BSDXFDA(200,"36,",2)="1_(a>yr}:3x3ja9\8vbH"
44 S BSDXFDA(200,"36,",11)="$;HOSs|:3w25lLD}Be="
45 S BSDXFDA(200,"36,",11.2)="88888,88888"
46 S BSDXFDA(200,"36,",201)="BMXRPC"
47 D FILE^DIE("","BSDXFDA","BSDXMSG")
48 Q
49 ;
50 ;
51SEARCHD(BSDXY,BSDXRES,BSDXSTRT,BSDXEND,BSDXTYPES,BSDXAMPM,BSDXWKDY) ;EP
52 ;Entry point for debugging
53 ;
54 ;D DEBUG^%Serenji("SEARCH^BSDX24(.RES,""ROGERS,BUCK|FUNAKOSHI,GICHIN"","""","""","""","""","""")")
55 ;D DEBUG^%Serenji("SEARCH^BSDX24(.BSDXY,BSDXRES,BSDXSTRT,BSDXEND,BSDXTYPES,BSDXAMPM,BSDXWKDY)")
56 Q
57 ;
58SEARCH(BSDXY,BSDXRES,BSDXSTRT,BSDXEND,BSDXTYPES,BSDXAMPM,BSDXWKDY) ;EP
59 ;Searches availability database for availability blocks between
60 ;BSDXSTRT and BSDXEND for each of the resources in BSDXRES.
61 ;The av blocks must be one of the types in BSDXTYPES, must be
62 ;AM or PM depending on value in BSDXAMPM and
63 ;must be on one of the weekdays listed in BSDXWKDY.
64 ;
65 ;Return recordset containing the start times of availability blocks
66 ;meeting the search criteria.
67 ;
68 ;Variables:
69 ;BSDXRES |-Delimited list of resource names
70 ;BSDXSTRT FM-formatted beginning date of search
71 ;BSDXEND FM-Formatted ending date of search
72 ;BSDXTYPES |-Delimited list of access type IENs
73 ;BSDXAMPM "AM" for am-only, "PM" for pm-only, "BOTH" for both
74 ;BSDXWKDY "" if any weekday, else |-delimited list of weekdays
75 ;
76 ;NOTE: If BSDXEND="" Then:
77 ; either ONE record is returned matching the first available block
78 ; -or- NO record is returned indicating no available block exists
79 ;
80 ;Called by BSDX SEARCH AVAILABILITY
81 ;Test Line:
82 ;D SEARCH^BSDX24(.RES,"ROGERS,BUCK|FUNAKOSHI,GICHIN","","","","","") ZW RES
83 ;
84 ;
85 S X=BSDXSTRT,%DT="X" D ^%DT S BSDXSTRT=$P(Y,".")
86 S:+BSDXSTRT<0 BSDXSTRT=DT
87 S X=BSDXEND,%DT="X" D ^%DT S BSDXEND=$P(Y,".")
88 S:+BSDXEND<0 BSDXEND=9990101
89 S BSDXEND=BSDXEND_".99"
90 N BSDXRESN,BSDXRESD,BSDXDATE,BSDXI,BSDXABD,BSDXNOD,BSDXATD,BSDXATN
91 N BSDXTYPE
92 ;
93 ;Set up access types array
94 F BSDX=1:1:$L(BSDXTYPES,"|") D
95 . S BSDXATD=$P(BSDXTYPES,"|",BSDX)
96 . S:+BSDXATD BSDXTYPE(BSDXTYPD)=""
97 ;
98 S BSDXI=0
99 S BSDXY="^BSDXTMP("_$J_")"
100 S ^BSDXTMP($J,0)="T00030RESOURCENAME^D00030DATE^T00030ACCESSTYPE^T00030COMMENT"_$C(30)
101 F BSDX=1:1:$L(BSDXRES,"|") S BSDXRESN=$P(BSDXRES,"|",BSDX) D
102 . Q:'$D(^BSDXRES("B",BSDXRESN))
103 . S BSDXRESD=$O(^BSDXRES("B",BSDXRESN,0))
104 . Q:'+BSDXRESD
105 . Q:'$D(^BSDXRES(BSDXRESD,0))
106 . Q:'$D(^BSDXAB("ARSCT",BSDXRESD))
107 . S BSDXDATE=$O(^BSDXAB("ARSCT",BSDXRESD,BSDXSTRT))
108 . Q:BSDXDATE=""
109 . Q:BSDXDATE>BSDXEND
110 . ;TODO: Screen for AMPM
111 . ;TODO: Screen for Weekday
112 . ;
113 . S BSDXI=BSDXI+1
114 . S BSDXABD=$O(^BSDXAB("ARSCT",BSDXRESD,BSDXDATE,0))
115 . S BSDXNOD=$G(^BSDXAB(BSDXABD,0))
116 . Q:BSDXNOD=""
117 . S Y=$P(BSDXDATE,".")
118 . D DD^%DT
119 . S BSDXATD=$P(BSDXNOD,U,5) ;ACCESS TYPE POINTER
120 . S BSDXATD=$G(^BSDXTYPE(+BSDXATD,0))
121 . S BSDXATN=$P(BSDXATD,U)
122 . I +BSDXATD,BSDXTYPES]"" Q:'$D(BSDXTYPES(BSDXATD))
123 . ;TODO: Screen for TYPE ----DONE!
124 . ;TODO: Comment
125 . S ^BSDXTMP($J,BSDXI)=BSDXRESN_U_Y_U_BSDXATN_U_$C(30)
126 S BSDXI=BSDXI+1
127 S ^BSDXTMP($J,BSDXI)=$C(31)
128 Q
Note: See TracBrowser for help on using the repository browser.