SDEC18 ;ALB/SAT - VISTA SCHEDULING RPCS ;JAN 15, 2016
;;5.3;Scheduling;**627**;Aug 13, 1993;Build 249
;
Q
;
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)
Q
;
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)
Q
;
ERR(SDECI,SDECID,SDECERR) ;Error processing
S SDECI=SDECI+1
S ^TMP("SDEC",$J,SDECI)=SDECID_"^"_SDECERR_$C(30,31)
Q
;
MADERR(SDECMSG) ;
W !,SDECMSG
Q
;
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")
;
Q
;
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)=""
Q
;
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)=""
Q
;
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
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
Q
;
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")
Q
;
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))
Q
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
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDEC18 10781 printed Apr 09, 2024@21:46:46 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
