Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SCAPMC33

SCAPMC33.m

Go to the documentation of this file. 
  1. SCAPMC33  ;BP/DJB - Get Provider Array For a Pt Tm Pos ; 5/24/99 12:39pm
  1.  ;;5.3;Scheduling;**177**;May 01, 1999
  1.  ;
  1. PRPTTP(PTTMPOS,SCDATES,SCLIST,SCERR,SCALLHIS,ADJDATE) ;Get provider array for
  1.  ;a Patient Team Position Assignment (#404.43).
  1.  ;
  1.  ; Input:
  1.  ;          PTTMPOS - Pointer to entry in PATIENT TEAM POSITION
  1.  ;                    ASSIGNMENT file (#404.43).
  1.  ; SCDATES("BEGIN") - Begin date to search (inclusive).
  1.  ;                    Default 1=Assign Date field in file 404.43.
  1.  ;                    Default 2=DT
  1.  ;          ("END"  - End date to search (inclusive).
  1.  ;                    Default 1=Unassign Date field in file 404.43.
  1.  ;                    Default 2=DT
  1.  ;         ("INCL") - 1: Only use pracitioners who were on
  1.  ;                       team for entire date range
  1.  ;                    0: Anytime in date range.
  1.  ;                    Default=1.
  1.  ;           SCLIST - Array name to store returned data.
  1.  ;            SCERR - Array name to store error messages.
  1.  ;                    Ex: ^TMP("ORXX",$J).
  1.  ;         SCALLHIS - 1: Return unfiltered sub-array in SCLIST
  1.  ;          ADJDATE - 1: Adjust Start/End dates of provider so they
  1.  ;                       don't exceed Assign/Unassign dates of Patient
  1.  ;                       Team Position Assignment.
  1.  ;Output:
  1.  ;         SCLIST() - Array of practitioners. See PRTP^SCAPMC8
  1.  ;          SCERR() - Array of error msg. See PRTP^SCAPMC8
  1.  ;Returned: 1 if ok, 0 if error
  1.  ;
  1.  ;Declare variables
  1.  NEW EDATE,ND,OK,SDATE,TMPOSPTR
  1.  ;
  1.  ;Initialize variables
  1.  S OK=0
  1.  I $D(SCERR) KILL @SCERR
  1.  ;
  1.  ;Check input
  1.  I '$G(PTTMPOS) G QUIT
  1.  I '$D(^SCPT(404.43,PTTMPOS,0)) G QUIT
  1.  ;
  1.  ;Get data
  1.  S ND=$G(^SCPT(404.43,PTTMPOS,0)) ;Zero node of 404.43
  1.  S TMPOSPTR=$P(ND,U,2) ;...........Team Position IEN
  1.  I 'TMPOSPTR G QUIT
  1.  S SDATE=$P(ND,U,3) ;..............Assigned Date
  1.  S EDATE=$P(ND,U,4) ;..............Unassigned Date
  1.  ;
  1.  S OK=$$ADJUST1(SDATE,EDATE)
  1.  G:'OK QUIT
  1.  S OK=$$PRTP^SCAPMC(TMPOSPTR,.SCDATES,.SCLIST,.SCERR,1,.SCALLHIS)
  1.  G:'OK QUIT
  1.  G:'$D(SCLIST(0)) QUIT
  1.  ;
  1.  I $G(ADJDATE) D ADJUST2 ;Adjust Start/End Dates.
  1.  ;
  1. QUIT Q OK
  1.  ;
  1. ADJUST1(SDATE,EDATE) ;Adjust SCDATES to Assign/Unassign Dates in 404.43.
  1.  ;
  1.  NEW OK
  1.  S OK=0
  1.  ;
  1.  ;Set defaults
  1.  I '$G(@SCDATES@("BEGIN")) S @SCDATES@("BEGIN")=SDATE
  1.  I '$G(@SCDATES@("END")) S @SCDATES@("END")=EDATE
  1.  I '@SCDATES@("BEGIN") S @SCDATES@("BEGIN")=DT
  1.  I '@SCDATES@("END") S @SCDATES@("END")=DT
  1.  ;
  1.  ;Quit if requested date range is outside of 404.43 date range.
  1.  I SDATE,@SCDATES@("END")<SDATE G ADJQUIT
  1.  I EDATE,@SCDATES@("BEGIN")>EDATE G ADJQUIT
  1.  ;
  1.  ;Adjust requested date range if it is wider than 404.43 date range.
  1.  I SDATE>@SCDATES@("BEGIN") S @SCDATES@("BEGIN")=SDATE
  1.  I EDATE,@SCDATES@("END")>EDATE S @SCDATES@("END")=EDATE
  1.  S OK=1
  1. ADJQUIT Q OK
  1.  ;
  1. ADJUST2 ;Adjust Assigned/Unassigned Dates in SCLIST array so they don't
  1.  ;exceed requested date range..
  1.  ;
  1.  NEW DATA,POSH,PREH
  1.  Q:'$D(@SCLIST)
  1.  ;
  1.  ;Position History
  1.  S POSH=0
  1.  F  S POSH=$O(@SCLIST@(POSH)) Q:'POSH  D  ;
  1.  . S DATA=$G(@SCLIST@(POSH))
  1.  . ;
  1.  . ;Adjust Begin Date
  1.  . I $P(DATA,U,9)<@SCDATES@("BEGIN") D  ;
  1.  . . ;Update main node
  1.  . . S $P(@SCLIST@(POSH),U,9)=@SCDATES@("BEGIN")
  1.  . . ;
  1.  . . ;Update "SCPR" node
  1.  . . K @SCLIST@("SCPR",$P(DATA,U,1),$P(DATA,U,3),$P(DATA,U,9),POSH)
  1.  . . S @SCLIST@("SCPR",$P(DATA,U,1),$P(DATA,U,3),@SCDATES@("BEGIN"),POSH)=""
  1.  . ;
  1.  . ;Adjust End Date
  1.  . I $P(DATA,U,10)>@SCDATES@("END") D  ;
  1.  . . S $P(@SCLIST@(POSH),U,10)=@SCDATES@("END")
  1.  . ;
  1.  . ;Preceptor History
  1.  . S PREH=0
  1.  . F  S PREH=$O(@SCLIST@(POSH,"PR",PREH)) Q:'PREH  D  ;
  1.  . . S DATA=$G(@SCLIST@(POSH,"PR",PREH))
  1.  . . ;
  1.  . . ;Adjust Begin Date
  1.  . . I $P(DATA,U,9)<@SCDATES@("BEGIN") D  ;
  1.  . . . ;Update "PR" node
  1.  . . . S $P(@SCLIST@(POSH,"PR",PREH),U,9)=@SCDATES@("BEGIN")
  1.  . . . ;Update "SCPR" node
  1.  . . . K @SCLIST@(POSH,"SCPR",$P(DATA,U,1),$P(DATA,U,3),$P(DATA,U,9),PREH)
  1.  . . . S @SCLIST@(POSH,"SCPR",$P(DATA,U,1),$P(DATA,U,3),@SCDATES@("BEGIN"),PREH)=""
  1.  . . ;
  1.  . . ;Adjust End Date
  1.  . . I $P($G(@SCLIST@(POSH,"PR",PREH)),U,10)>@SCDATES@("END") D  ;
  1.  . . . S $P(@SCLIST@(POSH,"PR",PREH),U,10)=@SCDATES@("END")
  1.  Q