source: Scheduling/trunk/m/BSDX33.m@ 966

Last change on this file since 966 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 
1BSDX33 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/15/10 12:33pm
2 ;;1.4;BSDX;;Sep 07, 2010
3 ; Mods by WV/STAR
4 ;
5 ; Change Log:
6 ; July 13, 2010
7 ; v 1.3 adds fixes Rebooking behavior in application (see RBNEXT)
8 ; also adds i18 support - Dates passed in FM format from application
9 ; in tag SETRBK and RBNEXT
10 ;
11 ;
12 Q
13RBNEXTD(BSDXY,BSDXDATE,BSDXRES,BSDXTPID) ;EP
14 ;Entry point for debugging
15 ;
16 ;D DEBUG^%Serenji("RBNEXT^BSDX33(.BSDXY,BSDXDATE,BSDXRES,BSDXTPID)")
17 Q
18 ;
19RBNEXT(BSDXY,BSDXDATE,BSDXRES,BSDXTPID) ;EP
20 ;Called by BSDX REBOOK NEXT BLOCK to find
21 ;the next ACCESS BLOCK in resource BSDXRES after BSDXDATE
22 ;Returns 1 in ERRORID and date in NEXTBLOCK if a block was found or NULL in NEXTBLOCK of no date found
23 ;Otherwise, returns 0 and error message in ERRORTEXT
24 ;If BSDXTPID = 0 then any access type match
25 ;
26 S X="ERROR2^BSDX33",@^%ZOSF("TRAP")
27 N BSDXI,BSDXIENS,%DT,BSDXMSG,Y,BSDXRESD,BSDXFND,BSDXIEN,BSDXNOD,BSDXATID
28 S BSDXY="^BSDXTMP("_$J_")"
29 S BSDXI=0
30 S ^BSDXTMP($J,BSDXI)="I00020ERRORID^D00010NEXTBLOCK^T00030ERRORTEXT"_$C(30)
31 ;
32 I BSDXRES="" D ERR2("BSDX REBOOK NEXT BLOCK: Invalid resource name") Q
33 I '$D(^BSDXRES("B",BSDXRES)) D ERR2("BSDX REBOOK NEXT BLOCK: Invalid resource name") Q
34 S BSDXRESD=$O(^BSDXRES("B",BSDXRES,0))
35 I '+BSDXRESD D ERR2("BSDX REBOOK NEXT BLOCK: Invalid resource name") Q
36 ;
37 ; i18n fix
38 ; S X=BSDXDATE,%DT="XT" D ^%DT
39 ; I Y=-1 D ERR2(1,"BSDX REBOOK NEXT BLOCK: Invalid datetime") Q
40 ;
41 ; S BSDXDATE=$P(Y,".")
42 ;
43 S BSDXFND=0
44 F S BSDXDATE=$O(^BSDXAB("ARSCT",BSDXRESD,BSDXDATE)) Q:'+BSDXDATE D Q:BSDXFND
45 . S BSDXIEN=0 F S BSDXIEN=$O(^BSDXAB("ARSCT",BSDXRESD,BSDXDATE,BSDXIEN)) Q:'+BSDXIEN D Q:BSDXFND
46 . . Q:'$D(^BSDXAB(BSDXIEN,0))
47 . . S BSDXNOD=^BSDXAB(BSDXIEN,0)
48 . . Q:+$P(BSDXNOD,U,4)=0 ;Slots
49 . . S BSDXATID=$P(BSDXNOD,U,5)
50 . . I BSDXTPID=0!(BSDXATID=BSDXTPID) S BSDXFND=$P(BSDXNOD,U,2) Q
51 ;
52 I BSDXFND=0 S BSDXFND=""
53 E S Y=BSDXFND X ^DD("DD") S BSDXFND=Y
54 S BSDXI=BSDXI+1
55 ;//smh - bug (V 1.3): Need to replace @ in FM date for C# to recognize it
56 S BSDXFND=$TR(BSDXFND,"@"," ")
57 ;//smh end fix
58 S ^BSDXTMP($J,BSDXI)="1^"_BSDXFND_"^"_$C(30)_$C(31)
59 Q
60SETRBKD(BSDXY,BSDXAPPT,BSDXDATE) ;EP
61 ;Entry point for debugging
62 ;
63 ;D DEBUG^%Serenji("SETRBK^BSDX33(.BSDXY,BSDXAPPT,BSDXDATE)")
64 Q
65 ;
66SETRBK(BSDXY,BSDXAPPT,BSDXDATE) ;EP
67 ;
68 ;Sets rebook date into appointment
69 ;BSDXAPPT - Appointment ID
70 ;BSDXDATE - Rebook Datetime in internal format
71 ;Called by BSDX REBOOK SET
72 ;
73 ;ErrorID:
74 ; 0 if a problem. Message in ERRORTEXT
75 ; 1 if OK
76 ;
77 S X="ERROR^BSDX33",@^%ZOSF("TRAP")
78 N BSDXI,BSDXIENS,%DT,BSDXMSG,Y
79 S BSDXY="^BSDXTMP("_$J_")"
80 S BSDXI=0
81 S ^BSDXTMP($J,BSDXI)="I00020ERRORID^T00030ERRORTEXT"_$C(30)
82 ;
83 I '+BSDXAPPT
84 I '$D(^BSDXAPPT(BSDXAPPT,0)) D ERR(1,"BSDX REBOOK SET: Invalid appointment ID") Q
85 ; i18n (v 1.3)
86 ;S X=BSDXDATE,%DT="XT" D ^%DT
87 ;I Y=-1 D ERR(1,"BSDX REBOOK SET: Invalid rebook datetime") Q
88 ;S BSDXDATE=Y
89 S BSDXIENS=BSDXAPPT_","
90 S BSDXFDA(9002018.4,BSDXIENS,.11)=+BSDXDATE
91 ;
92 K BSDXMSG
93 D FILE^DIE("","BSDXFDA","BSDXMSG")
94 S BSDXI=BSDXI+1
95 S ^BSDXTMP($J,BSDXI)="1^"_$C(31)
96 ;
97 Q
98 ;
99ERR(BSDXERID,ERRTXT) ;Error processing
100 S:'+$G(BSDXI) BSDXI=999999
101 S BSDXI=BSDXI+1
102 S ^BSDXTMP($J,BSDXI)=BSDXERID_"^"_ERRTXT_$C(30)
103 S BSDXI=BSDXI+1
104 S ^BSDXTMP($J,BSDXI)=$C(31)
105 Q
106 ;
107ERROR ;
108 D ^%ZTER
109 I '+$G(BSDXI) N BSDXI S BSDXI=999999
110 S BSDXI=BSDXI+1
111 D ERR(0,"BSDX33 M Error: <"_$G(%ZTERROR)_">")
112 Q
113 ;
114ERR2(BSDXERID,ERRTXT) ;Error processing
115 S:'+$G(BSDXI) BSDXI=999999
116 S BSDXI=BSDXI+1
117 S ^BSDXTMP($J,BSDXI)=BSDXERID_"^^"_ERRTXT_$C(30)
118 S BSDXI=BSDXI+1
119 S ^BSDXTMP($J,BSDXI)=$C(31)
120 Q
121 ;
122ERROR2 ;
123 D ^%ZTER
124 I '+$G(BSDXI) N BSDXI S BSDXI=999999
125 S BSDXI=BSDXI+1
126 D ERR2(0,"BSDX33 M Error: <"_$G(%ZTERROR)_">")
127 Q
Note: See TracBrowser for help on using the repository browser.