Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDEC63

SDEC63.m

Go to the documentation of this file.
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
 ;
 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