| [613] | 1 | SCAPMC33 ;BP/DJB - Get Provider Array For a Pt Tm Pos ; 5/24/99 12:39pm
|
|---|
| 2 | ;;5.3;Scheduling;**177**;May 01, 1999
|
|---|
| 3 | ;
|
|---|
| 4 | PRPTTP(PTTMPOS,SCDATES,SCLIST,SCERR,SCALLHIS,ADJDATE) ;Get provider array for
|
|---|
| 5 | ;a Patient Team Position Assignment (#404.43).
|
|---|
| 6 | ;
|
|---|
| 7 | ; Input:
|
|---|
| 8 | ; PTTMPOS - Pointer to entry in PATIENT TEAM POSITION
|
|---|
| 9 | ; ASSIGNMENT file (#404.43).
|
|---|
| 10 | ; SCDATES("BEGIN") - Begin date to search (inclusive).
|
|---|
| 11 | ; Default 1=Assign Date field in file 404.43.
|
|---|
| 12 | ; Default 2=DT
|
|---|
| 13 | ; ("END" - End date to search (inclusive).
|
|---|
| 14 | ; Default 1=Unassign Date field in file 404.43.
|
|---|
| 15 | ; Default 2=DT
|
|---|
| 16 | ; ("INCL") - 1: Only use pracitioners who were on
|
|---|
| 17 | ; team for entire date range
|
|---|
| 18 | ; 0: Anytime in date range.
|
|---|
| 19 | ; Default=1.
|
|---|
| 20 | ; SCLIST - Array name to store returned data.
|
|---|
| 21 | ; SCERR - Array name to store error messages.
|
|---|
| 22 | ; Ex: ^TMP("ORXX",$J).
|
|---|
| 23 | ; SCALLHIS - 1: Return unfiltered sub-array in SCLIST
|
|---|
| 24 | ; ADJDATE - 1: Adjust Start/End dates of provider so they
|
|---|
| 25 | ; don't exceed Assign/Unassign dates of Patient
|
|---|
| 26 | ; Team Position Assignment.
|
|---|
| 27 | ;Output:
|
|---|
| 28 | ; SCLIST() - Array of practitioners. See PRTP^SCAPMC8
|
|---|
| 29 | ; SCERR() - Array of error msg. See PRTP^SCAPMC8
|
|---|
| 30 | ;Returned: 1 if ok, 0 if error
|
|---|
| 31 | ;
|
|---|
| 32 | ;Declare variables
|
|---|
| 33 | NEW EDATE,ND,OK,SDATE,TMPOSPTR
|
|---|
| 34 | ;
|
|---|
| 35 | ;Initialize variables
|
|---|
| 36 | S OK=0
|
|---|
| 37 | I $D(SCERR) KILL @SCERR
|
|---|
| 38 | ;
|
|---|
| 39 | ;Check input
|
|---|
| 40 | I '$G(PTTMPOS) G QUIT
|
|---|
| 41 | I '$D(^SCPT(404.43,PTTMPOS,0)) G QUIT
|
|---|
| 42 | ;
|
|---|
| 43 | ;Get data
|
|---|
| 44 | S ND=$G(^SCPT(404.43,PTTMPOS,0)) ;Zero node of 404.43
|
|---|
| 45 | S TMPOSPTR=$P(ND,U,2) ;...........Team Position IEN
|
|---|
| 46 | I 'TMPOSPTR G QUIT
|
|---|
| 47 | S SDATE=$P(ND,U,3) ;..............Assigned Date
|
|---|
| 48 | S EDATE=$P(ND,U,4) ;..............Unassigned Date
|
|---|
| 49 | ;
|
|---|
| 50 | S OK=$$ADJUST1(SDATE,EDATE)
|
|---|
| 51 | G:'OK QUIT
|
|---|
| 52 | S OK=$$PRTP^SCAPMC(TMPOSPTR,.SCDATES,.SCLIST,.SCERR,1,.SCALLHIS)
|
|---|
| 53 | G:'OK QUIT
|
|---|
| 54 | G:'$D(SCLIST(0)) QUIT
|
|---|
| 55 | ;
|
|---|
| 56 | I $G(ADJDATE) D ADJUST2 ;Adjust Start/End Dates.
|
|---|
| 57 | ;
|
|---|
| 58 | QUIT Q OK
|
|---|
| 59 | ;
|
|---|
| 60 | ADJUST1(SDATE,EDATE) ;Adjust SCDATES to Assign/Unassign Dates in 404.43.
|
|---|
| 61 | ;
|
|---|
| 62 | NEW OK
|
|---|
| 63 | S OK=0
|
|---|
| 64 | ;
|
|---|
| 65 | ;Set defaults
|
|---|
| 66 | I '$G(@SCDATES@("BEGIN")) S @SCDATES@("BEGIN")=SDATE
|
|---|
| 67 | I '$G(@SCDATES@("END")) S @SCDATES@("END")=EDATE
|
|---|
| 68 | I '@SCDATES@("BEGIN") S @SCDATES@("BEGIN")=DT
|
|---|
| 69 | I '@SCDATES@("END") S @SCDATES@("END")=DT
|
|---|
| 70 | ;
|
|---|
| 71 | ;Quit if requested date range is outside of 404.43 date range.
|
|---|
| 72 | I SDATE,@SCDATES@("END")<SDATE G ADJQUIT
|
|---|
| 73 | I EDATE,@SCDATES@("BEGIN")>EDATE G ADJQUIT
|
|---|
| 74 | ;
|
|---|
| 75 | ;Adjust requested date range if it is wider than 404.43 date range.
|
|---|
| 76 | I SDATE>@SCDATES@("BEGIN") S @SCDATES@("BEGIN")=SDATE
|
|---|
| 77 | I EDATE,@SCDATES@("END")>EDATE S @SCDATES@("END")=EDATE
|
|---|
| 78 | S OK=1
|
|---|
| 79 | ADJQUIT Q OK
|
|---|
| 80 | ;
|
|---|
| 81 | ADJUST2 ;Adjust Assigned/Unassigned Dates in SCLIST array so they don't
|
|---|
| 82 | ;exceed requested date range..
|
|---|
| 83 | ;
|
|---|
| 84 | NEW DATA,POSH,PREH
|
|---|
| 85 | Q:'$D(@SCLIST)
|
|---|
| 86 | ;
|
|---|
| 87 | ;Position History
|
|---|
| 88 | S POSH=0
|
|---|
| 89 | F S POSH=$O(@SCLIST@(POSH)) Q:'POSH D ;
|
|---|
| 90 | . S DATA=$G(@SCLIST@(POSH))
|
|---|
| 91 | . ;
|
|---|
| 92 | . ;Adjust Begin Date
|
|---|
| 93 | . I $P(DATA,U,9)<@SCDATES@("BEGIN") D ;
|
|---|
| 94 | . . ;Update main node
|
|---|
| 95 | . . S $P(@SCLIST@(POSH),U,9)=@SCDATES@("BEGIN")
|
|---|
| 96 | . . ;
|
|---|
| 97 | . . ;Update "SCPR" node
|
|---|
| 98 | . . K @SCLIST@("SCPR",$P(DATA,U,1),$P(DATA,U,3),$P(DATA,U,9),POSH)
|
|---|
| 99 | . . S @SCLIST@("SCPR",$P(DATA,U,1),$P(DATA,U,3),@SCDATES@("BEGIN"),POSH)=""
|
|---|
| 100 | . ;
|
|---|
| 101 | . ;Adjust End Date
|
|---|
| 102 | . I $P(DATA,U,10)>@SCDATES@("END") D ;
|
|---|
| 103 | . . S $P(@SCLIST@(POSH),U,10)=@SCDATES@("END")
|
|---|
| 104 | . ;
|
|---|
| 105 | . ;Preceptor History
|
|---|
| 106 | . S PREH=0
|
|---|
| 107 | . F S PREH=$O(@SCLIST@(POSH,"PR",PREH)) Q:'PREH D ;
|
|---|
| 108 | . . S DATA=$G(@SCLIST@(POSH,"PR",PREH))
|
|---|
| 109 | . . ;
|
|---|
| 110 | . . ;Adjust Begin Date
|
|---|
| 111 | . . I $P(DATA,U,9)<@SCDATES@("BEGIN") D ;
|
|---|
| 112 | . . . ;Update "PR" node
|
|---|
| 113 | . . . S $P(@SCLIST@(POSH,"PR",PREH),U,9)=@SCDATES@("BEGIN")
|
|---|
| 114 | . . . ;Update "SCPR" node
|
|---|
| 115 | . . . K @SCLIST@(POSH,"SCPR",$P(DATA,U,1),$P(DATA,U,3),$P(DATA,U,9),PREH)
|
|---|
| 116 | . . . S @SCLIST@(POSH,"SCPR",$P(DATA,U,1),$P(DATA,U,3),@SCDATES@("BEGIN"),PREH)=""
|
|---|
| 117 | . . ;
|
|---|
| 118 | . . ;Adjust End Date
|
|---|
| 119 | . . I $P($G(@SCLIST@(POSH,"PR",PREH)),U,10)>@SCDATES@("END") D ;
|
|---|
| 120 | . . . S $P(@SCLIST@(POSH,"PR",PREH),U,10)=@SCDATES@("END")
|
|---|
| 121 | Q
|
|---|
