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

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

Change version to 1.4 on all routines
BSDX08 has fix for drag and drop because it referenced a non existent cancellation reason

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