SDECLOC ;ALB/SAT - VISTA SCHEDULING RPCS ;JAN 15, 2016
;;5.3;Scheduling;**627**;Aug 13, 1993;Build 249
;Input HIEN - File 44 IEN
; INACTIVE - Inactive flag. 0=return active only; 1=return active and inactive entries
;Output - Hospital Location IEN^Hospital Location Name^Privileged User IEN^Privileged User^INACTIVE
PRIVLOC(DATA,HIEN,INACTIVE) ;EP
N LP,CNT,INACT
S INACTIVE=$G(INACTIVE)
S DATA=$$TMPGBL()
S (LP,CNT)=0
S @DATA@(0)="I00020HOSPLOCID^T00030HOSPLOCID^I00020NEWPERSONID^T00030NEWPERSONNAME^T00030INACTIVE"_$C(30)
Q:'$G(HIEN)
F S LP=$O(^SC(HIEN,"SDPRIV",LP)) Q:'LP D
.S INACT=$$PC^SDEC45(LP)
.I 'INACTIVE,INACT Q
.S CNT=CNT+1,@DATA@(CNT)=HIEN_U_$P(^SC(HIEN,0),U)_U_LP_U_$$GET1^DIQ(200,LP,.01)_U_$S(+INACT:"INACTIVE",1:"ACTIVE")_$C(30)
S @DATA@(CNT)=@DATA@(CNT)_$C(31)
Q
; Update the list of privileged users for a hospital location
; Input - LOC = IEN of Hospital Location file entry
; LST = Array of NEW PERSON IENs. For example,
; LST(1)=34
; LST(2)=65
UPDPRIV(DATA,LOC,LST) ;
K DATA
N LP,FDA,CNT,VAL,ERR,IENS,IEN
I $L($G(LST)) D
.S CNT=$L(LST,",") F LP=1:1:CNT S LST($P(LST,",",LP))=$P(LST,",",LP)
.S LST=""
S DATA(0)="I00020ERRORID^T00030ERRORTEXT"_$C(30)
I '$G(LOC) D Q
.S DATA(1)="-1^MISSING LOCATION IEN"_$C(30,31)
.D ^%ZTER
I '$D(^SC(LOC,0)) D Q
.S DATA(1)="-1^LOCATION FILE ENTRY IS MISSING"_$C(30,31)
.D ^%ZTER
D PURGE(LOC)
S CNT=0
S LP=0 F S LP=$O(LST(LP)) Q:'LP D
.S VAL=LST(LP)
.S CNT=CNT+1
.S IENS(CNT)=+VAL
.S IEN="+"_CNT_","
.S FDA(44.04,IEN_LOC_",",.01)=+VAL
D:CNT UPDATE^DIE(,"FDA","IENS","ERR")
I $D(ERR) D
.S DATA(1)="-1^"_$G(ERR("DIERR",1,"TEXT",1))_$C(30,31)
E S DATA(1)="1^SUCCESSFUL"_$C(30,31)
Q
; Purge existings entries prior to updating
; Input - IEN of Hospital Location file
PURGE(IEN) ;EP-
N DIK,DA
S DIK="^SC("_IEN_",""SDPRIV"","
S DA(1)=IEN
S DA=999999999 F S DA=$O(^SC(IEN,"SDPRIV",DA),-1) Q:'DA D ^DIK
;S DA=0 F S DA=$O(^SC(IEN,"SDPRIV",DA)) Q:'DA D ^DIK
Q
TMPGBL() ;EP-
K ^TMP("SDECLOC",$J) Q $NA(^($J))
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDECLOC 2121 printed Nov 22, 2024@18:02:17 Page 2
SDECLOC ;ALB/SAT - VISTA SCHEDULING RPCS ;JAN 15, 2016
+1 ;;5.3;Scheduling;**627**;Aug 13, 1993;Build 249
+2 ;Input HIEN - File 44 IEN
+3 ; INACTIVE - Inactive flag. 0=return active only; 1=return active and inactive entries
+4 ;Output - Hospital Location IEN^Hospital Location Name^Privileged User IEN^Privileged User^INACTIVE
PRIVLOC(DATA,HIEN,INACTIVE) ;EP
+1 NEW LP,CNT,INACT
+2 SET INACTIVE=$GET(INACTIVE)
+3 SET DATA=$$TMPGBL()
+4 SET (LP,CNT)=0
+5 SET @DATA@(0)="I00020HOSPLOCID^T00030HOSPLOCID^I00020NEWPERSONID^T00030NEWPERSONNAME^T00030INACTIVE"_$CHAR(30)
+6 if '$GET(HIEN)
QUIT
+7 FOR
SET LP=$ORDER(^SC(HIEN,"SDPRIV",LP))
if 'LP
QUIT
Begin DoDot:1
+8 SET INACT=$$PC^SDEC45(LP)
+9 IF 'INACTIVE
IF INACT
QUIT
+10 SET CNT=CNT+1
SET @DATA@(CNT)=HIEN_U_$PIECE(^SC(HIEN,0),U)_U_LP_U_$$GET1^DIQ(200,LP,.01)_U_$SELECT(+INACT:"INACTIVE",1:"ACTIVE")_$CHAR(30)
End DoDot:1
+11 SET @DATA@(CNT)=@DATA@(CNT)_$CHAR(31)
+12 QUIT
+13 ; Update the list of privileged users for a hospital location
+14 ; Input - LOC = IEN of Hospital Location file entry
+15 ; LST = Array of NEW PERSON IENs. For example,
+16 ; LST(1)=34
+17 ; LST(2)=65
UPDPRIV(DATA,LOC,LST) ;
+1 KILL DATA
+2 NEW LP,FDA,CNT,VAL,ERR,IENS,IEN
+3 IF $LENGTH($GET(LST))
Begin DoDot:1
+4 SET CNT=$LENGTH(LST,",")
FOR LP=1:1:CNT
SET LST($PIECE(LST,",",LP))=$PIECE(LST,",",LP)
+5 SET LST=""
End DoDot:1
+6 SET DATA(0)="I00020ERRORID^T00030ERRORTEXT"_$CHAR(30)
+7 IF '$GET(LOC)
Begin DoDot:1
+8 SET DATA(1)="-1^MISSING LOCATION IEN"_$CHAR(30,31)
+9 DO ^%ZTER
End DoDot:1
QUIT
+10 IF '$DATA(^SC(LOC,0))
Begin DoDot:1
+11 SET DATA(1)="-1^LOCATION FILE ENTRY IS MISSING"_$CHAR(30,31)
+12 DO ^%ZTER
End DoDot:1
QUIT
+13 DO PURGE(LOC)
+14 SET CNT=0
+15 SET LP=0
FOR
SET LP=$ORDER(LST(LP))
if 'LP
QUIT
Begin DoDot:1
+16 SET VAL=LST(LP)
+17 SET CNT=CNT+1
+18 SET IENS(CNT)=+VAL
+19 SET IEN="+"_CNT_","
+20 SET FDA(44.04,IEN_LOC_",",.01)=+VAL
End DoDot:1
+21 if CNT
DO UPDATE^DIE(,"FDA","IENS","ERR")
+22 IF $DATA(ERR)
Begin DoDot:1
+23 SET DATA(1)="-1^"_$GET(ERR("DIERR",1,"TEXT",1))_$CHAR(30,31)
End DoDot:1
+24 IF '$TEST
SET DATA(1)="1^SUCCESSFUL"_$CHAR(30,31)
+25 QUIT
+26 ; Purge existings entries prior to updating
+27 ; Input - IEN of Hospital Location file
PURGE(IEN) ;EP-
+1 NEW DIK,DA
+2 SET DIK="^SC("_IEN_",""SDPRIV"","
+3 SET DA(1)=IEN
+4 SET DA=999999999
FOR
SET DA=$ORDER(^SC(IEN,"SDPRIV",DA),-1)
if 'DA
QUIT
DO ^DIK
+5 ;S DA=0 F S DA=$O(^SC(IEN,"SDPRIV",DA)) Q:'DA D ^DIK
+6 QUIT
TMPGBL() ;EP-
+1 KILL ^TMP("SDECLOC",$JOB)
QUIT $NAME(^($JOB))
