Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SDEC46

SDEC46.m

Go to the documentation of this file.
  1. SDEC46 ;ALB/SAT/JSM,LAB - VISTA SCHEDULING RPCS ;APR 1, 2022
  1. ;;5.3;Scheduling;**627,643,658,814**;Aug 13, 1993;Build 11
  1. ;
  1. Q
  1. ;
  1. CURFACG(SDECY,SDECDUZ) ;get current division/facility for given user
  1. ;CURFACG(SDECY,SDECDUZ) external parameter tag is in SDEC
  1. ; SDECDUZ = user IEN from the NEW PERSON file 200
  1. ; returns the Current Division/Facility for the given user
  1. N SDECCD,SDECI,SDECSUB
  1. S SDECI=0
  1. S SDECY="^TMP(""SDEC"","_$J_")"
  1. K @SDECY
  1. S ^TMP("SDEC",$J,0)="T00020ERROR_ID"_$C(30)
  1. ;check if valid user
  1. I $G(SDECDUZ)="" D ERR("0^SDEC46: User not specified.") Q
  1. I '$D(^VA(200,SDECDUZ)) D ERR("0^SDEC46: Invalid user specified.") Q
  1. S ^TMP("SDEC",$J,0)="T00020CURRENT_DIV"_$C(30)
  1. S SDECSUB="^VA(200,"_SDECDUZ_",""2"","
  1. S SDECCD=$G(^DISV(SDECDUZ,SDECSUB))
  1. I SDECCD'="" S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=SDECCD_$C(30)
  1. S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$C(31)
  1. Q
  1. ;
  1. GETFAC(SDECY,SDECDUZ) ;Gets all facilities for a user
  1. ;GETFAC(SDECY,SDECDUZ) external parameter tag is in SDEC
  1. ; Input SDECDUZ - (required) user IEN from the NEW PERSON file 200
  1. ; Returns:
  1. ;Global Array in which each array entry
  1. ;contains the following ^ pieces:
  1. ; DIV_IEN = institution Id pointer to the INSTITUTION file 4
  1. ; NOTE field in file 200 uses the term DIVISION but the
  1. ; field points to the INSTITUTION file.
  1. ; DIV_NAME = institution NAME from the INSTITUTION file
  1. ; DEFAULT = Is default division/facility?
  1. ; Value can be 'YES' or 'NO'
  1. ; TZ_CODE = CODE from the MAILMAN TIME ZONE file 4.4
  1. ; TZ_NAME = TIME ZONE NAME from the MAILMAN TIME ZONE file
  1. ; TZ_DIFF = DIFFERENTIAL from the MAILMAN TIME ZONE file
  1. ; 7. DIALOGUE = Allow appointment dialogue
  1. ; 0=NO (off)
  1. ; 1=YES (on) display and ask
  1. ; 8.DEF_FONT = User's default font size for VistA Scheduling letters
  1. N SDECFN,SDECI,SDECN,SDECNOD,SDIAL,SDTMP,SDTZ,SDTZN,SDFONT ;alb/jsm 658 added SDFONT
  1. S SDECI=0
  1. S SDECY="^TMP(""SDEC"","_$J_")"
  1. K @SDECY
  1. S ^TMP("SDEC",$J,0)="T00020ERROR_ID"_$C(30)
  1. ;check if valid user
  1. I $G(SDECDUZ)="" D ERR("0^SDEC46: User not specified.") Q
  1. I '$D(^VA(200,+SDECDUZ)) D ERR("0^SDEC46: Invalid user specified.") Q
  1. S ^TMP("SDEC",$J,0)="T00020DIV_IEN^T00020DIV_NAME^T00020DEFAULT^T00030TZ_CODE^T00030TZ_NAME^T00030TZ_DIFF^T00030DIALOGUE^T00010DEF_FONT"_$C(30)
  1. S SDIAL=+$P($G(^DVB(396.1,1,0)),U,18) ;APPT LINKING ENHANCE DIALOGUE from AMIE SITE PARAMETER file
  1. S SDTZ=$$GET1^DIQ(4.3,"1,",1,"I")
  1. S SDTZN=$G(^XMB(4.4,SDTZ,0))
  1. ;D GETFONT^SDECU4(.SDFONT,SDECDUZ) ;alb/jsm 658
  1. D GETFONT^SDECU4(.SDFONT,"DIV") ;alb/jsm 658
  1. S SDECFN=0
  1. F S SDECFN=$O(^VA(200,+SDECDUZ,2,SDECFN)) Q:SDECFN'>0 D
  1. . S SDECNOD=$G(^VA(200,+SDECDUZ,2,SDECFN,0))
  1. . S SDTMP=SDECFN_U_$P(^DIC(4,SDECFN,0),U,1)_U_$S($P(SDECNOD,U,2)=1:"YES",1:"NO")
  1. . 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
  1. . S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=SDTMP_$C(30)
  1. S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$C(31)
  1. Q
  1. ;
  1. SETFAC(SDECY,SDECDUZ,SDECFAC) ;SET FACILITY
  1. ;SETFAC(SDECY,SDECDUZ,SDECFAC) external parameter tag is in SDEC
  1. ; SDECDUZ = user IEN - pointer to the NEW PERSON file 200
  1. ; SDECFAC = facility/division to set - pointer to the INSTITUTE file 4
  1. ;Returns ERROR_ID^ERROR_TEXT
  1. ; where ERROR_ID = 1 if successful; 0 if failed
  1. ;Fails if SDECFAC is not one of the current user's divisions
  1. N SDECI,SDECSUB
  1. S SDECI=0
  1. S SDECY="^TMP(""SDEC"","_$J_")"
  1. K @SDECY
  1. S ^TMP("SDEC",$J,0)="T00020ERROR_ID^T00020ERROR_TEXT"_$C(30)
  1. I '+SDECDUZ S SDECDUZ=DUZ
  1. 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
  1. 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
  1. S SDECSUB="^VA(200,"_SDECDUZ_",""2"","
  1. S ^DISV(SDECDUZ,SDECSUB)=SDECFAC
  1. S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=1_U_""_$C(30)
  1. S SDECI=SDECI+1 S ^TMP("SDEC",$J,SDECI)=$C(31) Q
  1. Q
  1. ;
  1. GETINST(INSTITUTION) ;get institution id and name
  1. N INSTREC,INST
  1. S INST=$$SITE^VASITE()
  1. S INSTREC("Institution","ID")=$P(INST,U,1)
  1. S INSTREC("Institution","Name")=$P(INST,U,2)
  1. D BUILDER(.INSTREC,.INSTITUTION)
  1. Q
  1. ;
  1. BUILDER(DATAARR,JSONREC) ;build json record
  1. N ERR
  1. D ENCODE^XLFJSON("DATAARR","JSONREC","ERR")
  1. Q
  1. ;
  1. ERROR ;
  1. D ERR("Error")
  1. Q
  1. ;
  1. ERR(ERRTXT) ;Error processing
  1. S:'$D(SDECI) SDECI=999
  1. S ERRTXT=$G(ERRTXT)
  1. S SDECI=SDECI+1
  1. S ^TMP("SDEC",$J,SDECI)=ERRTXT_$C(30)
  1. S SDECI=SDECI+1
  1. S ^TMP("SDEC",$J,SDECI)=$C(31)
  1. Q