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

SCRPBK4.m

Go to the documentation of this file. 
  1. SCRPBK4 ;MJK/ALB - RPC Broker Utilities ; 27 FEB 96
  1.  ;;5.3;Scheduling;**41,1015**;AUG 13, 1993;Build 21
  1.  ;
  1. VALID(SCDATA,SCVM,SCQDEF) ; -- query definition validation
  1.  ;
  1.  ; input:  SCVM -> validation mode (FULL or SELECTIONS only)
  1.  ;
  1.  ;output:
  1.  ;    SCDATA(0) -> 1 - meaning validation checks found no errors
  1.  ;                        
  1.  ;                --- OR ---
  1.  ;
  1.  ;    SCDATA(0) -> 0 - meaning errors found ^ <number of errors>
  1.  ;SCDATA(1...n) -> error text
  1.  ;
  1.  ; -- SEE BOTTOM OF SCRPBK FOR MORW VARIABLE DEFINITIONS
  1.  ;
  1.  ; Related RPC: SCRP QUERY VALIDATE
  1.  ;
  1.  N SCQREC,SCTYPE,SCLOG,DIERR,SCER
  1.  S SCLOG="SCDATA"
  1.  ; -- build query record
  1.  D PARSE^SCRPBK5(.SCQDEF,.SCQREC)
  1.  ; -- validate query record
  1.  D VALCHK(SCLOG,.SCQREC,SCVM)
  1.  ; -- report back any erros found(if any) or 1 for success
  1.  D HDREC^SCUTBK3(.SCDATA,$G(DIERR),"Template Validation ("_SCVM_")")
  1.  Q
  1.  ;
  1. VALCHK(SCLOG,SCQREC,SCVM) ; -- determine validation mode and do appropriate checks
  1.  IF SCVM="FULL" D VALFLDS(SCLOG,.SCQREC)
  1.  IF SCVM="FULL"!(SCVM="SELECTIONS") D VALSELS(SCLOG,.SCQREC)
  1.  Q
  1.  ;
  1. VALFLDS(SCLOG,SCQREC) ; -- validate field data
  1.  N X,SCAN,SCFLD
  1.  ;
  1.  ; -- required single fields
  1.  D GETFLDS^SCRPBK2(+SCQREC("REPORTID"),.SCAN)
  1.  S SCFLD=""
  1.  F  S SCFLD=$O(SCAN(SCFLD)) Q:SCFLD=""  S X=SCAN(SCFLD) D
  1.  . IF $P(X,U,2),'$D(SCQREC("FIELDS",SCFLD)) D
  1.  . . D SETFLD(SCLOG,$P($G(^SD(404.93,+X,0),"UNKNOWN"),U))
  1.  Q
  1.  ;
  1. VALSELS(SCLOG,SCQREC) ; -- validate file entry selections
  1.  N SCTYPE,SCAN
  1.  ;
  1.  ; -- have all required selections been made?
  1.  K SCAN
  1.  D GETYPE^SCRPBK2(+SCQREC("REPORTID"),.SCAN)
  1.  S SCTYPE=""
  1.  F  S SCTYPE=$O(SCAN(SCTYPE)) Q:SCTYPE=""  S X=SCAN(SCTYPE) D
  1.  . IF $P(X,U,2),'$D(SCQREC("SELECTIONS",SCTYPE)) D
  1.  . . D SETFLD(SCLOG,SCTYPE)
  1.  ;
  1.  ; -- are selections consistent?
  1.  S SCTYPE=""
  1.  F  S SCTYPE=$O(SCQREC("SELECTIONS",SCTYPE)) Q:SCTYPE=""  IF $D(SCAN(SCTYPE)) D
  1.  . IF SCTYPE="DIVISION" D DIV(SCLOG,.SCQREC,SCTYPE)
  1.  . IF SCTYPE="TEAM" D TEAM(SCLOG,.SCQREC,SCTYPE)
  1.  . IF SCTYPE="PRACTITIONER" D PRAC(SCLOG,.SCQREC,SCTYPE)
  1.  . IF SCTYPE="ROLE" D ROLE(SCLOG,.SCQREC,SCTYPE)
  1.  . IF SCTYPE="CLINIC" D CLIN(SCLOG,.SCQREC,SCTYPE)
  1.  . IF SCTYPE="USERCLASS" D USER(SCLOG,.SCQREC,SCTYPE)
  1.  Q
  1.  ;
  1. DIV(SCLOG,SCQREC,SCTYPE) ; -- validate division selections
  1.  N SCSEL,Y,SC0
  1.  S SCSEL=""
  1.  F  S SCSEL=$O(SCQREC("SELECTIONS",SCTYPE,SCSEL)) Q:SCSEL=""  D
  1.  . S Y=SCSEL,SC0=$G(^DIC(4,+SCSEL,0))
  1.  . IF $D(^SCTM(404.51,"AINST",+Y)) D
  1.  . . Q
  1.  . ELSE  D
  1.  . . D SETSEL(SCLOG,SCTYPE,"NO TEAMS FOR DIVISION",SC0)
  1.  Q
  1.  ;
  1. TEAM(SCLOG,SCQREC,SCTYPE) ; -- validate team selections
  1.  N SCSEL,Y,SC0,VAUTD
  1.  S SCSEL=""
  1.  D BUILD^SCRPBK3(.SCQREC,"DIVISION",.VAUTD)
  1.  F  S SCSEL=$O(SCQREC("SELECTIONS",SCTYPE,SCSEL)) Q:SCSEL=""  D
  1.  . S Y=+SCSEL,SC0=$G(^SCTM(404.51,+SCSEL,0))
  1.  . IF $D(VAUTD(+$P(SC0,U,7))) D
  1.  . . Q
  1.  . ELSE  D
  1.  . . D SETSEL(SCLOG,SCTYPE,"DIVISION",SC0)
  1.  Q
  1.  ;
  1. PRAC(SCLOG,SCQREC,SCTYPE) ; -- validate practitioner selections
  1.  N SCSEL,Y,SC0,VAUTT
  1.  S SCSEL=""
  1.  IF SCQREC("REPORTID")=3 D
  1.  . S VAUTT=1
  1.  ELSE  D
  1.  . D BUILD^SCRPBK3(.SCQREC,"TEAM",.VAUTT)
  1.  F  S SCSEL=$O(SCQREC("SELECTIONS",SCTYPE,SCSEL)) Q:SCSEL=""  D
  1.  . S Y=+SCSEL,SC0=$G(^VA(200,Y,0))
  1.  . IF $D(VAUTT),$$PRACS^SCRPU1() D
  1.  . . Q
  1.  . ELSE  D
  1.  . . D SETSEL(SCLOG,SCTYPE,"TEAM",SC0)
  1.  Q
  1.  ;
  1. ROLE(SCLOG,SCQREC,SCTYPE) ; -- validate role selections
  1.  N SCSEL,Y,SC0,VAUTT
  1.  S SCSEL=""
  1.  D BUILD^SCRPBK3(.SCQREC,"TEAM",.VAUTT)
  1.  F  S SCSEL=$O(SCQREC("SELECTIONS",SCTYPE,SCSEL)) Q:SCSEL=""  D
  1.  . S Y=+SCSEL,SC0=$G(^SD(403.46,Y,0))
  1.  . IF $D(VAUTT),$$RL^SCRPU1() D
  1.  . . Q
  1.  . ELSE  D
  1.  . . D SETSEL(SCLOG,SCTYPE,"TEAM",SC0)
  1.  Q
  1.  ;
  1. CLIN(SCLOG,SCQREC,SCTYPE) ; -- validate clinic selections
  1.  N SCSEL,Y,SC0,SCRPTID,VAUTD,VAUTT
  1.  S SCSEL="",SCRPTID=SCQREC("REPORTID")
  1.  IF SCRPTID=2 D
  1.  . D BUILD^SCRPBK3(.SCQREC,"DIVISION",.VAUTD)
  1.  ELSE  D
  1.  . D BUILD^SCRPBK3(.SCQREC,"TEAM",.VAUTT)
  1.  ;
  1.  F  S SCSEL=$O(SCQREC("SELECTIONS",SCTYPE,SCSEL)) Q:SCSEL=""  D
  1.  . S Y=+SCSEL,SC0=$G(^SC(Y,0))
  1.  . IF SCRPTID=2,$D(VAUTD),$$CLSC2^SCRPU1() D  Q
  1.  . . Q
  1.  . ELSE  D  Q
  1.  . . D SETSEL(SCLOG,SCTYPE,"DIVISION",SC0)
  1.  . IF SCRPTID'=2,$D(VAUTT),$$CLSC^SCRPU1() D
  1.  . . Q
  1.  . ELSE  D
  1.  . . D SETSEL(SCLOG,SCTYPE,"TEAM",SC0)
  1.  Q
  1.  ;
  1. USER(SCLOG,SCQREC,SCTYPE) ; -- validate user selections
  1.  N SCSEL,Y,SC0,VAUTT
  1.  S SCSEL=""
  1.  D BUILD^SCRPBK3(.SCQREC,"TEAM",.VAUTT)
  1.  F  S SCSEL=$O(SCQREC("SELECTIONS",SCTYPE,SCSEL)) Q:SCSEL=""  D
  1.  . S Y=+SCSEL,SC0=$G(^USR(8930,+SCSEL,0))
  1.  . IF $D(VAUTT),$$USRCL^SCRPU1() D
  1.  . . Q
  1.  . ELSE  D
  1.  . . D SETSEL(SCLOG,SCTYPE,"TEAM",SC0)
  1.  Q
  1.  ;
  1. SETFLD(SCLOG,SCFLD) ; -- set field error in error log
  1.  N SCPARM
  1.  S SCPARM("FIELD")=SCFLD
  1.  D BLD^DIALOG(4035001.001,.SCPARM,"",SCLOG,"S")
  1.  Q
  1.  ;
  1. SETSEL(SCLOG,SCTYPE,SCDTYPE,SC0) ; -- set file entry error in error log
  1.  N SCPARM
  1.  S SCPARM("TYPE")=SCTYPE
  1.  S SCPARM("SELECTION")=$P(SC0,U)
  1.  S SCPARM("DEPENDENT")=SCDTYPE
  1.  D BLD^DIALOG(4035001.002,.SCPARM,"",SCLOG,"S")
  1.  Q
  1.  ;