- SCRPBK0 ;MJK/ALB - RPC Broker Utilities ; 27 FEB 96
- ;;5.3;Scheduling;**41,1015**;AUG 13, 1993;Build 21
- ;
- 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
- ;
- SCRPBK0 ;MJK/ALB - RPC Broker Utilities ; 27 FEB 96
- +1 ;;5.3;Scheduling;**41,1015**;AUG 13, 1993;Build 21
- +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 ;
