source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCAPMC14.m@ 1710

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

revised back to 6/30/08 version
File size: 3.3 KB
Line 
1SCAPMC14 ;ALB/REW - Team API's: PTPR ; JUN 30, 1995
2 ;;5.3;Scheduling;**41**;AUG 13, 1993
3 ;;1.0
4PTPR(SC200,SCDATES,SCPURPA,SCROLEA,SCLIST,SCERR,SCYESCL) ; -- list patients for a pract (scyescl NOT supported)
5 ; input:
6 ; SC200 = ien of NEW PERSON file(#200) [required]
7 ; SCDATES("BEGIN") = begin date to search (inclusive)
8 ; [default: TODAY]
9 ; ("END") = end date to search (inclusive)
10 ; [default: TODAY]
11 ; ("INCL") = 1: only use patients who were assigned to
12 ; team for entire date range
13 ; 0: anytime in date range
14 ; [default: 1]
15 ; SCPURPA -array of pointers to team purpose file 403.47
16 ; if none are defined - returns all teams
17 ; if @SCPURPA@('exclude') is defined - exclude listed teams
18 ; SCROLEA-array of pointer to 403.46 (per SCPURPA)
19 ; SCLIST -array name to store list
20 ; [ex. ^TMP("SCPT",$J)]
21 ;
22 ; SCERR = array NAME to store error messages.
23 ; [ex. ^TMP("ORXX",$J)]
24 ; SCYESCL = Boolean to indicate 1=use associated clinics 0=don't
25 ; default=0
26 ;
27 ;
28 ; Output:
29 ; SCLIST() = array of patients
30 ; Format:
31 ; Subscript: Sequential # from 1 to n
32 ; Piece Description
33 ; 1 IEN of PATIENT file entry
34 ; 2 Name of patient
35 ; 3 IEN of Pt Team Posit Asment if position=source
36 ; 4 Activation Date
37 ; 5 Inactivation Date
38 ; 6 Source 1=Clinic, Null=Position
39 ; 7 IEN of Clinic if clinic=source
40 ;
41 ; SCERR() = Array of DIALOG file messages(errors) .
42 ; @SCERR@(0) = number of errors, undefined if none
43 ; Format:
44 ; Subscript: Sequential # from 1 to n
45 ; Piece Description
46 ; 1 IEN of DIALOG file
47 ; Returned: 1 if ok, 0 if error
48 ;
49 ;
50ST N SCTM,SCPTA,SCPTA0,SCOK,SCX,NODE,TPACT,TPINACT,SCTEMP,SCTP,SCUSR
51 N SCLSEQ,SCN,SCESEQ,SCPARM,SCP,SCBEGIN,SCEND,SCINCL,SCDTS
52 ; -- initialize control variables
53 G:'$$OKDATA PRACQ
54 ; -- get list of positions for practitioner
55 G:'$$TPPR^SCAPMC(SC200,SCDATES,.SCPURPA,.SCROLEA,"SCTEMP",.SCERR) PRACQ
56 G:'$G(SCTEMP(0)) PRACQ
57 S SCTP=0
58 ;get list of patients for each position
59 F SCX=1:1 S NODE=$G(SCTEMP(SCX)),SCTP=+NODE Q:'SCTP D Q:'SCOK
60 .S TPACT=$P(SCTEMP(SCX),U,5)
61 .S TPINACT=$P(SCTEMP(SCX),U,6)
62 .N SCDTPR
63 .S SCDTPR("BEGIN")=$S(TPACT>@SCDATES@("BEGIN"):TPACT,1:@SCDATES@("BEGIN"))
64 .S SCDTPR("END")=$S('TPINACT:@SCDATES@("END"),(TPINACT<@SCDATES@("END")):TPINACT,1:@SCDATES@("END"))
65 .S SCDTPR("INCL")=@SCDATES@("INCL")
66 .S SCOK=$$PTTP^SCAPMC(SCTP,"SCDTPR",.SCLIST,.SCERR)
67 .Q:'SCOK
68 .Q:'SCYESCL
69 .S SC44=$P($G(^SCTM(404.57,+SCTP,0)),U,9)
70 .Q:'SC44
71 .S SCOK=$$PTCL^SCAPMC(SC44,"SCDTPR",.SCLIST,.SCERR)
72PRACQ Q $G(@SCERR@(0))<1
73 ;
74OKDATA() ;setup/check variables
75 N SCOK
76 S SCOK=1
77 S SCYESCL=$G(SCYESCL,0)
78 D INIT^SCAPMCU1(.SCOK) ; set default dates & error array (if undefined)
79 IF '$D(^VA(200,+$G(SC200),0)) D S SCOK=0
80 . S SCPARM("PRACT")=$G(SC200,"Undefined")
81 . D ERR^SCAPMCU1(.SCESEQ,4045101,.SCPARM,"",.SCERR)
82 ; -- is it a valid DFN passed (Error # 20001 in DIALOG file)
83 IF '$D(^VA(200,+SC200,0)) D S SCOK=0
84 . S SCPARM("PRACT")=SC200
85 . D ERR^SCAPMCU1(SCESEQ,20001,.SCPARM,"",.SCERR)
86 Q SCOK
87 ;
Note: See TracBrowser for help on using the repository browser.