Routine: SDECLOC

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)

 ; 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)

 ; 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

TMPGBL() ;EP-

 K ^TMP("SDECLOC",$J) Q $NA(^($J))

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDECLOC   2121     printed  Mar 13, 2025@21:57: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))

SDECLOC.m