BSDX01.m

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