- 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 Feb 19, 2025@00:17:26 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