BSDX01 ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;25-Aug-2010 08:44;DU
;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010
;
;
SUINFOD(BSDXY,BSDXDUZ) ;EP Debugging entry point
;
;
;D DEBUG^%Serenji("SUINFO^BSDX01(.BSDXY,BSDXDUZ)")
;
Q
;
SUINFO(BSDXY,BSDXDUZ) ;EP
;Called by BSDX SCHEDULING USER INFO
;Returns ADO Recordset having column MANAGER
;MANAGER = YES if user has keys BSDXZMGR or XUPROGMODE
;
N BSDXMGR,BSDXERR
K ^BSDXTMP($J)
S BSDXY="^BSDXTMP("_$J_")"
S BSDXI=0
S BSDXERR=""
S ^BSDXTMP($J,BSDXI)="T00010MANAGER"_$C(30)
;Check SECURITY KEY file for BSDXZMGR or XUPROGMODE keys
I '+BSDXDUZ S BSDXDUZ=DUZ
S BSDXMGR=$$APSEC("BSDXZMGR",BSDXDUZ)
S BSDXMGR=$S(BSDXMGR=1:"YES",1:"NO")
S BSDXI=BSDXI+1
S ^BSDXTMP($J,BSDXI)=BSDXMGR_$C(30)
S ^BSDXTMP($J,BSDXI+1)=$C(31)_BSDXERR
Q
DEPUSRD(BSDXY,BSDXDUZ) ;EP Debugging entry point
;
;
;D DEBUG^%Serenji("DEPUSR^BSDX01(.BSDXY,BSDXDUZ)")
;
Q
;
DEPUSR(BSDXY,BSDXDUZ) ;EP
;Called by BSDX RESOURCE GROUPS BY USER
;Returns ADO Recordset with all ACTIVE resource group names to which user has access
;based on entries in BSDX RESOURCE USER file
;If BSDXDUZ=0 then returns all department names for current DUZ
;If user BSDXDUZ possesses the key BSDXZMGR or XUPROGMODE
;then ALL resource group names are returned regardless of whether any active resources
;are associated with the group or not.
;
;
N BSDXERR,BSDXRET,BSDXIEN,BSDXRES,BSDXDEP,BSDXDDR,BSDXDEPN,BSDXRDAT,BSDXRNOD,BSDXI
N BSDXMGR,BSDXNOD
K ^BSDXTEMP($J)
K ^BSDXTMP($J)
S BSDXY="^BSDXTMP("_$J_")"
S BSDXI=0
S BSDXERR=""
S ^BSDXTMP($J,BSDXI)="I00020RESOURCE_GROUPID^T00030RESOURCE_GROUP"_$C(30)
I '+BSDXDUZ S BSDXDUZ=DUZ
;Check SECURITY KEY file for BSDXZMGR or XUPROGMODE keys
S BSDXMGR=$$APSEC("BSDXZMGR",BSDXDUZ)
;
;User does not have BSDXZMGR or XUPROGMODE keys, so
;$O THRU AC XREF OF BSDX RESOURCE USER
I 'BSDXMGR,$D(^BSDXRSU("AC",BSDXDUZ)) S BSDXIEN=0 F S BSDXIEN=$O(^BSDXRSU("AC",BSDXDUZ,BSDXIEN)) Q:'+BSDXIEN D
. S BSDXRES=$P(^BSDXRSU(BSDXIEN,0),U)
. Q:'$D(^BSDXDEPT("AB",BSDXRES))
. Q:'$D(^BSDXRES(BSDXRES))
. S BSDXRNOD=^BSDXRES(BSDXRES,0)
. ;QUIT if the resource is inactive
. Q:$P(BSDXRNOD,U,2)=1
. S BSDXDEP=0 F S BSDXDEP=$O(^BSDXDEPT("AB",BSDXRES,BSDXDEP)) Q:'+BSDXDEP D
. . Q:'$D(^BSDXDEPT(BSDXDEP,0))
. . Q:$D(^BSDXTEMP($J,BSDXDEP))
. . S ^BSDXTEMP($J,BSDXDEP)=""
. . S BSDXDEPN=$P(^BSDXDEPT(BSDXDEP,0),U)
. . S BSDXI=BSDXI+1
. . S ^BSDXTMP($J,BSDXI)=BSDXDEP_U_BSDXDEPN_$C(30)
. . Q
. Q
;
;User does have BSDXZMGR or XUPROGMODE keys, so
;$O THRU BSDX RESOURCE GROUP file directly
I BSDXMGR S BSDXIEN=0 F S BSDXIEN=$O(^BSDXDEPT(BSDXIEN)) Q:'+BSDXIEN D
. Q:'$D(^BSDXDEPT(BSDXIEN,0))
. S BSDXNOD=^BSDXDEPT(BSDXIEN,0)
. S BSDXDEPN=$P(BSDXNOD,U)
. S BSDXI=BSDXI+1
. S ^BSDXTMP($J,BSDXI)=BSDXIEN_U_BSDXDEPN_$C(30)
. Q
;
S ^BSDXTMP($J,BSDXI+1)=$C(31)_BSDXERR
Q
;
;
RESUSRD(BSDXY,BSDXDUZ) ;EP Debugging entry point
;
;
;D DEBUG^%Serenji("RESUSR^BSDX01(.BSDXY,BSDXDUZ)")
;
Q
;
RESUSR(BSDXY,BSDXDUZ) ;EP
;Returns ADO Recordset with ALL RESOURCE names
;Inactive RESOURCES are NOT filtered out
;Called by BSDX RESOURCES BY USER
;
N BSDXERR,BSDXRET,BSDXIEN,BSDXRES,BSDXDEP,BSDXDDR,BSDXDEPN,BSDXRDAT,BSDXRNOD,BSDXI,BSDX,BSDXLTR
N BSDXNOS,BSDXCAN
K ^BSDXTMP($J)
S BSDXY="^BSDXTMP("_$J_")"
S BSDXI=0
S BSDXERR=""
S ^BSDXTMP($J,BSDXI)="I00010RESOURCEID^T00030RESOURCE_NAME^T00010INACTIVE^I00010TIMESCALE^I00010HOSPITAL_LOCATION_ID^T00030LETTER_TEXT^T00030NO_SHOW_LETTER"
S ^BSDXTMP($J,BSDXI)=^(BSDXI)_"^T00030CLINIC_CANCELLATION_LETTER^I00010VIEW^I00010OVERBOOK^I00010MODIFY_SCHEDULE^I00010MODIFY_APPOINTMENTS"_$C(30)
I '+BSDXDUZ S BSDXDUZ=DUZ
;$O THRU AC XREF OF BSDX RESOURCE USER
;Rmoved these lines in order to just return all resource names
;I $D(^BSDXRSU("AC",BSDXDUZ)) S BSDXIEN=0 F S BSDXIEN=$O(^BSDXRSU("AC",BSDXDUZ,BSDXIEN)) Q:'+BSDXIEN D
;. S BSDXRES=$P(^BSDXRSU(BSDXIEN,0),U)
;
;$O THRU BSDX RESOURCE File
S BSDXRES=0 F S BSDXRES=$O(^BSDXRES(BSDXRES)) Q:'+BSDXRES D
. Q:'$D(^BSDXRES(BSDXRES,0))
. S BSDXRNOD=^BSDXRES(BSDXRES,0)
. ;Q:$P(BSDXRNOD,U,2)=1 ;Inactive resources not filtered
. ;S BSDXRDAT=$P(BSDXRNOD,U,1,4)
. K BSDXRDAT
. F BSDX=1:1:4 S $P(BSDXRDAT,U,BSDX)=$P(BSDXRNOD,U,BSDX)
. S BSDXRDAT=BSDXRES_U_BSDXRDAT
. ;Get letter text from wp field
. S BSDXLTR=""
. I $D(^BSDXRES(BSDXRES,1)) D
. . S BSDXIEN=0
. . F S BSDXIEN=$O(^BSDXRES(BSDXRES,1,BSDXIEN)) Q:'+BSDXIEN D
. . . S BSDXLTR=BSDXLTR_$G(^BSDXRES(BSDXRES,1,BSDXIEN,0))
. . . S BSDXLTR=BSDXLTR_$C(13)_$C(10)
. S BSDXNOS=""
. I $D(^BSDXRES(BSDXRES,12)) D
. . S BSDXIEN=0 F S BSDXIEN=$O(^BSDXRES(BSDXRES,12,BSDXIEN)) Q:'+BSDXIEN D
. . . S BSDXNOS=BSDXNOS_$G(^BSDXRES(BSDXRES,12,BSDXIEN,0))
. . . S BSDXNOS=BSDXNOS_$C(13)_$C(10)
. S BSDXCAN=""
. I $D(^BSDXRES(BSDXRES,13)) D
. . S BSDXIEN=0 F S BSDXIEN=$O(^BSDXRES(BSDXRES,13,BSDXIEN)) Q:'+BSDXIEN D
. . . S BSDXCAN=BSDXCAN_$G(^BSDXRES(BSDXRES,13,BSDXIEN,0))
. . . S BSDXCAN=BSDXCAN_$C(13)_$C(10)
. N BSDXACC,BSDXMGR
. S BSDXACC="0^0^0^0"
. S BSDXMGR=$O(^DIC(19.1,"B","BSDXZMGR",0))
. I +BSDXMGR,$D(^VA(200,BSDXDUZ,51,BSDXMGR)) S BSDXACC="1^1^1^1"
. S BSDXMGR=$O(^DIC(19.1,"B","XUPROGMODE",0))
. I +BSDXMGR,$D(^VA(200,BSDXDUZ,51,BSDXMGR)) S BSDXACC="1^1^1^1"
. I BSDXACC="0^0^0^0" D
. . N BSDXNOD,BSDXRUID
. . S BSDXRUID=0
. . ;Get entry for this user and resource
. . F S BSDXRUID=$O(^BSDXRSU("AC",BSDXDUZ,BSDXRUID)) Q:'+BSDXRUID I $D(^BSDXRSU(BSDXRUID,0)),$P(^(0),U)=BSDXRES Q
. . Q:'+BSDXRUID
. . S $P(BSDXACC,U)=1
. . S BSDXNOD=$G(^BSDXRSU(BSDXRUID,0))
. . S $P(BSDXACC,U,2)=+$P(BSDXNOD,U,3)
. . S $P(BSDXACC,U,3)=+$P(BSDXNOD,U,4)
. . S $P(BSDXACC,U,4)=+$P(BSDXNOD,U,5)
. S BSDXRDAT=BSDXRDAT_U_BSDXLTR_U_BSDXNOS_U_BSDXCAN_U_BSDXACC
. S BSDXI=BSDXI+1
. S ^BSDXTMP($J,BSDXI)=BSDXRDAT_$C(30)
S ^BSDXTMP($J,BSDXI+1)=$C(31)_BSDXERR
Q
;
DEPRESD(BSDXY,BSDXDUZ) ;EP Debugging entry point
;
;
;D DEBUG^%Serenji("DEPRES^BSDX01(.BSDXY,BSDXDUZ)")
;
Q
;
DEPRES(BSDXY,BSDXDUZ) ;EP
;Called by BSDX GROUP RESOURCE
;Returns ADO Recordset with all ACTIVE GROUP/RESOURCE combinations
;to which user has access based on entries in BSDX RESOURCE USER file
;If BSDXDUZ=0 then returns all ACTIVE GROUP/RESOURCE combinations for current DUZ
;If user BSDXDUZ possesses the key BSDXZMGR or XUPROGMODE
;then ALL ACTIVE resource group names are returned
;
N BSDXERR,BSDXRET,BSDXIEN,BSDXRES,BSDXDEP,BSDXDDR,BSDXDEPN,BSDXRDAT,BSDXRNOD,BSDXI
N BSDXRESN,BSDXMGR,BSDXRESD,BSDXNOD,BSDXSUBID
K ^BSDXTEMP($J)
K ^BSDXTMP($J)
S BSDXY="^BSDXTMP("_$J_")"
S BSDXI=0
S BSDXERR=""
S ^BSDXTMP($J,BSDXI)="I00020RESOURCE_GROUPID^T00030RESOURCE_GROUP^I00020RESOURCE_GROUP_ITEMID^T00030RESOURCE_NAME^I00020RESOURCEID"_$C(30)
I '+BSDXDUZ S BSDXDUZ=DUZ
;Check SECURITY KEY file for BSDXZMGR or XUPROGMODE keys
S BSDXMGR=$$APSEC("BSDXZMGR",BSDXDUZ)
;
;User does not have BSDXZMGR or XUPROGMODE keys, so
;$O THRU AC XREF OF BSDX RESOURCE USER
I 'BSDXMGR,$D(^BSDXRSU("AC",BSDXDUZ)) S BSDXIEN=0 F S BSDXIEN=$O(^BSDXRSU("AC",BSDXDUZ,BSDXIEN)) Q:'+BSDXIEN D
. S BSDXRES=$P(^BSDXRSU(BSDXIEN,0),U)
. Q:'$D(^BSDXDEPT("AB",BSDXRES))
. Q:'$D(^BSDXRES(BSDXRES))
. S BSDXRNOD=$G(^BSDXRES(BSDXRES,0))
. Q:BSDXRNOD=""
. ;QUIT if the resource is inactive
. Q:$P(BSDXRNOD,U,2)=1
. S BSDXRESN=$P(BSDXRNOD,U)
. S BSDXDEP=0 F S BSDXDEP=$O(^BSDXDEPT("AB",BSDXRES,BSDXDEP)) Q:'+BSDXDEP D
. . Q:'$D(^BSDXDEPT(BSDXDEP,0))
. . S BSDXDEPN=$P(^BSDXDEPT(BSDXDEP,0),U)
. . S BSDXSUBID=$O(^BSDXDEPT(BSDXDEP,1,"B",BSDXRES,0))
. . S BSDXI=BSDXI+1
. . S ^BSDXTMP($J,BSDXI)=BSDXDEP_U_BSDXDEPN_U_BSDXSUBID_U_BSDXRESN_U_BSDXRES_$C(30)
. Q
;
;User does have BSDXZMGR or XUPROGMODE keys, so
;$O THRU BSDX RESOURCE GROUP file directly
I BSDXMGR S BSDXIEN=0 F S BSDXIEN=$O(^BSDXDEPT(BSDXIEN)) Q:'+BSDXIEN D
. Q:'$D(^BSDXDEPT(BSDXIEN,0))
. S BSDXNOD=^BSDXDEPT(BSDXIEN,0)
. S BSDXDEPN=$P(BSDXNOD,U)
. S BSDXRES=0 F S BSDXRES=$O(^BSDXDEPT(BSDXIEN,1,BSDXRES)) Q:'+BSDXRES D
. . N BSDXRESD
. . Q:'$D(^BSDXDEPT(BSDXIEN,1,BSDXRES,0))
. . S BSDXRESD=$P(^BSDXDEPT(BSDXIEN,1,BSDXRES,0),"^")
. . Q:'$D(^BSDXRES(BSDXRESD,0))
. . S BSDXRNOD=$G(^BSDXRES(BSDXRESD,0))
. . Q:BSDXRNOD=""
. . ;QUIT if the resource is inactive
. . Q:$P(BSDXRNOD,U,2)=1
. . S BSDXRESN=$P(BSDXRNOD,U)
. . S BSDXI=BSDXI+1
. . S ^BSDXTMP($J,BSDXI)=BSDXIEN_U_BSDXDEPN_U_BSDXRES_U_BSDXRESN_U_BSDXRESD_$C(30)
. . Q
. Q
;
S ^BSDXTMP($J,BSDXI+1)=$C(31)_BSDXERR
Q
;
APSEC(BSDXKEY,BSDXDUZ) ;EP - Return TRUE (1) if user has keys BSDXKEY or XUPROGMODE, otherwise, returns FALSE (0)
;
N BSDXIEN,BSDXPROG,BSDXPKEY
I '$G(BSDXDUZ) Q 0
;
;Test for programmer mode key
S BSDXPROG=0
I $D(^DIC(19.1,"B","XUPROGMODE")) D
. S BSDXPKEY=$O(^DIC(19.1,"B","XUPROGMODE",0))
. I '+BSDXPKEY Q
. I '$D(^VA(200,BSDXDUZ,51,BSDXPKEY,0)) Q
. S BSDXPROG=1
I BSDXPROG Q 1
;
I BSDXKEY="" Q 0
I '$D(^DIC(19.1,"B",BSDXKEY)) Q 0
S BSDXIEN=$O(^DIC(19.1,"B",BSDXKEY,0))
I '+BSDXIEN Q 0
I '$D(^VA(200,BSDXDUZ,51,BSDXIEN,0)) Q 0
Q 1
BSDX01 ; IHS/OIT/HMW/MSC/SAT - WINDOWS SCHEDULING RPCS ;25-Aug-2010 08:44;DU
+1 ;;3.0;IHS WINDOWS SCHEDULING;;DEC 09, 2010
+2 ;
+3 ;
SUINFOD(BSDXY,BSDXDUZ) ;EP Debugging entry point
+1 ;
+2 ;
+3 ;D DEBUG^%Serenji("SUINFO^BSDX01(.BSDXY,BSDXDUZ)")
+4 ;
+5 QUIT
+6 ;
SUINFO(BSDXY,BSDXDUZ) ;EP
+1 ;Called by BSDX SCHEDULING USER INFO
+2 ;Returns ADO Recordset having column MANAGER
+3 ;MANAGER = YES if user has keys BSDXZMGR or XUPROGMODE
+4 ;
+5 NEW BSDXMGR,BSDXERR
+6 KILL ^BSDXTMP($JOB)
+7 SET BSDXY="^BSDXTMP("_$JOB_")"
+8 SET BSDXI=0
+9 SET BSDXERR=""
+10 SET ^BSDXTMP($JOB,BSDXI)="T00010MANAGER"_$CHAR(30)
+11 ;Check SECURITY KEY file for BSDXZMGR or XUPROGMODE keys
+12 IF '+BSDXDUZ
SET BSDXDUZ=DUZ
+13 SET BSDXMGR=$$APSEC("BSDXZMGR",BSDXDUZ)
+14 SET BSDXMGR=$SELECT(BSDXMGR=1:"YES",1:"NO")
+15 SET BSDXI=BSDXI+1
+16 SET ^BSDXTMP($JOB,BSDXI)=BSDXMGR_$CHAR(30)
+17 SET ^BSDXTMP($JOB,BSDXI+1)=$CHAR(31)_BSDXERR
+18 QUIT
DEPUSRD(BSDXY,BSDXDUZ) ;EP Debugging entry point
+1 ;
+2 ;
+3 ;D DEBUG^%Serenji("DEPUSR^BSDX01(.BSDXY,BSDXDUZ)")
+4 ;
+5 QUIT
+6 ;
DEPUSR(BSDXY,BSDXDUZ) ;EP
+1 ;Called by BSDX RESOURCE GROUPS BY USER
+2 ;Returns ADO Recordset with all ACTIVE resource group names to which user has access
+3 ;based on entries in BSDX RESOURCE USER file
+4 ;If BSDXDUZ=0 then returns all department names for current DUZ
+5 ;If user BSDXDUZ possesses the key BSDXZMGR or XUPROGMODE
+6 ;then ALL resource group names are returned regardless of whether any active resources
+7 ;are associated with the group or not.
+8 ;
+9 ;
+10 NEW BSDXERR,BSDXRET,BSDXIEN,BSDXRES,BSDXDEP,BSDXDDR,BSDXDEPN,BSDXRDAT,BSDXRNOD,BSDXI
+11 NEW BSDXMGR,BSDXNOD
+12 KILL ^BSDXTEMP($JOB)
+13 KILL ^BSDXTMP($JOB)
+14 SET BSDXY="^BSDXTMP("_$JOB_")"
+15 SET BSDXI=0
+16 SET BSDXERR=""
+17 SET ^BSDXTMP($JOB,BSDXI)="I00020RESOURCE_GROUPID^T00030RESOURCE_GROUP"_$CHAR(30)
+18 IF '+BSDXDUZ
SET BSDXDUZ=DUZ
+19 ;Check SECURITY KEY file for BSDXZMGR or XUPROGMODE keys
+20 SET BSDXMGR=$$APSEC("BSDXZMGR",BSDXDUZ)
+21 ;
+22 ;User does not have BSDXZMGR or XUPROGMODE keys, so
+23 ;$O THRU AC XREF OF BSDX RESOURCE USER
+24 IF 'BSDXMGR
IF $DATA(^BSDXRSU("AC",BSDXDUZ))
SET BSDXIEN=0
FOR
SET BSDXIEN=$ORDER(^BSDXRSU("AC",BSDXDUZ,BSDXIEN))
IF '+BSDXIEN
QUIT
Begin DoDot:1
+25 SET BSDXRES=$PIECE(^BSDXRSU(BSDXIEN,0),U)
+26 IF '$DATA(^BSDXDEPT("AB",BSDXRES))
QUIT
+27 IF '$DATA(^BSDXRES(BSDXRES))
QUIT
+28 SET BSDXRNOD=^BSDXRES(BSDXRES,0)
+29 ;QUIT if the resource is inactive
+30 IF $PIECE(BSDXRNOD,U,2)=1
QUIT
+31 SET BSDXDEP=0
FOR
SET BSDXDEP=$ORDER(^BSDXDEPT("AB",BSDXRES,BSDXDEP))
IF '+BSDXDEP
QUIT
Begin DoDot:2
+32 IF '$DATA(^BSDXDEPT(BSDXDEP,0))
QUIT
+33 IF $DATA(^BSDXTEMP($JOB,BSDXDEP))
QUIT
+34 SET ^BSDXTEMP($JOB,BSDXDEP)=""
+35 SET BSDXDEPN=$PIECE(^BSDXDEPT(BSDXDEP,0),U)
+36 SET BSDXI=BSDXI+1
+37 SET ^BSDXTMP($JOB,BSDXI)=BSDXDEP_U_BSDXDEPN_$CHAR(30)
+38 QUIT
End DoDot:2
+39 QUIT
End DoDot:1
+40 ;
+41 ;User does have BSDXZMGR or XUPROGMODE keys, so
+42 ;$O THRU BSDX RESOURCE GROUP file directly
+43 IF BSDXMGR
SET BSDXIEN=0
FOR
SET BSDXIEN=$ORDER(^BSDXDEPT(BSDXIEN))
IF '+BSDXIEN
QUIT
Begin DoDot:1
+44 IF '$DATA(^BSDXDEPT(BSDXIEN,0))
QUIT
+45 SET BSDXNOD=^BSDXDEPT(BSDXIEN,0)
+46 SET BSDXDEPN=$PIECE(BSDXNOD,U)
+47 SET BSDXI=BSDXI+1
+48 SET ^BSDXTMP($JOB,BSDXI)=BSDXIEN_U_BSDXDEPN_$CHAR(30)
+49 QUIT
End DoDot:1
+50 ;
+51 SET ^BSDXTMP($JOB,BSDXI+1)=$CHAR(31)_BSDXERR
+52 QUIT
+53 ;
+54 ;
RESUSRD(BSDXY,BSDXDUZ) ;EP Debugging entry point
+1 ;
+2 ;
+3 ;D DEBUG^%Serenji("RESUSR^BSDX01(.BSDXY,BSDXDUZ)")
+4 ;
+5 QUIT
+6 ;
RESUSR(BSDXY,BSDXDUZ) ;EP
+1 ;Returns ADO Recordset with ALL RESOURCE names
+2 ;Inactive RESOURCES are NOT filtered out
+3 ;Called by BSDX RESOURCES BY USER
+4 ;
+5 NEW BSDXERR,BSDXRET,BSDXIEN,BSDXRES,BSDXDEP,BSDXDDR,BSDXDEPN,BSDXRDAT,BSDXRNOD,BSDXI,BSDX,BSDXLTR
+6 NEW BSDXNOS,BSDXCAN
+7 KILL ^BSDXTMP($JOB)
+8 SET BSDXY="^BSDXTMP("_$JOB_")"
+9 SET BSDXI=0
+10 SET BSDXERR=""
+11 SET ^BSDXTMP($JOB,BSDXI)="I00010RESOURCEID^T00030RESOURCE_NAME^T00010INACTIVE^I00010TIMESCALE^I00010HOSPITAL_LOCATION_ID^T00030LETTER_TEXT^T00030NO_SHOW_LETTER"
+12 SET ^BSDXTMP($JOB,BSDXI)=^(BSDXI)_"^T00030CLINIC_CANCELLATION_LETTER^I00010VIEW^I00010OVERBOOK^I00010MODIFY_SCHEDULE^I00010MODIFY_APPOINTMENTS"_$CHAR(30)
+13 IF '+BSDXDUZ
SET BSDXDUZ=DUZ
+14 ;$O THRU AC XREF OF BSDX RESOURCE USER
+15 ;Rmoved these lines in order to just return all resource names
+16 ;I $D(^BSDXRSU("AC",BSDXDUZ)) S BSDXIEN=0 F S BSDXIEN=$O(^BSDXRSU("AC",BSDXDUZ,BSDXIEN)) Q:'+BSDXIEN D
+17 ;. S BSDXRES=$P(^BSDXRSU(BSDXIEN,0),U)
+18 ;
+19 ;$O THRU BSDX RESOURCE File
+20 SET BSDXRES=0
FOR
SET BSDXRES=$ORDER(^BSDXRES(BSDXRES))
IF '+BSDXRES
QUIT
Begin DoDot:1
+21 IF '$DATA(^BSDXRES(BSDXRES,0))
QUIT
+22 SET BSDXRNOD=^BSDXRES(BSDXRES,0)
+23 ;Q:$P(BSDXRNOD,U,2)=1 ;Inactive resources not filtered
+24 ;S BSDXRDAT=$P(BSDXRNOD,U,1,4)
+25 KILL BSDXRDAT
+26 FOR BSDX=1:1:4
SET $PIECE(BSDXRDAT,U,BSDX)=$PIECE(BSDXRNOD,U,BSDX)
+27 SET BSDXRDAT=BSDXRES_U_BSDXRDAT
+28 ;Get letter text from wp field
+29 SET BSDXLTR=""
+30 IF $DATA(^BSDXRES(BSDXRES,1))
Begin DoDot:2
+31 SET BSDXIEN=0
+32 FOR
SET BSDXIEN=$ORDER(^BSDXRES(BSDXRES,1,BSDXIEN))
IF '+BSDXIEN
QUIT
Begin DoDot:3
+33 SET BSDXLTR=BSDXLTR_$GET(^BSDXRES(BSDXRES,1,BSDXIEN,0))
+34 SET BSDXLTR=BSDXLTR_$CHAR(13)_$CHAR(10)
End DoDot:3
End DoDot:2
+35 SET BSDXNOS=""
+36 IF $DATA(^BSDXRES(BSDXRES,12))
Begin DoDot:2
+37 SET BSDXIEN=0
FOR
SET BSDXIEN=$ORDER(^BSDXRES(BSDXRES,12,BSDXIEN))
IF '+BSDXIEN
QUIT
Begin DoDot:3
+38 SET BSDXNOS=BSDXNOS_$GET(^BSDXRES(BSDXRES,12,BSDXIEN,0))
+39 SET BSDXNOS=BSDXNOS_$CHAR(13)_$CHAR(10)
End DoDot:3
End DoDot:2
+40 SET BSDXCAN=""
+41 IF $DATA(^BSDXRES(BSDXRES,13))
Begin DoDot:2
+42 SET BSDXIEN=0
FOR
SET BSDXIEN=$ORDER(^BSDXRES(BSDXRES,13,BSDXIEN))
IF '+BSDXIEN
QUIT
Begin DoDot:3
+43 SET BSDXCAN=BSDXCAN_$GET(^BSDXRES(BSDXRES,13,BSDXIEN,0))
+44 SET BSDXCAN=BSDXCAN_$CHAR(13)_$CHAR(10)
End DoDot:3
End DoDot:2
+45 NEW BSDXACC,BSDXMGR
+46 SET BSDXACC="0^0^0^0"
+47 SET BSDXMGR=$ORDER(^DIC(19.1,"B","BSDXZMGR",0))
+48 IF +BSDXMGR
IF $DATA(^VA(200,BSDXDUZ,51,BSDXMGR))
SET BSDXACC="1^1^1^1"
+49 SET BSDXMGR=$ORDER(^DIC(19.1,"B","XUPROGMODE",0))
+50 IF +BSDXMGR
IF $DATA(^VA(200,BSDXDUZ,51,BSDXMGR))
SET BSDXACC="1^1^1^1"
+51 IF BSDXACC="0^0^0^0"
Begin DoDot:2
+52 NEW BSDXNOD,BSDXRUID
+53 SET BSDXRUID=0
+54 ;Get entry for this user and resource
+55 FOR
SET BSDXRUID=$ORDER(^BSDXRSU("AC",BSDXDUZ,BSDXRUID))
IF '+BSDXRUID
QUIT
IF $DATA(^BSDXRSU(BSDXRUID,0))
IF $PIECE(^(0),U)=BSDXRES
QUIT
+56 IF '+BSDXRUID
QUIT
+57 SET $PIECE(BSDXACC,U)=1
+58 SET BSDXNOD=$GET(^BSDXRSU(BSDXRUID,0))
+59 SET $PIECE(BSDXACC,U,2)=+$PIECE(BSDXNOD,U,3)
+60 SET $PIECE(BSDXACC,U,3)=+$PIECE(BSDXNOD,U,4)
+61 SET $PIECE(BSDXACC,U,4)=+$PIECE(BSDXNOD,U,5)
End DoDot:2
+62 SET BSDXRDAT=BSDXRDAT_U_BSDXLTR_U_BSDXNOS_U_BSDXCAN_U_BSDXACC
+63 SET BSDXI=BSDXI+1
+64 SET ^BSDXTMP($JOB,BSDXI)=BSDXRDAT_$CHAR(30)
End DoDot:1
+65 SET ^BSDXTMP($JOB,BSDXI+1)=$CHAR(31)_BSDXERR
+66 QUIT
+67 ;
DEPRESD(BSDXY,BSDXDUZ) ;EP Debugging entry point
+1 ;
+2 ;
+3 ;D DEBUG^%Serenji("DEPRES^BSDX01(.BSDXY,BSDXDUZ)")
+4 ;
+5 QUIT
+6 ;
DEPRES(BSDXY,BSDXDUZ) ;EP
+1 ;Called by BSDX GROUP RESOURCE
+2 ;Returns ADO Recordset with all ACTIVE GROUP/RESOURCE combinations
+3 ;to which user has access based on entries in BSDX RESOURCE USER file
+4 ;If BSDXDUZ=0 then returns all ACTIVE GROUP/RESOURCE combinations for current DUZ
+5 ;If user BSDXDUZ possesses the key BSDXZMGR or XUPROGMODE
+6 ;then ALL ACTIVE resource group names are returned
+7 ;
+8 NEW BSDXERR,BSDXRET,BSDXIEN,BSDXRES,BSDXDEP,BSDXDDR,BSDXDEPN,BSDXRDAT,BSDXRNOD,BSDXI
+9 NEW BSDXRESN,BSDXMGR,BSDXRESD,BSDXNOD,BSDXSUBID
+10 KILL ^BSDXTEMP($JOB)
+11 KILL ^BSDXTMP($JOB)
+12 SET BSDXY="^BSDXTMP("_$JOB_")"
+13 SET BSDXI=0
+14 SET BSDXERR=""
+15 SET ^BSDXTMP($JOB,BSDXI)="I00020RESOURCE_GROUPID^T00030RESOURCE_GROUP^I00020RESOURCE_GROUP_ITEMID^T00030RESOURCE_NAME^I00020RESOURCEID"_$CHAR(30)
+16 IF '+BSDXDUZ
SET BSDXDUZ=DUZ
+17 ;Check SECURITY KEY file for BSDXZMGR or XUPROGMODE keys
+18 SET BSDXMGR=$$APSEC("BSDXZMGR",BSDXDUZ)
+19 ;
+20 ;User does not have BSDXZMGR or XUPROGMODE keys, so
+21 ;$O THRU AC XREF OF BSDX RESOURCE USER
+22 IF 'BSDXMGR
IF $DATA(^BSDXRSU("AC",BSDXDUZ))
SET BSDXIEN=0
FOR
SET BSDXIEN=$ORDER(^BSDXRSU("AC",BSDXDUZ,BSDXIEN))
IF '+BSDXIEN
QUIT
Begin DoDot:1
+23 SET BSDXRES=$PIECE(^BSDXRSU(BSDXIEN,0),U)
+24 IF '$DATA(^BSDXDEPT("AB",BSDXRES))
QUIT
+25 IF '$DATA(^BSDXRES(BSDXRES))
QUIT
+26 SET BSDXRNOD=$GET(^BSDXRES(BSDXRES,0))
+27 IF BSDXRNOD=""
QUIT
+28 ;QUIT if the resource is inactive
+29 IF $PIECE(BSDXRNOD,U,2)=1
QUIT
+30 SET BSDXRESN=$PIECE(BSDXRNOD,U)
+31 SET BSDXDEP=0
FOR
SET BSDXDEP=$ORDER(^BSDXDEPT("AB",BSDXRES,BSDXDEP))
IF '+BSDXDEP
QUIT
Begin DoDot:2
+32 IF '$DATA(^BSDXDEPT(BSDXDEP,0))
QUIT
+33 SET BSDXDEPN=$PIECE(^BSDXDEPT(BSDXDEP,0),U)
+34 SET BSDXSUBID=$ORDER(^BSDXDEPT(BSDXDEP,1,"B",BSDXRES,0))
+35 SET BSDXI=BSDXI+1
+36 SET ^BSDXTMP($JOB,BSDXI)=BSDXDEP_U_BSDXDEPN_U_BSDXSUBID_U_BSDXRESN_U_BSDXRES_$CHAR(30)
End DoDot:2
+37 QUIT
End DoDot:1
+38 ;
+39 ;User does have BSDXZMGR or XUPROGMODE keys, so
+40 ;$O THRU BSDX RESOURCE GROUP file directly
+41 IF BSDXMGR
SET BSDXIEN=0
FOR
SET BSDXIEN=$ORDER(^BSDXDEPT(BSDXIEN))
IF '+BSDXIEN
QUIT
Begin DoDot:1
+42 IF '$DATA(^BSDXDEPT(BSDXIEN,0))
QUIT
+43 SET BSDXNOD=^BSDXDEPT(BSDXIEN,0)
+44 SET BSDXDEPN=$PIECE(BSDXNOD,U)
+45 SET BSDXRES=0
FOR
SET BSDXRES=$ORDER(^BSDXDEPT(BSDXIEN,1,BSDXRES))
IF '+BSDXRES
QUIT
Begin DoDot:2
+46 NEW BSDXRESD
+47 IF '$DATA(^BSDXDEPT(BSDXIEN,1,BSDXRES,0))
QUIT
+48 SET BSDXRESD=$PIECE(^BSDXDEPT(BSDXIEN,1,BSDXRES,0),"^")
+49 IF '$DATA(^BSDXRES(BSDXRESD,0))
QUIT
+50 SET BSDXRNOD=$GET(^BSDXRES(BSDXRESD,0))
+51 IF BSDXRNOD=""
QUIT
+52 ;QUIT if the resource is inactive
+53 IF $PIECE(BSDXRNOD,U,2)=1
QUIT
+54 SET BSDXRESN=$PIECE(BSDXRNOD,U)
+55 SET BSDXI=BSDXI+1
+56 SET ^BSDXTMP($JOB,BSDXI)=BSDXIEN_U_BSDXDEPN_U_BSDXRES_U_BSDXRESN_U_BSDXRESD_$CHAR(30)
+57 QUIT
End DoDot:2
+58 QUIT
End DoDot:1
+59 ;
+60 SET ^BSDXTMP($JOB,BSDXI+1)=$CHAR(31)_BSDXERR
+61 QUIT
+62 ;
APSEC(BSDXKEY,BSDXDUZ) ;EP - Return TRUE (1) if user has keys BSDXKEY or XUPROGMODE, otherwise, returns FALSE (0)
+1 ;
+2 NEW BSDXIEN,BSDXPROG,BSDXPKEY
+3 IF '$GET(BSDXDUZ)
QUIT 0
+4 ;
+5 ;Test for programmer mode key
+6 SET BSDXPROG=0
+7 IF $DATA(^DIC(19.1,"B","XUPROGMODE"))
Begin DoDot:1
+8 SET BSDXPKEY=$ORDER(^DIC(19.1,"B","XUPROGMODE",0))
+9 IF '+BSDXPKEY
QUIT
+10 IF '$DATA(^VA(200,BSDXDUZ,51,BSDXPKEY,0))
QUIT
+11 SET BSDXPROG=1
End DoDot:1
+12 IF BSDXPROG
QUIT 1
+13 ;
+14 IF BSDXKEY=""
QUIT 0
+15 IF '$DATA(^DIC(19.1,"B",BSDXKEY))
QUIT 0
+16 SET BSDXIEN=$ORDER(^DIC(19.1,"B",BSDXKEY,0))
+17 IF '+BSDXIEN
QUIT 0
+18 IF '$DATA(^VA(200,BSDXDUZ,51,BSDXIEN,0))
QUIT 0
+19 QUIT 1
