SDEC14.m

SDEC14 ;ALB/SAT - VISTA SCHEDULING RPCS ;JAN 15, 2016

 ;;5.3;Scheduling;**627**;Aug 13, 1993;Build 249

 ;

 Q

 ;

ADDACCTY(SDECY,SDECVAL) ;ADD/EDIT ACCESS TYPE

 ;ADDACCTY(SDECY,SDECVAL)  external parameter tag is in SDEC

 ;Add/Edit ACCESS TYPE entry

 ;INPUT:

 ; SDECVAL - IEN|NAME|INACTIVE|COLOR|RED|GREEN|BLUE|PREVENT_ACCESS

 ; IEN      - (optional) Pointer to the SDEC ACCESS TYPE file

 ;                       a new entry is added if IEN is null

 ; NAME     - (required if new)    Value to be put into the ACCESS TYPE NAME field

 ; INACTIVE - (optional) Value to be put into the INACTIVE field

 ;                       0=active; 1=inactive

 ; COLOR    - (optional) Value to be put into the DISPLAY COLOR field

 ; RED      - (optional) Value to be put into the RED field

 ; GREEN    - (optional) Value to be put into the GREEN field

 ; BLUE     - (optional) Value to be put into the BLUE field

 ; PREVENT_ACCESS - (optional) Value to be put into the PREVENT ACCESS field

 ;                             0=NO; 1=YES

 ;RETURN:

 ; SDEC ACCESS TYPE ien

 ;

 N SDECIENS,SDECFDA,SDECIEN,SDECINA,SDECMSG,SDEC,SDECNAM,SDECPA

 S SDECY="^TMP(""SDEC"","_$J_")"

 K @SDECY

 S ^TMP("SDEC",$J,0)="I00020ACCESSTYPEID^T00030ERRORTEXT"_$C(30)

 I SDECVAL="" D ERR(0,"SDEC14: Invalid null input Parameter") Q

 S SDECIEN=$P(SDECVAL,"|")

 I +SDECIEN D

 . S SDEC="EDIT"

 . S SDECIENS=SDECIEN_","

 E  D

 . S SDEC="ADD"

 . S SDECIENS="+1,"

 ;

 S SDECNAM=$P(SDECVAL,"|",2)

 I SDECNAM="" D ERR(0,"SDEC14: Invalid null Access Type name.") Q

 ;

 ;Prevent adding entry with duplicate name

 I $D(^SDEC(409.823,"B",SDECNAM)),$O(^SDEC(409.823,"B",SDECNAM,0))'=SDECIEN D  Q

 . D ERR(0,"SDEC14: Cannot have two Access Types with the same name.")

 . Q

 ;setup inactive flag

 S SDECINA=$P(SDECVAL,"|",3)

 S SDECINA=$S(SDECINA="YES":1,1:0)

 ;setup prevent access flag

 S SDECPA=$P(SDECVAL,"|",8)

 S SDECPA=$S(SDECPA="YES":1,1:0)

 ;

 S SDECFDA(409.823,SDECIENS,.01)=$P(SDECVAL,"|",2) ;NAME

 S SDECFDA(409.823,SDECIENS,.02)=SDECINA ;INACTIVE

 S SDECFDA(409.823,SDECIENS,.04)=$P(SDECVAL,"|",4) ;COLOR

 S SDECFDA(409.823,SDECIENS,.05)=$P(SDECVAL,"|",5) ;RED

 S SDECFDA(409.823,SDECIENS,.06)=$P(SDECVAL,"|",6) ;GREEN

 S SDECFDA(409.823,SDECIENS,.07)=$P(SDECVAL,"|",7) ;BLUE

 S SDECFDA(409.823,SDECIENS,.08)=SDECPA  ;PREVENT ACCESS

 K SDECMSG

 I SDEC="ADD" D

 . K SDECIEN

 . D UPDATE^DIE("","SDECFDA","SDECIEN","SDECMSG")

 . S SDECIEN=+$G(SDECIEN(1))

 E  D

 . D FILE^DIE("","SDECFDA","SDECMSG")

 S ^TMP("SDEC",$J,1)=$G(SDECIEN)_"^-1"_$C(30)_$C(31)

 Q

 ;

ERR(SDECERID,ERRTXT) ;Error processing

 S:'+$G(SDECI) SDECI=999999

 S SDECI=SDECI+1

 S ^TMP("SDEC",$J,SDECI)=SDECERID_"^"_ERRTXT_$C(30)

 S SDECI=SDECI+1

 S ^TMP("SDEC",$J,SDECI)=$C(31)

 Q

 ;

ERROR ;

 D ^%ZTER

 I '+$G(SDECI) N SDECI S SDECI=999999

 S SDECI=SDECI+1

 D ERR(0,"SDEC14 Error")

 Q

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---SDEC14   2882     printed  Mar 13, 2025@21:55:09                                                                                                                                                                                                      Page 2

SDEC14    ;ALB/SAT - VISTA SCHEDULING RPCS ;JAN 15, 2016

 +1       ;;5.3;Scheduling;**627**;Aug 13, 1993;Build 249

 +2       ;

 +3        QUIT 

 +4       ;

