SDEC63 ;SPFO/DMR VSE ROUTINE CLINIC GROUP LOOKUP ;Apr 6, 2021@14:21
;;5.3;Scheduling;**774,781**;Build 2;Build 11
;
CLGRPLK(SDECY,SRCHAR) ;CLINIC GROUP LOOKUP
;INPUT - SRCHAR required search string
;RETURN - LIST of SDEC RESOURCE GROUP (#409.831)
; - GROUP IEN^GROUP NAME
;
N GRPNAME,GRPIEN,LEN
S SDECY="^TMP(""SDEC63"","_$J_",""GRPLKUP"")"
K @SDECY
S COUNT=0
S @SDECY@(COUNT)="I00010GRPIEN^T00035GROUP_NAME"_$C(30)
Q:$TR(SRCHAR," ")=""
S LEN=$L(SRCHAR)
D SEARCH
S @SDECY@(COUNT)=@SDECY@(COUNT)_$C(31)
Q
;
SEARCH ;
N INACTDT
D CHKNAME
S GRPNAME=$S($P(SRCHAR,"|",1)'="":$E($P(SRCHAR,"|",1),1,LEN),1:"")
F S GRPNAME=$O(^SDEC(409.832,"B",GRPNAME)) Q:(GRPNAME="")!(GRPNAME'[SRCHAR)!($E(GRPNAME,1,LEN)'=SRCHAR) D
. S GRPIEN=$O(^SDEC(409.832,"B",GRPNAME,""))
. S INACTDT=$$GET1^DIQ(409.832,",",.02,"I") ;inactive date
. Q:(INACTDT'="")&(INACTDT<DT) ;Quit if inactive
. S COUNT=COUNT+1
. S @SDECY@(COUNT)=GRPIEN_"^"_GRPNAME_$C(30)
Q
;
CHKNAME ;
S GRPIEN=$O(^SDEC(409.832,"B",SRCHAR,""))
Q:GRPIEN=""
S INACTDT=$$GET1^DIQ(409.832,",",.02,"I") ;inactive date
Q:(INACTDT'="")&(INACTDT<DT) ;Quit if inactive
S GRPNAME=SRCHAR
S COUNT=COUNT+1
S @SDECY@(COUNT)=GRPIEN_"^"_GRPNAME_$C(30)
Q
;
RESGRP(SDECY,SDECDUZ,GRPIEN) ;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
N SDECRESN,SDECMGR,SDECRESD,SDECNOD,SDECSUBID
N SDCL,SDPRV,SDTYP
N SDGRP,COUNT,RESIEN,RESNODE,RESN
K ^TMP("SDEC63",$J)
S SDECY="^TMP(""SDEC63"","_$J_")"
K @SDECY
S COUNT=0
S SDECERR=""
S @SDECY@(COUNT)="I00020RESOURCE_GROUPID^T00030RESOURCE_GROUP^I00020RESOURCE_GROUP_ITEMID^T00030RESOURCE_NAME^I00020RESOURCEID"_$C(30)
S SDECDUZ=0
;Check SECURITY KEY file for SDECZMGR key
;S SDECMGR=$$APSEC("SDECZMGR",SDECDUZ)
;
S SDGRP=$G(^SDEC(409.832,GRPIEN,0)) D
. Q:'$D(SDGRP)
. S SDECDEPN=$P(SDGRP,"^")
. S SDECRES=0 F S SDECRES=$O(^SDEC(409.832,GRPIEN,1,SDECRES)) Q:'+SDECRES D
. . N RESIEN
. . Q:'$D(^SDEC(409.832,GRPIEN,1,SDECRES,0))
. . S RESIEN=$P(^SDEC(409.832,GRPIEN,1,SDECRES,0),"^")
. . Q:'$D(^SDEC(409.831,RESIEN,0))
. . S RESNODE=$G(^SDEC(409.831,RESIEN,0))
. . Q:RESNODE=""
. . S RESN=$P(RESNODE,"^")
. . ;QUIT if the resource is inactive
. . S SDCL=$P(RESNODE,"^",4)
. . ;S SDTYP=$P(SDECRNOD,"^",11)
. . ;I $P(SDTYP,";",2)="VA(200," D RESPRV1^SDEC01B($P(SDTYP,";",1),SDCL)
. . ;Q:$$GET1^DIQ(409.831,SDECRESD_",",.02)="YES" ???? ".02" FIELD?????
. . S COUNT=COUNT+1
. . S @SDECY@(COUNT)=GRPIEN_"^"_SDECDEPN_"^"_SDECRES_"^"_RESN_"^"_RESIEN_$C(30)
. . Q
. Q
;
S @SDECY@(COUNT)=@SDECY@(COUNT)_$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
;
GETWLIEN(RET,APPTIEN) ;
N NODE
Q:APPTIEN=""
S NODE=^SDEC(409.84,APPTIEN,2)
Q:NODE'["SDWL"
S RET=$P(^SDEC(409.84,APPTIEN,2),";",1)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDEC63 3534 printed Oct 16, 2024@18:51:34 Page 2
SDEC63 ;SPFO/DMR VSE ROUTINE CLINIC GROUP LOOKUP ;Apr 6, 2021@14:21
+1 ;;5.3;Scheduling;**774,781**;Build 2;Build 11
+2 ;
CLGRPLK(SDECY,SRCHAR) ;CLINIC GROUP LOOKUP
+1 ;INPUT - SRCHAR required search string
+2 ;RETURN - LIST of SDEC RESOURCE GROUP (#409.831)
+3 ; - GROUP IEN^GROUP NAME
+4 ;
+5 NEW GRPNAME,GRPIEN,LEN
+6 SET SDECY="^TMP(""SDEC63"","_$JOB_",""GRPLKUP"")"
+7 KILL @SDECY
+8 SET COUNT=0
+9 SET @SDECY@(COUNT)="I00010GRPIEN^T00035GROUP_NAME"_$CHAR(30)
+10 if $TRANSLATE(SRCHAR," ")=""
QUIT
+11 SET LEN=$LENGTH(SRCHAR)
+12 DO SEARCH
+13 SET @SDECY@(COUNT)=@SDECY@(COUNT)_$CHAR(31)
+14 QUIT
+15 ;
SEARCH ;
+1 NEW INACTDT
+2 DO CHKNAME
+3 SET GRPNAME=$SELECT($PIECE(SRCHAR,"|",1)'="":$EXTRACT($PIECE(SRCHAR,"|",1),1,LEN),1:"")
+4 FOR
SET GRPNAME=$ORDER(^SDEC(409.832,"B",GRPNAME))
if (GRPNAME="")!(GRPNAME'[SRCHAR)!($EXTRACT(GRPNAME,1,LEN)'=SRCHAR)
QUIT
Begin DoDot:1
+5 SET GRPIEN=$ORDER(^SDEC(409.832,"B",GRPNAME,""))
+6 ;inactive date
SET INACTDT=$$GET1^DIQ(409.832,",",.02,"I")
+7 ;Quit if inactive
if (INACTDT'="")&(INACTDT<DT)
QUIT
+8 SET COUNT=COUNT+1
+9 SET @SDECY@(COUNT)=GRPIEN_"^"_GRPNAME_$CHAR(30)
End DoDot:1
+10 QUIT
+11 ;
CHKNAME ;
+1 SET GRPIEN=$ORDER(^SDEC(409.832,"B",SRCHAR,""))
+2 if GRPIEN=""
QUIT
+3 ;inactive date
SET INACTDT=$$GET1^DIQ(409.832,",",.02,"I")
+4 ;Quit if inactive
if (INACTDT'="")&(INACTDT<DT)
QUIT
+5 SET GRPNAME=SRCHAR
+6 SET COUNT=COUNT+1
+7 SET @SDECY@(COUNT)=GRPIEN_"^"_GRPNAME_$CHAR(30)
+8 QUIT
+9 ;
RESGRP(SDECY,SDECDUZ,GRPIEN) ;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
+9 NEW SDECRESN,SDECMGR,SDECRESD,SDECNOD,SDECSUBID
+10 NEW SDCL,SDPRV,SDTYP
+11 NEW SDGRP,COUNT,RESIEN,RESNODE,RESN
+12 KILL ^TMP("SDEC63",$JOB)
+13 SET SDECY="^TMP(""SDEC63"","_$JOB_")"
+14 KILL @SDECY
+15 SET COUNT=0
+16 SET SDECERR=""
+17 SET @SDECY@(COUNT)="I00020RESOURCE_GROUPID^T00030RESOURCE_GROUP^I00020RESOURCE_GROUP_ITEMID^T00030RESOURCE_NAME^I00020RESOURCEID"_$CHAR(30)
+18 SET SDECDUZ=0
+19 ;Check SECURITY KEY file for SDECZMGR key
+20 ;S SDECMGR=$$APSEC("SDECZMGR",SDECDUZ)
+21 ;
+22 SET SDGRP=$GET(^SDEC(409.832,GRPIEN,0))
Begin DoDot:1
+23 if '$DATA(SDGRP)
QUIT
+24 SET SDECDEPN=$PIECE(SDGRP,"^")
+25 SET SDECRES=0
FOR
SET SDECRES=$ORDER(^SDEC(409.832,GRPIEN,1,SDECRES))
if '+SDECRES
QUIT
Begin DoDot:2
+26 NEW RESIEN
+27 if '$DATA(^SDEC(409.832,GRPIEN,1,SDECRES,0))
QUIT
+28 SET RESIEN=$PIECE(^SDEC(409.832,GRPIEN,1,SDECRES,0),"^")
+29 if '$DATA(^SDEC(409.831,RESIEN,0))
QUIT
+30 SET RESNODE=$GET(^SDEC(409.831,RESIEN,0))
+31 if RESNODE=""
QUIT
+32 SET RESN=$PIECE(RESNODE,"^")
+33 ;QUIT if the resource is inactive
+34 SET SDCL=$PIECE(RESNODE,"^",4)
+35 ;S SDTYP=$P(SDECRNOD,"^",11)
+36 ;I $P(SDTYP,";",2)="VA(200," D RESPRV1^SDEC01B($P(SDTYP,";",1),SDCL)
+37 ;Q:$$GET1^DIQ(409.831,SDECRESD_",",.02)="YES" ???? ".02" FIELD?????
+38 SET COUNT=COUNT+1
+39 SET @SDECY@(COUNT)=GRPIEN_"^"_SDECDEPN_"^"_SDECRES_"^"_RESN_"^"_RESIEN_$CHAR(30)
+40 QUIT
End DoDot:2
+41 QUIT
End DoDot:1
+42 ;
+43 SET @SDECY@(COUNT)=@SDECY@(COUNT)_$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 ;
GETWLIEN(RET,APPTIEN) ;
+1 NEW NODE
+2 if APPTIEN=""
QUIT
+3 SET NODE=^SDEC(409.84,APPTIEN,2)
+4 if NODE'["SDWL"
QUIT
+5 SET RET=$PIECE(^SDEC(409.84,APPTIEN,2),";",1)
+6 QUIT
