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 ---[H[J[2J[HSDEC14 2882 printed Nov 22, 2024@18:00:08 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
