Routine: SDEC18

SDEC18 ;ALB/SAT - VISTA SCHEDULING RPCS ;JAN 15, 2016

 ;;5.3;Scheduling;**627**;Aug 13, 1993;Build 249

DELRU(SDECY,SDECIEN) ;Delete Resource User from SDEC RESOURCE USER file

 ;DELRU(SDECY,SDECIEN)  external parameter tag is in SDEC

 ;SDECIEN - Resource User ID - Pointer to SDEC RESOURCE USER file

 ;Deletes entry SDECIEN from RESOURCE USERS file

 ;Return recordset containing error message or "" if no error

 ;Called by SDEC DELETE RESOURCEUSER

 N SDECI,DIK,DA

 S SDECI=0

 S SDECY="^TMP(""SDEC"","_$J_")"

 K @SDECY

 S ^TMP("SDEC",$J,0)="I00020RESOURCEUSERID^I00020ERRORID"_$C(30)

 I '+SDECIEN D ERR(SDECI,SDECIEN,70) Q

 I '$D(^SDEC(409.833,SDECIEN,0)) D ERR(SDECI,SDECIEN,70) Q

 ;Delete entry SDECIEN

 S DIK="^SDEC(409.833,"

 S DA=SDECIEN

 D ^DIK

 S SDECI=SDECI+1

 S ^TMP("SDEC",$J,SDECI)=SDECIEN_"^"_"-1"_$C(30)_$C(31)

ADDRESU(SDECY,SDECVAL) ;ADD/EDIT RESOURCE USER

 ;ADDRESU(SDECY,SDECVAL)  external parameter tag is in SDEC

 ;Add/Edit SDEC RESOURCEUSER entry

 ;SDECVAL 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"

 N SDECIENS,SDECFDA,SDECIEN,SDECMSG,SDEC,SDECOVB,SDECMOD,SDECI,SDECUID,SDECRID

 N SDECRES,SDECRSU,SDECF,SDECAPPT,SDECMOB

 S SDECY="^TMP(""SDEC"","_$J_")"

 K @SDECY

 S SDECI=0

 S ^TMP("SDEC",$J,SDECI)="I00020RESOURCEID^I00020ERRORID"_$C(30)

 S SDECIEN=$P(SDECVAL,"|")

 I +SDECIEN D

 . S SDEC="EDIT"

 . S SDECIENS=SDECIEN_","

 E  D

 . S SDEC="ADD"

 . S SDECIENS="+1,"

 I '+$P(SDECVAL,"|",4) D ERR(SDECI,SDECIEN,70) Q

 I '+$P(SDECVAL,"|",5) D ERR(SDECI,SDECIEN,70) Q

 S SDECRID=$P(SDECVAL,"|",4) ;ResourceID

 S SDECUID=$P(SDECVAL,"|",5) ;UserID

 S SDECRSU=0 ;ResourceUserID

 S SDECF=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 SDEC="ADD" F  S SDECRSU=$O(^SDEC(409.833,"AC",SDECUID,SDECRSU)) Q:'+SDECRSU  D  Q:SDECF

 . S SDECRES=$G(^SDEC(409.833,SDECRSU,0))

 . S SDECRES=$P(SDECRES,U) ;ResourceID

 . S:SDECRES=SDECRID SDECF=1

 I SDECF S SDEC="EDIT",SDECIEN=SDECRSU,SDECIENS=SDECIEN_","

 S SDECOVB=$P(SDECVAL,"|",2)

 S SDECOVB=$S(SDECOVB="YES":1,1:0)

 S SDECMOD=$P(SDECVAL,"|",3)

 S SDECMOD=$S(SDECMOD="YES":1,1:0)

 S SDECAPPT=$P(SDECVAL,"|",6)

 S SDECAPPT=$S(SDECAPPT="YES":1,1:0)

 S SDECMOB=$P(SDECVAL,"|",7)

 S SDECMOB=$S(SDECMOB="YES":1,1:0) ;Master Overbook Authority

 S SDECFDA(409.833,SDECIENS,.01)=$P(SDECVAL,"|",4) ;RESOURCE ID

 S SDECFDA(409.833,SDECIENS,.02)=$P(SDECVAL,"|",5) ;USERID

 S SDECFDA(409.833,SDECIENS,.03)=SDECOVB ;OVERBOOK

 S SDECFDA(409.833,SDECIENS,.04)=SDECMOD ;MODIFY SCHEDULE

 S SDECFDA(409.833,SDECIENS,.05)=SDECAPPT ;ADD, EDIT, DELETE APPOINMENTS

 S SDECFDA(409.833,SDECIENS,.06)=SDECMOB ;Master Overbook Authority

 I SDEC="ADD" D

 . K SDECIEN

 . D UPDATE^DIE("","SDECFDA","SDECIEN","SDECMSG")

 . S SDECIEN=+$G(SDECIEN(1))

 E  D

 . D FILE^DIE("","SDECFDA","SDECMSG")

 ;S ^TMP("SDEC",$J,1)=$G(SDECIEN)_"^-1"_$C(31)

 S ^TMP("SDEC",$J,1)=$C(31)

