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

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

initial load of WorldVistAEHR
File size: 4.0 KB
RevLine 
[613]1SCAPMC3 ;ALB/REW - Team API's:TMPT ; 6/3/99 3:18pm
2 ;;5.3;Scheduling;**41,177,297**;AUG 13, 1993
3 ;;1.0
4TMPT(DFN,SCDATES,SCPURPA,SCLIST,SCERR) ; -- list of teams for a patient
5 ; input:
6 ; DFN = ien of PATIENT file [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.42 (Pt Tm Assignment)
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 ; 8 Is this the pt's PC Team?
37 ; Subscript: "SCTM",SCTM,IEN =""
38 ;
39 ; SCERR() = Array of DIALOG file messages(errors) .
40 ; @SCERR@(0) = number of errors, undefined if none
41 ; Format:
42 ; Subscript: Sequential # from 1 to n
43 ; Piece Description
44 ; 1 IEN of DIALOG file
45 ; Returned: 1 if ok, 0 if error
46 ;
47 ;
48 ;
49ST N SCTM,SCPTA,SCPTA0,SCP,SCTMPT
50 N SCLSEQ,SCN,SCESEQ,SCPARM,SCP,SCBEGIN,SCEND,SCINCL,SCDTS
51 ; -- initialize control variables
52 G:'$$OKDATA PRACQ
53 ; -- loop through patient team assignments
54 S SCTM=0
55 F S SCTM=$O(^SCPT(404.42,"APTTM",DFN,SCTM)) Q:'SCTM D
56 .Q:1>$$ACTHIST^SCAPMCU2(404.58,SCTM,SCDATES,.SCERR,"SCTMPT")
57 .S SCP=$P(^SCTM(404.51,SCTM,0),U,3)
58 .Q:'$$OKARRAY^SCAPU1(SCPURPA,SCP)
59 .S SCPTA=0
60 .F S SCPTA=$O(^SCPT(404.42,"APTTM",DFN,SCTM,SCPTA)) Q:'SCPTA D
61 ..S SCPTA0=$G(^SCPT(404.42,SCPTA,0))
62 ..Q:'SCPTA0
63 ..Q:'$$DTCHK^SCAPU1(SCBEGIN,SCEND,SCINCL,$P(SCPTA0,U,2),$P(SCPTA0,U,9))
64 ..D BLD(.SCLIST,SCPTA,SCPTA0)
65PRACQ Q $G(@SCERR@(0))<1
66 ;
67 ;
68BLD(SCLIST,SCPTA,SCPTA0) ; -- build list of patient's teams
69 ;
70 ; SCLIST - output array
71 ; SCPTA - ien of pt team assignment
72 ; SCPTA0 - 0 node of pt team assignment file
73 ;
74 ; this builds the array:
75 ; 1 2 3 4 5 6 7 8
76 ; sclist(1->n)=sctm^tmname^scpta^effdt^inactdt^p403.47^purpname^pctm?
77 ;
78 ; for each scpta zero node passed to it
79 ; AND a xref sclist('sctm',sctm,scpta,scn)=""
80 N SCEFFDT,SCCNT,SCTM,SCN,SCTMNODE,SCP,SCPC
81 S SCTM=$P(SCPTA0,U,3)
82 Q:$D(@SCLIST@("SCTM",SCTM,SCPTA))
83 S SCN=$G(@SCLIST@(0),0)+1
84 S @SCLIST@(0)=SCN
85 S SCTMNODE=$G(^SCTM(404.51,SCTM,0)),SCP=$P(SCTMNODE,U,3)
86 ;is assignment type=1?
87 S SCPC=$P(SCPTA0,U,8)=1
88 S @SCLIST@(SCN)=SCTM_U_$P(SCTMNODE,U,1)_U_SCPTA_U_$P(SCPTA0,U,2)_U_$P(SCPTA0,U,9)_U_SCP_U_$S(SCP:$P($G(^SC(403.47,SCP,0)),U,1),1:SCP)_U_SCPC
89 S @SCLIST@("SCTM",SCTM,SCPTA,SCN)=""
90 Q
91OKDATA() ;setup/check variables
92 N SCOK
93 S SCOK=1
94 S SCPURPA=$G(SCPURPA,"")
95 D INIT^SCAPMCU1(.SCOK) ; set default dates & error array (if undefined)
96 IF $L($G(SCPURPA))&($G(SCPURPA)'?1A1.7AN) D S SCOK=0
97 . S SCPARM("PURPOSE")=$G(SCPURPA,"Undefined")
98 . D ERR^SCAPMCU1(.SCESEQ,4045101,.SCPARM,"",.SCERR)
99 IF '$D(^DPT(+$G(DFN),0)) D S SCOK=0
100 . S SCPARM("PATIENT")=$G(PATIENT,"Undefined")
101 . D ERR^SCAPMCU1(.SCESEQ,4045101,.SCPARM,"",.SCERR)
102 ; -- is it a valid DFN passed (Error # 20001 in DIALOG file)
103 IF '$D(^DPT(+DFN,0)) D S SCOK=0
104 . S SCPARM("PATIENT")=DFN
105 . D ERR^SCAPMCU1(SCESEQ,20001,.SCPARM,"",.SCERR)
106 Q SCOK
107 ;
Note: See TracBrowser for help on using the repository browser.