SCRPBK ;MJK/ALB - RPC Broker Utilities ; 27 FEB 96
;;5.3;Scheduling;**41,1015**;AUG 13, 1993;Build 21
;
GETREC(SCDATA,SCRPT) ; -- get REPORT record
; input : SCRPT := ien of report definition
; output : SCDATA is the return array
; SCDATA(0) := 0th node of rpt def
; (1..n) := sections for
; [Description], [Sorts], [Fields], [Files]
;
; Related RPC: SCRP DEFINITION GETRECORD
;
N SC,X,SCINC
S SCINC=-1,SCRPT=+SCRPT
; -- get 0th node of team
S X=$$RPTDEF(SCRPT)
; -- add to return array
D SET(X,.SCINC,.SCDATA)
; -- get description
D DESC(.SCINC,SCRPT,.SCDATA)
; -- get sorts
D SORTS(.SCINC,SCRPT,.SCDATA)
; -- get fields
D FIELDS(.SCINC,SCRPT,.SCDATA)
; -- get files
D FILES(.SCINC,SCRPT,.SCDATA)
Q
;
SET(X,INC,SCDATA) ; -- set value in return array
S INC=$G(INC)+1,SCDATA(INC)=X
Q
;
RPTDEF(SCRPT) ; -- retrieve rpt def demographics
N X,Y
S X=$G(^SD(404.92,SCRPT,0))
S Y=$P(X,U)_U_$P($G(^SD(404.94,+$P(X,U,2),0)),U)
Q Y
;
DESC(SCINC,SCRPT,SCDATA) ; -- get rpt description
N I,X
D SET("[Description]",.SCINC,.SCDATA)
S I=0 F S I=$O(^SD(404.92,SCRPT,1,I)) Q:'I S X=$G(^(I,0)) D
. D SET(X,.SCINC,.SCDATA)
D SET("$$END",.SCINC,.SCDATA)
Q
;
SORTS(SCINC,SCRPT,SCDATA) ; -- get possible sorts
N I,X
D SET("[Sorts]",.SCINC,.SCDATA)
S I=0 F S I=$O(^SD(404.92,SCRPT,"SORTS",I)) Q:'I S X=$G(^(I,0)) D
. D SET(X,.SCINC,.SCDATA)
D SET("$$END",.SCINC,.SCDATA)
Q
;
FIELDS(SCINC,SCRPT,SCDATA) ; -- get fields to ask
N I,X,Y
D SET("[Fields]",.SCINC,.SCDATA)
S I=0 F S I=$O(^SD(404.92,SCRPT,"FIELDS",I)) Q:'I S X=$G(^(I,0)) D
. S Y=""
. S Y=Y_$P($G(^SD(404.93,+X,0)),U,2)_U ; component name
. S Y=Y_$P(X,U,2)_U ; required
. S Y=Y_$P(X,U,3)_U ; always ask
. S Y=Y_$P(X,U,4)_U ; default value
. D SET(Y,.SCINC,.SCDATA)
D SET("$$END",.SCINC,.SCDATA)
Q
;
FILES(SCINC,SCRPT,SCDATA) ; -- get files to select
N I,X,Y,SCTYPE
D SET("[Files]",.SCINC,.SCDATA)
S I=0 F S I=$O(^SD(404.92,SCRPT,"FILES",I)) Q:'I S X=$G(^(I,0)) D
. S SCTYPE=$$TYPE(+X)
. S Y=""
. S Y=Y_SCTYPE_U ; file type
. S Y=Y_+X_U ; file #
. S Y=Y_+$P(X,U,2)_U ; selections allowed
. IF $$CHKTYPE^SCRPBK2(SCTYPE) D SET(Y,.SCINC,.SCDATA)
D SET("$$END",.SCINC,.SCDATA)
Q
;
TYPE(FILENUM) ; -- determine file type for file
N X
S X=""
IF FILENUM=4 S X="DIVISION" G TYPEQ
IF FILENUM=404.51 S X="TEAM" G TYPEQ
IF FILENUM=200 S X="PRACTITIONER" G TYPEQ
IF FILENUM=403.46 S X="ROLE" G TYPEQ
IF FILENUM=8930 S X="USERCLASS" G TYPEQ
IF FILENUM=44 S X="CLINIC" G TYPEQ
TYPEQ Q X
;
;
; -- variable descriptions for SCRPBK* routines
; SCDATA -> result return array
; SCINC -> incrmental variable used when build SCDATA
; SCQRY -> ien of 404.95
; SCQDEF -> raw query defintion received from client
; SCQREC -> query definition
; SCRPT -> ien of 404.92 - query definition
; SCRPTID -> ien of 404.92 - report definifion
; SCRPT -> report name
; SCTYPE -> selection file type (DIVISION, TEAM, etc.)
; SCGLB -> closed global root of a file [i.e. ^SC]
; SCAN -> array where the name of used/required report
; fields or file selections are stored
; SCPROC -> process being performed when error occured
; SCPARM()-> error parameters to be used by BLD^DIALOG call
; SCLOG -> contains the array name where application generated
; error messages are stored(usually SCDATA)
; SCERR() -> array where FM DBS generated errors are stored
; SCTEXT -> text used to search files
; SCSELS()-> array of file entry selections
; VAUTD() -> array of divisions subscripted by iens
; VAUTT() -> array of teams subscripted by iens
; VAUTP() -> array of practitioners subscripted by iens
; VAUTR() -> array of roles subscripted by iens
; VAUTC() -> array of clinics subscripted by iens
; VAUTUC()-> array of user classes subscripted by iens
;
SCRPBK ;MJK/ALB - RPC Broker Utilities ; 27 FEB 96
+1 ;;5.3;Scheduling;**41,1015**;AUG 13, 1993;Build 21
+2 ;
GETREC(SCDATA,SCRPT) ; -- get REPORT record
+1 ; input : SCRPT := ien of report definition
+2 ; output : SCDATA is the return array
+3 ; SCDATA(0) := 0th node of rpt def
+4 ; (1..n) := sections for
+5 ; [Description], [Sorts], [Fields], [Files]
+6 ;
+7 ; Related RPC: SCRP DEFINITION GETRECORD
+8 ;
+9 NEW SC,X,SCINC
+10 SET SCINC=-1
SET SCRPT=+SCRPT
+11 ; -- get 0th node of team
+12 SET X=$$RPTDEF(SCRPT)
+13 ; -- add to return array
+14 DO SET(X,.SCINC,.SCDATA)
+15 ; -- get description
+16 DO DESC(.SCINC,SCRPT,.SCDATA)
+17 ; -- get sorts
+18 DO SORTS(.SCINC,SCRPT,.SCDATA)
+19 ; -- get fields
+20 DO FIELDS(.SCINC,SCRPT,.SCDATA)
+21 ; -- get files
+22 DO FILES(.SCINC,SCRPT,.SCDATA)
+23 QUIT
+24 ;
SET(X,INC,SCDATA) ; -- set value in return array
+1 SET INC=$GET(INC)+1
SET SCDATA(INC)=X
+2 QUIT
+3 ;
RPTDEF(SCRPT) ; -- retrieve rpt def demographics
+1 NEW X,Y
+2 SET X=$GET(^SD(404.92,SCRPT,0))
+3 SET Y=$PIECE(X,U)_U_$PIECE($GET(^SD(404.94,+$PIECE(X,U,2),0)),U)
+4 QUIT Y
+5 ;
DESC(SCINC,SCRPT,SCDATA) ; -- get rpt description
+1 NEW I,X
+2 DO SET("[Description]",.SCINC,.SCDATA)
+3 SET I=0
FOR
SET I=$ORDER(^SD(404.92,SCRPT,1,I))
IF 'I
QUIT
SET X=$GET(^(I,0))
Begin DoDot:1
+4 DO SET(X,.SCINC,.SCDATA)
End DoDot:1
+5 DO SET("$$END",.SCINC,.SCDATA)
+6 QUIT
+7 ;
SORTS(SCINC,SCRPT,SCDATA) ; -- get possible sorts
+1 NEW I,X
+2 DO SET("[Sorts]",.SCINC,.SCDATA)
+3 SET I=0
FOR
SET I=$ORDER(^SD(404.92,SCRPT,"SORTS",I))
IF 'I
QUIT
SET X=$GET(^(I,0))
Begin DoDot:1
+4 DO SET(X,.SCINC,.SCDATA)
End DoDot:1
+5 DO SET("$$END",.SCINC,.SCDATA)
+6 QUIT
+7 ;
FIELDS(SCINC,SCRPT,SCDATA) ; -- get fields to ask
+1 NEW I,X,Y
+2 DO SET("[Fields]",.SCINC,.SCDATA)
+3 SET I=0
FOR
SET I=$ORDER(^SD(404.92,SCRPT,"FIELDS",I))
IF 'I
QUIT
SET X=$GET(^(I,0))
Begin DoDot:1
+4 SET Y=""
+5 ; component name
SET Y=Y_$PIECE($GET(^SD(404.93,+X,0)),U,2)_U
+6 ; required
SET Y=Y_$PIECE(X,U,2)_U
+7 ; always ask
SET Y=Y_$PIECE(X,U,3)_U
+8 ; default value
SET Y=Y_$PIECE(X,U,4)_U
+9 DO SET(Y,.SCINC,.SCDATA)
End DoDot:1
+10 DO SET("$$END",.SCINC,.SCDATA)
+11 QUIT
+12 ;
FILES(SCINC,SCRPT,SCDATA) ; -- get files to select
+1 NEW I,X,Y,SCTYPE
+2 DO SET("[Files]",.SCINC,.SCDATA)
+3 SET I=0
FOR
SET I=$ORDER(^SD(404.92,SCRPT,"FILES",I))
IF 'I
QUIT
SET X=$GET(^(I,0))
Begin DoDot:1
+4 SET SCTYPE=$$TYPE(+X)
+5 SET Y=""
+6 ; file type
SET Y=Y_SCTYPE_U
+7 ; file #
SET Y=Y_+X_U
+8 ; selections allowed
SET Y=Y_+$PIECE(X,U,2)_U
+9 IF $$CHKTYPE^SCRPBK2(SCTYPE)
DO SET(Y,.SCINC,.SCDATA)
End DoDot:1
+10 DO SET("$$END",.SCINC,.SCDATA)
+11 QUIT
+12 ;
TYPE(FILENUM) ; -- determine file type for file
+1 NEW X
+2 SET X=""
+3 IF FILENUM=4
SET X="DIVISION"
GOTO TYPEQ
+4 IF FILENUM=404.51
SET X="TEAM"
GOTO TYPEQ
+5 IF FILENUM=200
SET X="PRACTITIONER"
GOTO TYPEQ
+6 IF FILENUM=403.46
SET X="ROLE"
GOTO TYPEQ
+7 IF FILENUM=8930
SET X="USERCLASS"
GOTO TYPEQ
+8 IF FILENUM=44
SET X="CLINIC"
GOTO TYPEQ
TYPEQ QUIT X
+1 ;
+2 ;
+3 ; -- variable descriptions for SCRPBK* routines
+4 ; SCDATA -> result return array
+5 ; SCINC -> incrmental variable used when build SCDATA
+6 ; SCQRY -> ien of 404.95
+7 ; SCQDEF -> raw query defintion received from client
+8 ; SCQREC -> query definition
+9 ; SCRPT -> ien of 404.92 - query definition
+10 ; SCRPTID -> ien of 404.92 - report definifion
+11 ; SCRPT -> report name
+12 ; SCTYPE -> selection file type (DIVISION, TEAM, etc.)
+13 ; SCGLB -> closed global root of a file [i.e. ^SC]
+14 ; SCAN -> array where the name of used/required report
+15 ; fields or file selections are stored
+16 ; SCPROC -> process being performed when error occured
+17 ; SCPARM()-> error parameters to be used by BLD^DIALOG call
+18 ; SCLOG -> contains the array name where application generated
+19 ; error messages are stored(usually SCDATA)
+20 ; SCERR() -> array where FM DBS generated errors are stored
+21 ; SCTEXT -> text used to search files
+22 ; SCSELS()-> array of file entry selections
+23 ; VAUTD() -> array of divisions subscripted by iens
+24 ; VAUTT() -> array of teams subscripted by iens
+25 ; VAUTP() -> array of practitioners subscripted by iens
+26 ; VAUTR() -> array of roles subscripted by iens
+27 ; VAUTC() -> array of clinics subscripted by iens
+28 ; VAUTUC()-> array of user classes subscripted by iens
+29 ;
