- 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 Mar 13, 2025@21:46:06 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
