SDEC46 ;ALB/SAT/JSM,LAB - VISTA SCHEDULING RPCS ;APR 1, 2022
;;5.3;Scheduling;**627,643,658,814**;Aug 13, 1993;Build 11
;
Q
;
CURFACG(SDECY,SDECDUZ) ;get current division/facility for given user
;CURFACG(SDECY,SDECDUZ) external parameter tag is in SDEC
; SDECDUZ = user IEN from the NEW PERSON file 200
; returns the Current Division/Facility for the given user
N SDECCD,SDECI,SDECSUB
S SDECI=0
S SDECY="^TMP(""SDEC"","_$J_")"
K @SDECY
S ^TMP("SDEC",$J,0)="T00020ERROR_ID"_$C(30)
;check if valid user
I $G(SDECDUZ)="" D ERR("0^SDEC46: User not specified.") Q
I '$D(^VA(200,SDECDUZ)) D ERR("0^SDEC46: Invalid user specified.") Q
S ^TMP("SDEC",$J,0)="T00020CURRENT_DIV"_$C(30)
S SDECSUB="^VA(200,"_SDECDUZ_",""2"","
S SDECCD=$G(^DISV(SDECDUZ,SDECSUB))
I SDECCD'="" S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=SDECCD_$C(30)
S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$C(31)
Q
;
GETFAC(SDECY,SDECDUZ) ;Gets all facilities for a user
;GETFAC(SDECY,SDECDUZ) external parameter tag is in SDEC
; Input SDECDUZ - (required) user IEN from the NEW PERSON file 200
; Returns:
;Global Array in which each array entry
;contains the following ^ pieces:
; DIV_IEN = institution Id pointer to the INSTITUTION file 4
; NOTE field in file 200 uses the term DIVISION but the
; field points to the INSTITUTION file.
; DIV_NAME = institution NAME from the INSTITUTION file
; DEFAULT = Is default division/facility?
; Value can be 'YES' or 'NO'
; TZ_CODE = CODE from the MAILMAN TIME ZONE file 4.4
; TZ_NAME = TIME ZONE NAME from the MAILMAN TIME ZONE file
; TZ_DIFF = DIFFERENTIAL from the MAILMAN TIME ZONE file
; 7. DIALOGUE = Allow appointment dialogue
; 0=NO (off)
; 1=YES (on) display and ask
; 8.DEF_FONT = User's default font size for VistA Scheduling letters
N SDECFN,SDECI,SDECN,SDECNOD,SDIAL,SDTMP,SDTZ,SDTZN,SDFONT ;alb/jsm 658 added SDFONT
S SDECI=0
S SDECY="^TMP(""SDEC"","_$J_")"
K @SDECY
S ^TMP("SDEC",$J,0)="T00020ERROR_ID"_$C(30)
;check if valid user
I $G(SDECDUZ)="" D ERR("0^SDEC46: User not specified.") Q
I '$D(^VA(200,+SDECDUZ)) D ERR("0^SDEC46: Invalid user specified.") Q
S ^TMP("SDEC",$J,0)="T00020DIV_IEN^T00020DIV_NAME^T00020DEFAULT^T00030TZ_CODE^T00030TZ_NAME^T00030TZ_DIFF^T00030DIALOGUE^T00010DEF_FONT"_$C(30)
S SDIAL=+$P($G(^DVB(396.1,1,0)),U,18) ;APPT LINKING ENHANCE DIALOGUE from AMIE SITE PARAMETER file
S SDTZ=$$GET1^DIQ(4.3,"1,",1,"I")
S SDTZN=$G(^XMB(4.4,SDTZ,0))
;D GETFONT^SDECU4(.SDFONT,SDECDUZ) ;alb/jsm 658
D GETFONT^SDECU4(.SDFONT,"DIV") ;alb/jsm 658
S SDECFN=0
F S SDECFN=$O(^VA(200,+SDECDUZ,2,SDECFN)) Q:SDECFN'>0 D
. S SDECNOD=$G(^VA(200,+SDECDUZ,2,SDECFN,0))
. S SDTMP=SDECFN_U_$P(^DIC(4,SDECFN,0),U,1)_U_$S($P(SDECNOD,U,2)=1:"YES",1:"NO")
. S SDTMP=SDTMP_U_$P(SDTZN,U,1)_U_$P(SDTZN,U,2)_U_$P(SDTZN,U,3)_U_SDIAL_U_$G(@SDFONT@(1)) ;alb/jsm 658
. S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=SDTMP_$C(30)
S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$C(31)
Q
;
SETFAC(SDECY,SDECDUZ,SDECFAC) ;SET FACILITY
;SETFAC(SDECY,SDECDUZ,SDECFAC) external parameter tag is in SDEC
; SDECDUZ = user IEN - pointer to the NEW PERSON file 200
; SDECFAC = facility/division to set - pointer to the INSTITUTE file 4
;Returns ERROR_ID^ERROR_TEXT
; where ERROR_ID = 1 if successful; 0 if failed
;Fails if SDECFAC is not one of the current user's divisions
N SDECI,SDECSUB
S SDECI=0
S SDECY="^TMP(""SDEC"","_$J_")"
K @SDECY
S ^TMP("SDEC",$J,0)="T00020ERROR_ID^T00020ERROR_TEXT"_$C(30)
I '+SDECDUZ S SDECDUZ=DUZ
I '+SDECFAC S SDECI=SDECI+1 S ^TMP("SDEC",$J,1)=0_U_"Division not specified."_$C(30) S SDECI=SDECI+1 S ^TMP("SDEC",$J,1)=$C(31) Q
I '$D(^VA(200,SDECDUZ,2,+SDECFAC)) S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=0_U_"Invalid division specified."_$C(30) S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$C(31) Q
S SDECSUB="^VA(200,"_SDECDUZ_",""2"","
S ^DISV(SDECDUZ,SDECSUB)=SDECFAC
S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=1_U_""_$C(30)
S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$C(31) Q
Q
;
GETINST(INSTITUTION) ;get institution id and name
N INSTREC,INST
S INST=$$SITE^VASITE()
S INSTREC("Institution","ID")=$P(INST,U,1)
S INSTREC("Institution","Name")=$P(INST,U,2)
D BUILDER(.INSTREC,.INSTITUTION)
Q
;
BUILDER(DATAARR,JSONREC) ;build json record
N ERR
D ENCODE^XLFJSON("DATAARR","JSONREC","ERR")
Q
;
ERROR ;
D ERR("Error")
Q
;
ERR(ERRTXT) ;Error processing
S:'$D(SDECI) SDECI=999
S ERRTXT=$G(ERRTXT)
S SDECI=SDECI+1
S ^TMP("SDEC",$J,SDECI)=ERRTXT_$C(30)
S SDECI=SDECI+1
S ^TMP("SDEC",$J,SDECI)=$C(31)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSDEC46 4714 printed Oct 16, 2024@18:51:11 Page 2
SDEC46 ;ALB/SAT/JSM,LAB - VISTA SCHEDULING RPCS ;APR 1, 2022
+1 ;;5.3;Scheduling;**627,643,658,814**;Aug 13, 1993;Build 11
+2 ;
+3 QUIT
+4 ;
CURFACG(SDECY,SDECDUZ) ;get current division/facility for given user
+1 ;CURFACG(SDECY,SDECDUZ) external parameter tag is in SDEC
+2 ; SDECDUZ = user IEN from the NEW PERSON file 200
+3 ; returns the Current Division/Facility for the given user
+4 NEW SDECCD,SDECI,SDECSUB
+5 SET SDECI=0
+6 SET SDECY="^TMP(""SDEC"","_$JOB_")"
+7 KILL @SDECY
+8 SET ^TMP("SDEC",$JOB,0)="T00020ERROR_ID"_$CHAR(30)
+9 ;check if valid user
+10 IF $GET(SDECDUZ)=""
DO ERR("0^SDEC46: User not specified.")
QUIT
+11 IF '$DATA(^VA(200,SDECDUZ))
DO ERR("0^SDEC46: Invalid user specified.")
QUIT
+12 SET ^TMP("SDEC",$JOB,0)="T00020CURRENT_DIV"_$CHAR(30)
+13 SET SDECSUB="^VA(200,"_SDECDUZ_",""2"","
+14 SET SDECCD=$GET(^DISV(SDECDUZ,SDECSUB))
+15 IF SDECCD'=""
SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,SDECI)=SDECCD_$CHAR(30)
+16 SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,SDECI)=$CHAR(31)
+17 QUIT
+18 ;
GETFAC(SDECY,SDECDUZ) ;Gets all facilities for a user
+1 ;GETFAC(SDECY,SDECDUZ) external parameter tag is in SDEC
+2 ; Input SDECDUZ - (required) user IEN from the NEW PERSON file 200
+3 ; Returns:
+4 ;Global Array in which each array entry
+5 ;contains the following ^ pieces:
+6 ; DIV_IEN = institution Id pointer to the INSTITUTION file 4
+7 ; NOTE field in file 200 uses the term DIVISION but the
+8 ; field points to the INSTITUTION file.
+9 ; DIV_NAME = institution NAME from the INSTITUTION file
+10 ; DEFAULT = Is default division/facility?
+11 ; Value can be 'YES' or 'NO'
+12 ; TZ_CODE = CODE from the MAILMAN TIME ZONE file 4.4
+13 ; TZ_NAME = TIME ZONE NAME from the MAILMAN TIME ZONE file
+14 ; TZ_DIFF = DIFFERENTIAL from the MAILMAN TIME ZONE file
+15 ; 7. DIALOGUE = Allow appointment dialogue
+16 ; 0=NO (off)
+17 ; 1=YES (on) display and ask
+18 ; 8.DEF_FONT = User's default font size for VistA Scheduling letters
+19 ;alb/jsm 658 added SDFONT
NEW SDECFN,SDECI,SDECN,SDECNOD,SDIAL,SDTMP,SDTZ,SDTZN,SDFONT
+20 SET SDECI=0
+21 SET SDECY="^TMP(""SDEC"","_$JOB_")"
+22 KILL @SDECY
+23 SET ^TMP("SDEC",$JOB,0)="T00020ERROR_ID"_$CHAR(30)
+24 ;check if valid user
+25 IF $GET(SDECDUZ)=""
DO ERR("0^SDEC46: User not specified.")
QUIT
+26 IF '$DATA(^VA(200,+SDECDUZ))
DO ERR("0^SDEC46: Invalid user specified.")
QUIT
+27 SET ^TMP("SDEC",$JOB,0)="T00020DIV_IEN^T00020DIV_NAME^T00020DEFAULT^T00030TZ_CODE^T00030TZ_NAME^T00030TZ_DIFF^T00030DIALOGUE^T00010DEF_FONT"_$CHAR(30)
+28 ;APPT LINKING ENHANCE DIALOGUE from AMIE SITE PARAMETER file
SET SDIAL=+$PIECE($GET(^DVB(396.1,1,0)),U,18)
+29 SET SDTZ=$$GET1^DIQ(4.3,"1,",1,"I")
+30 SET SDTZN=$GET(^XMB(4.4,SDTZ,0))
+31 ;D GETFONT^SDECU4(.SDFONT,SDECDUZ) ;alb/jsm 658
+32 ;alb/jsm 658
DO GETFONT^SDECU4(.SDFONT,"DIV")
+33 SET SDECFN=0
+34 FOR
SET SDECFN=$ORDER(^VA(200,+SDECDUZ,2,SDECFN))
if SDECFN'>0
QUIT
Begin DoDot:1
+35 SET SDECNOD=$GET(^VA(200,+SDECDUZ,2,SDECFN,0))
+36 SET SDTMP=SDECFN_U_$PIECE(^DIC(4,SDECFN,0),U,1)_U_$SELECT($PIECE(SDECNOD,U,2)=1:"YES",1:"NO")
+37 ;alb/jsm 658
SET SDTMP=SDTMP_U_$PIECE(SDTZN,U,1)_U_$PIECE(SDTZN,U,2)_U_$PIECE(SDTZN,U,3)_U_SDIAL_U_$GET(@SDFONT@(1))
+38 SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,SDECI)=SDTMP_$CHAR(30)
End DoDot:1
+39 SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,SDECI)=$CHAR(31)
+40 QUIT
+41 ;
SETFAC(SDECY,SDECDUZ,SDECFAC) ;SET FACILITY
+1 ;SETFAC(SDECY,SDECDUZ,SDECFAC) external parameter tag is in SDEC
+2 ; SDECDUZ = user IEN - pointer to the NEW PERSON file 200
+3 ; SDECFAC = facility/division to set - pointer to the INSTITUTE file 4
+4 ;Returns ERROR_ID^ERROR_TEXT
+5 ; where ERROR_ID = 1 if successful; 0 if failed
+6 ;Fails if SDECFAC is not one of the current user's divisions
+7 NEW SDECI,SDECSUB
+8 SET SDECI=0
+9 SET SDECY="^TMP(""SDEC"","_$JOB_")"
+10 KILL @SDECY
+11 SET ^TMP("SDEC",$JOB,0)="T00020ERROR_ID^T00020ERROR_TEXT"_$CHAR(30)
+12 IF '+SDECDUZ
SET SDECDUZ=DUZ
+13 IF '+SDECFAC
SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,1)=0_U_"Division not specified."_$CHAR(30)
SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,1)=$CHAR(31)
QUIT
+14 IF '$DATA(^VA(200,SDECDUZ,2,+SDECFAC))
SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,SDECI)=0_U_"Invalid division specified."_$CHAR(30)
SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,SDECI)=$CHAR(31)
QUIT
+15 SET SDECSUB="^VA(200,"_SDECDUZ_",""2"","
+16 SET ^DISV(SDECDUZ,SDECSUB)=SDECFAC
+17 SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,SDECI)=1_U_""_$CHAR(30)
+18 SET SDECI=SDECI+1
SET ^TMP("SDEC",$JOB,SDECI)=$CHAR(31)
QUIT
+19 QUIT
+20 ;
GETINST(INSTITUTION) ;get institution id and name
+1 NEW INSTREC,INST
+2 SET INST=$$SITE^VASITE()
+3 SET INSTREC("Institution","ID")=$PIECE(INST,U,1)
+4 SET INSTREC("Institution","Name")=$PIECE(INST,U,2)
+5 DO BUILDER(.INSTREC,.INSTITUTION)
+6 QUIT
+7 ;
BUILDER(DATAARR,JSONREC) ;build json record
+1 NEW ERR
+2 DO ENCODE^XLFJSON("DATAARR","JSONREC","ERR")
+3 QUIT
+4 ;
ERROR ;
+1 DO ERR("Error")
+2 QUIT
+3 ;
ERR(ERRTXT) ;Error processing
+1 if '$DATA(SDECI)
SET SDECI=999
+2 SET ERRTXT=$GET(ERRTXT)
+3 SET SDECI=SDECI+1
+4 SET ^TMP("SDEC",$JOB,SDECI)=ERRTXT_$CHAR(30)
+5 SET SDECI=SDECI+1
+6 SET ^TMP("SDEC",$JOB,SDECI)=$CHAR(31)
+7 QUIT
