SCRPBK4 ;MJK/ALB - RPC Broker Utilities ; 27 FEB 96
;;5.3;Scheduling;**41**;AUG 13, 1993
;
VALID(SCDATA,SCVM,SCQDEF) ; -- query definition validation
;
; input: SCVM -> validation mode (FULL or SELECTIONS only)
;
;output:
; SCDATA(0) -> 1 - meaning validation checks found no errors
;
; --- OR ---
;
; SCDATA(0) -> 0 - meaning errors found ^ <number of errors>
;SCDATA(1...n) -> error text
;
; -- SEE BOTTOM OF SCRPBK FOR MORW VARIABLE DEFINITIONS
;
; Related RPC: SCRP QUERY VALIDATE
;
N SCQREC,SCTYPE,SCLOG,DIERR,SCER
S SCLOG="SCDATA"
; -- build query record
D PARSE^SCRPBK5(.SCQDEF,.SCQREC)
; -- validate query record
D VALCHK(SCLOG,.SCQREC,SCVM)
; -- report back any erros found(if any) or 1 for success
D HDREC^SCUTBK3(.SCDATA,$G(DIERR),"Template Validation ("_SCVM_")")
Q
;
VALCHK(SCLOG,SCQREC,SCVM) ; -- determine validation mode and do appropriate checks
IF SCVM="FULL" D VALFLDS(SCLOG,.SCQREC)
IF SCVM="FULL"!(SCVM="SELECTIONS") D VALSELS(SCLOG,.SCQREC)
Q
;
VALFLDS(SCLOG,SCQREC) ; -- validate field data
N X,SCAN,SCFLD
;
; -- required single fields
D GETFLDS^SCRPBK2(+SCQREC("REPORTID"),.SCAN)
S SCFLD=""
F S SCFLD=$O(SCAN(SCFLD)) Q:SCFLD="" S X=SCAN(SCFLD) D
. IF $P(X,U,2),'$D(SCQREC("FIELDS",SCFLD)) D
. . D SETFLD(SCLOG,$P($G(^SD(404.93,+X,0),"UNKNOWN"),U))
Q
;
VALSELS(SCLOG,SCQREC) ; -- validate file entry selections
N SCTYPE,SCAN
;
; -- have all required selections been made?
K SCAN
D GETYPE^SCRPBK2(+SCQREC("REPORTID"),.SCAN)
S SCTYPE=""
F S SCTYPE=$O(SCAN(SCTYPE)) Q:SCTYPE="" S X=SCAN(SCTYPE) D
. IF $P(X,U,2),'$D(SCQREC("SELECTIONS",SCTYPE)) D
. . D SETFLD(SCLOG,SCTYPE)
;
; -- are selections consistent?
S SCTYPE=""
F S SCTYPE=$O(SCQREC("SELECTIONS",SCTYPE)) Q:SCTYPE="" IF $D(SCAN(SCTYPE)) D
. IF SCTYPE="DIVISION" D DIV(SCLOG,.SCQREC,SCTYPE)
. IF SCTYPE="TEAM" D TEAM(SCLOG,.SCQREC,SCTYPE)
. IF SCTYPE="PRACTITIONER" D PRAC(SCLOG,.SCQREC,SCTYPE)
. IF SCTYPE="ROLE" D ROLE(SCLOG,.SCQREC,SCTYPE)
. IF SCTYPE="CLINIC" D CLIN(SCLOG,.SCQREC,SCTYPE)
. IF SCTYPE="USERCLASS" D USER(SCLOG,.SCQREC,SCTYPE)
Q
;
DIV(SCLOG,SCQREC,SCTYPE) ; -- validate division selections
N SCSEL,Y,SC0
S SCSEL=""
F S SCSEL=$O(SCQREC("SELECTIONS",SCTYPE,SCSEL)) Q:SCSEL="" D
. S Y=SCSEL,SC0=$G(^DIC(4,+SCSEL,0))
. IF $D(^SCTM(404.51,"AINST",+Y)) D
. . Q
. ELSE D
. . D SETSEL(SCLOG,SCTYPE,"NO TEAMS FOR DIVISION",SC0)
Q
;
TEAM(SCLOG,SCQREC,SCTYPE) ; -- validate team selections
N SCSEL,Y,SC0,VAUTD
S SCSEL=""
D BUILD^SCRPBK3(.SCQREC,"DIVISION",.VAUTD)
F S SCSEL=$O(SCQREC("SELECTIONS",SCTYPE,SCSEL)) Q:SCSEL="" D
. S Y=+SCSEL,SC0=$G(^SCTM(404.51,+SCSEL,0))
. IF $D(VAUTD(+$P(SC0,U,7))) D
. . Q
. ELSE D
. . D SETSEL(SCLOG,SCTYPE,"DIVISION",SC0)
Q
;
PRAC(SCLOG,SCQREC,SCTYPE) ; -- validate practitioner selections
N SCSEL,Y,SC0,VAUTT
S SCSEL=""
IF SCQREC("REPORTID")=3 D
. S VAUTT=1
ELSE D
. D BUILD^SCRPBK3(.SCQREC,"TEAM",.VAUTT)
F S SCSEL=$O(SCQREC("SELECTIONS",SCTYPE,SCSEL)) Q:SCSEL="" D
. S Y=+SCSEL,SC0=$G(^VA(200,Y,0))
. IF $D(VAUTT),$$PRACS^SCRPU1() D
. . Q
. ELSE D
. . D SETSEL(SCLOG,SCTYPE,"TEAM",SC0)
Q
;
ROLE(SCLOG,SCQREC,SCTYPE) ; -- validate role selections
N SCSEL,Y,SC0,VAUTT
S SCSEL=""
D BUILD^SCRPBK3(.SCQREC,"TEAM",.VAUTT)
F S SCSEL=$O(SCQREC("SELECTIONS",SCTYPE,SCSEL)) Q:SCSEL="" D
. S Y=+SCSEL,SC0=$G(^SD(403.46,Y,0))
. IF $D(VAUTT),$$RL^SCRPU1() D
. . Q
. ELSE D
. . D SETSEL(SCLOG,SCTYPE,"TEAM",SC0)
Q
;
CLIN(SCLOG,SCQREC,SCTYPE) ; -- validate clinic selections
N SCSEL,Y,SC0,SCRPTID,VAUTD,VAUTT
S SCSEL="",SCRPTID=SCQREC("REPORTID")
IF SCRPTID=2 D
. D BUILD^SCRPBK3(.SCQREC,"DIVISION",.VAUTD)
ELSE D
. D BUILD^SCRPBK3(.SCQREC,"TEAM",.VAUTT)
;
F S SCSEL=$O(SCQREC("SELECTIONS",SCTYPE,SCSEL)) Q:SCSEL="" D
. S Y=+SCSEL,SC0=$G(^SC(Y,0))
. IF SCRPTID=2,$D(VAUTD),$$CLSC2^SCRPU1() D Q
. . Q
. ELSE D Q
. . D SETSEL(SCLOG,SCTYPE,"DIVISION",SC0)
. IF SCRPTID'=2,$D(VAUTT),$$CLSC^SCRPU1() D
. . Q
. ELSE D
. . D SETSEL(SCLOG,SCTYPE,"TEAM",SC0)
Q
;
USER(SCLOG,SCQREC,SCTYPE) ; -- validate user selections
N SCSEL,Y,SC0,VAUTT
S SCSEL=""
D BUILD^SCRPBK3(.SCQREC,"TEAM",.VAUTT)
F S SCSEL=$O(SCQREC("SELECTIONS",SCTYPE,SCSEL)) Q:SCSEL="" D
. S Y=+SCSEL,SC0=$G(^USR(8930,+SCSEL,0))
. IF $D(VAUTT),$$USRCL^SCRPU1() D
. . Q
. ELSE D
. . D SETSEL(SCLOG,SCTYPE,"TEAM",SC0)
Q
;
SETFLD(SCLOG,SCFLD) ; -- set field error in error log
N SCPARM
S SCPARM("FIELD")=SCFLD
D BLD^DIALOG(4035001.001,.SCPARM,"",SCLOG,"S")
Q
;
SETSEL(SCLOG,SCTYPE,SCDTYPE,SC0) ; -- set file entry error in error log
N SCPARM
S SCPARM("TYPE")=SCTYPE
S SCPARM("SELECTION")=$P(SC0,U)
S SCPARM("DEPENDENT")=SCDTYPE
D BLD^DIALOG(4035001.002,.SCPARM,"",SCLOG,"S")
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCRPBK4 4925 printed Apr 09, 2024@22:02:34 Page 2
SCRPBK4 ;MJK/ALB - RPC Broker Utilities ; 27 FEB 96
+1 ;;5.3;Scheduling;**41**;AUG 13, 1993
+2 ;
VALID(SCDATA,SCVM,SCQDEF) ; -- query definition validation
+1 ;
+2 ; input: SCVM -> validation mode (FULL or SELECTIONS only)
+3 ;
+4 ;output:
+5 ; SCDATA(0) -> 1 - meaning validation checks found no errors
+6 ;
+7 ; --- OR ---
+8 ;
+9 ; SCDATA(0) -> 0 - meaning errors found ^ <number of errors>
+10 ;SCDATA(1...n) -> error text
+11 ;
+12 ; -- SEE BOTTOM OF SCRPBK FOR MORW VARIABLE DEFINITIONS
+13 ;
+14 ; Related RPC: SCRP QUERY VALIDATE
+15 ;
+16 NEW SCQREC,SCTYPE,SCLOG,DIERR,SCER
+17 SET SCLOG="SCDATA"
+18 ; -- build query record
+19 DO PARSE^SCRPBK5(.SCQDEF,.SCQREC)
+20 ; -- validate query record
+21 DO VALCHK(SCLOG,.SCQREC,SCVM)
+22 ; -- report back any erros found(if any) or 1 for success
+23 DO HDREC^SCUTBK3(.SCDATA,$GET(DIERR),"Template Validation ("_SCVM_")")
+24 QUIT
+25 ;
VALCHK(SCLOG,SCQREC,SCVM) ; -- determine validation mode and do appropriate checks
+1 IF SCVM="FULL"
DO VALFLDS(SCLOG,.SCQREC)
+2 IF SCVM="FULL"!(SCVM="SELECTIONS")
DO VALSELS(SCLOG,.SCQREC)
+3 QUIT
+4 ;
VALFLDS(SCLOG,SCQREC) ; -- validate field data
+1 NEW X,SCAN,SCFLD
+2 ;
+3 ; -- required single fields
+4 DO GETFLDS^SCRPBK2(+SCQREC("REPORTID"),.SCAN)
+5 SET SCFLD=""
+6 FOR
SET SCFLD=$ORDER(SCAN(SCFLD))
if SCFLD=""
QUIT
SET X=SCAN(SCFLD)
Begin DoDot:1
+7 IF $PIECE(X,U,2)
IF '$DATA(SCQREC("FIELDS",SCFLD))
Begin DoDot:2
+8 DO SETFLD(SCLOG,$PIECE($GET(^SD(404.93,+X,0),"UNKNOWN"),U))
End DoDot:2
End DoDot:1
+9 QUIT
+10 ;
VALSELS(SCLOG,SCQREC) ; -- validate file entry selections
+1 NEW SCTYPE,SCAN
+2 ;
+3 ; -- have all required selections been made?
+4 KILL SCAN
+5 DO GETYPE^SCRPBK2(+SCQREC("REPORTID"),.SCAN)
+6 SET SCTYPE=""
+7 FOR
SET SCTYPE=$ORDER(SCAN(SCTYPE))
if SCTYPE=""
QUIT
SET X=SCAN(SCTYPE)
Begin DoDot:1
+8 IF $PIECE(X,U,2)
IF '$DATA(SCQREC("SELECTIONS",SCTYPE))
Begin DoDot:2
+9 DO SETFLD(SCLOG,SCTYPE)
End DoDot:2
End DoDot:1
+10 ;
+11 ; -- are selections consistent?
+12 SET SCTYPE=""
+13 FOR
SET SCTYPE=$ORDER(SCQREC("SELECTIONS",SCTYPE))
if SCTYPE=""
QUIT
IF $DATA(SCAN(SCTYPE))
Begin DoDot:1
+14 IF SCTYPE="DIVISION"
DO DIV(SCLOG,.SCQREC,SCTYPE)
+15 IF SCTYPE="TEAM"
DO TEAM(SCLOG,.SCQREC,SCTYPE)
+16 IF SCTYPE="PRACTITIONER"
DO PRAC(SCLOG,.SCQREC,SCTYPE)
+17 IF SCTYPE="ROLE"
DO ROLE(SCLOG,.SCQREC,SCTYPE)
+18 IF SCTYPE="CLINIC"
DO CLIN(SCLOG,.SCQREC,SCTYPE)
+19 IF SCTYPE="USERCLASS"
DO USER(SCLOG,.SCQREC,SCTYPE)
End DoDot:1
+20 QUIT
+21 ;
DIV(SCLOG,SCQREC,SCTYPE) ; -- validate division selections
+1 NEW SCSEL,Y,SC0
+2 SET SCSEL=""
+3 FOR
SET SCSEL=$ORDER(SCQREC("SELECTIONS",SCTYPE,SCSEL))
if SCSEL=""
QUIT
Begin DoDot:1
+4 SET Y=SCSEL
SET SC0=$GET(^DIC(4,+SCSEL,0))
+5 IF $DATA(^SCTM(404.51,"AINST",+Y))
Begin DoDot:2
+6 QUIT
End DoDot:2
+7 IF '$TEST
Begin DoDot:2
+8 DO SETSEL(SCLOG,SCTYPE,"NO TEAMS FOR DIVISION",SC0)
End DoDot:2
End DoDot:1
+9 QUIT
+10 ;
TEAM(SCLOG,SCQREC,SCTYPE) ; -- validate team selections
+1 NEW SCSEL,Y,SC0,VAUTD
+2 SET SCSEL=""
+3 DO BUILD^SCRPBK3(.SCQREC,"DIVISION",.VAUTD)
+4 FOR
SET SCSEL=$ORDER(SCQREC("SELECTIONS",SCTYPE,SCSEL))
if SCSEL=""
QUIT
Begin DoDot:1
+5 SET Y=+SCSEL
SET SC0=$GET(^SCTM(404.51,+SCSEL,0))
+6 IF $DATA(VAUTD(+$PIECE(SC0,U,7)))
Begin DoDot:2
+7 QUIT
End DoDot:2
+8 IF '$TEST
Begin DoDot:2
+9 DO SETSEL(SCLOG,SCTYPE,"DIVISION",SC0)
End DoDot:2
End DoDot:1
+10 QUIT
+11 ;
PRAC(SCLOG,SCQREC,SCTYPE) ; -- validate practitioner selections
+1 NEW SCSEL,Y,SC0,VAUTT
+2 SET SCSEL=""
+3 IF SCQREC("REPORTID")=3
Begin DoDot:1
+4 SET VAUTT=1
End DoDot:1
+5 IF '$TEST
Begin DoDot:1
+6 DO BUILD^SCRPBK3(.SCQREC,"TEAM",.VAUTT)
End DoDot:1
+7 FOR
SET SCSEL=$ORDER(SCQREC("SELECTIONS",SCTYPE,SCSEL))
if SCSEL=""
QUIT
Begin DoDot:1
+8 SET Y=+SCSEL
SET SC0=$GET(^VA(200,Y,0))
+9 IF $DATA(VAUTT)
IF $$PRACS^SCRPU1()
Begin DoDot:2
+10 QUIT
End DoDot:2
+11 IF '$TEST
Begin DoDot:2
+12 DO SETSEL(SCLOG,SCTYPE,"TEAM",SC0)
End DoDot:2
End DoDot:1
+13 QUIT
+14 ;
ROLE(SCLOG,SCQREC,SCTYPE) ; -- validate role selections
+1 NEW SCSEL,Y,SC0,VAUTT
+2 SET SCSEL=""
+3 DO BUILD^SCRPBK3(.SCQREC,"TEAM",.VAUTT)
+4 FOR
SET SCSEL=$ORDER(SCQREC("SELECTIONS",SCTYPE,SCSEL))
if SCSEL=""
QUIT
Begin DoDot:1
+5 SET Y=+SCSEL
SET SC0=$GET(^SD(403.46,Y,0))
+6 IF $DATA(VAUTT)
IF $$RL^SCRPU1()
Begin DoDot:2
+7 QUIT
End DoDot:2
+8 IF '$TEST
Begin DoDot:2
+9 DO SETSEL(SCLOG,SCTYPE,"TEAM",SC0)
End DoDot:2
End DoDot:1
+10 QUIT
+11 ;
CLIN(SCLOG,SCQREC,SCTYPE) ; -- validate clinic selections
+1 NEW SCSEL,Y,SC0,SCRPTID,VAUTD,VAUTT
+2 SET SCSEL=""
SET SCRPTID=SCQREC("REPORTID")
+3 IF SCRPTID=2
Begin DoDot:1
+4 DO BUILD^SCRPBK3(.SCQREC,"DIVISION",.VAUTD)
End DoDot:1
+5 IF '$TEST
Begin DoDot:1
+6 DO BUILD^SCRPBK3(.SCQREC,"TEAM",.VAUTT)
End DoDot:1
+7 ;
+8 FOR
SET SCSEL=$ORDER(SCQREC("SELECTIONS",SCTYPE,SCSEL))
if SCSEL=""
QUIT
Begin DoDot:1
+9 SET Y=+SCSEL
SET SC0=$GET(^SC(Y,0))
+10 IF SCRPTID=2
IF $DATA(VAUTD)
IF $$CLSC2^SCRPU1()
Begin DoDot:2
+11 QUIT
End DoDot:2
QUIT
+12 IF '$TEST
Begin DoDot:2
+13 DO SETSEL(SCLOG,SCTYPE,"DIVISION",SC0)
End DoDot:2
QUIT
+14 IF SCRPTID'=2
IF $DATA(VAUTT)
IF $$CLSC^SCRPU1()
Begin DoDot:2
+15 QUIT
End DoDot:2
+16 IF '$TEST
Begin DoDot:2
+17 DO SETSEL(SCLOG,SCTYPE,"TEAM",SC0)
End DoDot:2
End DoDot:1
+18 QUIT
+19 ;
USER(SCLOG,SCQREC,SCTYPE) ; -- validate user selections
+1 NEW SCSEL,Y,SC0,VAUTT
+2 SET SCSEL=""
+3 DO BUILD^SCRPBK3(.SCQREC,"TEAM",.VAUTT)
+4 FOR
SET SCSEL=$ORDER(SCQREC("SELECTIONS",SCTYPE,SCSEL))
if SCSEL=""
QUIT
Begin DoDot:1
+5 SET Y=+SCSEL
SET SC0=$GET(^USR(8930,+SCSEL,0))
+6 IF $DATA(VAUTT)
IF $$USRCL^SCRPU1()
Begin DoDot:2
+7 QUIT
End DoDot:2
+8 IF '$TEST
Begin DoDot:2
+9 DO SETSEL(SCLOG,SCTYPE,"TEAM",SC0)
End DoDot:2
End DoDot:1
+10 QUIT
+11 ;
SETFLD(SCLOG,SCFLD) ; -- set field error in error log
+1 NEW SCPARM
+2 SET SCPARM("FIELD")=SCFLD
+3 DO BLD^DIALOG(4035001.001,.SCPARM,"",SCLOG,"S")
+4 QUIT
+5 ;
SETSEL(SCLOG,SCTYPE,SCDTYPE,SC0) ; -- set file entry error in error log
+1 NEW SCPARM
+2 SET SCPARM("TYPE")=SCTYPE
+3 SET SCPARM("SELECTION")=$PIECE(SC0,U)
+4 SET SCPARM("DEPENDENT")=SCDTYPE
+5 DO BLD^DIALOG(4035001.002,.SCPARM,"",SCLOG,"S")
+6 QUIT
+7 ;
