SCRPBK11 ;MJK/ALB - RPC Broker Utilities ; 27 FEB 96
;;5.3;Scheduling;**41,520,1015**;AUG 13, 1993;Build 21
;
GETSEL(SCDATA,SCTYPE,SCIEN) ;
; -- get SELECTION entity data for details form
;
; input: SCTYPE := type of autolink (DIVISIOND, TEAM, ectc.)
; SCIEN := ien of entity
; output: SCDATA(1..n) := info about entity
;
; -- SEE BOTTOM OF SCRPBK FOR VARIABLE DEFINITIONS
;
; Related RPC: SCRP FILE ENTRY GETSELECTION
;
N SC0,SCI,SCINC
S SCINC=0,SCID=+SCIEN
;
IF SCTYPE="DIVISION" D DIV G GETSELQ
;
IF SCTYPE="TEAM" D TEAM G GETSELQ
;
IF SCTYPE="PRACTITIONER" D PRAC G GETSELQ
;
IF SCTYPE="ROLE" D ROLE G GETSELQ
;
IF SCTYPE="CLINIC" D CLIN G GETSELQ
;
IF SCTYPE="USERCLASS" D USER G GETSELQ
;
GETSELQ Q
;
SET(X,INC,SCDATA) ; -- set value in return array
S INC=$G(INC)+1,SCDATA(INC)=X
Q
;
DIV ; -- get division details
D SET("Teams in Division:",.SCINC,.SCDATA)
D SET("------------------",.SCINC,.SCDATA)
S SCI=0 F S SCI=$O(^SCTM(404.51,"AINST",SCID,SCI)) Q:'SCI D
. D SET($P($G(^SCTM(404.51,SCI,0)),U),.SCINC,.SCDATA)
Q
;
TEAM ; -- get team description
N SC,SCFLE,SCIEN,SCDEF
S SCFLE=404.51,SCIEN=SCID_",",SCDEF="<none specified>"
D GETS^DIQ(SCFLE,SCID_",",50,"","SC")
D SET("Team Description:",.SCINC,.SCDATA)
D SET("-----------------",.SCINC,.SCDATA)
IF $O(SC(SCFLE,SCIEN,50,0)) D
. S SCI=0 F S SCI=$O(SC(SCFLE,SCIEN,50,SCI)) Q:'SCI S X=SC(SCFLE,SCIEN,50,SCI) D
. . D SET(X,.SCINC,.SCDATA)
ELSE D
. D SET(SCDEF,.SCINC,.SCDATA)
Q
;
PRAC ; -- get practitioner details
N SC,SCFLE,SCIEN,SCDEF
S SCFLE=200,SCIEN=SCID_",",SCDEF="<none specified>"
D GETS^DIQ(SCFLE,SCID_",","1;8;28","","SC")
D SET(" Initials: "_$S($G(SC(SCFLE,SCIEN,1))]"":SC(SCFLE,SCIEN,1),1:SCDEF),.SCINC,.SCDATA)
D SET("Mail Code: "_$S($G(SC(SCFLE,SCIEN,28))]"":SC(SCFLE,SCIEN,28),1:SCDEF),.SCINC,.SCDATA)
D SET(" Title: "_$S($G(SC(SCFLE,SCIEN,8))]"":SC(SCFLE,SCIEN,8),1:SCDEF),.SCINC,.SCDATA)
Q
;
ROLE ; -- get standard role description
N SC,SCFLE,SCIEN,SCDEF
S SCFLE=403.46,SCIEN=SCID_",",SCDEF="<none specified>"
D GETS^DIQ(SCFLE,SCID_",",1,"","SC")
D SET("Role Description:",.SCINC,.SCDATA)
D SET("-----------------",.SCINC,.SCDATA)
IF $O(SC(SCFLE,SCIEN,1,0)) D
. S SCI=0 F S SCI=$O(SC(SCFLE,SCIEN,1,SCI)) Q:'SCI S X=SC(SCFLE,SCIEN,1,SCI) D
. . D SET(X,.SCINC,.SCDATA)
ELSE D
. D SET(SCDEF,.SCINC,.SCDATA)
Q
;
CLIN ; -- get clinic details
N SC,SCFLE,SCIEN,SCDEF
S SCFLE=44,SCIEN=SCID_",",SCDEF="<none specified>"
D GETS^DIQ(SCFLE,SCID_",","1;3.5","","SC")
D SET("Abbreviation: "_$S($G(SC(SCFLE,SCIEN,1))]"":SC(SCFLE,SCIEN,1),1:SCDEF),.SCINC,.SCDATA)
D SET(" Division: "_$S($G(SC(SCFLE,SCIEN,3.5))]"":SC(SCFLE,SCIEN,3.5),1:SCDEF),.SCINC,.SCDATA)
D SET(" ",.SCINC,.SCDATA)
D SET("Associated Teams and Positions:",.SCINC,.SCDATA)
D SET("-------------------------------",.SCINC,.SCDATA)
S SCI=0 F S SCI=$O(^SCTM(404.57,"E",SCID,SCI)) Q:'SCI D
. S X=$G(^SCTM(404.57,SCI,0))
. D SET(" Team: "_$P($G(^SCTM(404.51,+$P(X,U,2),0)),U),.SCINC,.SCDATA)
. D SET(" Position: "_$P(X,U),.SCINC,.SCDATA)
. D SET(" ",.SCINC,.SCDATA)
Q
;
USER ; -- get user class details
D SET("No additional information available at this time. ",.SCINC,.SCDATA)
Q
;
SCRPBK11 ;MJK/ALB - RPC Broker Utilities ; 27 FEB 96
+1 ;;5.3;Scheduling;**41,520,1015**;AUG 13, 1993;Build 21
+2 ;
GETSEL(SCDATA,SCTYPE,SCIEN) ;
+1 ; -- get SELECTION entity data for details form
+2 ;
+3 ; input: SCTYPE := type of autolink (DIVISIOND, TEAM, ectc.)
+4 ; SCIEN := ien of entity
+5 ; output: SCDATA(1..n) := info about entity
+6 ;
+7 ; -- SEE BOTTOM OF SCRPBK FOR VARIABLE DEFINITIONS
+8 ;
+9 ; Related RPC: SCRP FILE ENTRY GETSELECTION
+10 ;
+11 NEW SC0,SCI,SCINC
+12 SET SCINC=0
SET SCID=+SCIEN
+13 ;
+14 IF SCTYPE="DIVISION"
DO DIV
GOTO GETSELQ
+15 ;
+16 IF SCTYPE="TEAM"
DO TEAM
GOTO GETSELQ
+17 ;
+18 IF SCTYPE="PRACTITIONER"
DO PRAC
GOTO GETSELQ
+19 ;
+20 IF SCTYPE="ROLE"
DO ROLE
GOTO GETSELQ
+21 ;
+22 IF SCTYPE="CLINIC"
DO CLIN
GOTO GETSELQ
+23 ;
+24 IF SCTYPE="USERCLASS"
DO USER
GOTO GETSELQ
+25 ;
GETSELQ QUIT
+1 ;
SET(X,INC,SCDATA) ; -- set value in return array
+1 SET INC=$GET(INC)+1
SET SCDATA(INC)=X
+2 QUIT
+3 ;
DIV ; -- get division details
+1 DO SET("Teams in Division:",.SCINC,.SCDATA)
+2 DO SET("------------------",.SCINC,.SCDATA)
+3 SET SCI=0
FOR
SET SCI=$ORDER(^SCTM(404.51,"AINST",SCID,SCI))
IF 'SCI
QUIT
Begin DoDot:1
+4 DO SET($PIECE($GET(^SCTM(404.51,SCI,0)),U),.SCINC,.SCDATA)
End DoDot:1
+5 QUIT
+6 ;
TEAM ; -- get team description
+1 NEW SC,SCFLE,SCIEN,SCDEF
+2 SET SCFLE=404.51
SET SCIEN=SCID_","
SET SCDEF="<none specified>"
+3 DO GETS^DIQ(SCFLE,SCID_",",50,"","SC")
+4 DO SET("Team Description:",.SCINC,.SCDATA)
+5 DO SET("-----------------",.SCINC,.SCDATA)
+6 IF $ORDER(SC(SCFLE,SCIEN,50,0))
Begin DoDot:1
+7 SET SCI=0
FOR
SET SCI=$ORDER(SC(SCFLE,SCIEN,50,SCI))
IF 'SCI
QUIT
SET X=SC(SCFLE,SCIEN,50,SCI)
Begin DoDot:2
+8 DO SET(X,.SCINC,.SCDATA)
End DoDot:2
End DoDot:1
+9 IF '$TEST
Begin DoDot:1
+10 DO SET(SCDEF,.SCINC,.SCDATA)
End DoDot:1
+11 QUIT
+12 ;
PRAC ; -- get practitioner details
+1 NEW SC,SCFLE,SCIEN,SCDEF
+2 SET SCFLE=200
SET SCIEN=SCID_","
SET SCDEF="<none specified>"
+3 DO GETS^DIQ(SCFLE,SCID_",","1;8;28","","SC")
+4 DO SET(" Initials: "_$SELECT($GET(SC(SCFLE,SCIEN,1))]"":SC(SCFLE,SCIEN,1),1:SCDEF),.SCINC,.SCDATA)
+5 DO SET("Mail Code: "_$SELECT($GET(SC(SCFLE,SCIEN,28))]"":SC(SCFLE,SCIEN,28),1:SCDEF),.SCINC,.SCDATA)
+6 DO SET(" Title: "_$SELECT($GET(SC(SCFLE,SCIEN,8))]"":SC(SCFLE,SCIEN,8),1:SCDEF),.SCINC,.SCDATA)
+7 QUIT
+8 ;
ROLE ; -- get standard role description
+1 NEW SC,SCFLE,SCIEN,SCDEF
+2 SET SCFLE=403.46
SET SCIEN=SCID_","
SET SCDEF="<none specified>"
+3 DO GETS^DIQ(SCFLE,SCID_",",1,"","SC")
+4 DO SET("Role Description:",.SCINC,.SCDATA)
+5 DO SET("-----------------",.SCINC,.SCDATA)
+6 IF $ORDER(SC(SCFLE,SCIEN,1,0))
Begin DoDot:1
+7 SET SCI=0
FOR
SET SCI=$ORDER(SC(SCFLE,SCIEN,1,SCI))
IF 'SCI
QUIT
SET X=SC(SCFLE,SCIEN,1,SCI)
Begin DoDot:2
+8 DO SET(X,.SCINC,.SCDATA)
End DoDot:2
End DoDot:1
+9 IF '$TEST
Begin DoDot:1
+10 DO SET(SCDEF,.SCINC,.SCDATA)
End DoDot:1
+11 QUIT
+12 ;
CLIN ; -- get clinic details
+1 NEW SC,SCFLE,SCIEN,SCDEF
+2 SET SCFLE=44
SET SCIEN=SCID_","
SET SCDEF="<none specified>"
+3 DO GETS^DIQ(SCFLE,SCID_",","1;3.5","","SC")
+4 DO SET("Abbreviation: "_$SELECT($GET(SC(SCFLE,SCIEN,1))]"":SC(SCFLE,SCIEN,1),1:SCDEF),.SCINC,.SCDATA)
+5 DO SET(" Division: "_$SELECT($GET(SC(SCFLE,SCIEN,3.5))]"":SC(SCFLE,SCIEN,3.5),1:SCDEF),.SCINC,.SCDATA)
+6 DO SET(" ",.SCINC,.SCDATA)
+7 DO SET("Associated Teams and Positions:",.SCINC,.SCDATA)
+8 DO SET("-------------------------------",.SCINC,.SCDATA)
+9 SET SCI=0
FOR
SET SCI=$ORDER(^SCTM(404.57,"E",SCID,SCI))
IF 'SCI
QUIT
Begin DoDot:1
+10 SET X=$GET(^SCTM(404.57,SCI,0))
+11 DO SET(" Team: "_$PIECE($GET(^SCTM(404.51,+$PIECE(X,U,2),0)),U),.SCINC,.SCDATA)
+12 DO SET(" Position: "_$PIECE(X,U),.SCINC,.SCDATA)
+13 DO SET(" ",.SCINC,.SCDATA)
End DoDot:1
+14 QUIT
+15 ;
USER ; -- get user class details
+1 DO SET("No additional information available at this time. ",.SCINC,.SCDATA)
+2 QUIT
+3 ;
