SCAPMC8C.m

SCAPMC8C ;BP/DJB - Convert Practitioners List to PCP/AP ; 8/4/00 2:28pm

 ;;5.3;Scheduling;**177,224,1015**;AUG 13, 1993;Build 21

 ;;1.0

 ;

PRTPC(SCTP,SCDATES,SCLIST,SCERR,SCALLHIS,ADJUSTDT) ;Convert list of providers

 ;for a position, to a list of PROV-U/PROV-P/PRECs.

 ;       PROV-U - Unprecepted provider  (PCP)

 ;       PROV-P - Precepted provider    (AP)

 ;       PREC   - Preceptor             (PCP)

 ;

 ; Input:

 ;  SCTP    - IEN of TEAM POSITION [required]

 ;  SCDATES - See PRTP^SCAPMC8

 ;  SCLIST  - Array NAME for output

 ;  SCERR   - Array NAME to store error messages.

 ;            Example: ^TMP("ORXX",$J).

 ; SCALLHIS - 1: Return unfiltered sub-array in SCLIST

 ; ADJUSTDT - 1:Adjust Start/End dates if provider if is both

 ;              precepted & unprecepted for different times periods.

 ;

 ;Output:

 ;  SCLIST(scn,"PROV-U"/"PROV-P"/"PREC",n) = array of practitioners

 ;            Format: See PRTP^SCAPMC8

 ;  SCERR() - See PRTP^SCAPMC8

 ;

 ;Returned: 1 if ok, 0 if error

 ;

 NEW RESULT,PRTPC

 ;

 S ADJUSTDT=$G(ADJUSTDT)

 ;

 ;Get list of practioners for a team position.

 S RESULT=$$PRTP^SCAPMC(.SCTP,.SCDATES,"PRTPC",.SCERR,1,.SCALLHIS)

 I 'RESULT G QUIT

 I '$D(PRTPC(0)) G QUIT

 ;

 D ADJUST ;Process returned array

QUIT Q RESULT

 ;

ADJUST ;Convert returned array to PROV-P/PROV-U/PREC array.

 ;Adjust Start/End dates if provider is both precepted & unprecepted.

 ;

 NEW DATA,DATA1,ID,NUM,NUM1

 NEW ADJEDATE,ADJSDATE,EDATE,SDATE,SDATE1

 ;

 ;Loop thru array

 S NUM=0

 F  S NUM=$O(PRTPC(NUM)) Q:'NUM  D  ;

 . KILL SDATE ;Initialize SDATE array

 . S DATA=$G(PRTPC(NUM))

 . ;If no preceptor nodes set PCP node.

 . ;Place a zero in "404.53 IEN" subscript.

 . S ID=$P(DATA,U,11)_"-0-PCP"

 . I '$D(PRTPC(NUM,"PR")) S @SCLIST@(NUM,"PROV-U",ID)=DATA Q

 . S SDATE=$P(DATA,U,9) ;...Position History Start Date

 . S EDATE=$P(DATA,U,10) ;..Position History End Date

 . ;

 . ;Loop thru "PR" nodes to find preceptor

 . S NUM1=0

 . F  S NUM1=$O(PRTPC(NUM,"PR",NUM1)) Q:'NUM1  D  ;

 . . S DATA1=$G(PRTPC(NUM,"PR",NUM1))

 . . ;Compare piece 9 & piece 14. Use later date.

 . . ;   Piece 9  - Date provider assigned

 . . ;   Piece 14 - Date position assigned.

 . . S SDATE1=$P(DATA1,U,9)

 . . I $P(DATA1,U,14)>SDATE1 S SDATE1=$P(DATA1,U,14)

 . . ;Set temp array to later find earliest preceptor Start Date.

 . . ;

 . . ;alb/rpm;Patch 224;Filter preceptors outside requested date range

 . . Q:'$$DTCHK^SCAPU1(@SCDATES@("BEGIN"),@SCDATES@("END"),0,SDATE1,$P(DATA1,U,10))

 . . ;

 . . I SDATE1 S SDATE(SDATE1)=""

 . . ;

 . . ;Set preceptor as PCP.

 . . S ID=$P(DATA1,U,11)_"-"_$P(DATA1,U,16)_"-PCP"

 . . S @SCLIST@(NUM,"PREC",ID)=DATA1

 . . Q

 . ;Get earliest preceptor Start Date

 . S SDATE1=$O(SDATE(0))

 . ;

 . ;If position date is not earlier than preceptor date, it's all AP.

 . S ID=$P(DATA,U,11)_"-0-AP"

 . I SDATE'<SDATE1 S @SCLIST@(NUM,"PROV-P",ID)=DATA Q

 . ;

 . ;If postion Start/End Dates are both earlier than preceptor date,

 . ;then it's all PCP.

 . S ID=$P(DATA,U,11)_"-0-PCP"

 . I EDATE,EDATE<SDATE1 S @SCLIST@(NUM,"PROV-U",ID)=DATA Q

 . ;

 . ;Set PCP and AP portions

 . ;

 . ;Set PCP portion

 . S ID=$P(DATA,U,11)_"-0-PCP"

 . S ADJSDATE=SDATE ;.....................Adjusted Start Date

 . S ADJEDATE=$$FMADD^XLFDT(SDATE1,-1) ;..Adjusted End Date

 . I ADJUSTDT S $P(DATA,U,10)=ADJEDATE ;..Adjust End Date

 . D  ;After AP/PCP split, recheck Start/End Dates.

 . . I ADJSDATE,ADJSDATE>@SCDATES@("END") Q  ;

 . . I ADJEDATE,ADJEDATE<@SCDATES@("BEGIN") Q  ;

 . . S @SCLIST@(NUM,"PROV-U",ID)=DATA

 . ;

 . ;Set AP portion

 . S ID=$P(DATA,U,11)_"-0-AP"

 . S ADJSDATE=SDATE1 ;..Adjusted Start Date

 . I $P(DATA,U,15),$P(DATA,U,15)<EDATE S EDATE=$P(DATA,U,15)

 . S ADJEDATE=EDATE ;...Adjusted End Date

 . I ADJUSTDT D  ;......Adjust Start/End dates

 . . S $P(DATA,U,9)=ADJSDATE

 . . S $P(DATA,U,10)=ADJEDATE

 . D  ;After AP/PCP split, recheck Start/End Dates.

 . . I ADJSDATE,ADJSDATE>@SCDATES@("END") Q  ;

 . . I ADJEDATE,ADJEDATE<@SCDATES@("BEGIN") Q  ;

 . . S @SCLIST@(NUM,"PROV-P",ID)=DATA

 ;

 Q

