source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCAPMC13.m@ 1141

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

initial load of WorldVistAEHR

File size: 3.1 KB
RevLine 
[613]1SCAPMC13 ;ALB/REW - Team API's: TMPR ; JUN 30, 1995 [10/22/98 2:10pm]
2 ;;5.3;Scheduling;**41,157**;AUG 13, 1993
3 ;
4TMPR(SC200,SCDATES,SCPURPA,SCLIST,SCERR) ; -- list of teams for a pract
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 ; SCLIST -array name to store list
19 ; [ex. ^TMP("SCPT",$J)]
20 ;
21 ; SCERR = array NAME to store error messages.
22 ; [ex. ^TMP("ORXX",$J)]
23 ;
24 ; Output:
25 ; SCLIST() = array of teams (includes SCTM xref)
26 ; Format:
27 ; Subscript: Sequential # from 1 to n
28 ; Piece Description
29 ; 1 IEN of TEAM file entry
30 ; 2 Name of team
31 ; 3 IEN of file #404.52 (Pos Assign History)
32 ; 4 current effective date
33 ; 5 current inactivate date (if any)
34 ; 6 pointer to 403.47 (purpose)
35 ; 7 Name of Purpose
36 ; Subscript: "SCTM",SCTM,IEN =""
37 ;
38 ; SCERR() = Array of DIALOG file messages(errors) .
39 ; @SCERR@(0) = number of errors, undefined if none
40 ; Format:
41 ; Subscript: Sequential # from 1 to n
42 ; Piece Description
43 ; 1 IEN of DIALOG file
44 ; Returned: 1 if ok, 0 if error
45 ;
46 ;
47ST N SCTM,SCPTA,SCPTA0,SCTP,SCTMPR
48 N SCLSEQ,SCN,SCESEQ,SCPARM,SCP,SCBEGIN,SCEND,SCINCL,SCDTS
49 ; -- initialize control variables
50 G:'$$OKDATA PRACQ
51 ; -- loop through position assignments (404.52) for pract
52 S SCTPA=0
53 F S SCTPA=$O(^SCTM(404.52,"C",SC200,SCTPA)) Q:'SCTPA D
54 .S SCTP=$P($G(^SCTM(404.52,SCTPA,0)),U,1)
55 .Q:'SCTP
56 .S SCTM=$P($G(^SCTM(404.57,+$G(SCTP),0)),U,2)
57 .Q:'SCTM
58 .;;bp/djb Fix error due to bad pointers in TEAM field of
59 .;; TEAM POSITION file
60 .;;new code begin
61 .Q:'$D(^SCTM(404.51,SCTM,0))
62 .;;new code end
63 .S SCP=$P(^SCTM(404.51,SCTM,0),U,3)
64 .;;bp/djb Fix error due to calling rtn not initializing SCPURPA in
65 .;; parameter list. Change line to pass SCPURPA by reference.
66 .;;changed code begin
67 .Q:'$$OKARRAY^SCAPU1(.SCPURPA,SCP)
68 .;;changed code end
69 .S ACTHIST=$$ACTHIST^SCAPMCU2(404.52,SCTP,SCDATES,.SCERR,"SCTMPR")
70 .Q:'ACTHIST
71 .D BLDTM^SCAPMC4(SCTM,SCDATES,ACTHIST,.SCLIST,.SCERR)
72PRACQ Q $G(@SCERR@(0))<1
73 ;
74OKDATA() ;setup/check variables
75 N SCOK
76 S SCOK=1
77 D INIT^SCAPMCU1(.SCOK) ; set default dates & error array (if undefined)
78 IF '$D(^VA(200,+$G(SC200),0)) D S SCOK=0
79 . S SCPARM("PRACTITIONER")=$G(SC200,"Undefined")
80 . D ERR^SCAPMCU1(.SCESEQ,4045101,.SCPARM,"",.SCERR)
81 Q SCOK
82 ;
Note: See TracBrowser for help on using the repository browser.