SCMCPREC.m

SCMCPREC ;bpoifo/swo move preceptors;3.20.08

 ;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20

 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

SCMCPREC  ;bpoifo/swo move preceptors;3.20.08

 +1       ;;5.3;PIMS;**1016**;JUN 30, 2012;Build 20

 +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