| 1 | SCAPMC29 ;ALB/REW - TEAM APIs:CLPT ; 2/17/00 1:33pm
|
|---|
| 2 | ;;5.3;Scheduling;**41,210**;AUG 13, 1993
|
|---|
| 3 | ;;1.0
|
|---|
| 4 | CLPT(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 | ;
|
|---|
| 41 | ST 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)=""
|
|---|
| 71 | PTCLQ Q $G(@SCERR@(0))<1
|
|---|
| 72 | ;
|
|---|
| 73 | OKCLIN(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
|
|---|
| 78 | QTOKC Q SCOK
|
|---|
| 79 | ;
|
|---|
| 80 | OKDATA() ;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
|
|---|
