[614] | 1 | BSDX12 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ;
|
---|
| 2 | ;;2.0;IHS WINDOWS SCHEDULING;;NOV 01, 2007
|
---|
| 3 | ;
|
---|
| 4 | ;
|
---|
| 5 | AVADD(BSDXY,BSDXSTART,BSDXEND,BSDXTYPID,BSDXRES,BSDXSLOTS,BSDXNOTE) ;EP
|
---|
| 6 | ;Called by BSDX ADD NEW AVAILABILITY
|
---|
| 7 | ;Create entry in BSDX ACCESS BLOCK
|
---|
| 8 | ;
|
---|
| 9 | ;BSDXRES is Resource Name
|
---|
| 10 | ;Returns recordset having fields
|
---|
| 11 | ; AvailabilityID and ErrorNumber
|
---|
| 12 | ;
|
---|
| 13 | ;Test lines:
|
---|
| 14 | ;D AVADD^BSDX12(.RES,"1-27-2001@0900","1-27-2001@1000","1","WHITT",2,"SCRATCH AV NOTE") ZW RES
|
---|
| 15 | ;BSDX ADD NEW AVAILABILITY^1-27-2001@0900^1-278-2001@1000^1^WHITT^2^SCRATCH AVAILABILITY NOTE
|
---|
| 16 | ;
|
---|
| 17 | N BSDXERR,BSDXIEN,BSDXDEP,BSDXI,BSDXAVID,BSDXI,BSDXERR,BSDXFDA,BSDXMSG,BSDXRESD
|
---|
| 18 | K ^BSDXTMP($J)
|
---|
| 19 | S BSDXERR=0
|
---|
| 20 | S BSDXI=0
|
---|
| 21 | S BSDXY="^BSDXTMP("_$J_")"
|
---|
| 22 | S ^BSDXTMP($J,0)="I00020AVAILABILITYID^I00020ERRORID"_$C(30)
|
---|
| 23 | ;Check input data for errors
|
---|
| 24 | S:BSDXSTART["@0000" BSDXSTART=$P(BSDXSTART,"@")
|
---|
| 25 | S:BSDXEND["@0000" BSDXEND=$P(BSDXEND,"@")
|
---|
| 26 | S %DT="T",X=BSDXSTART D ^%DT S BSDXSTART=Y
|
---|
| 27 | I BSDXSTART=-1 D ERR(70) Q
|
---|
| 28 | S %DT="T",X=BSDXEND D ^%DT S BSDXEND=Y
|
---|
| 29 | I BSDXEND=-1 D ERR(70) Q
|
---|
| 30 | I $L(BSDXEND,".")=1 D ERR(70) Q
|
---|
| 31 | I BSDXSTART>BSDXEND S BSDXTMP=BSDXEND,BSDXEND=BSDXSTART,BSDXSTART=BSDXTMP
|
---|
| 32 | ;Validate Access Type
|
---|
| 33 | I '+BSDXTYPID,'$D(^BSDXTYPE(BSDXTYPID,0)) D ERR(70) Q
|
---|
| 34 | ;Validate Resource
|
---|
| 35 | I '$D(^BSDXRES("B",BSDXRES)) S BSDXERR=70 D ERR(BSDXERR) Q
|
---|
| 36 | S BSDXRESD=$O(^BSDXRES("B",BSDXRES,0)) I '+BSDXRESD S BSDXERR=70 D ERR(BSDXERR) Q
|
---|
| 37 | ;
|
---|
| 38 | ;Create entry in BSDX ACCESS BLOCK
|
---|
| 39 | S BSDXFDA(9002018.3,"+1,",.01)=BSDXRESD
|
---|
| 40 | S BSDXFDA(9002018.3,"+1,",.02)=BSDXSTART
|
---|
| 41 | S BSDXFDA(9002018.3,"+1,",.03)=BSDXEND
|
---|
| 42 | S BSDXFDA(9002018.3,"+1,",.04)=BSDXSLOTS
|
---|
| 43 | S BSDXFDA(9002018.3,"+1,",.05)=BSDXTYPID
|
---|
| 44 | K BSDXIEN,BSDXMSG
|
---|
| 45 | D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
|
---|
| 46 | S BSDXAVID=+$G(BSDXIEN(1))
|
---|
| 47 | I 'BSDXAVID D ERR(70) Q
|
---|
| 48 | ;
|
---|
| 49 | ;Add WP field
|
---|
| 50 | I BSDXNOTE]"" S BSDXNOTE(.5)=BSDXNOTE,BSDXNOTE=""
|
---|
| 51 | I $D(BSDXNOTE(0)) S BSDXNOTE(.5)=BSDXNOTE(0) K BSDXNOTE(0)
|
---|
| 52 | I $D(BSDXNOTE(.5)) D
|
---|
| 53 | . D WP^DIE(9002018.3,BSDXAVID_",",1,"","BSDXNOTE","BSDXMSG")
|
---|
| 54 | ;
|
---|
| 55 | ;Return Recordset
|
---|
| 56 | S BSDXI=BSDXI+1
|
---|
| 57 | S ^BSDXTMP($J,BSDXI)=BSDXAVID_"^-1"_$C(30)
|
---|
| 58 | S BSDXI=BSDXI+1
|
---|
| 59 | S ^BSDXTMP($J,BSDXI)=$C(31)
|
---|
| 60 | Q
|
---|
| 61 | ;
|
---|
| 62 | ERR(ERRNO) ;Error processing
|
---|
| 63 | S BSDXERR=ERRNO+134234112 ;vbObjectError
|
---|
| 64 | S BSDXI=BSDXI+1
|
---|
| 65 | S ^BSDXTMP($J,BSDXI)="0^"_BSDXERR_$C(30)
|
---|
| 66 | S BSDXI=BSDXI+1
|
---|
| 67 | S ^BSDXTMP($J,BSDXI)=$C(31)
|
---|
| 68 | Q
|
---|