Changeset 623 for WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCAPMC29.m
- Timestamp:
- Dec 4, 2009, 12:11:15 AM (14 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCAPMC29.m
r613 r623 1 SCAPMC29 2 ;;5.3;Scheduling;**41,210,520**;AUG 13, 1993;Build 26 3 4 CLPT(DFN,SCDATES,SCTEAMA,SCLIST,SCERR) 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 ST 42 43 44 45 46 47 48 49 50 ;S SCX=0 F S SCX=$O(^DPT(DFN,"DE",SCX)) Q:'SCX D51 ;.S SC44=+$G(^DPT(DFN,"DE",SCX,0))52 ;.Q:'SC4453 ;.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 D56 ;..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)+163 ;..;bp/ar nois brx-1298-12323 prevent undefined variable error64 ;..;New code begins65 ;..Q:'SCACT66 ;..Q:'SCN67 ;.;End of brx-1298-1232368 ;..S @SCLIST@(0)=SCN69 ;..S @SCLIST@(SCN)=SC44_U_SCCLNM_U_SCACT_U_SCINACT_U_SCACOPT_U_SCREVDT70 ;..S @SCLIST@("SCCL",SC44,SCACT,SCN)=""71 PTCLQ 72 73 OKCLIN(SC44,SCPOSA) 74 75 76 77 F S SCTP=$O(^SCTM(404.57,"E",+SC44,SCTP)) Q:'SCTP S:$$OKARRAY^SCAPU1(.SCPOSA,SCTP) SCOK=178 QTOKC 79 80 OKDATA() 81 82 83 84 85 86 87 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
Note:
See TracChangeset
for help on using the changeset viewer.