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

Last change on this file since 1386 was 1187, checked in by Sam Habiel, 13 years ago

Changes to BSDX01 to prevent Scheduled,dc'ed,completed radiology appointments from being cancelled. Updated files to T2.
File size: 2.5 KB
Line 
1BSDX12 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 4/28/11 10:18am
2 ;;1.6T2;BSDX;;May 16, 2011
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.