SCUTBK4.m

SCUTBK4 ;ALB/JLU;BROKER UTILITIES

 ;;5.3;Scheduling;**148,157,1015**;AUG 13, 1993;Build 21

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

SCUTBK4   ;ALB/JLU;BROKER UTILITIES

 +1       ;;5.3;Scheduling;**148,157,1015**;AUG 13, 1993;Build 21

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