- 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 Feb 19, 2025@00:17:03 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