Routine: BSDX18

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)")

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)

ADDRUD(BSDXY,BSDXVAL) ;EP

 ;Entry point for debugging

 ;D DEBUG^%Serenji("ADDRU^BSDX18(.BSDXY,BSDXVAL)")

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)

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)

MADERR(BSDXMSG) ;

 W !,BSDXMSG

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")

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)=""

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)=""

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

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

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")

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

BSDX18.m