SCRPBK0 ;MJK/ALB - RPC Broker Utilities ; 27 FEB 96
;;5.3;Scheduling;**41**;AUG 13, 1993
;
GETREC(SCDATA,SCQRY) ; -- get QUERY record
; input : SCQRY := ien of query definition
; output : SCDATA is the return array
; SCDATA(0) := 0th node of qry def
; (1) := externals for 0th
; (2..n) := sections for
; [Description], [Fields], [Selections]
;
; -- SEE BOTTOM OF SCRPBK FOR MORE VARIABLE DEFINITIONS
;
; Related RPC: SCRP QUERY GETRECORD
;
N SC,X,SCINC
S SCINC=-1,SCQRY=+SCQRY
; -- get 0th node of team
D QRYDEF(.X,SCQRY)
; -- add 0TH to return array
D SET(X(0),.SCINC,.SCDATA)
; -- add external values for 0th to ret array
D SET(X(1),.SCINC,.SCDATA)
; -- get description
D DESC(.SCINC,SCQRY,.SCDATA)
; -- get fields
D FIELDS(.SCINC,SCQRY,.SCDATA)
; -- get files
D SELECT(.SCINC,SCQRY,.SCDATA)
Q
;
SET(X,INC,SCDATA) ; -- set value in return array
S INC=$G(INC)+1,SCDATA(INC)=X
Q
;
QRYDEF(X,SCQRY) ; -- retrieve rpt def demographics
N Y,Z
S Y=$G(^SD(404.95,SCQRY,0))
S X(0)=Y ; 0th node
S X(1)=SCQRY ; query name
S $P(X(1),U,2)=$P($G(^VA(200,+$P(Y,U,2),0)),U) ; creator
S $P(X(1),U,3)=$S($P(Y,U,3)=1:"PRIVATE",1:"PUBLIC") ; access level
S $P(X(1),U,4)=$P($G(^SD(404.92,+$P(Y,U,4),0)),U) ; report name
S $P(X(1),U,5)=$$FMTE^XLFDT($P(Y,U,5),"2FP")
Q
;
DESC(SCINC,SCQRY,SCDATA) ; -- get query description
N I,X
D SET("[Description]",.SCINC,.SCDATA)
S I=0 F S I=$O(^SD(404.95,SCQRY,1,I)) Q:'I S X=$G(^(I,0)) D
. D SET(X,.SCINC,.SCDATA)
D SET("$$END",.SCINC,.SCDATA)
Q
;
FIELDS(SCINC,SCQRY,SCDATA) ; -- get fields to ask
N I,X,Y
D SET("[Fields]",.SCINC,.SCDATA)
S I=0 F S I=$O(^SD(404.95,SCQRY,"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 ; value
. D SET(Y,.SCINC,.SCDATA)
D SET("$$END",.SCINC,.SCDATA)
Q
;
SELECT(SCINC,SCQRY,SCDATA) ; -- get files to select
N I,X,Y
D SET("[Selections]",.SCINC,.SCDATA)
S I=0 F S I=$O(^SD(404.95,SCQRY,"FILES",I)) Q:'I S X=$G(^(I,0)) D
. IF X["DIC(4" S SCGLB="^DIC(4)",SCTYPE="DIVISION"
. IF X["SCTM(404.51" S SCGLB="^SCTM(404.51)",SCTYPE="TEAM"
. IF X["VA(200" S SCGLB="^VA(200)",SCTYPE="PRACTITIONER"
. IF X["SD(403.46" S SCGLB="^SD(403.46)",SCTYPE="ROLE"
. IF X["USR(8930" S SCGLB="^USR(8930)",SCTYPE="USERCLASS"
. IF X["SC(" S SCGLB="^SC",SCTYPE="CLINIC"
. IF $D(@SCGLB@(+X,0)) D SET($P(^(0),U)_U_SCTYPE_U_+X,.SCINC,.SCDATA)
D SET("$$END",.SCINC,.SCDATA)
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCRPBK0 2586 printed Nov 22, 2024@17:52:17 Page 2
SCRPBK0 ;MJK/ALB - RPC Broker Utilities ; 27 FEB 96
+1 ;;5.3;Scheduling;**41**;AUG 13, 1993
+2 ;
GETREC(SCDATA,SCQRY) ; -- get QUERY record
+1 ; input : SCQRY := ien of query definition
+2 ; output : SCDATA is the return array
+3 ; SCDATA(0) := 0th node of qry def
+4 ; (1) := externals for 0th
+5 ; (2..n) := sections for
+6 ; [Description], [Fields], [Selections]
+7 ;
+8 ; -- SEE BOTTOM OF SCRPBK FOR MORE VARIABLE DEFINITIONS
+9 ;
+10 ; Related RPC: SCRP QUERY GETRECORD
+11 ;
+12 NEW SC,X,SCINC
+13 SET SCINC=-1
SET SCQRY=+SCQRY
+14 ; -- get 0th node of team
+15 DO QRYDEF(.X,SCQRY)
+16 ; -- add 0TH to return array
+17 DO SET(X(0),.SCINC,.SCDATA)
+18 ; -- add external values for 0th to ret array
+19 DO SET(X(1),.SCINC,.SCDATA)
+20 ; -- get description
+21 DO DESC(.SCINC,SCQRY,.SCDATA)
+22 ; -- get fields
+23 DO FIELDS(.SCINC,SCQRY,.SCDATA)
+24 ; -- get files
+25 DO SELECT(.SCINC,SCQRY,.SCDATA)
+26 QUIT
+27 ;
SET(X,INC,SCDATA) ; -- set value in return array
+1 SET INC=$GET(INC)+1
SET SCDATA(INC)=X
+2 QUIT
+3 ;
QRYDEF(X,SCQRY) ; -- retrieve rpt def demographics
+1 NEW Y,Z
+2 SET Y=$GET(^SD(404.95,SCQRY,0))
+3 ; 0th node
SET X(0)=Y
+4 ; query name
SET X(1)=SCQRY
+5 ; creator
SET $PIECE(X(1),U,2)=$PIECE($GET(^VA(200,+$PIECE(Y,U,2),0)),U)
+6 ; access level
SET $PIECE(X(1),U,3)=$SELECT($PIECE(Y,U,3)=1:"PRIVATE",1:"PUBLIC")
+7 ; report name
SET $PIECE(X(1),U,4)=$PIECE($GET(^SD(404.92,+$PIECE(Y,U,4),0)),U)
+8 SET $PIECE(X(1),U,5)=$$FMTE^XLFDT($PIECE(Y,U,5),"2FP")
+9 QUIT
+10 ;
DESC(SCINC,SCQRY,SCDATA) ; -- get query description
+1 NEW I,X
+2 DO SET("[Description]",.SCINC,.SCDATA)
+3 SET I=0
FOR
SET I=$ORDER(^SD(404.95,SCQRY,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 ;
FIELDS(SCINC,SCQRY,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.95,SCQRY,"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 ; value
SET Y=Y_$PIECE(X,U,2)_U
+7 DO SET(Y,.SCINC,.SCDATA)
End DoDot:1
+8 DO SET("$$END",.SCINC,.SCDATA)
+9 QUIT
+10 ;
SELECT(SCINC,SCQRY,SCDATA) ; -- get files to select
+1 NEW I,X,Y
+2 DO SET("[Selections]",.SCINC,.SCDATA)
+3 SET I=0
FOR
SET I=$ORDER(^SD(404.95,SCQRY,"FILES",I))
if 'I
QUIT
SET X=$GET(^(I,0))
Begin DoDot:1
+4 IF X["DIC(4"
SET SCGLB="^DIC(4)"
SET SCTYPE="DIVISION"
+5 IF X["SCTM(404.51"
SET SCGLB="^SCTM(404.51)"
SET SCTYPE="TEAM"
+6 IF X["VA(200"
SET SCGLB="^VA(200)"
SET SCTYPE="PRACTITIONER"
+7 IF X["SD(403.46"
SET SCGLB="^SD(403.46)"
SET SCTYPE="ROLE"
+8 IF X["USR(8930"
SET SCGLB="^USR(8930)"
SET SCTYPE="USERCLASS"
+9 IF X["SC("
SET SCGLB="^SC"
SET SCTYPE="CLINIC"
+10 IF $DATA(@SCGLB@(+X,0))
DO SET($PIECE(^(0),U)_U_SCTYPE_U_+X,.SCINC,.SCDATA)
End DoDot:1
+11 DO SET("$$END",.SCINC,.SCDATA)
+12 QUIT
+13 ;
