source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCAPMC29.m@ 1766

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

revised back to 6/30/08 version

File size: 3.2 KB
Line 
1SCAPMC29 ;ALB/REW - TEAM APIs:CLPT ; 2/17/00 1:33pm
2 ;;5.3;Scheduling;**41,210**;AUG 13, 1993
3 ;;1.0
4CLPT(DFN,SCDATES,SCTEAMA,SCLIST,SCERR) ;clinics for patient
5 ; input:
6 ; DFN = ien of PATIENT <FILE#2> [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 pracitioners who were on
12 ; team for entire date range
13 ; 0: anytime in date range
14 ; [default: 1]
15 ; SCTEAMA= array of teams to include reverse with scposa('exclude')
16 ; SCERR = array NAME to store error messages.
17 ; [ex. ^TMP("ORXX",$J)]
18 ;
19 ; Output:
20 ; SCLIST() = array of clinics
21 ; Format:
22 ; Subscript: Sequential # from 1 to n
23 ; Piece Description
24 ; 1 IEN of HOSPITAL LOCATION file entry (#44)
25 ; 2 Name of CLINIC
26 ; 3 ENROLLMENT DATE
27 ; 4 DISCHARGE DATE
28 ; 5 OPT OR AC
29 ; 6 REVIEW DATE
30 ;
31 ; SCERR() = Array of DIALOG file messages(errors) .
32 ; @SCERR(0)= Number of error(s), UNDEFINED if no errors
33 ; Foramt:
34 ; Subscript: Sequential # from 1 to n
35 ; Piece Description
36 ; 1 IEN of DIALOG file
37 ; Returned: 1 if ok, 0 if error
38 ;
39 ; -- initialize control variables
40 ;
41ST N SCX,SCS,SC44,SCACOPT,SCTM,SCPOSA,SCTP
42 N SCLSEQ,SCN,SCESEQ,SCPARM,SCP,SCBEGIN,SCEND,SCINCL,SCDTS,SCOK,SCS,SCND,SCACT,SCINACT,SCREVDT,SCCLNM
43 G:'$$OKDATA PTCLQ ; check/setup variables
44 IF $L($G(SCTEAMA)) D
45 .S SCTM=0
46 .F S SCTM=$O(@SCTEAMA@(SCTM)) Q:'SCTM D Q:'SCX
47 ..S SCX=$$TPTM^SCAPMC(SCTM,SCDATES,,,"SCPOSAX",.SCERR)
48 .F SCX=1:1 S SCTP=+$G(SCPOSAX(SCX)) Q:'SCTP S SCPOSA(SCTP)=""
49 .S:$D(@SCTEAMA@("EXCLUDE")) SCPOSA("EXCLUDE")=""
50 S SCX=0 F S SCX=$O(^DPT(DFN,"DE",SCX)) Q:'SCX D
51 .S SC44=+$G(^DPT(DFN,"DE",SCX,0))
52 .Q:'SC44
53 .Q:'$$OKCLIN(SC44,.SCPOSA)
54 .S SCCLNM=$P($G(^SC(SC44,0)),U,1)
55 .S SCS=0 F S SCS=$O(^DPT(DFN,"DE",SCX,1,SCS)) Q:'SCS D
56 ..S SCND=$G(^DPT(DFN,"DE",SCX,1,SCS,0))
57 ..S SCACT=$P(SCND,U,1)
58 ..S SCINACT=$P(SCND,U,3)
59 ..Q:'$$DTCHK^SCAPU1(SCBEGIN,SCEND,SCINCL,SCACT,SCINACT)
60 ..S SCACOPT=$P(SCND,U,2)
61 ..S SCREVDT=$P(SCND,U,5)
62 ..S SCN=$G(@SCLIST@(0),0)+1
63 ..;bp/ar nois brx-1298-12323 prevent undefined variable error
64 ..;New code begins
65 ..Q:'SCACT
66 ..Q:'SCN
67 ..;End of brx-1298-12323
68 ..S @SCLIST@(0)=SCN
69 ..S @SCLIST@(SCN)=SC44_U_SCCLNM_U_SCACT_U_SCINACT_U_SCACOPT_U_SCREVDT
70 ..S @SCLIST@("SCCL",SC44,SCACT,SCN)=""
71PTCLQ Q $G(@SCERR@(0))<1
72 ;
73OKCLIN(SC44,SCPOSA) ;is clinic ok, given position array
74 N SCOK,SCTP
75 IF '$D(SCPOSA) S SCOK=1 G QTOKC
76 S (SCOK,SCTP)=0
77 F S SCTP=$O(^SCTM(404.57,"D",+SC44,SCTP)) Q:'SCTP S:$$OKARRAY^SCAPU1(.SCPOSA,SCTP) SCOK=1
78QTOKC Q SCOK
79 ;
80OKDATA() ;check/setup variables - return 1 if ok; 0 if error
81 N SCOK
82 S SCOK=1
83 D INIT^SCAPMCU1(.SCOK) ; set default dates & error array (if undefined)
84 IF '$D(^DPT(+$G(DFN),0)) D S SCOK=0
85 . S SCPARM("PATIENT")=$G(DFN,"Undefined")
86 . D ERR^SCAPMCU1(.SCESEQ,4045101,.SCPARM,"",.SCERR)
87 Q SCOK
Note: See TracBrowser for help on using the repository browser.