SCAPMC8C  ;BP/DJB - Convert Practitioners List to PCP/AP ; 8/4/00 2:28pm

 +1       ;;5.3;Scheduling;**177,224,1015**;AUG 13, 1993;Build 21

 +2       ;;1.0

 +3       ;

PRTPC(SCTP,SCDATES,SCLIST,SCERR,SCALLHIS,ADJUSTDT) ;Convert list of providers

 +1       ;for a position, to a list of PROV-U/PROV-P/PRECs.

 +2       ;       PROV-U - Unprecepted provider  (PCP)

 +3       ;       PROV-P - Precepted provider    (AP)

 +4       ;       PREC   - Preceptor             (PCP)

 +5       ;

 +6       ; Input:

 +7       ;  SCTP    - IEN of TEAM POSITION [required]

 +8       ;  SCDATES - See PRTP^SCAPMC8

 +9       ;  SCLIST  - Array NAME for output

 +10      ;  SCERR   - Array NAME to store error messages.

 +11      ;            Example: ^TMP("ORXX",$J).

 +12      ; SCALLHIS - 1: Return unfiltered sub-array in SCLIST

 +13      ; ADJUSTDT - 1:Adjust Start/End dates if provider if is both

 +14      ;              precepted & unprecepted for different times periods.

 +15      ;

 +16      ;Output:

 +17      ;  SCLIST(scn,"PROV-U"/"PROV-P"/"PREC",n) = array of practitioners

 +18      ;            Format: See PRTP^SCAPMC8

 +19      ;  SCERR() - See PRTP^SCAPMC8

 +20      ;

 +21      ;Returned: 1 if ok, 0 if error

 +22      ;

 +23       NEW RESULT,PRTPC

 +24      ;

 +25       SET ADJUSTDT=$GET(ADJUSTDT)

 +26      ;

 +27      ;Get list of practioners for a team position.

 +28       SET RESULT=$$PRTP^SCAPMC(.SCTP,.SCDATES,"PRTPC",.SCERR,1,.SCALLHIS)

 +29       IF 'RESULT

               GOTO QUIT

 +30       IF '$DATA(PRTPC(0))

               GOTO QUIT

 +31      ;

 +32      ;Process returned array

           DO ADJUST

QUIT       QUIT RESULT

 +1       ;