ADDACCTY(SDECY,SDECVAL) ;ADD/EDIT ACCESS TYPE

 +1       ;ADDACCTY(SDECY,SDECVAL)  external parameter tag is in SDEC

 +2       ;Add/Edit ACCESS TYPE entry

 +3       ;INPUT:

 +4       ; SDECVAL - IEN|NAME|INACTIVE|COLOR|RED|GREEN|BLUE|PREVENT_ACCESS

 +5       ; IEN      - (optional) Pointer to the SDEC ACCESS TYPE file

 +6       ;                       a new entry is added if IEN is null

 +7       ; NAME     - (required if new)    Value to be put into the ACCESS TYPE NAME field

 +8       ; INACTIVE - (optional) Value to be put into the INACTIVE field

 +9       ;                       0=active; 1=inactive

 +10      ; COLOR    - (optional) Value to be put into the DISPLAY COLOR field

 +11      ; RED      - (optional) Value to be put into the RED field

 +12      ; GREEN    - (optional) Value to be put into the GREEN field

 +13      ; BLUE     - (optional) Value to be put into the BLUE field

 +14      ; PREVENT_ACCESS - (optional) Value to be put into the PREVENT ACCESS field

 +15      ;                             0=NO; 1=YES

 +16      ;RETURN:

 +17      ; SDEC ACCESS TYPE ien

 +18      ;

 +19       NEW SDECIENS,SDECFDA,SDECIEN,SDECINA,SDECMSG,SDEC,SDECNAM,SDECPA

 +20       SET SDECY="^TMP(""SDEC"","_$JOB_")"

 +21       KILL @SDECY

 +22       SET ^TMP("SDEC",$JOB,0)="I00020ACCESSTYPEID^T00030ERRORTEXT"_$CHAR(30)

 +23       IF SDECVAL=""

               DO ERR(0,"SDEC14: Invalid null input Parameter")

               QUIT 

 +24       SET SDECIEN=$PIECE(SDECVAL,"|")

 +25       IF +SDECIEN

               Begin DoDot:1

 +26               SET SDEC="EDIT"

 +27               SET SDECIENS=SDECIEN_","

               End DoDot:1

 +28      IF '$TEST

               Begin DoDot:1

 +29               SET SDEC="ADD"

 +30               SET SDECIENS="+1,"

               End DoDot:1

 +31      ;

 +32       SET SDECNAM=$PIECE(SDECVAL,"|",2)

 +33       IF SDECNAM=""

               DO ERR(0,"SDEC14: Invalid null Access Type name.")

               QUIT 

 +34      ;

 +35      ;Prevent adding entry with duplicate name

 +36       IF $DATA(^SDEC(409.823,"B",SDECNAM))

               IF $ORDER(^SDEC(409.823,"B",SDECNAM,0))'=SDECIEN

                   Begin DoDot:1

 +37                   DO ERR(0,"SDEC14: Cannot have two Access Types with the same name.")

 +38                   QUIT 

                   End DoDot:1

                   QUIT 

 +39      ;setup inactive flag

 +40       SET SDECINA=$PIECE(SDECVAL,"|",3)

 +41       SET SDECINA=$SELECT(SDECINA="YES":1,1:0)

 +42      ;setup prevent access flag

 +43       SET SDECPA=$PIECE(SDECVAL,"|",8)

 +44       SET SDECPA=$SELECT(SDECPA="YES":1,1:0)

 +45      ;

 +46      ;NAME

           SET SDECFDA(409.823,SDECIENS,.01)=$PIECE(SDECVAL,"|",2)

 +47      ;INACTIVE

           SET SDECFDA(409.823,SDECIENS,.02)=SDECINA

 +48      ;COLOR

           SET SDECFDA(409.823,SDECIENS,.04)=$PIECE(SDECVAL,"|",4)

 +49      ;RED

           SET SDECFDA(409.823,SDECIENS,.05)=$PIECE(SDECVAL,"|",5)

 +50      ;GREEN

           SET SDECFDA(409.823,SDECIENS,.06)=$PIECE(SDECVAL,"|",6)

 +51      ;BLUE

           SET SDECFDA(409.823,SDECIENS,.07)=$PIECE(SDECVAL,"|",7)

 +52      ;PREVENT ACCESS

           SET SDECFDA(409.823,SDECIENS,.08)=SDECPA

 +53       KILL SDECMSG

 +54       IF SDEC="ADD"

               Begin DoDot:1

 +55               KILL SDECIEN

 +56               DO UPDATE^DIE("","SDECFDA","SDECIEN","SDECMSG")

 +57               SET SDECIEN=+$GET(SDECIEN(1))

               End DoDot:1

 +58      IF '$TEST

               Begin DoDot:1

 +59               DO FILE^DIE("","SDECFDA","SDECMSG")

               End DoDot:1

 +60       SET ^TMP("SDEC",$JOB,1)=$GET(SDECIEN)_"^-1"_$CHAR(30)_$CHAR(31)

 +61       QUIT 

 +62      ;

ERR(SDECERID,ERRTXT) ;Error processing

 +1        if '+$GET(SDECI)

               SET SDECI=999999

 +2        SET SDECI=SDECI+1

 +3        SET ^TMP("SDEC",$JOB,SDECI)=SDECERID_"^"_ERRTXT_$CHAR(30)

 +4        SET SDECI=SDECI+1

 +5        SET ^TMP("SDEC",$JOB,SDECI)=$CHAR(31)

 +6        QUIT 

 +7       ;

ERROR     ;

 +1        DO ^%ZTER

 +2        IF '+$GET(SDECI)

               NEW SDECI

               SET SDECI=999999

 +3        SET SDECI=SDECI+1

 +4        DO ERR(0,"SDEC14 Error")

 +5        QUIT