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

Last change on this file since 802 was 614, checked in by Sam Habiel, 15 years ago

Initial committ of scheduling package
File size: 3.2 KB
Line 
1BSDX33 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
2 ;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
3 ;
4 ;
5 Q
6RBNEXTD(BSDXY,BSDXDATE,BSDXRES,BSDXTPID) ;EP
7 ;Entry point for debugging
8 ;
9 ;D DEBUG^%Serenji("RBNEXT^BSDX33(.BSDXY,BSDXDATE,BSDXRES,BSDXTPID)")
10 Q
11 ;
12RBNEXT(BSDXY,BSDXDATE,BSDXRES,BSDXTPID) ;EP
13 ;Called by BSDX REBOOK NEXT BLOCK to find
14 ;the next ACCESS BLOCK in resource BSDXRES after BSDXSTART
15 ;Returns 1 in ERRORID and date in NEXTBLOCK if a block was found or NULL in NEXTBLOCK of no date found
16 ;Otherwise, returns 0 and error message in ERRORTEXT
17 ;If BSDXTPID = 0 then any access type match
18 ;
19 S X="ERROR2^BSDX33",@^%ZOSF("TRAP")
20 N BSDXI,BSDXIENS,%DT,BSDXMSG,Y,BSDXRESD,BSDXFND,BSDXIEN,BSDXNOD,BSDXATID
21 S BSDXY="^BSDXTMP("_$J_")"
22 S BSDXI=0
23 S ^BSDXTMP($J,BSDXI)="I00020ERRORID^D00010NEXTBLOCK^T00030ERRORTEXT"_$C(30)
24 ;
25 I BSDXRES="" D ERR2("BSDX REBOOK NEXT BLOCK: Invalid resource name") Q
26 I '$D(^BSDXRES("B",BSDXRES)) D ERR2("BSDX REBOOK NEXT BLOCK: Invalid resource name") Q
27 S BSDXRESD=$O(^BSDXRES("B",BSDXRES,0))
28 I '+BSDXRESD D ERR2("BSDX REBOOK NEXT BLOCK: Invalid resource name") Q
29 S X=BSDXDATE,%DT="XT" D ^%DT
30 I Y=-1 D ERR2(1,"BSDX REBOOK NEXT BLOCK: Invalid datetime") Q
31 S BSDXDATE=$P(Y,".")
32 ;
33 S BSDXFND=0
34 F S BSDXDATE=$O(^BSDXAB("ARSCT",BSDXRESD,BSDXDATE)) Q:'+BSDXDATE D Q:BSDXFND
35 . S BSDXIEN=0 F S BSDXIEN=$O(^BSDXAB("ARSCT",BSDXRESD,BSDXDATE,BSDXIEN)) Q:'+BSDXIEN D Q:BSDXFND
36 . . Q:'$D(^BSDXAB(BSDXIEN,0))
37 . . S BSDXNOD=^BSDXAB(BSDXIEN,0)
38 . . Q:+$P(BSDXNOD,U,4)=0 ;Slots
39 . . S BSDXATID=$P(BSDXNOD,U,5)
40 . . I BSDXTPID=0!(BSDXATID=BSDXTPID) S BSDXFND=$P(BSDXNOD,U,2) Q
41 ;
42 I BSDXFND=0 S BSDXFND=""
43 E S Y=BSDXFND X ^DD("DD") S BSDXFND=Y
44 S BSDXI=BSDXI+1
45 S ^BSDXTMP($J,BSDXI)="1^"_BSDXFND_"^"_$C(30)_$C(31)
46 Q
47SETRBKD(BSDXY,BSDXAPPT,BSDXDATE) ;EP
48 ;Entry point for debugging
49 ;
50 ;D DEBUG^%Serenji("SETRBK^BSDX33(.BSDXY,BSDXAPPT,BSDXDATE)")
51 Q
52 ;
53SETRBK(BSDXY,BSDXAPPT,BSDXDATE) ;EP
54 ;
55 ;Sets rebook date into appointment
56 ;BSDXAPPT - Appointment ID
57 ;BSDXDATE - Rebook Datetime in external format
58 ;Called by BSDX REBOOK SET
59 ;
60 ;ErrorID:
61 ; 0 if a problem. Message in ERRORTEXT
62 ; 1 if OK
63 ;
64 S X="ERROR^BSDX33",@^%ZOSF("TRAP")
65 N BSDXI,BSDXIENS,%DT,BSDXMSG,Y
66 S BSDXY="^BSDXTMP("_$J_")"
67 S BSDXI=0
68 S ^BSDXTMP($J,BSDXI)="I00020ERRORID^T00030ERRORTEXT"_$C(30)
69 ;
70 I '+BSDXAPPT
71 I '$D(^BSDXAPPT(BSDXAPPT,0)) D ERR(1,"BSDX REBOOK SET: Invalid appointment ID") Q
72 S X=BSDXDATE,%DT="XT" D ^%DT
73 I Y=-1 D ERR(1,"BSDX REBOOK SET: Invalid rebook datetime") Q
74 S BSDXDATE=Y
75 S BSDXIENS=BSDXAPPT_","
76 S BSDXFDA(9002018.4,BSDXIENS,.11)=BSDXDATE
77 ;
78 K BSDXMSG
79 D FILE^DIE("","BSDXFDA","BSDXMSG")
80 S BSDXI=BSDXI+1
81 S ^BSDXTMP($J,BSDXI)="1^"_$C(31)
82 ;
83 Q
84 ;
85ERR(BSDXERID,ERRTXT) ;Error processing
86 S:'+$G(BSDXI) BSDXI=999999
87 S BSDXI=BSDXI+1
88 S ^BSDXTMP($J,BSDXI)=BSDXERID_"^"_ERRTXT_$C(30)
89 S BSDXI=BSDXI+1
90 S ^BSDXTMP($J,BSDXI)=$C(31)
91 Q
92 ;
93ERROR ;
94 D ^%ZTER
95 I '+$G(BSDXI) N BSDXI S BSDXI=999999
96 S BSDXI=BSDXI+1
97 D ERR(0,"BSDX33 M Error: <"_$G(%ZTERROR)_">")
98 Q
99 ;
100ERR2(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 ;
108ERROR2 ;
109 D ^%ZTER
110 I '+$G(BSDXI) N BSDXI S BSDXI=999999
111 S BSDXI=BSDXI+1
112 D ERR2(0,"BSDX33 M Error: <"_$G(%ZTERROR)_">")
113 Q
Note: See TracBrowser for help on using the repository browser.