BSDX18 ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;
;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010
;
;
DELRUD(BSDXY,BSDXIEN) ;EP
;Entry point for debugging
;
;D DEBUG^%Serenji("DELRU^BSDX18(.BSDXY,BSDXIEN)")
Q
;
DELRU(BSDXY,BSDXIEN) ;EP
;Deletes entry BSDXIEN from RESOURCE USERS file
;Return recordset containing error message or "" if no error
;Called by BSDX DELETE RESOURCEUSER
;Test Line:
;D DELRU^BSDX18(.RES,99)
;
N BSDXI,DIK,DA
S BSDXI=0
S BSDXY="^BSDXTMP("_$J_")"
S ^BSDXTMP($J,0)="I00020RESOURCEUSERID^I00020ERRORID"_$C(30)
I '+BSDXIEN D ERR(BSDXI,BSDXIEN,70) Q
I '$D(^BSDXRSU(BSDXIEN,0)) D ERR(BSDXI,BSDXIEN,70) Q
;Delete entry BSDXIEN
S DIK="^BSDXRSU("
S DA=BSDXIEN
D ^DIK
;
S BSDXI=BSDXI+1
S ^BSDXTMP($J,BSDXI)=BSDXIEN_"^"_"-1"_$C(30)_$C(31)
Q
;
ADDRUD(BSDXY,BSDXVAL) ;EP
;Entry point for debugging
;
;D DEBUG^%Serenji("ADDRU^BSDX18(.BSDXY,BSDXVAL)")
Q
;
ADDRU(BSDXY,BSDXVAL) ;EP
;
;Called by BSDX ADD/EDIT RESOURCEUSER
;Add/Edit BSDX RESOURCEUSER entry
;BSDXVAL is sResourceUserID|sOverbook|sModifySchedule|ResourceID|UserID|sModifyAppointments|MASTEROVERBOOK
;If IEN=0 Then this is a new ResourceUser entry
; MASTEROVERBOOK = determines if this user has Master Overbook Authority 0="NO"; 1="YES"
;Test Line:
;D ADDRU^BSDX18(.RES,"sResourceUserID|sOverbook|sModifySchedule|sResourceID|sUserID|sModifyAppointments")
;
N BSDXIENS,BSDXFDA,BSDXIEN,BSDXMSG,BSDX,BSDXOVB,BSDXMOD,BSDXI,BSDXUID,BSDXRID
N BSDXRES,BSDXRSU,BSDXF,BSDXAPPT
S BSDXY="^BSDXTMP("_$J_")"
S BSDXI=0
S ^BSDXTMP($J,BSDXI)="I00020RESOURCEID^I00020ERRORID"_$C(30)
S BSDXIEN=$P(BSDXVAL,"|")
I +BSDXIEN D
. S BSDX="EDIT"
. S BSDXIENS=BSDXIEN_","
E D
. S BSDX="ADD"
. S BSDXIENS="+1,"
;
I '+$P(BSDXVAL,"|",4) D ERR(BSDXI,BSDXIEN,70) Q
I '+$P(BSDXVAL,"|",5) D ERR(BSDXI,BSDXIEN,70) Q
;
S BSDXRID=$P(BSDXVAL,"|",4) ;ResourceID
S BSDXUID=$P(BSDXVAL,"|",5) ;UserID
S BSDXRSU=0 ;ResourceUserID
S BSDXF=0 ;flag
;If this is an add, check if the user is already assigned to the resource.
;If so, then change to an edit
I BSDX="ADD" F S BSDXRSU=$O(^BSDXRSU("AC",BSDXUID,BSDXRSU)) Q:'+BSDXRSU D Q:BSDXF
. S BSDXRES=$G(^BSDXRSU(BSDXRSU,0))
. S BSDXRES=$P(BSDXRES,U) ;ResourceID
. S:BSDXRES=BSDXRID BSDXF=1
I BSDXF S BSDX="EDIT",BSDXIEN=BSDXRSU,BSDXIENS=BSDXIEN_","
;
S BSDXOVB=$P(BSDXVAL,"|",2)
S BSDXOVB=$S(BSDXOVB="YES":1,1:0)
S BSDXMOD=$P(BSDXVAL,"|",3)
S BSDXMOD=$S(BSDXMOD="YES":1,1:0)
S BSDXAPPT=$P(BSDXVAL,"|",6)
S BSDXAPPT=$S(BSDXAPPT="YES":1,1:0)
S BSDXMOB=$P(BSDXVAL,"|",7)
S BSDXMOB=$S(BSDXMOB="YES":1,1:0) ;Master Overbook Authority
;
S BSDXFDA(9002018.15,BSDXIENS,.01)=$P(BSDXVAL,"|",4) ;RESOURCE ID
S BSDXFDA(9002018.15,BSDXIENS,.02)=$P(BSDXVAL,"|",5) ;USERID
S BSDXFDA(9002018.15,BSDXIENS,.03)=BSDXOVB ;OVERBOOK
S BSDXFDA(9002018.15,BSDXIENS,.04)=BSDXMOD ;MODIFY SCHEDULE
S BSDXFDA(9002018.15,BSDXIENS,.05)=BSDXAPPT ;ADD, EDIT, DELETE APPOINMENTS
S BSDXFDA(9002018.15,BSDXIENS,.06)=BSDXMOB ;Master Overbook Authority
K BSDXMSG
I BSDX="ADD" D
. K BSDXIEN
. D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
. S BSDXIEN=+$G(BSDXIEN(1))
E D
. D FILE^DIE("","BSDXFDA","BSDXMSG")
;S ^BSDXTMP($J,1)=$G(BSDXIEN)_"^-1"_$C(31)
S ^BSDXTMP($J,1)=$C(31)
Q
;
ERR(BSDXI,BSDXID,BSDXERR) ;Error processing
S BSDXERR=BSDXERR+134234112 ;vbObjectError
S BSDXI=BSDXI+1
S ^BSDXTMP($J,BSDXI)=BSDXID_"^"_BSDXERR_$C(30)
S BSDXI=BSDXI+1
S ^BSDXTMP($J,BSDXI)=$C(31)
Q
;
MADERR(BSDXMSG) ;
W !,BSDXMSG
Q
;
MADSCR(BSDXDUZ,BSDXZMGR,BSDXZMENU,BSDXZPROG) ;EP - File 200 screening code for MADDRU
;Called from DIR to screen for scheduling users
I $D(^VA(200,BSDXDUZ,51,"B",BSDXZMENU)) Q 1
I $D(^VA(200,BSDXDUZ,51,"B",BSDXZMGR)) Q 1
I $D(^VA(200,BSDXDUZ,51,"B",BSDXZPROG)) Q 1
Q 0
;
MADDRU ;EP -Command line utility to bulk-add users and set access rights IHS/HMW 20060420 **1**
;Main entry point
;
N BSDX,BSDXZMENU,BSDXZMGR,BSDXZPROG,DIR
;
;INIT
K ^TMP($J)
S BSDXZMENU=$O(^DIC(19.1,"B","BSDXZMENU",0)) I '+BSDXZMENU D MADERR("Error: BSDXZMENU KEY NOT FOUND.") Q
S BSDXZMGR=$O(^DIC(19.1,"B","BSDXZMGR",0)) I '+BSDXZMGR D MADERR("Error: BSDXZMGR KEY NOT FOUND.") Q
S BSDXZPROG=$O(^DIC(19.1,"B","XUPROGMODE",0)) I '+BSDXZPROG D MADERR("Error: XUPROGMODE KEY NOT FOUND.") Q
;
D MADUSR
I '$D(^TMP($J,"BSDX MADDRU","USER")) D MADERR("Cancelled: No Users selected.") Q
D MADRES
I '$D(^TMP($J,"BSDX MADDRU","RESOURCE")) D MADERR("Cancelled: No Resources selected.") Q
I '$$MADACC(.BSDX) ;D MADERR("Selected users will have no access to the selected clinics.")
I '$$MADCONF(.BSDX) W ! D MADERR("--Cancelled") Q
D MADASS(.BSDX)
W ! D MADERR("--Done")
;
Q
;
MADUSR ;Prompt for users from file 200 who have BSDXUSER key
;Store results in ^TMP($J,"BSDX MADDRU","USER",DUZ) array
N DIRUT,Y,DIR
S DIR(0)="PO^200:EMZ",DIR("S")="I $$MADSCR^BSDX18(Y,BSDXZMGR,BSDXZMENU,BSDXZPROG)"
S Y=0
K ^TMP($J,"BSDX MADDRU","USER")
W !!,"-------Select Users-------"
F D ^DIR Q:$G(DIRUT) Q:'Y D
. S ^TMP($J,"BSDX MADDRU","USER",+Y)=""
Q
;
MADRES ;Prompt for Resources
;Store results in ^TMP($J,"BSDX MADDRU","RESOURCE",ResourceID) array
N DIRUT,Y,DIR
S DIR(0)="PO^9002018.1:EMZ"
S Y=0
K ^TMP($J,"BSDX MADDRU","RESOURCE")
W !!,"-------Select Resources-------"
F D ^DIR Q:$G(DIRUT) Q:'Y D
. S ^TMP($J,"BSDX MADDRU","RESOURCE",+Y)=""
Q
;
MADACC(BSDX) ;Prompt for access level.
;Start with Overbook and go to read-only access.
;Store results in variables for:
;sOverbook, sModifySchedule, sModifyAppointments
;
N DIRUT,Y,DIR,J
W !!,"-------Select Access Level-------"
S Y=0
F J="MODIFY","OVERBOOK","WRITE","READ" S BSDX(J)=1
S DIR(0)="Y"
;
S DIR("A")="Allow users to Modify Clinic Availability"
D ^DIR
Q:$G(DIRUT) 0
Q:Y 1
S BSDX("MODIFY")=0
;
S DIR("A")="Allow users to Overbook the selected clinics"
D ^DIR
Q:$G(DIRUT) 0
Q:Y 1
S BSDX("OVERBOOK")=0
;
S DIR("A")="Allow users to Add, Edit and Delete appointments in the selected resources"
D ^DIR
Q:$G(DIRUT)
Q:Y 1
S BSDX("WRITE")=0
;
S DIR("A")="Allow users to View appointments in the selected resources"
D ^DIR
Q:$G(DIRUT)
Q:Y 1
S BSDX("READ")=0
;
Q 0
;
MADCONF(BSDX) ;Confirm selections
N DIR,DIRUT,Y
S DIR(0)="Y"
W !!,"-------Confirm Selections-------"
I BSDX("READ")=0 D
. S DIR("A")="Are you sure you want to remove all access to these clinics for these users"
E D
. W !,"Selected users will be assigned the following access:"
. W !,"Modify clinic availability: ",?50,BSDX("MODIFY")
. W !,"Overbook Appointments: ",?50,BSDX("OVERBOOK")
. W !,"Add, Edit and Delete Appointments: ",?50,BSDX("WRITE")
. W !,"View Clinic Appointments: ",?50,BSDX("READ")
. S DIR("A")="Are you sure you want to assign these access rights to the selected users"
D ^DIR
Q:$G(DIRUT) 0
Q:$G(Y) 1
Q 0
;
MADASS(BSDX) ;
;Assign access level to selected users and resources
;Loop through selected users
;. Loop through selected resources
; . . If an entry in ^BSDXRSU for this user/resource combination exists, then
; . . . S sResourceUserID = to it
; . . Else
; . . . S sResourceUserID = 0
; . . Call MADFILE
N BSDXU,BSDXR,BSDXRUID,BSDXVAL
S BSDXU=0
F S BSDXU=$O(^TMP($J,"BSDX MADDRU","USER",BSDXU)) Q:'+BSDXU D
. S BSDXR=0 F S BSDXR=$O(^TMP($J,"BSDX MADDRU","RESOURCE",BSDXR)) Q:'+BSDXR D
. . S BSDXRUID=$$MADEXST(BSDXU,BSDXR)
. . S BSDXVAL=BSDXRUID_"|"_BSDX("OVERBOOK")_"|"_BSDX("MODIFY")_"|"_BSDXR_"|"_BSDXU_"|"_BSDX("WRITE")
. . I +BSDXRUID,BSDX("READ")=0 D MADDEL(BSDXRUID)
. . Q:BSDX("READ")=0
. . D MADFILE(BSDXVAL)
. . Q
. Q
Q
;
MADDEL(BSDXRUID) ;
;Delete entry BSDXRUID from BSDX RESOURCE USER file
N DIK,DA
Q:'+BSDXRUID
Q:'$D(^BSDXRSU(BSDXRUID))
S DIK="^BSDXRSU("
S DA=BSDXRUID
D ^DIK
Q
;
MADFILE(BSDXVAL) ;
;
;Add/Edit BSDX RESOURCEUSER entry
;BSDXVAL is sResourceUserID|sOverbook|sModifySchedule|ResourceID|UserID|sModifyAppointments
;If sResourceUserID=0 Then this is a new ResourceUser entry
;
N BSDXIENS,BSDXFDA,BSDXIEN,BSDXMSG,BSDX,BSDXOVB,BSDXMOD,BSDXI,BSDXUID,BSDXRID
N BSDXRES,BSDXRSU,BSDXF,BSDXAPPT
S BSDXIEN=$P(BSDXVAL,"|")
I +BSDXIEN D
. S BSDX="EDIT"
. S BSDXIENS=BSDXIEN_","
E D
. S BSDX="ADD"
. S BSDXIENS="+1,"
;
I '+$P(BSDXVAL,"|",4) D MADERR("Error in MADFILE^BSDX18: No Resource ID") Q
I '+$P(BSDXVAL,"|",5) D MADERR("Error in MADFILE^BSDX18: No User ID") Q
;
S BSDXRID=$P(BSDXVAL,"|",4) ;ResourceID
S BSDXUID=$P(BSDXVAL,"|",5) ;UserID
S BSDXRSU=0 ;ResourceUserID
S BSDXF=0 ;flag
;If this is an add, check if the user is already assigned to the resource.
;If so, then change to an edit
I BSDX="ADD" F S BSDXRSU=$O(^BSDXRSU("AC",BSDXUID,BSDXRSU)) Q:'+BSDXRSU D Q:BSDXF
. S BSDXRES=$G(^BSDXRSU(BSDXRSU,0))
. S BSDXRES=$P(BSDXRES,U) ;ResourceID
. S:BSDXRES=BSDXRID BSDXF=1
I BSDXF S BSDX="EDIT",BSDXIEN=BSDXRSU,BSDXIENS=BSDXIEN_","
;
S BSDXOVB=$P(BSDXVAL,"|",2)
S BSDXMOD=$P(BSDXVAL,"|",3)
S BSDXAPPT=$P(BSDXVAL,"|",6)
;
S BSDXFDA(9002018.15,BSDXIENS,.01)=$P(BSDXVAL,"|",4) ;RESOURCE ID
S BSDXFDA(9002018.15,BSDXIENS,.02)=$P(BSDXVAL,"|",5) ;USERID
S BSDXFDA(9002018.15,BSDXIENS,.03)=BSDXOVB ;OVERBOOK
S BSDXFDA(9002018.15,BSDXIENS,.04)=BSDXMOD ;MODIFY SCHEDULE
S BSDXFDA(9002018.15,BSDXIENS,.05)=BSDXAPPT ;ADD, EDIT, DELETE APPOINMENTS
K BSDXMSG
I BSDX="ADD" D
. K BSDXIEN
. D UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
. S BSDXIEN=+$G(BSDXIEN(1))
E D
. D FILE^DIE("","BSDXFDA","BSDXMSG")
Q
;
MADEXST(BSDXU,BSDXR) ;
;Returns BSDX RESOURCE USER ID
;if there is a BSDX RESOURCE USER entry for
;user BSDXU and resource BSDXR
;Otherwise, returns 0
;
N BSDXID,BSDXFOUND,BSDXNOD
I '$D(^BSDXRSU("AC",BSDXU)) Q 0
S BSDXID=0,BSDXFOUND=0
F S BSDXID=$O(^BSDXRSU("AC",BSDXU,BSDXID)) Q:'+BSDXID D Q:BSDXFOUND
. S BSDXNOD=$G(^BSDXRSU(BSDXID,0))
. I +BSDXNOD=BSDXR S BSDXFOUND=BSDXID
. Q
Q BSDXFOUND
BSDX18 ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;
+1 ;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010
+2 ;
+3 ;
DELRUD(BSDXY,BSDXIEN) ;EP
+1 ;Entry point for debugging
+2 ;
+3 ;D DEBUG^%Serenji("DELRU^BSDX18(.BSDXY,BSDXIEN)")
+4 QUIT
+5 ;
DELRU(BSDXY,BSDXIEN) ;EP
+1 ;Deletes entry BSDXIEN from RESOURCE USERS file
+2 ;Return recordset containing error message or "" if no error
+3 ;Called by BSDX DELETE RESOURCEUSER
+4 ;Test Line:
+5 ;D DELRU^BSDX18(.RES,99)
+6 ;
+7 NEW BSDXI,DIK,DA
+8 SET BSDXI=0
+9 SET BSDXY="^BSDXTMP("_$JOB_")"
+10 SET ^BSDXTMP($JOB,0)="I00020RESOURCEUSERID^I00020ERRORID"_$CHAR(30)
+11 IF '+BSDXIEN
DO ERR(BSDXI,BSDXIEN,70)
QUIT
+12 IF '$DATA(^BSDXRSU(BSDXIEN,0))
DO ERR(BSDXI,BSDXIEN,70)
QUIT
+13 ;Delete entry BSDXIEN
+14 SET DIK="^BSDXRSU("
+15 SET DA=BSDXIEN
+16 DO ^DIK
+17 ;
+18 SET BSDXI=BSDXI+1
+19 SET ^BSDXTMP($JOB,BSDXI)=BSDXIEN_"^"_"-1"_$CHAR(30)_$CHAR(31)
+20 QUIT
+21 ;
ADDRUD(BSDXY,BSDXVAL) ;EP
+1 ;Entry point for debugging
+2 ;
+3 ;D DEBUG^%Serenji("ADDRU^BSDX18(.BSDXY,BSDXVAL)")
+4 QUIT
+5 ;
ADDRU(BSDXY,BSDXVAL) ;EP
+1 ;
+2 ;Called by BSDX ADD/EDIT RESOURCEUSER
+3 ;Add/Edit BSDX RESOURCEUSER entry
+4 ;BSDXVAL is sResourceUserID|sOverbook|sModifySchedule|ResourceID|UserID|sModifyAppointments|MASTEROVERBOOK
+5 ;If IEN=0 Then this is a new ResourceUser entry
+6 ; MASTEROVERBOOK = determines if this user has Master Overbook Authority 0="NO"; 1="YES"
+7 ;Test Line:
+8 ;D ADDRU^BSDX18(.RES,"sResourceUserID|sOverbook|sModifySchedule|sResourceID|sUserID|sModifyAppointments")
+9 ;
+10 NEW BSDXIENS,BSDXFDA,BSDXIEN,BSDXMSG,BSDX,BSDXOVB,BSDXMOD,BSDXI,BSDXUID,BSDXRID
+11 NEW BSDXRES,BSDXRSU,BSDXF,BSDXAPPT
+12 SET BSDXY="^BSDXTMP("_$JOB_")"
+13 SET BSDXI=0
+14 SET ^BSDXTMP($JOB,BSDXI)="I00020RESOURCEID^I00020ERRORID"_$CHAR(30)
+15 SET BSDXIEN=$PIECE(BSDXVAL,"|")
+16 IF +BSDXIEN
Begin DoDot:1
+17 SET BSDX="EDIT"
+18 SET BSDXIENS=BSDXIEN_","
End DoDot:1
+19 IF '$TEST
Begin DoDot:1
+20 SET BSDX="ADD"
+21 SET BSDXIENS="+1,"
End DoDot:1
+22 ;
+23 IF '+$PIECE(BSDXVAL,"|",4)
DO ERR(BSDXI,BSDXIEN,70)
QUIT
+24 IF '+$PIECE(BSDXVAL,"|",5)
DO ERR(BSDXI,BSDXIEN,70)
QUIT
+25 ;
+26 ;ResourceID
SET BSDXRID=$PIECE(BSDXVAL,"|",4)
+27 ;UserID
SET BSDXUID=$PIECE(BSDXVAL,"|",5)
+28 ;ResourceUserID
SET BSDXRSU=0
+29 ;flag
SET BSDXF=0
+30 ;If this is an add, check if the user is already assigned to the resource.
+31 ;If so, then change to an edit
+32 IF BSDX="ADD"
FOR
SET BSDXRSU=$ORDER(^BSDXRSU("AC",BSDXUID,BSDXRSU))
IF '+BSDXRSU
QUIT
Begin DoDot:1
+33 SET BSDXRES=$GET(^BSDXRSU(BSDXRSU,0))
+34 ;ResourceID
SET BSDXRES=$PIECE(BSDXRES,U)
+35 IF BSDXRES=BSDXRID
SET BSDXF=1
End DoDot:1
IF BSDXF
QUIT
+36 IF BSDXF
SET BSDX="EDIT"
SET BSDXIEN=BSDXRSU
SET BSDXIENS=BSDXIEN_","
+37 ;
+38 SET BSDXOVB=$PIECE(BSDXVAL,"|",2)
+39 SET BSDXOVB=$SELECT(BSDXOVB="YES":1,1:0)
+40 SET BSDXMOD=$PIECE(BSDXVAL,"|",3)
+41 SET BSDXMOD=$SELECT(BSDXMOD="YES":1,1:0)
+42 SET BSDXAPPT=$PIECE(BSDXVAL,"|",6)
+43 SET BSDXAPPT=$SELECT(BSDXAPPT="YES":1,1:0)
+44 SET BSDXMOB=$PIECE(BSDXVAL,"|",7)
+45 ;Master Overbook Authority
SET BSDXMOB=$SELECT(BSDXMOB="YES":1,1:0)
+46 ;
+47 ;RESOURCE ID
SET BSDXFDA(9002018.15,BSDXIENS,.01)=$PIECE(BSDXVAL,"|",4)
+48 ;USERID
SET BSDXFDA(9002018.15,BSDXIENS,.02)=$PIECE(BSDXVAL,"|",5)
+49 ;OVERBOOK
SET BSDXFDA(9002018.15,BSDXIENS,.03)=BSDXOVB
+50 ;MODIFY SCHEDULE
SET BSDXFDA(9002018.15,BSDXIENS,.04)=BSDXMOD
+51 ;ADD, EDIT, DELETE APPOINMENTS
SET BSDXFDA(9002018.15,BSDXIENS,.05)=BSDXAPPT
+52 ;Master Overbook Authority
SET BSDXFDA(9002018.15,BSDXIENS,.06)=BSDXMOB
+53 KILL BSDXMSG
+54 IF BSDX="ADD"
Begin DoDot:1
+55 KILL BSDXIEN
+56 DO UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
+57 SET BSDXIEN=+$GET(BSDXIEN(1))
End DoDot:1
+58 IF '$TEST
Begin DoDot:1
+59 DO FILE^DIE("","BSDXFDA","BSDXMSG")
End DoDot:1
+60 ;S ^BSDXTMP($J,1)=$G(BSDXIEN)_"^-1"_$C(31)
+61 SET ^BSDXTMP($JOB,1)=$CHAR(31)
+62 QUIT
+63 ;
ERR(BSDXI,BSDXID,BSDXERR) ;Error processing
+1 ;vbObjectError
SET BSDXERR=BSDXERR+134234112
+2 SET BSDXI=BSDXI+1
+3 SET ^BSDXTMP($JOB,BSDXI)=BSDXID_"^"_BSDXERR_$CHAR(30)
+4 SET BSDXI=BSDXI+1
+5 SET ^BSDXTMP($JOB,BSDXI)=$CHAR(31)
+6 QUIT
+7 ;
MADERR(BSDXMSG) ;
+1 WRITE !,BSDXMSG
+2 QUIT
+3 ;
MADSCR(BSDXDUZ,BSDXZMGR,BSDXZMENU,BSDXZPROG) ;EP - File 200 screening code for MADDRU
+1 ;Called from DIR to screen for scheduling users
+2 IF $DATA(^VA(200,BSDXDUZ,51,"B",BSDXZMENU))
QUIT 1
+3 IF $DATA(^VA(200,BSDXDUZ,51,"B",BSDXZMGR))
QUIT 1
+4 IF $DATA(^VA(200,BSDXDUZ,51,"B",BSDXZPROG))
QUIT 1
+5 QUIT 0
+6 ;
MADDRU ;EP -Command line utility to bulk-add users and set access rights IHS/HMW 20060420 **1**
+1 ;Main entry point
+2 ;
+3 NEW BSDX,BSDXZMENU,BSDXZMGR,BSDXZPROG,DIR
+4 ;
+5 ;INIT
+6 KILL ^TMP($JOB)
+7 SET BSDXZMENU=$ORDER(^DIC(19.1,"B","BSDXZMENU",0))
IF '+BSDXZMENU
DO MADERR("Error: BSDXZMENU KEY NOT FOUND.")
QUIT
+8 SET BSDXZMGR=$ORDER(^DIC(19.1,"B","BSDXZMGR",0))
IF '+BSDXZMGR
DO MADERR("Error: BSDXZMGR KEY NOT FOUND.")
QUIT
+9 SET BSDXZPROG=$ORDER(^DIC(19.1,"B","XUPROGMODE",0))
IF '+BSDXZPROG
DO MADERR("Error: XUPROGMODE KEY NOT FOUND.")
QUIT
+10 ;
+11 DO MADUSR
+12 IF '$DATA(^TMP($JOB,"BSDX MADDRU","USER"))
DO MADERR("Cancelled: No Users selected.")
QUIT
+13 DO MADRES
+14 IF '$DATA(^TMP($JOB,"BSDX MADDRU","RESOURCE"))
DO MADERR("Cancelled: No Resources selected.")
QUIT
+15 ;D MADERR("Selected users will have no access to the selected clinics.")
IF '$$MADACC(.BSDX)
+16 IF '$$MADCONF(.BSDX)
WRITE !
DO MADERR("--Cancelled")
QUIT
+17 DO MADASS(.BSDX)
+18 WRITE !
DO MADERR("--Done")
+19 ;
+20 QUIT
+21 ;
MADUSR ;Prompt for users from file 200 who have BSDXUSER key
+1 ;Store results in ^TMP($J,"BSDX MADDRU","USER",DUZ) array
+2 NEW DIRUT,Y,DIR
+3 SET DIR(0)="PO^200:EMZ"
SET DIR("S")="I $$MADSCR^BSDX18(Y,BSDXZMGR,BSDXZMENU,BSDXZPROG)"
+4 SET Y=0
+5 KILL ^TMP($JOB,"BSDX MADDRU","USER")
+6 WRITE !!,"-------Select Users-------"
+7 FOR
DO ^DIR
IF $GET(DIRUT)
QUIT
IF 'Y
QUIT
Begin DoDot:1
+8 SET ^TMP($JOB,"BSDX MADDRU","USER",+Y)=""
End DoDot:1
+9 QUIT
+10 ;
MADRES ;Prompt for Resources
+1 ;Store results in ^TMP($J,"BSDX MADDRU","RESOURCE",ResourceID) array
+2 NEW DIRUT,Y,DIR
+3 SET DIR(0)="PO^9002018.1:EMZ"
+4 SET Y=0
+5 KILL ^TMP($JOB,"BSDX MADDRU","RESOURCE")
+6 WRITE !!,"-------Select Resources-------"
+7 FOR
DO ^DIR
IF $GET(DIRUT)
QUIT
IF 'Y
QUIT
Begin DoDot:1
+8 SET ^TMP($JOB,"BSDX MADDRU","RESOURCE",+Y)=""
End DoDot:1
+9 QUIT
+10 ;
MADACC(BSDX) ;Prompt for access level.
+1 ;Start with Overbook and go to read-only access.
+2 ;Store results in variables for:
+3 ;sOverbook, sModifySchedule, sModifyAppointments
+4 ;
+5 NEW DIRUT,Y,DIR,J
+6 WRITE !!,"-------Select Access Level-------"
+7 SET Y=0
+8 FOR J="MODIFY","OVERBOOK","WRITE","READ"
SET BSDX(J)=1
+9 SET DIR(0)="Y"
+10 ;
+11 SET DIR("A")="Allow users to Modify Clinic Availability"
+12 DO ^DIR
+13 IF $GET(DIRUT)
QUIT 0
+14 IF Y
QUIT 1
+15 SET BSDX("MODIFY")=0
+16 ;
+17 SET DIR("A")="Allow users to Overbook the selected clinics"
+18 DO ^DIR
+19 IF $GET(DIRUT)
QUIT 0
+20 IF Y
QUIT 1
+21 SET BSDX("OVERBOOK")=0
+22 ;
+23 SET DIR("A")="Allow users to Add, Edit and Delete appointments in the selected resources"
+24 DO ^DIR
+25 IF $GET(DIRUT)
QUIT
+26 IF Y
QUIT 1
+27 SET BSDX("WRITE")=0
+28 ;
+29 SET DIR("A")="Allow users to View appointments in the selected resources"
+30 DO ^DIR
+31 IF $GET(DIRUT)
QUIT
+32 IF Y
QUIT 1
+33 SET BSDX("READ")=0
+34 ;
+35 QUIT 0
+36 ;
MADCONF(BSDX) ;Confirm selections
+1 NEW DIR,DIRUT,Y
+2 SET DIR(0)="Y"
+3 WRITE !!,"-------Confirm Selections-------"
+4 IF BSDX("READ")=0
Begin DoDot:1
+5 SET DIR("A")="Are you sure you want to remove all access to these clinics for these users"
End DoDot:1
+6 IF '$TEST
Begin DoDot:1
+7 WRITE !,"Selected users will be assigned the following access:"
+8 WRITE !,"Modify clinic availability: ",?50,BSDX("MODIFY")
+9 WRITE !,"Overbook Appointments: ",?50,BSDX("OVERBOOK")
+10 WRITE !,"Add, Edit and Delete Appointments: ",?50,BSDX("WRITE")
+11 WRITE !,"View Clinic Appointments: ",?50,BSDX("READ")
+12 SET DIR("A")="Are you sure you want to assign these access rights to the selected users"
End DoDot:1
+13 DO ^DIR
+14 IF $GET(DIRUT)
QUIT 0
+15 IF $GET(Y)
QUIT 1
+16 QUIT 0
+17 ;
MADASS(BSDX) ;
+1 ;Assign access level to selected users and resources
+2 ;Loop through selected users
+3 ;. Loop through selected resources
+4 ; . . If an entry in ^BSDXRSU for this user/resource combination exists, then
+5 ; . . . S sResourceUserID = to it
+6 ; . . Else
+7 ; . . . S sResourceUserID = 0
+8 ; . . Call MADFILE
+9 NEW BSDXU,BSDXR,BSDXRUID,BSDXVAL
+10 SET BSDXU=0
+11 FOR
SET BSDXU=$ORDER(^TMP($JOB,"BSDX MADDRU","USER",BSDXU))
IF '+BSDXU
QUIT
Begin DoDot:1
+12 SET BSDXR=0
FOR
SET BSDXR=$ORDER(^TMP($JOB,"BSDX MADDRU","RESOURCE",BSDXR))
IF '+BSDXR
QUIT
Begin DoDot:2
+13 SET BSDXRUID=$$MADEXST(BSDXU,BSDXR)
+14 SET BSDXVAL=BSDXRUID_"|"_BSDX("OVERBOOK")_"|"_BSDX("MODIFY")_"|"_BSDXR_"|"_BSDXU_"|"_BSDX("WRITE")
+15 IF +BSDXRUID
IF BSDX("READ")=0
DO MADDEL(BSDXRUID)
+16 IF BSDX("READ")=0
QUIT
+17 DO MADFILE(BSDXVAL)
+18 QUIT
End DoDot:2
+19 QUIT
End DoDot:1
+20 QUIT
+21 ;
MADDEL(BSDXRUID) ;
+1 ;Delete entry BSDXRUID from BSDX RESOURCE USER file
+2 NEW DIK,DA
+3 IF '+BSDXRUID
QUIT
+4 IF '$DATA(^BSDXRSU(BSDXRUID))
QUIT
+5 SET DIK="^BSDXRSU("
+6 SET DA=BSDXRUID
+7 DO ^DIK
+8 QUIT
+9 ;
MADFILE(BSDXVAL) ;
+1 ;
+2 ;Add/Edit BSDX RESOURCEUSER entry
+3 ;BSDXVAL is sResourceUserID|sOverbook|sModifySchedule|ResourceID|UserID|sModifyAppointments
+4 ;If sResourceUserID=0 Then this is a new ResourceUser entry
+5 ;
+6 NEW BSDXIENS,BSDXFDA,BSDXIEN,BSDXMSG,BSDX,BSDXOVB,BSDXMOD,BSDXI,BSDXUID,BSDXRID
+7 NEW BSDXRES,BSDXRSU,BSDXF,BSDXAPPT
+8 SET BSDXIEN=$PIECE(BSDXVAL,"|")
+9 IF +BSDXIEN
Begin DoDot:1
+10 SET BSDX="EDIT"
+11 SET BSDXIENS=BSDXIEN_","
End DoDot:1
+12 IF '$TEST
Begin DoDot:1
+13 SET BSDX="ADD"
+14 SET BSDXIENS="+1,"
End DoDot:1
+15 ;
+16 IF '+$PIECE(BSDXVAL,"|",4)
DO MADERR("Error in MADFILE^BSDX18: No Resource ID")
QUIT
+17 IF '+$PIECE(BSDXVAL,"|",5)
DO MADERR("Error in MADFILE^BSDX18: No User ID")
QUIT
+18 ;
+19 ;ResourceID
SET BSDXRID=$PIECE(BSDXVAL,"|",4)
+20 ;UserID
SET BSDXUID=$PIECE(BSDXVAL,"|",5)
+21 ;ResourceUserID
SET BSDXRSU=0
+22 ;flag
SET BSDXF=0
+23 ;If this is an add, check if the user is already assigned to the resource.
+24 ;If so, then change to an edit
+25 IF BSDX="ADD"
FOR
SET BSDXRSU=$ORDER(^BSDXRSU("AC",BSDXUID,BSDXRSU))
IF '+BSDXRSU
QUIT
Begin DoDot:1
+26 SET BSDXRES=$GET(^BSDXRSU(BSDXRSU,0))
+27 ;ResourceID
SET BSDXRES=$PIECE(BSDXRES,U)
+28 IF BSDXRES=BSDXRID
SET BSDXF=1
End DoDot:1
IF BSDXF
QUIT
+29 IF BSDXF
SET BSDX="EDIT"
SET BSDXIEN=BSDXRSU
SET BSDXIENS=BSDXIEN_","
+30 ;
+31 SET BSDXOVB=$PIECE(BSDXVAL,"|",2)
+32 SET BSDXMOD=$PIECE(BSDXVAL,"|",3)
+33 SET BSDXAPPT=$PIECE(BSDXVAL,"|",6)
+34 ;
+35 ;RESOURCE ID
SET BSDXFDA(9002018.15,BSDXIENS,.01)=$PIECE(BSDXVAL,"|",4)
+36 ;USERID
SET BSDXFDA(9002018.15,BSDXIENS,.02)=$PIECE(BSDXVAL,"|",5)
+37 ;OVERBOOK
SET BSDXFDA(9002018.15,BSDXIENS,.03)=BSDXOVB
+38 ;MODIFY SCHEDULE
SET BSDXFDA(9002018.15,BSDXIENS,.04)=BSDXMOD
+39 ;ADD, EDIT, DELETE APPOINMENTS
SET BSDXFDA(9002018.15,BSDXIENS,.05)=BSDXAPPT
+40 KILL BSDXMSG
+41 IF BSDX="ADD"
Begin DoDot:1
+42 KILL BSDXIEN
+43 DO UPDATE^DIE("","BSDXFDA","BSDXIEN","BSDXMSG")
+44 SET BSDXIEN=+$GET(BSDXIEN(1))
End DoDot:1
+45 IF '$TEST
Begin DoDot:1
+46 DO FILE^DIE("","BSDXFDA","BSDXMSG")
End DoDot:1
+47 QUIT
+48 ;
MADEXST(BSDXU,BSDXR) ;
+1 ;Returns BSDX RESOURCE USER ID
+2 ;if there is a BSDX RESOURCE USER entry for
+3 ;user BSDXU and resource BSDXR
+4 ;Otherwise, returns 0
+5 ;
+6 NEW BSDXID,BSDXFOUND,BSDXNOD
+7 IF '$DATA(^BSDXRSU("AC",BSDXU))
QUIT 0
+8 SET BSDXID=0
SET BSDXFOUND=0
+9 FOR
SET BSDXID=$ORDER(^BSDXRSU("AC",BSDXU,BSDXID))
IF '+BSDXID
QUIT
Begin DoDot:1
+10 SET BSDXNOD=$GET(^BSDXRSU(BSDXID,0))
+11 IF +BSDXNOD=BSDXR
SET BSDXFOUND=BSDXID
+12 QUIT
End DoDot:1
IF BSDXFOUND
QUIT
+13 QUIT BSDXFOUND
