1 | BSDX12 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:18am
|
---|
2 | ;;1.7;BSDX;;Jun 01, 2013;Build 24
|
---|
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 | ;
|
---|
10 | AVADD(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 | ;
|
---|
71 | ERR(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
|
---|