| [613] | 1 | SCAPMC8C ;BP/DJB - Convert Practitioners List to PCP/AP ; 8/4/00 2:28pm
|
|---|
| 2 | ;;5.3;Scheduling;**177,224**;AUG 13, 1993
|
|---|
| 3 | ;;1.0
|
|---|
| 4 | ;
|
|---|
| 5 | PRTPC(SCTP,SCDATES,SCLIST,SCERR,SCALLHIS,ADJUSTDT) ;Convert list of providers
|
|---|
| 6 | ;for a position, to a list of PROV-U/PROV-P/PRECs.
|
|---|
| 7 | ; PROV-U - Unprecepted provider (PCP)
|
|---|
| 8 | ; PROV-P - Precepted provider (AP)
|
|---|
| 9 | ; PREC - Preceptor (PCP)
|
|---|
| 10 | ;
|
|---|
| 11 | ; Input:
|
|---|
| 12 | ; SCTP - IEN of TEAM POSITION [required]
|
|---|
| 13 | ; SCDATES - See PRTP^SCAPMC8
|
|---|
| 14 | ; SCLIST - Array NAME for output
|
|---|
| 15 | ; SCERR - Array NAME to store error messages.
|
|---|
| 16 | ; Example: ^TMP("ORXX",$J).
|
|---|
| 17 | ; SCALLHIS - 1: Return unfiltered sub-array in SCLIST
|
|---|
| 18 | ; ADJUSTDT - 1:Adjust Start/End dates if provider if is both
|
|---|
| 19 | ; precepted & unprecepted for different times periods.
|
|---|
| 20 | ;
|
|---|
| 21 | ;Output:
|
|---|
| 22 | ; SCLIST(scn,"PROV-U"/"PROV-P"/"PREC",n) = array of practitioners
|
|---|
| 23 | ; Format: See PRTP^SCAPMC8
|
|---|
| 24 | ; SCERR() - See PRTP^SCAPMC8
|
|---|
| 25 | ;
|
|---|
| 26 | ;Returned: 1 if ok, 0 if error
|
|---|
| 27 | ;
|
|---|
| 28 | NEW RESULT,PRTPC
|
|---|
| 29 | ;
|
|---|
| 30 | S ADJUSTDT=$G(ADJUSTDT)
|
|---|
| 31 | ;
|
|---|
| 32 | ;Get list of practioners for a team position.
|
|---|
| 33 | S RESULT=$$PRTP^SCAPMC(.SCTP,.SCDATES,"PRTPC",.SCERR,1,.SCALLHIS)
|
|---|
| 34 | I 'RESULT G QUIT
|
|---|
| 35 | I '$D(PRTPC(0)) G QUIT
|
|---|
| 36 | ;
|
|---|
| 37 | D ADJUST ;Process returned array
|
|---|
| 38 | QUIT Q RESULT
|
|---|
| 39 | ;
|
|---|
| 40 | ADJUST ;Convert returned array to PROV-P/PROV-U/PREC array.
|
|---|
| 41 | ;Adjust Start/End dates if provider is both precepted & unprecepted.
|
|---|
| 42 | ;
|
|---|
| 43 | NEW DATA,DATA1,ID,NUM,NUM1
|
|---|
| 44 | NEW ADJEDATE,ADJSDATE,EDATE,SDATE,SDATE1
|
|---|
| 45 | ;
|
|---|
| 46 | ;Loop thru array
|
|---|
| 47 | S NUM=0
|
|---|
| 48 | F S NUM=$O(PRTPC(NUM)) Q:'NUM D ;
|
|---|
| 49 | . KILL SDATE ;Initialize SDATE array
|
|---|
| 50 | . S DATA=$G(PRTPC(NUM))
|
|---|
| 51 | . ;If no preceptor nodes set PCP node.
|
|---|
| 52 | . ;Place a zero in "404.53 IEN" subscript.
|
|---|
| 53 | . S ID=$P(DATA,U,11)_"-0-PCP"
|
|---|
| 54 | . I '$D(PRTPC(NUM,"PR")) S @SCLIST@(NUM,"PROV-U",ID)=DATA Q
|
|---|
| 55 | . S SDATE=$P(DATA,U,9) ;...Position History Start Date
|
|---|
| 56 | . S EDATE=$P(DATA,U,10) ;..Position History End Date
|
|---|
| 57 | . ;
|
|---|
| 58 | . ;Loop thru "PR" nodes to find preceptor
|
|---|
| 59 | . S NUM1=0
|
|---|
| 60 | . F S NUM1=$O(PRTPC(NUM,"PR",NUM1)) Q:'NUM1 D ;
|
|---|
| 61 | . . S DATA1=$G(PRTPC(NUM,"PR",NUM1))
|
|---|
| 62 | . . ;Compare piece 9 & piece 14. Use later date.
|
|---|
| 63 | . . ; Piece 9 - Date provider assigned
|
|---|
| 64 | . . ; Piece 14 - Date position assigned.
|
|---|
| 65 | . . S SDATE1=$P(DATA1,U,9)
|
|---|
| 66 | . . I $P(DATA1,U,14)>SDATE1 S SDATE1=$P(DATA1,U,14)
|
|---|
| 67 | . . ;Set temp array to later find earliest preceptor Start Date.
|
|---|
| 68 | . . ;
|
|---|
| 69 | . . ;alb/rpm;Patch 224;Filter preceptors outside requested date range
|
|---|
| 70 | . . Q:'$$DTCHK^SCAPU1(@SCDATES@("BEGIN"),@SCDATES@("END"),0,SDATE1,$P(DATA1,U,10))
|
|---|
| 71 | . . ;
|
|---|
| 72 | . . I SDATE1 S SDATE(SDATE1)=""
|
|---|
| 73 | . . ;
|
|---|
| 74 | . . ;Set preceptor as PCP.
|
|---|
| 75 | . . S ID=$P(DATA1,U,11)_"-"_$P(DATA1,U,16)_"-PCP"
|
|---|
| 76 | . . S @SCLIST@(NUM,"PREC",ID)=DATA1
|
|---|
| 77 | . . Q
|
|---|
| 78 | . ;Get earliest preceptor Start Date
|
|---|
| 79 | . S SDATE1=$O(SDATE(0))
|
|---|
| 80 | . ;
|
|---|
| 81 | . ;If position date is not earlier than preceptor date, it's all AP.
|
|---|
| 82 | . S ID=$P(DATA,U,11)_"-0-AP"
|
|---|
| 83 | . I SDATE'<SDATE1 S @SCLIST@(NUM,"PROV-P",ID)=DATA Q
|
|---|
| 84 | . ;
|
|---|
| 85 | . ;If postion Start/End Dates are both earlier than preceptor date,
|
|---|
| 86 | . ;then it's all PCP.
|
|---|
| 87 | . S ID=$P(DATA,U,11)_"-0-PCP"
|
|---|
| 88 | . I EDATE,EDATE<SDATE1 S @SCLIST@(NUM,"PROV-U",ID)=DATA Q
|
|---|
| 89 | . ;
|
|---|
| 90 | . ;Set PCP and AP portions
|
|---|
| 91 | . ;
|
|---|
| 92 | . ;Set PCP portion
|
|---|
| 93 | . S ID=$P(DATA,U,11)_"-0-PCP"
|
|---|
| 94 | . S ADJSDATE=SDATE ;.....................Adjusted Start Date
|
|---|
| 95 | . S ADJEDATE=$$FMADD^XLFDT(SDATE1,-1) ;..Adjusted End Date
|
|---|
| 96 | . I ADJUSTDT S $P(DATA,U,10)=ADJEDATE ;..Adjust End Date
|
|---|
| 97 | . D ;After AP/PCP split, recheck Start/End Dates.
|
|---|
| 98 | . . I ADJSDATE,ADJSDATE>@SCDATES@("END") Q ;
|
|---|
| 99 | . . I ADJEDATE,ADJEDATE<@SCDATES@("BEGIN") Q ;
|
|---|
| 100 | . . S @SCLIST@(NUM,"PROV-U",ID)=DATA
|
|---|
| 101 | . ;
|
|---|
| 102 | . ;Set AP portion
|
|---|
| 103 | . S ID=$P(DATA,U,11)_"-0-AP"
|
|---|
| 104 | . S ADJSDATE=SDATE1 ;..Adjusted Start Date
|
|---|
| 105 | . I $P(DATA,U,15),$P(DATA,U,15)<EDATE S EDATE=$P(DATA,U,15)
|
|---|
| 106 | . S ADJEDATE=EDATE ;...Adjusted End Date
|
|---|
| 107 | . I ADJUSTDT D ;......Adjust Start/End dates
|
|---|
| 108 | . . S $P(DATA,U,9)=ADJSDATE
|
|---|
| 109 | . . S $P(DATA,U,10)=ADJEDATE
|
|---|
| 110 | . D ;After AP/PCP split, recheck Start/End Dates.
|
|---|
| 111 | . . I ADJSDATE,ADJSDATE>@SCDATES@("END") Q ;
|
|---|
| 112 | . . I ADJEDATE,ADJEDATE<@SCDATES@("BEGIN") Q ;
|
|---|
| 113 | . . S @SCLIST@(NUM,"PROV-P",ID)=DATA
|
|---|
| 114 | ;
|
|---|
| 115 | Q
|
|---|
