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.
  1. SDEC63 ;SPFO/DMR VSE ROUTINE CLINIC GROUP LOOKUP ;Apr 6, 2021@14:21
  1. ;;5.3;Scheduling;**774,781**;Build 2;Build 11
  1. ;
  1. CLGRPLK(SDECY,SRCHAR) ;CLINIC GROUP LOOKUP
  1. ;INPUT - SRCHAR required search string
  1. ;RETURN - LIST of SDEC RESOURCE GROUP (#409.831)
  1. ; - GROUP IEN^GROUP NAME
  1. ;
  1. N GRPNAME,GRPIEN,LEN
  1. S SDECY="^TMP(""SDEC63"","_$J_",""GRPLKUP"")"
  1. K @SDECY
  1. S COUNT=0
  1. S @SDECY@(COUNT)="I00010GRPIEN^T00035GROUP_NAME"_$C(30)
  1. Q:$TR(SRCHAR," ")=""
  1. S LEN=$L(SRCHAR)
  1. D SEARCH
  1. S @SDECY@(COUNT)=@SDECY@(COUNT)_$C(31)
  1. Q
  1. ;
  1. N INACTDT
  1. D CHKNAME
  1. S GRPNAME=$S($P(SRCHAR,"|",1)'="":$E($P(SRCHAR,"|",1),1,LEN),1:"")
  1. F S GRPNAME=$O(^SDEC(409.832,"B",GRPNAME)) Q:(GRPNAME="")!(GRPNAME'[SRCHAR)!($E(GRPNAME,1,LEN)'=SRCHAR) D
  1. . S GRPIEN=$O(^SDEC(409.832,"B",GRPNAME,""))
  1. . S INACTDT=$$GET1^DIQ(409.832,",",.02,"I") ;inactive date
  1. . Q:(INACTDT'="")&(INACTDT<DT) ;Quit if inactive
  1. . S COUNT=COUNT+1
  1. . S @SDECY@(COUNT)=GRPIEN_"^"_GRPNAME_$C(30)
  1. Q
  1. ;
  1. CHKNAME ;
  1. S GRPIEN=$O(^SDEC(409.832,"B",SRCHAR,""))
  1. Q:GRPIEN=""
  1. S INACTDT=$$GET1^DIQ(409.832,",",.02,"I") ;inactive date
  1. Q:(INACTDT'="")&(INACTDT<DT) ;Quit if inactive
  1. S GRPNAME=SRCHAR
  1. S COUNT=COUNT+1
  1. S @SDECY@(COUNT)=GRPIEN_"^"_GRPNAME_$C(30)
  1. Q
  1. ;
  1. RESGRP(SDECY,SDECDUZ,GRPIEN) ;GROUP RESOURCE
  1. ;RESGPUSR(SDECY,SDECDUZ) external parameter tag is in SDEC
  1. ;Returns ADO Recordset with all ACTIVE GROUP/RESOURCE combinations
  1. ;to which user has access based on entries in SDEC RESOURCE USER file
  1. ;If SDECDUZ=0 then returns all ACTIVE GROUP/RESOURCE combinations for current DUZ
  1. ;If user SDECDUZ possesses the key SDECZMGR
  1. ;then ALL ACTIVE resource group names are returned
  1. ;
  1. N SDECERR,SDECRET,SDECIEN,SDECRES,SDECDEP,SDECDDR,SDECDEPN,SDECRDAT,SDECRNOD
  1. N SDECRESN,SDECMGR,SDECRESD,SDECNOD,SDECSUBID
  1. N SDCL,SDPRV,SDTYP
  1. N SDGRP,COUNT,RESIEN,RESNODE,RESN
  1. K ^TMP("SDEC63",$J)
  1. S SDECY="^TMP(""SDEC63"","_$J_")"
  1. K @SDECY
  1. S COUNT=0
  1. S SDECERR=""
  1. S @SDECY@(COUNT)="I00020RESOURCE_GROUPID^T00030RESOURCE_GROUP^I00020RESOURCE_GROUP_ITEMID^T00030RESOURCE_NAME^I00020RESOURCEID"_$C(30)
  1. S SDECDUZ=0
  1. ;Check SECURITY KEY file for SDECZMGR key
  1. ;S SDECMGR=$$APSEC("SDECZMGR",SDECDUZ)
  1. ;
  1. S SDGRP=$G(^SDEC(409.832,GRPIEN,0)) D
  1. . Q:'$D(SDGRP)
  1. . S SDECDEPN=$P(SDGRP,"^")
  1. . S SDECRES=0 F S SDECRES=$O(^SDEC(409.832,GRPIEN,1,SDECRES)) Q:'+SDECRES D
  1. . . N RESIEN
  1. . . Q:'$D(^SDEC(409.832,GRPIEN,1,SDECRES,0))
  1. . . S RESIEN=$P(^SDEC(409.832,GRPIEN,1,SDECRES,0),"^")
  1. . . Q:'$D(^SDEC(409.831,RESIEN,0))
  1. . . S RESNODE=$G(^SDEC(409.831,RESIEN,0))
  1. . . Q:RESNODE=""
  1. . . S RESN=$P(RESNODE,"^")
  1. . . ;QUIT if the resource is inactive
  1. . . S SDCL=$P(RESNODE,"^",4)
  1. . . ;S SDTYP=$P(SDECRNOD,"^",11)
  1. . . ;I $P(SDTYP,";",2)="VA(200," D RESPRV1^SDEC01B($P(SDTYP,";",1),SDCL)
  1. . . ;Q:$$GET1^DIQ(409.831,SDECRESD_",",.02)="YES" ???? ".02" FIELD?????
  1. . . S COUNT=COUNT+1
  1. . . S @SDECY@(COUNT)=GRPIEN_"^"_SDECDEPN_"^"_SDECRES_"^"_RESN_"^"_RESIEN_$C(30)
  1. . . Q
  1. . Q
  1. ;
  1. S @SDECY@(COUNT)=@SDECY@(COUNT)_$C(31)_SDECERR
  1. Q
  1. ;
  1. APSEC(SDECKEY,SDECDUZ) ;EP - Return TRUE (1) if user has keys SDECKEY, otherwise, returns FALSE (0)
  1. ;
  1. N SDECIEN,SDECPKEY
  1. I '$G(SDECDUZ) Q 0
  1. ;
  1. I SDECKEY="" Q 0
  1. I '$D(^DIC(19.1,"B",SDECKEY)) Q 0
  1. S SDECIEN=$O(^DIC(19.1,"B",SDECKEY,0))
  1. I '+SDECIEN Q 0
  1. I '$D(^VA(200,SDECDUZ,51,SDECIEN,0)) Q 0
  1. Q 1
  1. ;
  1. GETWLIEN(RET,APPTIEN) ;
  1. N NODE
  1. Q:APPTIEN=""
  1. S NODE=^SDEC(409.84,APPTIEN,2)
  1. Q:NODE'["SDWL"
  1. S RET=$P(^SDEC(409.84,APPTIEN,2),";",1)
  1. Q