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

Last change on this file since 1563 was 1563, checked in by Tariq Hamkari, 12 years ago

updated the BSDX version to 1.7

  • fix "BSDX01.m" routine , it was take too long time to retrieve patient radiology exams.
File size: 3.7 KB
Line 
1BSDX33 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:29am
2 ;;1.6;BSDX;;Aug 31, 2011;Build 25
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.