source: FOIAVistA/trunk/r/SCHEDULING-SD-SC/SCAPMC8C.m@ 1267

Last change on this file since 1267 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version

File size: 3.9 KB
Line 
1SCAPMC8C ;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 ;
5PRTPC(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
38QUIT Q RESULT
39 ;
40ADJUST ;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
Note: See TracBrowser for help on using the repository browser.