SCMCPREC ;bpoifo/swo move preceptors;3.20.08
;;5.3;Scheduling;**504**;AUG 13, 1993;Build 21
Q
LISTPREC(SCRESULT,SCPIEN) ;
;List preceptees for a preceptor position
;Input
; SCPIEN := preceptor pos ien (404.57) (required)
; SCRESULT := return array
; Piece Description
; 1 IEN of NEW PERSON file entry (#200)
; 2 Name of person
; 3 IEN of TEAM POSITION file (#404.57)
; 4 Name of Position
; 5 IEN OF USR CLASS(8930) of POSITION (404.57)
; 6 USR Class Name
; 7 IEN of STANDARD POSITION (#403.46)
; 8 Standard Role (Position) Name
; 9 Activation Date for 404.52 (not 404.59!)
; 10 Inactivation Date for 404.52
; 11 IEN of Position Asgn History (404.52)
; 12 IEN of Current(=DT) Preceptor Position
; 13 Name of Current(=DT) Preceptor Position
; 14 precept start date
; 15 precept end date
; 16 IEN of Preceptor Asgn History (404.53)
N SCDATES,V1
I SCPIEN="" S SCRESULT(0)=0 Q 0
S SCDATES("BEGIN")=DT
S SCDATES("END")=DT
S SCDATES("INCL")=0
S V1=$$PRECHIS^SCMCLK(SCPIEN,"SCDATES","SCRESULT") I $D(SCRESULT) K SCRESULT("SCPR") Q 1
S SCRESULT(0)=0
Q 0
MOVEPREC(SCRESULT,SCPIEN1,SCED1,SCPIEN2,SCED2) ;
;Move preceptees from one position to another
;Input
; SCPIEN1 := FROM preceptor pos ien (404.57) (required)
; SCPIEN2 := TO preceptor pos ien (404.57) (required)
; SCED1 := FROM preceptor effective date
; SCED2 := TO preceptor effective date
; SCRESULT := return array 0 = fail 1 = success
I SCPIEN1="" S SCRESULT(0)=0 Q 0
I SCPIEN2="" S SCRESULT(0)=0 Q 0
S SCED1=$S($G(SCED1)="":"T-1",1:SCED1)
S SCED2=$S($G(SCED2)="":"TODAY",1:SCED2)
N V1,ZNODE,DIC,DIE,DR,DA,SCARRAY
S DIE="^SCTM(404.53,"
S DR=".02///"_SCED1_";.04///0;.05///CHANGE PRECEPTOR LINK;.08///NOW;.07///"_DUZ
;Loop thru "FROM" preceptor for current preceptees and inactivate them
S V1=0 F S V1=$O(^SCTM(404.53,"D",SCPIEN1,V1)) Q:'V1 D
.S ZNODE=$G(^SCTM(404.53,V1,0)) Q:ZNODE=""
.I '$P(ZNODE,"^",4) Q ;INACTIVE
.S SCARRAY($P(ZNODE,U))=""
.S DA=V1
.D ^DIE
;Create new assignments for the "TO" preceptor
S DIC="^SCTM(404.53,"
S DIC(0)="Z"
S DIC("DR")=".02///"_SCED2_";.04///1;.05///ACTIVATE PRECEPTOR LINK;.06///"_SCPIEN2_";.08///NOW;.07///"_DUZ
S V1=0 F S V1=$O(SCARRAY(V1)) Q:'V1 D
.K D0
.S X=V1
.D FILE^DICN
S SCRESULT(0)=1
Q 1
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCMCPREC 2711 printed Dec 13, 2024@02:41:11 Page 2
SCMCPREC ;bpoifo/swo move preceptors;3.20.08
+1 ;;5.3;Scheduling;**504**;AUG 13, 1993;Build 21
+2 QUIT
LISTPREC(SCRESULT,SCPIEN) ;
+1 ;List preceptees for a preceptor position
+2 ;Input
+3 ; SCPIEN := preceptor pos ien (404.57) (required)
+4 ; SCRESULT := return array
+5 ; Piece Description
+6 ; 1 IEN of NEW PERSON file entry (#200)
+7 ; 2 Name of person
+8 ; 3 IEN of TEAM POSITION file (#404.57)
+9 ; 4 Name of Position
+10 ; 5 IEN OF USR CLASS(8930) of POSITION (404.57)
+11 ; 6 USR Class Name
+12 ; 7 IEN of STANDARD POSITION (#403.46)
+13 ; 8 Standard Role (Position) Name
+14 ; 9 Activation Date for 404.52 (not 404.59!)
+15 ; 10 Inactivation Date for 404.52
+16 ; 11 IEN of Position Asgn History (404.52)
+17 ; 12 IEN of Current(=DT) Preceptor Position
+18 ; 13 Name of Current(=DT) Preceptor Position
+19 ; 14 precept start date
+20 ; 15 precept end date
+21 ; 16 IEN of Preceptor Asgn History (404.53)
+22 NEW SCDATES,V1
+23 IF SCPIEN=""
SET SCRESULT(0)=0
QUIT 0
+24 SET SCDATES("BEGIN")=DT
+25 SET SCDATES("END")=DT
+26 SET SCDATES("INCL")=0
+27 SET V1=$$PRECHIS^SCMCLK(SCPIEN,"SCDATES","SCRESULT")
IF $DATA(SCRESULT)
KILL SCRESULT("SCPR")
QUIT 1
+28 SET SCRESULT(0)=0
+29 QUIT 0
MOVEPREC(SCRESULT,SCPIEN1,SCED1,SCPIEN2,SCED2) ;
+1 ;Move preceptees from one position to another
+2 ;Input
+3 ; SCPIEN1 := FROM preceptor pos ien (404.57) (required)
+4 ; SCPIEN2 := TO preceptor pos ien (404.57) (required)
+5 ; SCED1 := FROM preceptor effective date
+6 ; SCED2 := TO preceptor effective date
+7 ; SCRESULT := return array 0 = fail 1 = success
+8 IF SCPIEN1=""
SET SCRESULT(0)=0
QUIT 0
+9 IF SCPIEN2=""
SET SCRESULT(0)=0
QUIT 0
+10 SET SCED1=$SELECT($GET(SCED1)="":"T-1",1:SCED1)
+11 SET SCED2=$SELECT($GET(SCED2)="":"TODAY",1:SCED2)
+12 NEW V1,ZNODE,DIC,DIE,DR,DA,SCARRAY
+13 SET DIE="^SCTM(404.53,"
+14 SET DR=".02///"_SCED1_";.04///0;.05///CHANGE PRECEPTOR LINK;.08///NOW;.07///"_DUZ
+15 ;Loop thru "FROM" preceptor for current preceptees and inactivate them
+16 SET V1=0
FOR
SET V1=$ORDER(^SCTM(404.53,"D",SCPIEN1,V1))
if 'V1
QUIT
Begin DoDot:1
+17 SET ZNODE=$GET(^SCTM(404.53,V1,0))
if ZNODE=""
QUIT
+18 ;INACTIVE
IF '$PIECE(ZNODE,"^",4)
QUIT
+19 SET SCARRAY($PIECE(ZNODE,U))=""
+20 SET DA=V1
+21 DO ^DIE
End DoDot:1
+22 ;Create new assignments for the "TO" preceptor
+23 SET DIC="^SCTM(404.53,"
+24 SET DIC(0)="Z"
+25 SET DIC("DR")=".02///"_SCED2_";.04///1;.05///ACTIVATE PRECEPTOR LINK;.06///"_SCPIEN2_";.08///NOW;.07///"_DUZ
+26 SET V1=0
FOR
SET V1=$ORDER(SCARRAY(V1))
if 'V1
QUIT
Begin DoDot:1
+27 KILL D0
+28 SET X=V1
+29 DO FILE^DICN
End DoDot:1
+30 SET SCRESULT(0)=1
+31 QUIT 1
