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

SCAPMCU4.m

Go to the documentation of this file.
  1. SCAPMCU4 ;ALB/REW - TEAM API UTILITIES ; 30 Mar 96
  1. ;;5.3;Scheduling;**41**;AUG 13, 1993
  1. ;;1.0
  1. RESTPT(DFN,SCDATE,SCRPA) ;is pt a restricted consult pt?
  1. ; DFN - ien to PATIENT File
  1. ; SCATE - Date of interest - default=DT
  1. ; SCRPA - literal value of desired restrict patients array
  1. ; e.g. scrpa=xx results in xx(sctm)=teamname
  1. ; Returned: [1 if yes, 0 if no, -1 if error]
  1. ;
  1. N SCRPDTS,SCOK,SCRPLIST,SCRPERR,SCTM,SCTP,SCYES,SCTMNM,SCNDX,SCND
  1. S SCYES=0
  1. S SCRPDTS("BEGIN")=SCDATE
  1. S SCRPDTS("END")=SCDATE
  1. S SCRPDTS("INCL")=0
  1. S SCOK=$$TMPT^SCAPMC(DFN,"SCRPDTS",,"SCRPLIST","SCRPERR")
  1. IF $G(SCRPLIST(0)) D
  1. .F SCNDX=1:1:+$G(SCRPLIST(0)) D
  1. ..S SCND=SCRPLIST(SCNDX)
  1. ..S SCTM=+SCND
  1. ..S SCTMNM=$P(SCND,U,2)
  1. ..S SCPTTM=$P(SCND,U,3)
  1. ..; restrict from 404.51 (TEAM) file entry??
  1. ..IF $P($G(^SCTM(404.51,+SCTM,0)),U,13) D
  1. ...S SCYES=1
  1. ...S:$L(SCTMNM) @SCRPA@(SCTM)=SCTMNM
  1. ..; restring from 404.42 (PATIENT TEAM) file entry??
  1. ..IF $P($G(^SCPT(404.42,+SCPTTM,0)),U,10) D
  1. ...S SCYES=1
  1. ...S:$L(SCTMNM) @SCRPA@(SCTM)=SCTMNM
  1. Q $S($D(SCRPERR):-1,1:SCYES)