ADJUST    ;Convert returned array to PROV-P/PROV-U/PREC array.

 +1       ;Adjust Start/End dates if provider is both precepted & unprecepted.

 +2       ;

 +3        NEW DATA,DATA1,ID,NUM,NUM1

 +4        NEW ADJEDATE,ADJSDATE,EDATE,SDATE,SDATE1

 +5       ;

 +6       ;Loop thru array

 +7        SET NUM=0

 +8       ;

           FOR 

               SET NUM=$ORDER(PRTPC(NUM))

               IF 'NUM

                   QUIT 

               Begin DoDot:1

 +9       ;Initialize SDATE array

                   KILL SDATE

 +10               SET DATA=$GET(PRTPC(NUM))

 +11      ;If no preceptor nodes set PCP node.

 +12      ;Place a zero in "404.53 IEN" subscript.

 +13               SET ID=$PIECE(DATA,U,11)_"-0-PCP"

 +14               IF '$DATA(PRTPC(NUM,"PR"))

                       SET @SCLIST@(NUM,"PROV-U",ID)=DATA

                       QUIT 

 +15      ;...Position History Start Date

                   SET SDATE=$PIECE(DATA,U,9)

 +16      ;..Position History End Date

                   SET EDATE=$PIECE(DATA,U,10)

 +17      ;

 +18      ;Loop thru "PR" nodes to find preceptor

 +19               SET NUM1=0

 +20      ;

                   FOR 

                       SET NUM1=$ORDER(PRTPC(NUM,"PR",NUM1))

                       IF 'NUM1

                           QUIT 

                       Begin DoDot:2

 +21                       SET DATA1=$GET(PRTPC(NUM,"PR",NUM1))

 +22      ;Compare piece 9 & piece 14. Use later date.

 +23      ;   Piece 9  - Date provider assigned

 +24      ;   Piece 14 - Date position assigned.

 +25                       SET SDATE1=$PIECE(DATA1,U,9)

 +26                       IF $PIECE(DATA1,U,14)>SDATE1

                               SET SDATE1=$PIECE(DATA1,U,14)

 +27      ;Set temp array to later find earliest preceptor Start Date.

 +28      ;

 +29      ;alb/rpm;Patch 224;Filter preceptors outside requested date range

 +30                       IF '$$DTCHK^SCAPU1(@SCDATES@("BEGIN"),@SCDATES@("END"),0,SDATE1,$PIECE(DATA1,U,10))

                               QUIT 

 +31      ;

 +32                       IF SDATE1

                               SET SDATE(SDATE1)=""

 +33      ;

 +34      ;Set preceptor as PCP.

 +35                       SET ID=$PIECE(DATA1,U,11)_"-"_$PIECE(DATA1,U,16)_"-PCP"

 +36                       SET @SCLIST@(NUM,"PREC",ID)=DATA1

 +37                       QUIT 

                       End DoDot:2

 +38      ;Get earliest preceptor Start Date

 +39               SET SDATE1=$ORDER(SDATE(0))

 +40      ;

 +41      ;If position date is not earlier than preceptor date, it's all AP.

 +42               SET ID=$PIECE(DATA,U,11)_"-0-AP"

 +43               IF SDATE'<SDATE1

                       SET @SCLIST@(NUM,"PROV-P",ID)=DATA

                       QUIT 

 +44      ;

 +45      ;If postion Start/End Dates are both earlier than preceptor date,

 +46      ;then it's all PCP.

 +47               SET ID=$PIECE(DATA,U,11)_"-0-PCP"

 +48               IF EDATE

                       IF EDATE<SDATE1

                           SET @SCLIST@(NUM,"PROV-U",ID)=DATA

                           QUIT 

 +49      ;

 +50      ;Set PCP and AP portions

 +51      ;

 +52      ;Set PCP portion

 +53               SET ID=$PIECE(DATA,U,11)_"-0-PCP"

 +54      ;.....................Adjusted Start Date

                   SET ADJSDATE=SDATE

 +55      ;..Adjusted End Date

                   SET ADJEDATE=$$FMADD^XLFDT(SDATE1,-1)

 +56      ;..Adjust End Date

                   IF ADJUSTDT

                       SET $PIECE(DATA,U,10)=ADJEDATE

 +57      ;After AP/PCP split, recheck Start/End Dates.

                   Begin DoDot:2

 +58      ;

                       IF ADJSDATE

                           IF ADJSDATE>@SCDATES@("END")

                               QUIT 

 +59      ;

                       IF ADJEDATE

                           IF ADJEDATE<@SCDATES@("BEGIN")

                               QUIT 

 +60                   SET @SCLIST@(NUM,"PROV-U",ID)=DATA

                   End DoDot:2

 +61      ;

 +62      ;Set AP portion

 +63               SET ID=$PIECE(DATA,U,11)_"-0-AP"

 +64      ;..Adjusted Start Date

                   SET ADJSDATE=SDATE1

 +65               IF $PIECE(DATA,U,15)

                       IF $PIECE(DATA,U,15)<EDATE

                           SET EDATE=$PIECE(DATA,U,15)

 +66      ;...Adjusted End Date

                   SET ADJEDATE=EDATE

 +67      ;......Adjust Start/End dates

                   IF ADJUSTDT

                       Begin DoDot:2

 +68                       SET $PIECE(DATA,U,9)=ADJSDATE

 +69                       SET $PIECE(DATA,U,10)=ADJEDATE

                       End DoDot:2

 +70      ;After AP/PCP split, recheck Start/End Dates.

                   Begin DoDot:2

 +71      ;

                       IF ADJSDATE

                           IF ADJSDATE>@SCDATES@("END")

                               QUIT 

 +72      ;

                       IF ADJEDATE

                           IF ADJEDATE<@SCDATES@("BEGIN")

                               QUIT 

 +73                   SET @SCLIST@(NUM,"PROV-P",ID)=DATA

                   End DoDot:2

               End DoDot:1

 +74      ;

 +75       QUIT