SCUTBK4 ;ALB/JLU;BROKER UTILITIES
;;5.3;Scheduling;**148,157**;AUG 13, 1993
ACTPOS(RESULTS,SCARY) ;
;
;This broker entry point returns an array of active positions for a
;patient on a specific team.
;
;INPUTS SCARY - Contains the following subscripted elements
; DFN - DFN of the patient.
; BEGIN - The beginning date range.
; END - The ending date range.
; TEAM - The team associated with the patient.
;
;OUTPUTS RESULTS - The array of active positions. The following
; is a description of the piece structure.
; PIECE - Description
; 1 IEN of TEAM POSITION FILE(#404.57)
; 2 NAME of Position
; 3 Current effective date
; 4 Pointer to role (403.46)
; 5 Name of Standard role
; 6 Pointer to User Class
; 7 Name of User Class
; 8 IEN of 404.43
;
N SCOK,SCDT,SCDFN,SCTEAM,SCPOS,LP,CNT,SCERR
;
D CHK^SCUTBK
D TMP^SCUTBK
;
D PARSE(.SCARY) ;parse array for inputs
K ^TMP($J,"ACTLST")
;gets a list o positions for this patient
S SCOK=$$TPPT^SCAPMC(SCDFN,.SCDT,"","","","","","SCPOS","SCBKERR")
I 'SCOK G EXIT
S CNT=1
;
;loop through positions only getting the ones associated with the team
;and that are active.
;
F LP=0:0 S LP=$O(SCPOS(LP)) Q:'LP DO
.I $P(SCPOS(LP),U,3)'=SCTEAM Q
.I $P(SCPOS(LP),U,6)]"" Q
.S ^TMP($J,"ACTLST",CNT)=$P(SCPOS(LP),U,1)_U_$P(SCPOS(LP),U,2)_U_$P(SCPOS(LP),U,5)_U_$P(SCPOS(LP),U,7)_U_$P(SCPOS(LP),U,8)_U_$P(SCPOS(LP),U,9)_U_$P(SCPOS(LP),U,10)_U_$P(SCPOS(LP),U,4)
.S CNT=CNT+1
.Q
;
EXIT S RESULTS=$NA(^TMP($J,"ACTLST"))
Q
;
PARSE(ARY) ;parses the input parameters from the broker.
;
S SCDFN=$G(ARY("DFN"))
S SCDT("BEGIN")=$G(ARY("BEGIN"))
S SCDT("END")=$G(ARY("END"))
S SCTEAM=$G(ARY("TEAM"))
Q
;
PARIEN(RESULT) ;returns the ien for 404.91
;used by SCMC GET PARAMETER IEN (rpc)
;
N RES
S RES=$O(^SD(404.91,0))
S RESULT=$S(RES="":0,1:+RES)
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCUTBK4 2149 printed Apr 09, 2024@21:55:52 Page 2
SCUTBK4 ;ALB/JLU;BROKER UTILITIES
+1 ;;5.3;Scheduling;**148,157**;AUG 13, 1993
ACTPOS(RESULTS,SCARY) ;
+1 ;
+2 ;This broker entry point returns an array of active positions for a
+3 ;patient on a specific team.
+4 ;
+5 ;INPUTS SCARY - Contains the following subscripted elements
+6 ; DFN - DFN of the patient.
+7 ; BEGIN - The beginning date range.
+8 ; END - The ending date range.
+9 ; TEAM - The team associated with the patient.
+10 ;
+11 ;OUTPUTS RESULTS - The array of active positions. The following
+12 ; is a description of the piece structure.
+13 ; PIECE - Description
+14 ; 1 IEN of TEAM POSITION FILE(#404.57)
+15 ; 2 NAME of Position
+16 ; 3 Current effective date
+17 ; 4 Pointer to role (403.46)
+18 ; 5 Name of Standard role
+19 ; 6 Pointer to User Class
+20 ; 7 Name of User Class
+21 ; 8 IEN of 404.43
+22 ;
+23 NEW SCOK,SCDT,SCDFN,SCTEAM,SCPOS,LP,CNT,SCERR
+24 ;
+25 DO CHK^SCUTBK
+26 DO TMP^SCUTBK
+27 ;
+28 ;parse array for inputs
DO PARSE(.SCARY)
+29 KILL ^TMP($JOB,"ACTLST")
+30 ;gets a list o positions for this patient
+31 SET SCOK=$$TPPT^SCAPMC(SCDFN,.SCDT,"","","","","","SCPOS","SCBKERR")
+32 IF 'SCOK
GOTO EXIT
+33 SET CNT=1
+34 ;
+35 ;loop through positions only getting the ones associated with the team
+36 ;and that are active.
+37 ;
+38 FOR LP=0:0
SET LP=$ORDER(SCPOS(LP))
if 'LP
QUIT
Begin DoDot:1
+39 IF $PIECE(SCPOS(LP),U,3)'=SCTEAM
QUIT
+40 IF $PIECE(SCPOS(LP),U,6)]""
QUIT
+41 SET ^TMP($JOB,"ACTLST",CNT)=$PIECE(SCPOS(LP),U,1)_U_$PIECE(SCPOS(LP),U,2)_U_$PIECE(SCPOS(LP),U,5)_U_$PIECE(SCPOS(LP),U,7)_U_$PIECE(SCPOS(LP),U,8)_U_$PIECE(SCPOS(LP),U,9)_U_$PIECE(SCPOS(LP),U,10)_U_$PIECE(SCPOS(LP),U,4)
+42 SET CNT=CNT+1
+43 QUIT
End DoDot:1
+44 ;
EXIT SET RESULTS=$NAME(^TMP($JOB,"ACTLST"))
+1 QUIT
+2 ;
PARSE(ARY) ;parses the input parameters from the broker.
+1 ;
+2 SET SCDFN=$GET(ARY("DFN"))
+3 SET SCDT("BEGIN")=$GET(ARY("BEGIN"))
+4 SET SCDT("END")=$GET(ARY("END"))
+5 SET SCTEAM=$GET(ARY("TEAM"))
+6 QUIT
+7 ;
PARIEN(RESULT) ;returns the ien for 404.91
+1 ;used by SCMC GET PARAMETER IEN (rpc)
+2 ;
+3 NEW RES
+4 SET RES=$ORDER(^SD(404.91,0))
+5 SET RESULT=$SELECT(RES="":0,1:+RES)
+6 QUIT
