| [613] | 1 | SCAPMCU4 ;ALB/REW - TEAM API UTILITIES ; 30 Mar 96
|
|---|
| 2 | ;;5.3;Scheduling;**41**;AUG 13, 1993
|
|---|
| 3 | ;;1.0
|
|---|
| 4 | RESTPT(DFN,SCDATE,SCRPA) ;is pt a restricted consult pt?
|
|---|
| 5 | ; DFN - ien to PATIENT File
|
|---|
| 6 | ; SCATE - Date of interest - default=DT
|
|---|
| 7 | ; SCRPA - literal value of desired restrict patients array
|
|---|
| 8 | ; e.g. scrpa=xx results in xx(sctm)=teamname
|
|---|
| 9 | ; Returned: [1 if yes, 0 if no, -1 if error]
|
|---|
| 10 | ;
|
|---|
| 11 | N SCRPDTS,SCOK,SCRPLIST,SCRPERR,SCTM,SCTP,SCYES,SCTMNM,SCNDX,SCND
|
|---|
| 12 | S SCYES=0
|
|---|
| 13 | S SCRPDTS("BEGIN")=SCDATE
|
|---|
| 14 | S SCRPDTS("END")=SCDATE
|
|---|
| 15 | S SCRPDTS("INCL")=0
|
|---|
| 16 | S SCOK=$$TMPT^SCAPMC(DFN,"SCRPDTS",,"SCRPLIST","SCRPERR")
|
|---|
| 17 | IF $G(SCRPLIST(0)) D
|
|---|
| 18 | .F SCNDX=1:1:+$G(SCRPLIST(0)) D
|
|---|
| 19 | ..S SCND=SCRPLIST(SCNDX)
|
|---|
| 20 | ..S SCTM=+SCND
|
|---|
| 21 | ..S SCTMNM=$P(SCND,U,2)
|
|---|
| 22 | ..S SCPTTM=$P(SCND,U,3)
|
|---|
| 23 | ..; restrict from 404.51 (TEAM) file entry??
|
|---|
| 24 | ..IF $P($G(^SCTM(404.51,+SCTM,0)),U,13) D
|
|---|
| 25 | ...S SCYES=1
|
|---|
| 26 | ...S:$L(SCTMNM) @SCRPA@(SCTM)=SCTMNM
|
|---|
| 27 | ..; restring from 404.42 (PATIENT TEAM) file entry??
|
|---|
| 28 | ..IF $P($G(^SCPT(404.42,+SCPTTM,0)),U,10) D
|
|---|
| 29 | ...S SCYES=1
|
|---|
| 30 | ...S:$L(SCTMNM) @SCRPA@(SCTM)=SCTMNM
|
|---|
| 31 | Q $S($D(SCRPERR):-1,1:SCYES)
|
|---|
