Changeset 623 for WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCMCDD2.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/SCMCDD2.m
r613 r623 1 SCMCDD2 2 ;;5.3;Scheduling;**41,107,520**;AUG 13, 1993;Build 26 3 4 USEPCDEF(SCCL) 5 6 7 SETSCTM(SCTP,SCCL,SCTMNM) 8 9 10 11 12 13 14 KILLSCTM(SCTP,SCCL,SCTMNM) 15 16 17 18 19 20 21 22 OKTMCL(SCTM,SCTP,SCCL) 23 24 25 26 F S SCXTP=$O(^SCTM(404.57,"E",SCCL,SCXTP)) Q:('SCXTP)!(SCXTP=SCTP) D27 28 29 30 STSCTMNM(SCTM,SCTMNM) 31 32 33 34 35 36 37 38 39 40 KLSCTMNM(SCTM,SCTMNM) 41 42 43 44 45 46 47 48 49 1 SCMCDD2 ;ALB/REW - DD Calls used by PCMM ; 27 March 1996 2 ;;5.3;Scheduling;**41,107**;AUG 13, 1993 3 ;1 4 USEPCDEF(SCCL) ;how should pc practitioner be used for clinic 5 ; return 2=always default 1=default if no provider listed 0 -never 6 Q 2 7 SETSCTM(SCTP,SCCL,SCTMNM) ;create 'TEAM' x-ref for Hospital Location File (#44) 8 ; x=sccl, da=sctp sctmnm=name of team 9 Q:'$G(SCTP)!('$G(SCCL)) 10 S SCTMNM=$G(SCTMNM,$P(^SCTM(404.51,+$P(^SCTM(404.57,SCTP,0),U,2),0),U)) 11 S:$L(SCTMNM) ^SC("TEAM",SCTMNM,+SCCL)="" 12 Q 13 ; 14 KILLSCTM(SCTP,SCCL,SCTMNM) ;kill 'TEAM' x-ref for File #44 (if no other positions from team have this as associated clinic) 15 ; x=sccl, da=sctp sctmnm=name of team 16 N SCTM 17 Q:'$G(SCTP)!('$G(SCCL)) 18 S SCTM=+$P(^SCTM(404.57,SCTP,0),U,2) 19 S SCTMNM=$G(SCTMNM,$P(^SCTM(404.51,+SCTM,0),U)) 20 K:$L(SCTMNM)&('$$OKTMCL(SCTM,SCTP,SCCL)) ^SC("TEAM",SCTMNM,+SCCL) 21 Q 22 OKTMCL(SCTM,SCTP,SCCL) ;does team have another position with this clinic as an assoicated clinic? 23 N SCXTP,SCOK 24 S SCOK=0 25 S SCXTP=0 26 F S SCXTP=$O(^SCTM(404.57,"D",SCCL,SCXTP)) Q:('SCXTP)!(SCXTP=SCTP) D 27 .I $P(^SCTM(404.57,SCXTP,0),U,2)'=SCTM Q 28 .S SCOK=1 29 Q SCOK 30 STSCTMNM(SCTM,SCTMNM) ;if team name changes - set for 'TEAM' xrefs for file#44 31 ; sctm=da sctmnm=x 32 Q:'$G(SCTM)!(SCTMNM="") 33 N SCTPNM,SCCL 34 S SCTPNM="" 35 F S SCTPNM=$O(^SCTM(404.57,"ATMPOS",SCTM,SCTPNM)) Q:SCTPNM="" D 36 .S SCTP=$O(^SCTM(404.57,"ATMPOS",SCTM,SCTPNM,0)) ;note: name is unique 37 .S SCCL=$P($G(^SCTM(404.57,+SCTP,0)),U,9) 38 .D:SCCL SETSCTM(SCTP,SCCL,SCTMNM) 39 Q 40 KLSCTMNM(SCTM,SCTMNM) ;if team name changes - kill 'TEAM' xrefs for file #44 41 ; sctm=da sctmnm=x 42 Q:'$G(SCTM)!(SCTMNM="") 43 N SCTPNM,SCCL 44 S SCTPNM="" 45 F S SCTPNM=$O(^SCTM(404.57,"ATMPOS",SCTM,SCTPNM)) Q:SCTPNM="" D 46 .S SCTP=$O(^SCTM(404.57,"ATMPOS",SCTM,SCTPNM,0)) ;note: name is unique 47 .S SCCL=$P($G(^SCTM(404.57,+SCTP,0)),U,9) 48 .K:SCCL ^SC("TEAM",SCTMNM) 49 Q
Note:
See TracChangeset
for help on using the changeset viewer.