ERR(SDECI,SDECID,SDECERR) ;Error processing

 S SDECI=SDECI+1

 S ^TMP("SDEC",$J,SDECI)=SDECID_"^"_SDECERR_$C(30,31)

MADERR(SDECMSG) ;

 W !,SDECMSG

MADSCR(SDECDUZ,SDECZMGR,SDECZMENU) ;EP - File 200 screening code for MADDRU

 ;Called from DIR to screen for scheduling users

 I $D(^VA(200,SDECDUZ,51,"B",SDECZMENU)) Q 1

 I $D(^VA(200,SDECDUZ,51,"B",SDECZMGR)) 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 SDEC,SDECZMENU,SDECZMGR,DIR

 ;INIT

 K ^TMP($J)

 S SDECZMENU=$O(^DIC(19.1,"B","SDECZMENU",0)) I '+SDECZMENU D MADERR("Error: SDECZMENU KEY NOT FOUND.") Q

 S SDECZMGR=$O(^DIC(19.1,"B","SDECZMGR",0)) I '+SDECZMGR D MADERR("Error: SDECZMGR KEY NOT FOUND.") Q

 D MADUSR

 I '$D(^TMP($J,"SDEC MADDRU","USER")) D MADERR("Cancelled:  No Users selected.") Q

 D MADRES

 I '$D(^TMP($J,"SDEC MADDRU","RESOURCE")) D MADERR("Cancelled:  No Resources selected.") Q

 I '$$MADACC(.SDEC) ;D MADERR("Selected users will have no access to the selected clinics.")

 I '$$MADCONF(.SDEC) W ! D MADERR("--Cancelled") Q

 D MADASS(.SDEC)

 W ! D MADERR("--Done")

MADUSR ;Prompt for users from file 200 who have SDECUSER key

 ;Store results in ^TMP($J,"SDEC MADDRU","USER",DUZ) array

 N DIRUT,Y,DIR

 S DIR(0)="PO^200:EMZ",DIR("S")="I $$MADSCR^SDEC18(Y,SDECZMGR,SDECZMENU)"

 S Y=0

 K ^TMP($J,"SDEC MADDRU","USER")

 W !!,"-------Select Users-------"

 F  D ^DIR Q:$G(DIRUT)  Q:'Y  D

 . S ^TMP($J,"SDEC MADDRU","USER",+Y)=""

MADRES ;Prompt for Resources

 ;Store results in ^TMP($J,"SDEC MADDRU","RESOURCE",ResourceID) array

 N DIRUT,Y,DIR

 S DIR(0)="PO^409.831:EMZ"

 S Y=0

 K ^TMP($J,"SDEC MADDRU","RESOURCE")

 W !!,"-------Select Resources-------"

 F  D ^DIR Q:$G(DIRUT)  Q:'Y  D

 . S ^TMP($J,"SDEC MADDRU","RESOURCE",+Y)=""

