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

Last change on this file since 1472 was 1472, checked in by Sam Habiel, 12 years ago

Updated version number on all routines to be 1.7T1.
Minor fixes here and there for XINDEX errors.

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