source: Scheduling/branches/Radiology-Support/m/BSDX33.m@ 1150

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

Alpha 3 version files

File size: 3.7 KB
Line 
1BSDX33 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 7/15/10 12:33pm
2 ;;1.5V3;BSDX;;Mar 16, 2011
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.