source: Scheduling/branches/Radiology-Support/m/BSDX24.m@ 1154

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

Alpha 3 version files

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