| 1 | BSDX13 ; IHS/OIT/HMW - WINDOWS SCHEDULING RPCS ; 12/6/10 6:05pm
|
|---|
| 2 | ;;1.5;BSDX;;Jan 25, 2011
|
|---|
| 3 | ;
|
|---|
| 4 | ; Change Log:
|
|---|
| 5 | ; V 1.3 - i18n support - Dates passed to Routine as FM Date - WV/SMH
|
|---|
| 6 | Q
|
|---|
| 7 | AVDELDTD(BSDXY,BSDXRESD,BSDXSTART,BSDXEND) ;EP
|
|---|
| 8 | ;Entry point for debugging
|
|---|
| 9 | ;
|
|---|
| 10 | ;D DEBUG^%Serenji("AVDELDT^BSDX13(.BSDXY,BSDXRESD,BSDXSTART,BSDXEND)")
|
|---|
| 11 | Q
|
|---|
| 12 | ;
|
|---|
| 13 | AVDELDT(BSDXY,BSDXRESD,BSDXSTART,BSDXEND) ;EP
|
|---|
| 14 | ;Cancel availability in a date range
|
|---|
| 15 | ;Called by BSDX CANCEL AV BY DATE
|
|---|
| 16 | ;
|
|---|
| 17 | ;BSDXRESD is BSDX RESOURCE ien
|
|---|
| 18 | ;BSDXSTART and BSDXEND are FM dates (change in v 1.3)
|
|---|
| 19 | ;
|
|---|
| 20 | S X="ERROR^BSDX13",@^%ZOSF("TRAP")
|
|---|
| 21 | N BMXIEN,BSDXI
|
|---|
| 22 | S BSDXI=0
|
|---|
| 23 | S BSDXY="^BSDXTMP("_$J_")"
|
|---|
| 24 | K ^BSDXTMP($J)
|
|---|
| 25 | S ^BSDXTMP($J,BSDXI)="I00020ERRORID^T00030ERRORTEXT"_$C(30)
|
|---|
| 26 | ; S X=BSDXSTART ; commented out *v1.3
|
|---|
| 27 | ; S %DT="X" D ^%DT
|
|---|
| 28 | ; I Y=-1 D ERR(0,"AVDELDT-BSDX13: Invalid Start Date") Q
|
|---|
| 29 | ; S BSDXSTART=$P(Y,".")
|
|---|
| 30 | ; S X=BSDXEND
|
|---|
| 31 | ; S %DT="X" D ^%DT
|
|---|
| 32 | ; I Y=-1 D ERR(0,"AVDELDT-BSDX13: Invalid End Date") Q
|
|---|
| 33 | S BSDXEND=$P(BSDXEND,".")_".99999"
|
|---|
| 34 | I '+BSDXRESD D ERR(0,"AVDELDT-BSDX13: Invalid Resource ID") Q
|
|---|
| 35 | ;
|
|---|
| 36 | F S BSDXSTART=$O(^BSDXAB("ARSCT",BSDXRESD,BSDXSTART)) Q:'+BSDXSTART Q:BSDXSTART>BSDXEND D
|
|---|
| 37 | . S BMXIEN=0
|
|---|
| 38 | . F S BMXIEN=$O(^BSDXAB("ARSCT",BSDXRESD,BSDXSTART,BMXIEN)) Q:'+BMXIEN D
|
|---|
| 39 | . . D CALLDIK(BMXIEN)
|
|---|
| 40 | ;
|
|---|
| 41 | S BSDXI=BSDXI+1
|
|---|
| 42 | S ^BSDXTMP($J,BSDXI)="-1^"_$C(30)_$C(31)
|
|---|
| 43 | Q
|
|---|
| 44 | ERROR ;
|
|---|
| 45 | D ^%ZTER
|
|---|
| 46 | I '+$G(BSDXI) N BSDXI S BSDXI=999999
|
|---|
| 47 | S BSDXI=BSDXI+1
|
|---|
| 48 | D ERR(0,"BSDX13 M Error: <"_$G(%ZTERZE)_">")
|
|---|
| 49 | Q
|
|---|
| 50 | ;
|
|---|
| 51 | ERR(BSDXERID,ERRTXT) ;Error processing
|
|---|
| 52 | S:'+$G(BSDXI) BSDXI=999999
|
|---|
| 53 | S BSDXI=BSDXI+1
|
|---|
| 54 | S ^BSDXTMP($J,BSDXI)=BSDXERID_"^"_ERRTXT_$C(30)
|
|---|
| 55 | S BSDXI=BSDXI+1
|
|---|
| 56 | S ^BSDXTMP($J,BSDXI)=$C(31)
|
|---|
| 57 | Q
|
|---|
| 58 | ;
|
|---|
| 59 | AVDEL(BSDXY,BSDXAVID) ;EP
|
|---|
| 60 | ;Called by BSDX CANCEL AVAILABILITY
|
|---|
| 61 | ;Deletes Access block
|
|---|
| 62 | ;BSDXAVID is entry number in BSDX AVAILABILITY file
|
|---|
| 63 | ;Returns error code in recordset field ERRORID
|
|---|
| 64 | ;
|
|---|
| 65 | S X="ERROR^BSDX13",@^%ZOSF("TRAP")
|
|---|
| 66 | N BSDXNOD,BSDXSTART,DIK,DA,BSDXID,BSDXI,BSDXEND,BSDXRSID
|
|---|
| 67 | ;
|
|---|
| 68 | S BSDXI=0
|
|---|
| 69 | S BSDXY="^BSDXTMP("_$J_")"
|
|---|
| 70 | K ^BSDXTMP($J)
|
|---|
| 71 | S ^BSDXTMP($J,0)="I00020ERRORID^T00030ERRORTEXT"_$C(30)
|
|---|
| 72 | I '+BSDXAVID D ERR(70) Q
|
|---|
| 73 | I '$D(^BSDXAB(BSDXAVID,0)) D ERR(70) Q
|
|---|
| 74 | ;
|
|---|
| 75 | ;
|
|---|
| 76 | ;TODO: Test for existing appointments in availability block
|
|---|
| 77 | ; (corresponds to old qryAppointmentBlocksOverlapC
|
|---|
| 78 | ; and AVBlockHasAppointments)
|
|---|
| 79 | ;
|
|---|
| 80 | ;I $$APTINBLK(BSDXAVID) D ERR(20) Q
|
|---|
| 81 | ;
|
|---|
| 82 | ;Delete AVAILABILITY entries
|
|---|
| 83 | D CALLDIK(BSDXAVID)
|
|---|
| 84 | ;
|
|---|
| 85 | S BSDXI=BSDXI+1
|
|---|
| 86 | S ^BSDXTMP($J,BSDXI)="-1^"_$C(30)_$C(31)
|
|---|
| 87 | Q
|
|---|
| 88 | ;
|
|---|
| 89 | CALLDIK(BSDXAVID) ;
|
|---|
| 90 | ;Delete AVAILABILITY entries
|
|---|
| 91 | ;
|
|---|
| 92 | S DIK="^BSDXAB("
|
|---|
| 93 | S DA=BSDXAVID
|
|---|
| 94 | D ^DIK
|
|---|
| 95 | ;
|
|---|
| 96 | Q
|
|---|
| 97 | ;
|
|---|
| 98 | APTINBLK(BSDXAVID) ;
|
|---|
| 99 | ;
|
|---|
| 100 | ;NOTE: This Subroutine Not called in current version. Keep code for later use.
|
|---|
| 101 | ;
|
|---|
| 102 | ;N BSDXS,BSDXID,BSDXHIT,BSDXNOD,BSDXE,BSDXSTART,BSDXEND,BSDXRSID
|
|---|
| 103 | ;S BSDXNOD=^BSDXAB(BSDXAVID,0)
|
|---|
| 104 | ;S BSDXSTART=$P(BSDXNOD,U,3)
|
|---|
| 105 | ;S BSDXEND=$P(BSDXNOD,U,4)
|
|---|
| 106 | ;S BSDXRSID=$P(BSDXNOD,U,1)
|
|---|
| 107 | ;I '$D(^BSDXDAPRS("ARSRC",BSDXRSID)) Q 0
|
|---|
| 108 | ;;If any appointments start at the AV block start time:
|
|---|
| 109 | ;I $D(^BSDXDAPRS("ARSRC",BSDXRSID,BSDXSTART)) Q 1
|
|---|
| 110 | ;;Find the first appt time BSDXS on the same day as the av block
|
|---|
| 111 | ;S BSDXS=$O(^BSDXDAPRS("ARSRC",BSDXRSID,$P(BSDXSTART,".")))
|
|---|
| 112 | ;I BSDXS>BSDXEND Q 0
|
|---|
| 113 | ;;For all the appts that day with start times less
|
|---|
| 114 | ;;than the av block's end time, find any whose end time is
|
|---|
| 115 | ;;greater than the av block's start time
|
|---|
| 116 | ;S BSDXHIT=0
|
|---|
| 117 | ;S BSDXS=BSDXS-.0001
|
|---|
| 118 | ;F S BSDXS=$O(^BSDXDAPRS("ARSRC",BSDXRSID,BSDXS)) Q:'+BSDXS Q:BSDXS'<BSDXEND D Q:BSDXHIT
|
|---|
| 119 | ;. S BSDXID=0 F S BSDXID=$O(^BSDXDAPRS("ARSRC",BSDXRSID,BSDXS,BSDXID)) Q:'+BSDXID D Q:BSDXHIT
|
|---|
| 120 | ;. . Q:'$D(^BSDXDAPT(BSDXID,0))
|
|---|
| 121 | ;. . S BSDXNOD=^BSDXDAPT(BSDXID,0)
|
|---|
| 122 | ;. . S BSDXE=$P(BSDXNOD,U,2)
|
|---|
| 123 | ;. . I BSDXE>BSDXSTART S BSDXHIT=1 Q
|
|---|
| 124 | ;;
|
|---|
| 125 | ;I BSDXHIT Q 1
|
|---|
| 126 | Q 0
|
|---|
| 127 | ;
|
|---|
| 128 | ;ERR(ERRNO) ;Error processing
|
|---|
| 129 | ;N BSDXERR
|
|---|
| 130 | ;S BSDXERR=ERRNO+134234112 ;vbObjectError
|
|---|
| 131 | ;S BSDXI=BSDXI+1
|
|---|
| 132 | ;S ^BSDXTMP($J,BSDXI)=BSDXERR_$C(30)
|
|---|
| 133 | ;S BSDXI=BSDXI+1
|
|---|
| 134 | ;S ^BSDXTMP($J,BSDXI)=$C(31)
|
|---|
| 135 | ;Q
|
|---|
