source: Scheduling/trunk/m/BSDX12.m@ 1575

Last change on this file since 1575 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: 2.5 KB
Line 
1BSDX12 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:18am
2 ;;1.6;BSDX;;Aug 31, 2011;Build 25
3 ; Licensed under LGPL
4 ;
5 ; Change Log:
6 ; v 1.3 - i18n support - 3100718
7 ; BSDXSTART and BSDXEND passed in FM Dates, not US dates
8 ;
9 ;
10AVADD(BSDXY,BSDXSTART,BSDXEND,BSDXTYPID,BSDXRES,BSDXSLOTS,BSDXNOTE) ;EP
11 ;Called by BSDX ADD NEW AVAILABILITY
12 ;Create entry in BSDX ACCESS BLOCK
13 ;
14 ;BSDXRES is Resource Name
15 ;Returns recordset having fields
16 ; AvailabilityID and ErrorNumber
17 ;
18 ;Test lines:
19 ;D AVADD^BSDX12(.RES,"3091227.09","3091227.0930","1","WHITT",2,"SCRATCH AV NOTE") ZW RES
20 ;BSDX ADD NEW AVAILABILITY^3091227.09^3091227.0930^1^WHITT^2^SCRATCH AVAILABILITY NOTE
21 ;
22 N BSDXERR,BSDXIEN,BSDXDEP,BSDXI,BSDXAVID,BSDXI,BSDXERR,BSDXFDA,BSDXMSG,BSDXRESD
23 K ^BSDXTMP($J)
24 S BSDXERR=0
25 S BSDXI=0
26 S BSDXY="^BSDXTMP("_$J_")"
27 S ^BSDXTMP($J,0)="I00020AVAILABILITYID^I00020ERRORID"_$C(30)
28 ;Check input data for errors
29 ; i18n - FM Dates passed in
30 ; S:BSDXSTART["@0000" BSDXSTART=$P(BSDXSTART,"@")
31 ; S:BSDXEND["@0000" BSDXEND=$P(BSDXEND,"@")
32 ; S %DT="T",X=BSDXSTART D ^%DT S BSDXSTART=Y
33 ; I BSDXSTART=-1 D ERR(70) Q
34 ; S %DT="T",X=BSDXEND D ^%DT S BSDXEND=Y
35 ; I BSDXEND=-1 D ERR(70) Q
36 ; Make sure dates are canonical and don't contain extra zeros
37 S BSDXSTART=+BSDXSTART,BSDXEND=+BSDXEND
38 ;
39 I $L(BSDXEND,".")=1 D ERR(70) Q
40 I BSDXSTART>BSDXEND S BSDXTMP=BSDXEND,BSDXEND=BSDXSTART,BSDXSTART=BSDXTMP
41 ;Validate Access Type
42 I '+BSDXTYPID,'$D(^BSDXTYPE(BSDXTYPID,0)) D ERR(70) Q
43 ;Validate Resource
44 I '$D(^BSDXRES("B",BSDXRES)) S BSDXERR=70 D ERR(BSDXERR) Q
45 S BSDXRESD=$O(^BSDXRES("B",BSDXRES,0)) I '+BSDXRESD S BSDXERR=70 D ERR(BSDXERR) Q
46 ;
47 ;Create entry in BSDX ACCESS BLOCK
48 S BSDXFDA(9002018.3,"+1,",.01)=BSDXRESD
49 S BSDXFDA(9002018.3,"+1,",.02)=BSDXSTART
50 S BSDXFDA(9002018.3,"+1,",.03)=BSDXEND
51 S BSDXFDA(9002018.3,"+1,",.04)=BSDXSLOTS
52 S BSDXFDA(9002018.3,"+1,",.05)=BSDXTYPID
53 K BSDXIEN,BSDXMSG
54 D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
55 S BSDXAVID=+$G(BSDXIEN(1))
56 I 'BSDXAVID D ERR(70) Q
57 ;
58 ;Add WP field
59 I BSDXNOTE]"" S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE=""
60 I $D(BSDXNOTE(0)) S BSDXNOTE(.5)=BSDXNOTE(0) K BSDXNOTE(0)
61 I $D(BSDXNOTE(.5)) D
62 . D WP^DIE(9002018.3,BSDXAVID_",",1,"","BSDXNOTE","BSDXMSG")
63 ;
64 ;Return Recordset
65 S BSDXI=BSDXI+1
66 S ^BSDXTMP($J,BSDXI)=BSDXAVID_"^-1"_$C(30)
67 S BSDXI=BSDXI+1
68 S ^BSDXTMP($J,BSDXI)=$C(31)
69 Q
70 ;
71ERR(ERRNO) ;Error processing
72 S BSDXERR=ERRNO+134234112 ;vbObjectError
73 S BSDXI=BSDXI+1
74 S ^BSDXTMP($J,BSDXI)="0^"_BSDXERR_$C(30)
75 S BSDXI=BSDXI+1
76 S ^BSDXTMP($J,BSDXI)=$C(31)
77 Q
Note: See TracBrowser for help on using the repository browser.