MADACC(SDEC) ;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 SDEC(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 SDEC("MODIFY")=0

 S DIR("A")="Allow users to Overbook the selected clinics"

 D ^DIR

 Q:$G(DIRUT) 0

 Q:Y 1

 S SDEC("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 SDEC("WRITE")=0

 S DIR("A")="Allow users to View appointments in the selected resources"

 D ^DIR

 Q:$G(DIRUT)

 Q:Y 1

 S SDEC("READ")=0

Q 0

MADCONF(SDEC) ;Confirm selections

 N DIR,DIRUT,Y

 S DIR(0)="Y"

 W !!,"-------Confirm Selections-------"

 I SDEC("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,SDEC("MODIFY")

 . W !,"Overbook Appointments:  ",?50,SDEC("OVERBOOK")

 . W !,"Add, Edit and Delete Appointments:  ",?50,SDEC("WRITE")

 . W !,"View Clinic Appointments:  ",?50,SDEC("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(SDEC) ;

 ;Assign access level to selected users and resources

 ;Loop through selected users

 ;. Loop through selected resources

 ; . . If an entry in ^SDECRSU for this user/resource combination exists, then

 ; . . . S sResourceUserID = to it

 ; . . Else

 ; . . . S sResourceUserID = 0

 ; . . Call MADFILE

 N SDECU,SDECR,SDECRUID,SDECVAL

 S SDECU=0

 F  S SDECU=$O(^TMP($J,"SDEC MADDRU","USER",SDECU)) Q:'+SDECU  D

 . S SDECR=0 F  S SDECR=$O(^TMP($J,"SDEC MADDRU","RESOURCE",SDECR)) Q:'+SDECR  D

 . . S SDECRUID=$$MADEXST(SDECU,SDECR)

 . . S SDECVAL=SDECRUID_"|"_SDEC("OVERBOOK")_"|"_SDEC("MODIFY")_"|"_SDECR_"|"_SDECU_"|"_SDEC("WRITE")

 . . I +SDECRUID,SDEC("READ")=0 D MADDEL(SDECRUID)

 . . Q:SDEC("READ")=0

 . . D MADFILE(SDECVAL)

 . . Q

. Q

MADDEL(SDECRUID) ;

 ;Delete entry SDECRUID from SDEC RESOURCE USER file

 N DIK,DA

 Q:'+SDECRUID

 Q:'$D(^SDEC(409.833,SDECRUID))

 S DIK="^SDEC(409.833,"

 S DA=SDECRUID

 D ^DIK

MADFILE(SDECVAL) ;

 ;Add/Edit SDEC RESOURCEUSER entry

 ;SDECVAL is sResourceUserID|sOverbook|sModifySchedule|ResourceID|UserID|sModifyAppointments

 ;If sResourceUserID=0 Then this is a new ResourceUser entry

 N SDECIENS,SDECFDA,SDECIEN,SDECMSG,SDEC,SDECOVB,SDECMOD,SDECI,SDECUID,SDECRID

 N SDECRES,SDECRSU,SDECF,SDECAPPT

 S SDECIEN=$P(SDECVAL,"|")

 I +SDECIEN D

 . S SDEC="EDIT"

 . S SDECIENS=SDECIEN_","

 E  D

 . S SDEC="ADD"

 . S SDECIENS="+1,"

 I '+$P(SDECVAL,"|",4) D MADERR("Error in MADFILE^SDEC18: No Resource ID") Q

 I '+$P(SDECVAL,"|",5) D MADERR("Error in MADFILE^SDEC18: No User ID") Q

 S SDECRID=$P(SDECVAL,"|",4) ;ResourceID

 S SDECUID=$P(SDECVAL,"|",5) ;UserID

 S SDECRSU=0 ;ResourceUserID

 S SDECF=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 SDEC="ADD" F  S SDECRSU=$O(^SDEC(409.833,"AC",SDECUID,SDECRSU)) Q:'+SDECRSU  D  Q:SDECF

 . S SDECRES=$G(^SDEC(409.833,SDECRSU,0))

 . S SDECRES=$P(SDECRES,U) ;ResourceID

 . S:SDECRES=SDECRID SDECF=1

 I SDECF S SDEC="EDIT",SDECIEN=SDECRSU,SDECIENS=SDECIEN_","

 S SDECOVB=$P(SDECVAL,"|",2)

 S SDECMOD=$P(SDECVAL,"|",3)

 S SDECAPPT=$P(SDECVAL,"|",6)

 S SDECFDA(409.833,SDECIENS,.01)=$P(SDECVAL,"|",4) ;RESOURCE ID

 S SDECFDA(409.833,SDECIENS,.02)=$P(SDECVAL,"|",5) ;USERID

 S SDECFDA(409.833,SDECIENS,.03)=SDECOVB ;OVERBOOK

 S SDECFDA(409.833,SDECIENS,.04)=SDECMOD ;MODIFY SCHEDULE

 S SDECFDA(409.833,SDECIENS,.05)=SDECAPPT ;ADD, EDIT, DELETE APPOINMENTS

 K SDECMSG

 I SDEC="ADD" D

 . K SDECIEN

 . D UPDATE^DIE("","SDECFDA","SDECIEN","SDECMSG")

 . S SDECIEN=+$G(SDECIEN(1))

 E  D

 . D FILE^DIE("","SDECFDA","SDECMSG")

MADEXST(SDECU,SDECR) ;

 ;Returns SDEC RESOURCE USER ID

 ;if there is a SDEC RESOURCE USER entry for

 ;user SDECU and resource SDECR

 ;Otherwise, returns 0

 N SDECID,SDECFOUND,SDECNOD

 I '$D(^SDEC(409.833,"AC",SDECU)) Q 0

 S SDECID=0,SDECFOUND=0

 F  S SDECID=$O(^SDEC(409.833,"AC",SDECU,SDECID)) Q:'+SDECID  D  Q:SDECFOUND

 . S SDECNOD=$G(^SDEC(409.833,SDECID,0))

 . I +SDECNOD=SDECR S SDECFOUND=SDECID

. Q

 Q SDECFOUND

ADDRUXR(SDECR,SDECU)   ;Called from X-ref to add a resource user

 N IEN,SCIEN,SDECFDA,SDECIENS,SDECIEN,SDECMSG

 S SCIEN=0 F  S SCIEN=$O(^SDEC(409.831,"ALOC",SDECR,SCIEN)) Q:SCIEN'>0  S TYPE=$$GET1^DIQ(409.831,SCIEN_",",.012,"I") Q:TYPE["SC("

 I +SCIEN D

 .S IEN=$O(^SDEC(409.833,"AD",SCIEN,SDECU,""))

 .;If IEN,person is already in file for this clinic can quit.

 .I '+IEN D

 ..S SDECIENS="+1,"

 ..S SDECFDA(409.833,SDECIENS,.01)=SCIEN ;RESOURCE ID

 ..S SDECFDA(409.833,SDECIENS,.02)=SDECU ;USERID

 ..K SDECIEN

 ..D UPDATE^DIE("","SDECFDA","SDECIEN","SDECMSG")

 ..S SDECIEN=+$G(SDECIEN(1))

DELRUXR(SDECR,SDECU)  ;Called from X-ref to delete a resource user

 N IEN,SCIEN,SDECFDA,SDECIENS,SDECIEN,SDECMSG,TYPE

 N DA,DIK

 S SCIEN=0 F  S SCIEN=$O(^SDEC(409.831,"ALOC",SDECR,SCIEN)) Q:SCIEN'>0  S TYPE=$$GET1^DIQ(409.831,SCIEN_",",.012,"I") Q:TYPE["SC("

 I +SCIEN D

 .S IEN=$O(^SDEC(409.833,"AD",SCIEN,SDECU,""))

 .;Only need to delete if person is in file for this clinic

 .I +IEN D

 ..;Delete entry SDECIEN

 ..S DIK="^SDEC(409.833,"

 ..S DA=IEN

 ..D ^DIK

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDEC18   10781     printed  Feb 19, 2025@00:16:37                                                                                                                                                                                                     Page 2

SDEC18    ;ALB/SAT - VISTA SCHEDULING RPCS ;JAN 15, 2016

 +1       ;;5.3;Scheduling;**627**;Aug 13, 1993;Build 249

 +2       ;

 +3        QUIT

 +4       ;

DELRU(SDECY,SDECIEN) ;Delete Resource User from SDEC RESOURCE USER file

 +1       ;DELRU(SDECY,SDECIEN)  external parameter tag is in SDEC

 +2       ;SDECIEN - Resource User ID - Pointer to SDEC RESOURCE USER file

 +3       ;Deletes entry SDECIEN from RESOURCE USERS file

 +4       ;Return recordset containing error message or "" if no error

 +5       ;Called by SDEC DELETE RESOURCEUSER

 +6       ;

 +7        NEW SDECI,DIK,DA

 +8        SET SDECI=0

 +9        SET SDECY="^TMP(""SDEC"","_$JOB_")"

 +10       KILL @SDECY

 +11       SET ^TMP("SDEC",$JOB,0)="I00020RESOURCEUSERID^I00020ERRORID"_$CHAR(30)

 +12       IF '+SDECIEN

               DO ERR(SDECI,SDECIEN,70)

               QUIT

 +13       IF '$DATA(^SDEC(409.833,SDECIEN,0))

               DO ERR(SDECI,SDECIEN,70)

               QUIT

 +14      ;Delete entry SDECIEN

 +15       SET DIK="^SDEC(409.833,"

 +16       SET DA=SDECIEN

 +17       DO ^DIK

 +18      ;

 +19       SET SDECI=SDECI+1

 +20       SET ^TMP("SDEC",$JOB,SDECI)=SDECIEN_"^"_"-1"_$CHAR(30)_$CHAR(31)

 +21       QUIT

 +22      ;

ADDRESU(SDECY,SDECVAL) ;ADD/EDIT RESOURCE USER

 +1       ;ADDRESU(SDECY,SDECVAL)  external parameter tag is in SDEC

 +2       ;Add/Edit SDEC RESOURCEUSER entry

 +3       ;SDECVAL is sResourceUserID|sOverbook|sModifySchedule|ResourceID|UserID|sModifyAppointments|MASTEROVERBOOK

 +4       ;If IEN=0 Then this is a new ResourceUser entry

 +5       ; MASTEROVERBOOK = determines if this user has Master Overbook Authority  0="NO"; 1="YES"

 +6       ;

 +7        NEW SDECIENS,SDECFDA,SDECIEN,SDECMSG,SDEC,SDECOVB,SDECMOD,SDECI,SDECUID,SDECRID

 +8        NEW SDECRES,SDECRSU,SDECF,SDECAPPT,SDECMOB

 +9        SET SDECY="^TMP(""SDEC"","_$JOB_")"

 +10       KILL @SDECY

 +11       SET SDECI=0

 +12       SET ^TMP("SDEC",$JOB,SDECI)="I00020RESOURCEID^I00020ERRORID"_$CHAR(30)

 +13       SET SDECIEN=$PIECE(SDECVAL,"|")

 +14       IF +SDECIEN

               Begin DoDot:1

 +15               SET SDEC="EDIT"

 +16               SET SDECIENS=SDECIEN_","

               End DoDot:1

 +17      IF '$TEST

               Begin DoDot:1

 +18               SET SDEC="ADD"

 +19               SET SDECIENS="+1,"

               End DoDot:1

 +20      ;

 +21       IF '+$PIECE(SDECVAL,"|",4)

               DO ERR(SDECI,SDECIEN,70)

               QUIT

 +22       IF '+$PIECE(SDECVAL,"|",5)

               DO ERR(SDECI,SDECIEN,70)

               QUIT

 +23      ;

 +24      ;ResourceID

           SET SDECRID=$PIECE(SDECVAL,"|",4)

 +25      ;UserID

           SET SDECUID=$PIECE(SDECVAL,"|",5)

 +26      ;ResourceUserID

           SET SDECRSU=0

 +27      ;flag

           SET SDECF=0

 +28      ;If this is an add, check if the user is already assigned to the resource.

 +29      ;If so, then change to an edit

 +30       IF SDEC="ADD"

FOR

                   SET SDECRSU=$ORDER(^SDEC(409.833,"AC",SDECUID,SDECRSU))

                   if '+SDECRSU

                       QUIT

                   Begin DoDot:1

 +31                   SET SDECRES=$GET(^SDEC(409.833,SDECRSU,0))

 +32      ;ResourceID

                       SET SDECRES=$PIECE(SDECRES,U)

 +33                   if SDECRES=SDECRID

                           SET SDECF=1

                   End DoDot:1

                   if SDECF

                       QUIT

 +34       IF SDECF

               SET SDEC="EDIT"

               SET SDECIEN=SDECRSU

               SET SDECIENS=SDECIEN_","

 +35      ;

 +36       SET SDECOVB=$PIECE(SDECVAL,"|",2)

 +37       SET SDECOVB=$SELECT(SDECOVB="YES":1,1:0)

 +38       SET SDECMOD=$PIECE(SDECVAL,"|",3)

 +39       SET SDECMOD=$SELECT(SDECMOD="YES":1,1:0)

 +40       SET SDECAPPT=$PIECE(SDECVAL,"|",6)

 +41       SET SDECAPPT=$SELECT(SDECAPPT="YES":1,1:0)

 +42       SET SDECMOB=$PIECE(SDECVAL,"|",7)

 +43      ;Master Overbook Authority

           SET SDECMOB=$SELECT(SDECMOB="YES":1,1:0)

 +44      ;

 +45      ;RESOURCE ID

           SET SDECFDA(409.833,SDECIENS,.01)=$PIECE(SDECVAL,"|",4)

 +46      ;USERID

           SET SDECFDA(409.833,SDECIENS,.02)=$PIECE(SDECVAL,"|",5)

 +47      ;OVERBOOK

           SET SDECFDA(409.833,SDECIENS,.03)=SDECOVB

 +48      ;MODIFY SCHEDULE

           SET SDECFDA(409.833,SDECIENS,.04)=SDECMOD

 +49      ;ADD, EDIT, DELETE APPOINMENTS

           SET SDECFDA(409.833,SDECIENS,.05)=SDECAPPT

 +50      ;Master Overbook Authority

           SET SDECFDA(409.833,SDECIENS,.06)=SDECMOB

 +51       IF SDEC="ADD"

               Begin DoDot:1

 +52               KILL SDECIEN

 +53               DO UPDATE^DIE("","SDECFDA","SDECIEN","SDECMSG")

 +54               SET SDECIEN=+$GET(SDECIEN(1))

               End DoDot:1

 +55      IF '$TEST

               Begin DoDot:1

 +56               DO FILE^DIE("","SDECFDA","SDECMSG")

               End DoDot:1

 +57      ;S ^TMP("SDEC",$J,1)=$G(SDECIEN)_"^-1"_$C(31)

 +58       SET ^TMP("SDEC",$JOB,1)=$CHAR(31)

 +59       QUIT

 +60      ;

ERR(SDECI,SDECID,SDECERR) ;Error processing

 +1        SET SDECI=SDECI+1

 +2        SET ^TMP("SDEC",$JOB,SDECI)=SDECID_"^"_SDECERR_$CHAR(30,31)

 +3        QUIT

 +4       ;

MADERR(SDECMSG) ;

 +1        WRITE !,SDECMSG

 +2        QUIT

 +3       ;

MADSCR(SDECDUZ,SDECZMGR,SDECZMENU) ;EP - File 200 screening code for MADDRU

 +1       ;Called from DIR to screen for scheduling users

 +2        IF $DATA(^VA(200,SDECDUZ,51,"B",SDECZMENU))

               QUIT 1

 +3        IF $DATA(^VA(200,SDECDUZ,51,"B",SDECZMGR))

               QUIT 1

 +4        QUIT 0

 +5       ;

MADDRU    ;EP -Command line utility to bulk-add users and set access rights IHS/HMW 20060420 **1**

 +1       ;Main entry point

 +2       ;

 +3        NEW SDEC,SDECZMENU,SDECZMGR,DIR

 +4       ;

 +5       ;INIT

 +6        KILL ^TMP($JOB)

 +7        SET SDECZMENU=$ORDER(^DIC(19.1,"B","SDECZMENU",0))

           IF '+SDECZMENU

               DO MADERR("Error: SDECZMENU KEY NOT FOUND.")

               QUIT

 +8        SET SDECZMGR=$ORDER(^DIC(19.1,"B","SDECZMGR",0))

           IF '+SDECZMGR

               DO MADERR("Error: SDECZMGR KEY NOT FOUND.")

               QUIT

 +9       ;

 +10       DO MADUSR

 +11       IF '$DATA(^TMP($JOB,"SDEC MADDRU","USER"))

               DO MADERR("Cancelled:  No Users selected.")

               QUIT

 +12       DO MADRES

 +13       IF '$DATA(^TMP($JOB,"SDEC MADDRU","RESOURCE"))

               DO MADERR("Cancelled:  No Resources selected.")

               QUIT

 +14      ;D MADERR("Selected users will have no access to the selected clinics.")

           IF '$$MADACC(.SDEC)

 +15       IF '$$MADCONF(.SDEC)

               WRITE !

               DO MADERR("--Cancelled")

               QUIT

 +16       DO MADASS(.SDEC)

 +17       WRITE !

           DO MADERR("--Done")

 +18      ;

 +19       QUIT

 +20      ;

MADUSR    ;Prompt for users from file 200 who have SDECUSER key

 +1       ;Store results in ^TMP($J,"SDEC MADDRU","USER",DUZ) array

 +2        NEW DIRUT,Y,DIR

 +3        SET DIR(0)="PO^200:EMZ"

           SET DIR("S")="I $$MADSCR^SDEC18(Y,SDECZMGR,SDECZMENU)"

 +4        SET Y=0

 +5        KILL ^TMP($JOB,"SDEC MADDRU","USER")

 +6        WRITE !!,"-------Select Users-------"

 +7        FOR

               DO ^DIR

               if $GET(DIRUT)

                   QUIT

               if 'Y

                   QUIT

               Begin DoDot:1

 +8                SET ^TMP($JOB,"SDEC MADDRU","USER",+Y)=""

               End DoDot:1

 +9        QUIT

 +10      ;

MADRES    ;Prompt for Resources

 +1       ;Store results in ^TMP($J,"SDEC MADDRU","RESOURCE",ResourceID) array

 +2        NEW DIRUT,Y,DIR

 +3        SET DIR(0)="PO^409.831:EMZ"

 +4        SET Y=0

 +5        KILL ^TMP($JOB,"SDEC MADDRU","RESOURCE")

 +6        WRITE !!,"-------Select Resources-------"

 +7        FOR

               DO ^DIR

               if $GET(DIRUT)

                   QUIT

               if 'Y

                   QUIT

               Begin DoDot:1

 +8                SET ^TMP($JOB,"SDEC MADDRU","RESOURCE",+Y)=""

               End DoDot:1

 +9        QUIT

 +10      ;

MADACC(SDEC) ;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 SDEC(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 SDEC("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 SDEC("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 SDEC("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 SDEC("READ")=0

 +34      ;

 +35       QUIT 0

 +36      ;

MADCONF(SDEC) ;Confirm selections

 +1        NEW DIR,DIRUT,Y

 +2        SET DIR(0)="Y"

 +3        WRITE !!,"-------Confirm Selections-------"

 +4        IF SDEC("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,SDEC("MODIFY")

 +9                WRITE !,"Overbook Appointments:  ",?50,SDEC("OVERBOOK")

 +10               WRITE !,"Add, Edit and Delete Appointments:  ",?50,SDEC("WRITE")

 +11               WRITE !,"View Clinic Appointments:  ",?50,SDEC("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(SDEC) ;

 +1       ;Assign access level to selected users and resources

 +2       ;Loop through selected users

 +3       ;. Loop through selected resources

 +4       ; . . If an entry in ^SDECRSU for this user/resource combination exists, then

 +5       ; . . . S sResourceUserID = to it

 +6       ; . . Else

 +7       ; . . . S sResourceUserID = 0

 +8       ; . . Call MADFILE

 +9        NEW SDECU,SDECR,SDECRUID,SDECVAL

 +10       SET SDECU=0

 +11       FOR

               SET SDECU=$ORDER(^TMP($JOB,"SDEC MADDRU","USER",SDECU))

               if '+SDECU

                   QUIT

               Begin DoDot:1

 +12               SET SDECR=0

FOR

                       SET SDECR=$ORDER(^TMP($JOB,"SDEC MADDRU","RESOURCE",SDECR))

                       if '+SDECR

                           QUIT

                       Begin DoDot:2

 +13                       SET SDECRUID=$$MADEXST(SDECU,SDECR)

 +14                       SET SDECVAL=SDECRUID_"|"_SDEC("OVERBOOK")_"|"_SDEC("MODIFY")_"|"_SDECR_"|"_SDECU_"|"_SDEC("WRITE")

 +15                       IF +SDECRUID

                               IF SDEC("READ")=0

                                   DO MADDEL(SDECRUID)

 +16                       if SDEC("READ")=0

                               QUIT

 +17                       DO MADFILE(SDECVAL)

 +18                       QUIT

                       End DoDot:2

 +19               QUIT

               End DoDot:1

 +20       QUIT

 +21      ;

MADDEL(SDECRUID) ;

 +1       ;Delete entry SDECRUID from SDEC RESOURCE USER file

 +2        NEW DIK,DA

 +3        if '+SDECRUID

               QUIT

 +4        if '$DATA(^SDEC(409.833,SDECRUID))

               QUIT

 +5        SET DIK="^SDEC(409.833,"

 +6        SET DA=SDECRUID

 +7        DO ^DIK

 +8        QUIT

 +9       ;

MADFILE(SDECVAL) ;

 +1       ;

 +2       ;Add/Edit SDEC RESOURCEUSER entry

 +3       ;SDECVAL is sResourceUserID|sOverbook|sModifySchedule|ResourceID|UserID|sModifyAppointments

 +4       ;If sResourceUserID=0 Then this is a new ResourceUser entry

 +5       ;

 +6        NEW SDECIENS,SDECFDA,SDECIEN,SDECMSG,SDEC,SDECOVB,SDECMOD,SDECI,SDECUID,SDECRID

 +7        NEW SDECRES,SDECRSU,SDECF,SDECAPPT

 +8        SET SDECIEN=$PIECE(SDECVAL,"|")

 +9        IF +SDECIEN

               Begin DoDot:1

 +10               SET SDEC="EDIT"

 +11               SET SDECIENS=SDECIEN_","

               End DoDot:1

 +12      IF '$TEST

               Begin DoDot:1

 +13               SET SDEC="ADD"

 +14               SET SDECIENS="+1,"

               End DoDot:1

 +15      ;

 +16       IF '+$PIECE(SDECVAL,"|",4)

               DO MADERR("Error in MADFILE^SDEC18: No Resource ID")

               QUIT

 +17       IF '+$PIECE(SDECVAL,"|",5)

               DO MADERR("Error in MADFILE^SDEC18: No User ID")

               QUIT

 +18      ;

 +19      ;ResourceID

           SET SDECRID=$PIECE(SDECVAL,"|",4)

 +20      ;UserID

           SET SDECUID=$PIECE(SDECVAL,"|",5)

 +21      ;ResourceUserID

           SET SDECRSU=0

 +22      ;flag

           SET SDECF=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 SDEC="ADD"

FOR

                   SET SDECRSU=$ORDER(^SDEC(409.833,"AC",SDECUID,SDECRSU))

                   if '+SDECRSU

                       QUIT

                   Begin DoDot:1

 +26                   SET SDECRES=$GET(^SDEC(409.833,SDECRSU,0))

 +27      ;ResourceID

                       SET SDECRES=$PIECE(SDECRES,U)

 +28                   if SDECRES=SDECRID

                           SET SDECF=1

                   End DoDot:1

                   if SDECF

                       QUIT

 +29       IF SDECF

               SET SDEC="EDIT"

               SET SDECIEN=SDECRSU

               SET SDECIENS=SDECIEN_","

 +30      ;

 +31       SET SDECOVB=$PIECE(SDECVAL,"|",2)

 +32       SET SDECMOD=$PIECE(SDECVAL,"|",3)

 +33       SET SDECAPPT=$PIECE(SDECVAL,"|",6)

 +34      ;

 +35      ;RESOURCE ID

           SET SDECFDA(409.833,SDECIENS,.01)=$PIECE(SDECVAL,"|",4)

 +36      ;USERID

           SET SDECFDA(409.833,SDECIENS,.02)=$PIECE(SDECVAL,"|",5)

 +37      ;OVERBOOK

           SET SDECFDA(409.833,SDECIENS,.03)=SDECOVB

 +38      ;MODIFY SCHEDULE

           SET SDECFDA(409.833,SDECIENS,.04)=SDECMOD

 +39      ;ADD, EDIT, DELETE APPOINMENTS

           SET SDECFDA(409.833,SDECIENS,.05)=SDECAPPT

 +40       KILL SDECMSG

 +41       IF SDEC="ADD"

               Begin DoDot:1

 +42               KILL SDECIEN

 +43               DO UPDATE^DIE("","SDECFDA","SDECIEN","SDECMSG")

 +44               SET SDECIEN=+$GET(SDECIEN(1))

               End DoDot:1

 +45      IF '$TEST

               Begin DoDot:1

 +46               DO FILE^DIE("","SDECFDA","SDECMSG")

               End DoDot:1

 +47       QUIT

 +48      ;

MADEXST(SDECU,SDECR) ;

 +1       ;Returns SDEC RESOURCE USER ID

 +2       ;if there is a SDEC RESOURCE USER entry for

 +3       ;user SDECU and resource SDECR

 +4       ;Otherwise, returns 0

 +5       ;

 +6        NEW SDECID,SDECFOUND,SDECNOD

 +7        IF '$DATA(^SDEC(409.833,"AC",SDECU))

               QUIT 0

 +8        SET SDECID=0

           SET SDECFOUND=0

 +9        FOR

               SET SDECID=$ORDER(^SDEC(409.833,"AC",SDECU,SDECID))

               if '+SDECID

                   QUIT

               Begin DoDot:1

 +10               SET SDECNOD=$GET(^SDEC(409.833,SDECID,0))

 +11               IF +SDECNOD=SDECR

                       SET SDECFOUND=SDECID

 +12               QUIT

               End DoDot:1

               if SDECFOUND

                   QUIT

 +13       QUIT SDECFOUND

ADDRUXR(SDECR,SDECU) ;Called from X-ref to add a resource user

 +1        NEW IEN,SCIEN,SDECFDA,SDECIENS,SDECIEN,SDECMSG

 +2        SET SCIEN=0

FOR

               SET SCIEN=$ORDER(^SDEC(409.831,"ALOC",SDECR,SCIEN))

               if SCIEN'>0

                   QUIT

               SET TYPE=$$GET1^DIQ(409.831,SCIEN_",",.012,"I")

               if TYPE["SC("

                   QUIT

 +3        IF +SCIEN

               Begin DoDot:1

 +4                SET IEN=$ORDER(^SDEC(409.833,"AD",SCIEN,SDECU,""))

 +5       ;If IEN,person is already in file for this clinic can quit.

 +6                IF '+IEN

                       Begin DoDot:2

 +7                        SET SDECIENS="+1,"

 +8       ;RESOURCE ID

                           SET SDECFDA(409.833,SDECIENS,.01)=SCIEN

 +9       ;USERID

                           SET SDECFDA(409.833,SDECIENS,.02)=SDECU

 +10                       KILL SDECIEN

 +11                       DO UPDATE^DIE("","SDECFDA","SDECIEN","SDECMSG")

 +12                       SET SDECIEN=+$GET(SDECIEN(1))

                       End DoDot:2

               End DoDot:1

 +13       QUIT

DELRUXR(SDECR,SDECU) ;Called from X-ref to delete a resource user

 +1        NEW IEN,SCIEN,SDECFDA,SDECIENS,SDECIEN,SDECMSG,TYPE

 +2        NEW DA,DIK

 +3        SET SCIEN=0

FOR

               SET SCIEN=$ORDER(^SDEC(409.831,"ALOC",SDECR,SCIEN))

               if SCIEN'>0

                   QUIT

               SET TYPE=$$GET1^DIQ(409.831,SCIEN_",",.012,"I")

               if TYPE["SC("

                   QUIT

 +4        IF +SCIEN

               Begin DoDot:1

 +5                SET IEN=$ORDER(^SDEC(409.833,"AD",SCIEN,SDECU,""))

 +6       ;Only need to delete if person is in file for this clinic

 +7                IF +IEN

                       Begin DoDot:2

 +8       ;Delete entry SDECIEN

 +9                        SET DIK="^SDEC(409.833,"

 +10                       SET DA=IEN

 +11                       DO ^DIK

                       End DoDot:2

               End DoDot:1

 +12       QUIT

SDEC18.m