SDEC01 ;ALB/SAT/JSM,WTC - VISTA SCHEDULING RPCS ;Feb 12, 2020@15:22
;;5.3;Scheduling;**627,642,658,694**;Aug 13, 1993;Build 61
;
Q
;
SUSRINFO(SDECY,SDECDUZ,GUIVERS) ;get SCHEDULING USER INFO
;SUSRINFO(SDECY,SDECDUZ) external parameter tag is in SDEC
;INPUT:
; SDECDUZ = (optional) user ID pointer to NEW PATIENT file
; Default to current user
; GUIVERS = GUI version of the calling software. ; SD*5.3*694 wtc 8/24/2018
;
; RETURN:
; Successful Return:
; Global Array containing 1 entry with following:
; Data is separated by ^:
; 1. MANAGER - YES if the user has the SDECZMGR key
; NO if not
; 2. USER_NAME
; 3. MENU - YES if the user has the SDECZMENU key
; NO if not
; 4. SUPER - YES if the user has the SD SUPERVISOR key
; NO if not
; 5. SDWLMENU - YES if the user has the SDWL MENU key
; NO if not
; 6. SDECRMIC - YES if the user has the SDECZ REQUEST key
; NO if not
; 7. SDOB - YES if the user has the SDOB key
; NO if not
; 8. SDMOB - YES if the user has the SDMOB key
; NO if not
; 9. SDECVW - YES if the user has the SDECVIEW key
; NO if not
;
; SD*5.3*694 wtc 8/24/2018
; If the calling software does not pass a GUI version and the current version field in the SDEC SETTINGS (#409.98) file is populated, return an error.
;
; Unsuccessful Return:
;
; 10. Error message - text of error that occurred.
;
; Global array containing 1 entry stating the current version number and that the user is not using it stored in the error field.
;
N SDECMENU,SDECMGR,SDECERR,SDECI,SDSUPER,SDWLMENU,SDECRMIC
N SDOB,SDMOB,SDTMP,SDECVW ;alb/jsm 658 added SDECVW
N SDECSTNG ; SD*5.3*694 wtc 8/24/2018
K ^TMP("SDEC",$J)
S SDECY="^TMP(""SDEC"","_$J_")"
;
; Compare version of software with current version deployed. Version and effective date are stored in record 2 in file #409.98. SD*5.3*694 wtc 8/24/2018
;
S SDECSTNG=$G(^SDEC(409.98,2,0)) ;
;
; GUI in use is too old to pass its version number. SD*5.3*694 wtc 8/24/2018
;
I $P(SDECSTNG,"^",2)'="",$G(GUIVERS)="" D Q ;
. S ^TMP("SDEC",$J,0)="T00010MANAGER^T00020USER_NAME^T00030MENU^T00030SUPER^T00030SDWLMENU^T00030SDECRMIC^T00030SDOB^T00030SDMOB^T00030SDECVW^T00100ERROR"_$C(30)_$C(31) ;
;
; GUI in use is new enough to pass its version number. Determine if it is current. SD*5.3*694 wtc 8/24/2018
;
I $P(SDECSTNG,"^",2)'="",$P(SDECSTNG,"^",2)'=$G(GUIVERS),$P(SDECSTNG,"^",3)'>$$NOW^XLFDT() D Q ;
. S ^TMP("SDEC",$J,0)="T00010MANAGER^T00020USER_NAME^T00030MENU^T00030SUPER^T00030SDWLMENU^T00030SDECRMIC^T00030SDOB^T00030SDMOB^T00030SDECVW^T00100ERROR"_$C(30) ;
. S ^TMP("SDEC",$J,1)="^^^^^^^^^The version of VS GUI that you are using is not current. Install version "_$P(SDECSTNG,"^",2)_" immediately."_$C(30)_$C(31) ;
;
S SDECI=0
S SDECERR=""
;
; Added ERROR message field to end. SD*5.3*694 wtc 8/27/2018
;
S SDTMP="T00010MANAGER^T00020USER_NAME^T00030MENU^T00030SUPER^T00030SDWLMENU^T00030SDECRMIC"
S SDTMP=SDTMP_"^T00030SDOB^T00030SDMOB^T00030SDECVW^T00100ERROR"
S ^TMP("SDEC",$J,SDECI)=SDTMP_$C(30)
;Check SECURITY KEY file for SDECZMGR keys
I '+$G(SDECDUZ) S SDECDUZ=DUZ
S SDECMGR=$$APSEC("SDECZMGR",SDECDUZ)
S SDECMGR=$S(SDECMGR=1:"YES",1:"NO")
S SDECMENU=$$APSEC("SDECZMENU",SDECDUZ)
S SDECMENU=$S(SDECMENU=1:"YES",1:"NO")
S SDSUPER=$$APSEC("SD SUPERVISOR",SDECDUZ)
S SDSUPER=$S(SDSUPER=1:"YES",1:"NO")
S SDWLMENU=$$APSEC("SDWL MENU",SDECDUZ)
S SDWLMENU=$S(SDWLMENU=1:"YES",1:"NO")
S SDECRMIC=$$APSEC("SDECZ REQUEST",SDECDUZ)
S SDECRMIC=$S(SDECRMIC=1:"YES",1:"NO")
S SDOB=$$APSEC("SDOB",SDECDUZ)
S SDOB=$S(SDOB=1:"YES",1:"NO")
S SDMOB=$$APSEC("SDMOB",SDECDUZ)
S SDMOB=$S(SDMOB=1:"YES",1:"NO")
S SDECVW=$$APSEC("SDECVIEW",SDECDUZ) ;alb/jsm 658
S SDECVW=$S(SDECVW=1:"YES",1:"NO")
S SDECI=SDECI+1
S ^TMP("SDEC",$J,SDECI)=SDECMGR_"^"_$$GET1^DIQ(200,SDECDUZ_",",.01)_"^"_SDECMENU_"^"_SDSUPER_"^"_SDWLMENU_"^"_SDECRMIC_"^"_SDOB_"^"_SDMOB_"^"_SDECVW_$C(30)
S ^TMP("SDEC",$J,SDECI)=^TMP("SDEC",$J,SDECI)_$C(31)_SDECERR
Q
;
RESGRPUS(SDECY,SDECDUZ) ;return ACTIVE resource group names for the given user
;RESGRPUS(SDECY,SDECDUZ) external parameter tag is in SDEC
;Returns ADO Recordset with all ACTIVE resource group names to which user has access
;based on entries in SDEC RESOURCE USER file
;If SDECDUZ=0 then returns all department names for current DUZ
;If user SDECDUZ possesses the key SDECZMGR
;then ALL resource group names are returned regardless of whether any active resources
;are associated with the group or not.
;
N SDECERR,SDECRET,SDECIEN,SDECRES,SDECDEP,SDECDDR,SDECDEPN,SDECRDAT,SDECRNOD,SDECI
N SDECMGR,SDECNOD
K ^TMP("SDEC01",$J)
K ^TMP("SDEC",$J)
S SDECY="^TMP(""SDEC"","_$J_")"
S SDECI=0
S SDECERR=""
S ^TMP("SDEC",$J,SDECI)="I00020RESOURCE_GROUPID^T00030RESOURCE_GROUP"_$C(30)
I '+SDECDUZ S SDECDUZ=DUZ
;Check SECURITY KEY file for SDECZMGR keys
S SDECMGR=$$APSEC("SDECZMGR",SDECDUZ)
;
;User does not have SDECZMGR keys, so
;$O THRU AC XREF OF SDEC RESOURCE USER
I 'SDECMGR,$D(^SDEC(409.833,"AC",SDECDUZ)) S SDECIEN=0 F S SDECIEN=$O(^SDEC(409.833,"AC",SDECDUZ,SDECIEN)) Q:'+SDECIEN D
. S SDECRES=$P(^SDEC(409.833,SDECIEN,0),U)
. Q:'$D(^SDEC(409.832,"AB",SDECRES))
. Q:'$D(^SDEC(409.831,SDECRES))
. S SDECRNOD=^SDEC(409.831,SDECRES,0)
. ;QUIT if the resource is inactive
. Q:$P(SDECRNOD,U,2)=1
. S SDECDEP=0 F S SDECDEP=$O(^SDEC(409.832,"AB",SDECRES,SDECDEP)) Q:'+SDECDEP D
. . Q:'$D(^SDEC(409.832,SDECDEP,0))
. . Q:$D(^TMP("SDEC01",$J,SDECDEP))
. . S ^TMP("SDEC01",$J,SDECDEP)=""
. . S SDECDEPN=$P(^SDEC(409.832,SDECDEP,0),U)
. . S SDECI=SDECI+1
. . S ^TMP("SDEC",$J,SDECI)=SDECDEP_U_SDECDEPN_$C(30)
. . Q
. Q
;
;User does have SDECZMGR keys, so
;$O THRU SDEC RESOURCE GROUP file directly
I SDECMGR S SDECIEN=0 F S SDECIEN=$O(^SDEC(409.832,SDECIEN)) Q:'+SDECIEN D
. Q:'$D(^SDEC(409.832,SDECIEN,0))
. S SDECNOD=^SDEC(409.832,SDECIEN,0)
. S SDECDEPN=$P(SDECNOD,U)
. S SDECI=SDECI+1
. S ^TMP("SDEC",$J,SDECI)=SDECIEN_U_SDECDEPN_$C(30)
. Q
;
S ^TMP("SDEC",$J,SDECI)=^TMP("SDEC",$J,SDECI)_$C(31)_SDECERR
Q
;
RESGPUSR(SDECY,SDECDUZ) ;GROUP RESOURCE
;RESGPUSR(SDECY,SDECDUZ) external parameter tag is in SDEC
;Returns ADO Recordset with all ACTIVE GROUP/RESOURCE combinations
;to which user has access based on entries in SDEC RESOURCE USER file
;If SDECDUZ=0 then returns all ACTIVE GROUP/RESOURCE combinations for current DUZ
;If user SDECDUZ possesses the key SDECZMGR
;then ALL ACTIVE resource group names are returned
;
N SDECERR,SDECRET,SDECIEN,SDECRES,SDECDEP,SDECDDR,SDECDEPN,SDECRDAT,SDECRNOD,SDECI
N SDECRESN,SDECMGR,SDECRESD,SDECNOD,SDECSUBID
N SDCL,SDPRV,SDTYP
K ^TMP("SDEC01",$J)
S SDECY="^TMP(""SDEC"","_$J_")"
K @SDECY
S SDECI=0
S SDECERR=""
S @SDECY@(SDECI)="I00020RESOURCE_GROUPID^T00030RESOURCE_GROUP^I00020RESOURCE_GROUP_ITEMID^T00030RESOURCE_NAME^I00020RESOURCEID"_$C(30)
I '+SDECDUZ S SDECDUZ=DUZ
;Check SECURITY KEY file for SDECZMGR key
S SDECMGR=$$APSEC("SDECZMGR",SDECDUZ)
;
S SDECIEN=0 F S SDECIEN=$O(^SDEC(409.832,SDECIEN)) Q:'+SDECIEN D
. Q:'$D(^SDEC(409.832,SDECIEN,0))
. S SDECNOD=^SDEC(409.832,SDECIEN,0)
. S SDECDEPN=$P(SDECNOD,U)
. S SDECRES=0 F S SDECRES=$O(^SDEC(409.832,SDECIEN,1,SDECRES)) Q:'+SDECRES D
. . N SDECRESD
. . Q:'$D(^SDEC(409.832,SDECIEN,1,SDECRES,0))
. . S SDECRESD=$P(^SDEC(409.832,SDECIEN,1,SDECRES,0),"^")
. . Q:'$D(^SDEC(409.831,SDECRESD,0))
. . S SDECRNOD=$G(^SDEC(409.831,SDECRESD,0))
. . Q:SDECRNOD=""
. . ;QUIT if the resource is inactive
. . S SDCL=$P(SDECRNOD,U,4)
. . S SDTYP=$P(SDECRNOD,U,11)
. . I $P(SDTYP,";",2)="VA(200," D RESPRV1^SDEC01B($P(SDTYP,";",1),SDCL)
. . Q:$$GET1^DIQ(409.831,SDECRESD_",",.02)="YES"
. . S SDECRESN=$P(SDECRNOD,U)
. . S SDECI=SDECI+1
. . S @SDECY@(SDECI)=SDECIEN_U_SDECDEPN_U_SDECRES_U_SDECRESN_U_SDECRESD_$C(30)
. . Q
. Q
;
S @SDECY@(SDECI)=@SDECY@(SDECI)_$C(31)_SDECERR
Q
;
APSEC(SDECKEY,SDECDUZ) ;EP - Return TRUE (1) if user has keys SDECKEY, otherwise, returns FALSE (0)
;
N SDECIEN,SDECPKEY
I '$G(SDECDUZ) Q 0
;
I SDECKEY="" Q 0
I '$D(^DIC(19.1,"B",SDECKEY)) Q 0
S SDECIEN=$O(^DIC(19.1,"B",SDECKEY,0))
I '+SDECIEN Q 0
I '$D(^VA(200,SDECDUZ,51,SDECIEN,0)) Q 0
Q 1
;
CLINICS(RET,STOP,SC) ;GET clinics for given stop code or matching stop code for given clinic alb/sat 658
; STOP - (optional) Clinic Stop partial name lookup into the CLINIC STOP file (#40.7)
; OR Clinic Stop id pointer to the CLINIC STOP file (#40.7)
; OR "A"999 Amis Reporting Stop Code
; SC - (optional) Clinic ID pointer to HOSPITAL LOCATION file (#44)
;RETURN:
; 1. CLINSTOP - Pointer to the CLINIC STOP file (#40.7)
; 2. CLINIEN - Clinic ID pointer to HOSPITAL LOCATION file (#44)
; 3. CLINNAME - Clinic Name
N SDCL,SDECI,SDI,SDTMP,STP,STPL
S STPL=""
S SDECI=0
S RET=$NA(^TMP("SDEC01",$J,"CLINICS"))
K @RET
S @RET@(0)="T00030CLINSTOP^T00030CLINIEN^T00030CLINNAME"_$C(30)
;
;validate SC
S SC=$G(SC)
I SC'="",$D(^SC(SC,0)) S STPL=$$GET1^DIQ(44,SC_",",8,"I")
;validate STOP
S STOP=$G(STOP)
I STPL="",+STOP,'$D(^DIC(40.7,STOP,0)) S @RET@(1)="-1^Invalid Clinic Stop id "_STOP_"."_$C(30,31) Q
I STPL="",+STOP S STPL=STOP
I STPL="",$E(STOP)="A" D ;amis stop code
.S SDTMP=$E(STOP,2,$L(STOP))
.S SDI=0 F S SDI=$O(^DIC(40.7,"C",SDTMP,SDI)) Q:SDI="" D
..Q:'$D(^DIC(40.7,SDI,0))
..S STPL=STPL_$S(STPL'="":"|",1:"")_SDI
I STPL="",STOP'="",'+STOP D ;partial clinic stop name
.S STP=$S(STOP'="":$$GETSUB^SDECU(STOP),1:"")
.F S STP=$O(^DIC(40.7,"B",STP)) Q:STP="" Q:(STOP'="")&(STP'[STOP) D
..S SDI=0 F S SDI=$O(^DIC(40.7,"B",STP,SDI)) Q:SDI="" D
...Q:'$D(^DIC(40.7,SDI,0))
...S STPL=STPL_$S(STPL'="":"|",1:"")_SDI
;
F SDI=1:1:$L(STPL,"|") S STOP=$P(STPL,"|",SDI) D
.Q:STOP=""
.S SDCL="" F S SDCL=$O(^SC("AST",STOP,SDCL)) Q:SDCL="" D
..Q:'$D(^SC(SDCL,0))
..Q:$$INACTIVE^SDEC32(SDCL) ;determine if clinic is active
..S SDECI=SDECI+1 S @RET@(SDECI)=STOP_U_SDCL_U_$$GET1^DIQ(44,SDCL_",",.01)_$C(30)
S @RET@(SDECI)=@RET@(SDECI)_$C(31)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDEC01 10450 printed Dec 13, 2024@02:49:48 Page 2
SDEC01 ;ALB/SAT/JSM,WTC - VISTA SCHEDULING RPCS ;Feb 12, 2020@15:22
+1 ;;5.3;Scheduling;**627,642,658,694**;Aug 13, 1993;Build 61
+2 ;
+3 QUIT
+4 ;
SUSRINFO(SDECY,SDECDUZ,GUIVERS) ;get SCHEDULING USER INFO
+1 ;SUSRINFO(SDECY,SDECDUZ) external parameter tag is in SDEC
+2 ;INPUT:
+3 ; SDECDUZ = (optional) user ID pointer to NEW PATIENT file
+4 ; Default to current user
+5 ; GUIVERS = GUI version of the calling software. ; SD*5.3*694 wtc 8/24/2018
+6 ;
+7 ; RETURN:
+8 ; Successful Return:
+9 ; Global Array containing 1 entry with following:
+10 ; Data is separated by ^:
+11 ; 1. MANAGER - YES if the user has the SDECZMGR key
+12 ; NO if not
+13 ; 2. USER_NAME
+14 ; 3. MENU - YES if the user has the SDECZMENU key
+15 ; NO if not
+16 ; 4. SUPER - YES if the user has the SD SUPERVISOR key
+17 ; NO if not
+18 ; 5. SDWLMENU - YES if the user has the SDWL MENU key
+19 ; NO if not
+20 ; 6. SDECRMIC - YES if the user has the SDECZ REQUEST key
+21 ; NO if not
+22 ; 7. SDOB - YES if the user has the SDOB key
+23 ; NO if not
+24 ; 8. SDMOB - YES if the user has the SDMOB key
+25 ; NO if not
+26 ; 9. SDECVW - YES if the user has the SDECVIEW key
+27 ; NO if not
+28 ;
+29 ; SD*5.3*694 wtc 8/24/2018
+30 ; If the calling software does not pass a GUI version and the current version field in the SDEC SETTINGS (#409.98) file is populated, return an error.
+31 ;
+32 ; Unsuccessful Return:
+33 ;
+34 ; 10. Error message - text of error that occurred.
+35 ;
+36 ; Global array containing 1 entry stating the current version number and that the user is not using it stored in the error field.
+37 ;
+38 NEW SDECMENU,SDECMGR,SDECERR,SDECI,SDSUPER,SDWLMENU,SDECRMIC
+39 ;alb/jsm 658 added SDECVW
NEW SDOB,SDMOB,SDTMP,SDECVW
+40 ; SD*5.3*694 wtc 8/24/2018
NEW SDECSTNG
+41 KILL ^TMP("SDEC",$JOB)
+42 SET SDECY="^TMP(""SDEC"","_$JOB_")"
+43 ;
+44 ; Compare version of software with current version deployed. Version and effective date are stored in record 2 in file #409.98. SD*5.3*694 wtc 8/24/2018
+45 ;
+46 ;
SET SDECSTNG=$GET(^SDEC(409.98,2,0))
+47 ;
+48 ; GUI in use is too old to pass its version number. SD*5.3*694 wtc 8/24/2018
+49 ;
+50 ;
IF $PIECE(SDECSTNG,"^",2)'=""
IF $GET(GUIVERS)=""
Begin DoDot:1
+51 ;
SET ^TMP("SDEC",$JOB,0)="T00010MANAGER^T00020USER_NAME^T00030MENU^T00030SUPER^T00030SDWLMENU^T00030SDECRMIC^T00030SDOB^T00030SDMOB^T00030SDECVW^T00100ERROR"_$CHAR(30)_$CHAR(31)
End DoDot:1
QUIT
+52 ;
+53 ; GUI in use is new enough to pass its version number. Determine if it is current. SD*5.3*694 wtc 8/24/2018
+54 ;
+55 ;
IF $PIECE(SDECSTNG,"^",2)'=""
IF $PIECE(SDECSTNG,"^",2)'=$GET(GUIVERS)
IF $PIECE(SDECSTNG,"^",3)'>$$NOW^XLFDT()
Begin DoDot:1
+56 ;
SET ^TMP("SDEC",$JOB,0)="T00010MANAGER^T00020USER_NAME^T00030MENU^T00030SUPER^T00030SDWLMENU^T00030SDECRMIC^T00030SDOB^T00030SDMOB^T00030SDECVW^T00100ERROR"_$CHAR(30)
+57 ;
SET ^TMP("SDEC",$JOB,1)="^^^^^^^^^The version of VS GUI that you are using is not current. Install version "_$PIECE(SDECSTNG,"^",2)_" immediately."_$CHAR(30)_$CHAR(31)
End DoDot:1
QUIT
+58 ;
+59 SET SDECI=0
+60 SET SDECERR=""
+61 ;
+62 ; Added ERROR message field to end. SD*5.3*694 wtc 8/27/2018
+63 ;
+64 SET SDTMP="T00010MANAGER^T00020USER_NAME^T00030MENU^T00030SUPER^T00030SDWLMENU^T00030SDECRMIC"
+65 SET SDTMP=SDTMP_"^T00030SDOB^T00030SDMOB^T00030SDECVW^T00100ERROR"
+66 SET ^TMP("SDEC",$JOB,SDECI)=SDTMP_$CHAR(30)
+67 ;Check SECURITY KEY file for SDECZMGR keys
+68 IF '+$GET(SDECDUZ)
SET SDECDUZ=DUZ
+69 SET SDECMGR=$$APSEC("SDECZMGR",SDECDUZ)
+70 SET SDECMGR=$SELECT(SDECMGR=1:"YES",1:"NO")
+71 SET SDECMENU=$$APSEC("SDECZMENU",SDECDUZ)
+72 SET SDECMENU=$SELECT(SDECMENU=1:"YES",1:"NO")
+73 SET SDSUPER=$$APSEC("SD SUPERVISOR",SDECDUZ)
+74 SET SDSUPER=$SELECT(SDSUPER=1:"YES",1:"NO")
+75 SET SDWLMENU=$$APSEC("SDWL MENU",SDECDUZ)
+76 SET SDWLMENU=$SELECT(SDWLMENU=1:"YES",1:"NO")
+77 SET SDECRMIC=$$APSEC("SDECZ REQUEST",SDECDUZ)
+78 SET SDECRMIC=$SELECT(SDECRMIC=1:"YES",1:"NO")
+79 SET SDOB=$$APSEC("SDOB",SDECDUZ)
+80 SET SDOB=$SELECT(SDOB=1:"YES",1:"NO")
+81 SET SDMOB=$$APSEC("SDMOB",SDECDUZ)
+82 SET SDMOB=$SELECT(SDMOB=1:"YES",1:"NO")
+83 ;alb/jsm 658
SET SDECVW=$$APSEC("SDECVIEW",SDECDUZ)
+84 SET SDECVW=$SELECT(SDECVW=1:"YES",1:"NO")
+85 SET SDECI=SDECI+1
+86 SET ^TMP("SDEC",$JOB,SDECI)=SDECMGR_"^"_$$GET1^DIQ(200,SDECDUZ_",",.01)_"^"_SDECMENU_"^"_SDSUPER_"^"_SDWLMENU_"^"_SDECRMIC_"^"_SDOB_"^"_SDMOB_"^"_SDECVW_$CHAR(30)
+87 SET ^TMP("SDEC",$JOB,SDECI)=^TMP("SDEC",$JOB,SDECI)_$CHAR(31)_SDECERR
+88 QUIT
+89 ;
RESGRPUS(SDECY,SDECDUZ) ;return ACTIVE resource group names for the given user
+1 ;RESGRPUS(SDECY,SDECDUZ) external parameter tag is in SDEC
+2 ;Returns ADO Recordset with all ACTIVE resource group names to which user has access
+3 ;based on entries in SDEC RESOURCE USER file
+4 ;If SDECDUZ=0 then returns all department names for current DUZ
+5 ;If user SDECDUZ possesses the key SDECZMGR
+6 ;then ALL resource group names are returned regardless of whether any active resources
+7 ;are associated with the group or not.
+8 ;
+9 NEW SDECERR,SDECRET,SDECIEN,SDECRES,SDECDEP,SDECDDR,SDECDEPN,SDECRDAT,SDECRNOD,SDECI
+10 NEW SDECMGR,SDECNOD
+11 KILL ^TMP("SDEC01",$JOB)
+12 KILL ^TMP("SDEC",$JOB)
+13 SET SDECY="^TMP(""SDEC"","_$JOB_")"
+14 SET SDECI=0
+15 SET SDECERR=""
+16 SET ^TMP("SDEC",$JOB,SDECI)="I00020RESOURCE_GROUPID^T00030RESOURCE_GROUP"_$CHAR(30)
+17 IF '+SDECDUZ
SET SDECDUZ=DUZ
+18 ;Check SECURITY KEY file for SDECZMGR keys
+19 SET SDECMGR=$$APSEC("SDECZMGR",SDECDUZ)
+20 ;
+21 ;User does not have SDECZMGR keys, so
+22 ;$O THRU AC XREF OF SDEC RESOURCE USER
+23 IF 'SDECMGR
IF $DATA(^SDEC(409.833,"AC",SDECDUZ))
SET SDECIEN=0
FOR
SET SDECIEN=$ORDER(^SDEC(409.833,"AC",SDECDUZ,SDECIEN))
if '+SDECIEN
QUIT
Begin DoDot:1
+24 SET SDECRES=$PIECE(^SDEC(409.833,SDECIEN,0),U)
+25 if '$DATA(^SDEC(409.832,"AB",SDECRES))
QUIT
+26 if '$DATA(^SDEC(409.831,SDECRES))
QUIT
+27 SET SDECRNOD=^SDEC(409.831,SDECRES,0)
+28 ;QUIT if the resource is inactive
+29 if $PIECE(SDECRNOD,U,2)=1
QUIT
+30 SET SDECDEP=0
FOR
SET SDECDEP=$ORDER(^SDEC(409.832,"AB",SDECRES,SDECDEP))
if '+SDECDEP
QUIT
Begin DoDot:2
+31 if '$DATA(^SDEC(409.832,SDECDEP,0))
QUIT
+32 if $DATA(^TMP("SDEC01",$JOB,SDECDEP))
QUIT
+33 SET ^TMP("SDEC01",$JOB,SDECDEP)=""
+34 SET SDECDEPN=$PIECE(^SDEC(409.832,SDECDEP,0),U)
+35 SET SDECI=SDECI+1
+36 SET ^TMP("SDEC",$JOB,SDECI)=SDECDEP_U_SDECDEPN_$CHAR(30)
+37 QUIT
End DoDot:2
+38 QUIT
End DoDot:1
+39 ;
+40 ;User does have SDECZMGR keys, so
+41 ;$O THRU SDEC RESOURCE GROUP file directly
+42 IF SDECMGR
SET SDECIEN=0
FOR
SET SDECIEN=$ORDER(^SDEC(409.832,SDECIEN))
if '+SDECIEN
QUIT
Begin DoDot:1
+43 if '$DATA(^SDEC(409.832,SDECIEN,0))
QUIT
+44 SET SDECNOD=^SDEC(409.832,SDECIEN,0)
+45 SET SDECDEPN=$PIECE(SDECNOD,U)
+46 SET SDECI=SDECI+1
+47 SET ^TMP("SDEC",$JOB,SDECI)=SDECIEN_U_SDECDEPN_$CHAR(30)
+48 QUIT
End DoDot:1
+49 ;
+50 SET ^TMP("SDEC",$JOB,SDECI)=^TMP("SDEC",$JOB,SDECI)_$CHAR(31)_SDECERR
+51 QUIT
+52 ;
RESGPUSR(SDECY,SDECDUZ) ;GROUP RESOURCE
+1 ;RESGPUSR(SDECY,SDECDUZ) external parameter tag is in SDEC
+2 ;Returns ADO Recordset with all ACTIVE GROUP/RESOURCE combinations
+3 ;to which user has access based on entries in SDEC RESOURCE USER file
+4 ;If SDECDUZ=0 then returns all ACTIVE GROUP/RESOURCE combinations for current DUZ
+5 ;If user SDECDUZ possesses the key SDECZMGR
+6 ;then ALL ACTIVE resource group names are returned
+7 ;
+8 NEW SDECERR,SDECRET,SDECIEN,SDECRES,SDECDEP,SDECDDR,SDECDEPN,SDECRDAT,SDECRNOD,SDECI
+9 NEW SDECRESN,SDECMGR,SDECRESD,SDECNOD,SDECSUBID
+10 NEW SDCL,SDPRV,SDTYP
+11 KILL ^TMP("SDEC01",$JOB)
+12 SET SDECY="^TMP(""SDEC"","_$JOB_")"
+13 KILL @SDECY
+14 SET SDECI=0
+15 SET SDECERR=""
+16 SET @SDECY@(SDECI)="I00020RESOURCE_GROUPID^T00030RESOURCE_GROUP^I00020RESOURCE_GROUP_ITEMID^T00030RESOURCE_NAME^I00020RESOURCEID"_$CHAR(30)
+17 IF '+SDECDUZ
SET SDECDUZ=DUZ
+18 ;Check SECURITY KEY file for SDECZMGR key
+19 SET SDECMGR=$$APSEC("SDECZMGR",SDECDUZ)
+20 ;
+21 SET SDECIEN=0
FOR
SET SDECIEN=$ORDER(^SDEC(409.832,SDECIEN))
if '+SDECIEN
QUIT
Begin DoDot:1
+22 if '$DATA(^SDEC(409.832,SDECIEN,0))
QUIT
+23 SET SDECNOD=^SDEC(409.832,SDECIEN,0)
+24 SET SDECDEPN=$PIECE(SDECNOD,U)
+25 SET SDECRES=0
FOR
SET SDECRES=$ORDER(^SDEC(409.832,SDECIEN,1,SDECRES))
if '+SDECRES
QUIT
Begin DoDot:2
+26 NEW SDECRESD
+27 if '$DATA(^SDEC(409.832,SDECIEN,1,SDECRES,0))
QUIT
+28 SET SDECRESD=$PIECE(^SDEC(409.832,SDECIEN,1,SDECRES,0),"^")
+29 if '$DATA(^SDEC(409.831,SDECRESD,0))
QUIT
+30 SET SDECRNOD=$GET(^SDEC(409.831,SDECRESD,0))
+31 if SDECRNOD=""
QUIT
+32 ;QUIT if the resource is inactive
+33 SET SDCL=$PIECE(SDECRNOD,U,4)
+34 SET SDTYP=$PIECE(SDECRNOD,U,11)
+35 IF $PIECE(SDTYP,";",2)="VA(200,"
DO RESPRV1^SDEC01B($PIECE(SDTYP,";",1),SDCL)
+36 if $$GET1^DIQ(409.831,SDECRESD_",",.02)="YES"
QUIT
+37 SET SDECRESN=$PIECE(SDECRNOD,U)
+38 SET SDECI=SDECI+1
+39 SET @SDECY@(SDECI)=SDECIEN_U_SDECDEPN_U_SDECRES_U_SDECRESN_U_SDECRESD_$CHAR(30)
+40 QUIT
End DoDot:2
+41 QUIT
End DoDot:1
+42 ;
+43 SET @SDECY@(SDECI)=@SDECY@(SDECI)_$CHAR(31)_SDECERR
+44 QUIT
+45 ;
APSEC(SDECKEY,SDECDUZ) ;EP - Return TRUE (1) if user has keys SDECKEY, otherwise, returns FALSE (0)
+1 ;
+2 NEW SDECIEN,SDECPKEY
+3 IF '$GET(SDECDUZ)
QUIT 0
+4 ;
+5 IF SDECKEY=""
QUIT 0
+6 IF '$DATA(^DIC(19.1,"B",SDECKEY))
QUIT 0
+7 SET SDECIEN=$ORDER(^DIC(19.1,"B",SDECKEY,0))
+8 IF '+SDECIEN
QUIT 0
+9 IF '$DATA(^VA(200,SDECDUZ,51,SDECIEN,0))
QUIT 0
+10 QUIT 1
+11 ;
CLINICS(RET,STOP,SC) ;GET clinics for given stop code or matching stop code for given clinic alb/sat 658
+1 ; STOP - (optional) Clinic Stop partial name lookup into the CLINIC STOP file (#40.7)
+2 ; OR Clinic Stop id pointer to the CLINIC STOP file (#40.7)
+3 ; OR "A"999 Amis Reporting Stop Code
+4 ; SC - (optional) Clinic ID pointer to HOSPITAL LOCATION file (#44)
+5 ;RETURN:
+6 ; 1. CLINSTOP - Pointer to the CLINIC STOP file (#40.7)
+7 ; 2. CLINIEN - Clinic ID pointer to HOSPITAL LOCATION file (#44)
+8 ; 3. CLINNAME - Clinic Name
+9 NEW SDCL,SDECI,SDI,SDTMP,STP,STPL
+10 SET STPL=""
+11 SET SDECI=0
+12 SET RET=$NAME(^TMP("SDEC01",$JOB,"CLINICS"))
+13 KILL @RET
+14 SET @RET@(0)="T00030CLINSTOP^T00030CLINIEN^T00030CLINNAME"_$CHAR(30)
+15 ;
+16 ;validate SC
+17 SET SC=$GET(SC)
+18 IF SC'=""
IF $DATA(^SC(SC,0))
SET STPL=$$GET1^DIQ(44,SC_",",8,"I")
+19 ;validate STOP
+20 SET STOP=$GET(STOP)
+21 IF STPL=""
IF +STOP
IF '$DATA(^DIC(40.7,STOP,0))
SET @RET@(1)="-1^Invalid Clinic Stop id "_STOP_"."_$CHAR(30,31)
QUIT
+22 IF STPL=""
IF +STOP
SET STPL=STOP
+23 ;amis stop code
IF STPL=""
IF $EXTRACT(STOP)="A"
Begin DoDot:1
+24 SET SDTMP=$EXTRACT(STOP,2,$LENGTH(STOP))
+25 SET SDI=0
FOR
SET SDI=$ORDER(^DIC(40.7,"C",SDTMP,SDI))
if SDI=""
QUIT
Begin DoDot:2
+26 if '$DATA(^DIC(40.7,SDI,0))
QUIT
+27 SET STPL=STPL_$SELECT(STPL'="":"|",1:"")_SDI
End DoDot:2
End DoDot:1
+28 ;partial clinic stop name
IF STPL=""
IF STOP'=""
IF '+STOP
Begin DoDot:1
+29 SET STP=$SELECT(STOP'="":$$GETSUB^SDECU(STOP),1:"")
+30 FOR
SET STP=$ORDER(^DIC(40.7,"B",STP))
if STP=""
QUIT
if (STOP'="")&(STP'[STOP)
QUIT
Begin DoDot:2
+31 SET SDI=0
FOR
SET SDI=$ORDER(^DIC(40.7,"B",STP,SDI))
if SDI=""
QUIT
Begin DoDot:3
+32 if '$DATA(^DIC(40.7,SDI,0))
QUIT
+33 SET STPL=STPL_$SELECT(STPL'="":"|",1:"")_SDI
End DoDot:3
End DoDot:2
End DoDot:1
+34 ;
+35 FOR SDI=1:1:$LENGTH(STPL,"|")
SET STOP=$PIECE(STPL,"|",SDI)
Begin DoDot:1
+36 if STOP=""
QUIT
+37 SET SDCL=""
FOR
SET SDCL=$ORDER(^SC("AST",STOP,SDCL))
if SDCL=""
QUIT
Begin DoDot:2
+38 if '$DATA(^SC(SDCL,0))
QUIT
+39 ;determine if clinic is active
if $$INACTIVE^SDEC32(SDCL)
QUIT
+40 SET SDECI=SDECI+1
SET @RET@(SDECI)=STOP_U_SDCL_U_$$GET1^DIQ(44,SDCL_",",.01)_$CHAR(30)
End DoDot:2
End DoDot:1
+41 SET @RET@(SDECI)=@RET@(SDECI)_$CHAR(31)
+42 QUIT
