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