source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCAPMCU5.m@ 1133

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

initial load of WorldVistAEHR

File size: 3.1 KB
RevLine 
[613]1SCAPMCU5 ;bp/cmf - TEAM API UTILITIES ; 2 june 1999
2 ;;5.3;Scheduling;**177**;AUG 13, 1993
3 ;;1.0
4 ;
5VALHIST(SCFILE,SCTPIEN,SCVAL) ; returns valid act/inact ien pairs in SCVAL
6 ;
7 S SCFILE=$G(SCFILE,0)
8 I "^404.58^404.59^404.52^404.53^"'[SCFILE Q $$S(1)
9 S SCTPIEN=+$G(SCTPIEN,0)
10 I SCTPIEN<1!('$D(^SCTM(404.57,SCTPIEN))) Q $$S(2)
11 S SCVAL=$G(SCVAL,"")
12 I SCVAL']"" Q $$S(3)
13 ;
14 N SCCNT,SCTOP,SCX,SCACT,SCACT1,SCINACT,SCINACT1,SCFIRST,SCSTOP
15 M SCX(1)=^SCTM(SCFILE,"AIDT",SCTPIEN,1)
16 M SCX(0)=^SCTM(SCFILE,"AIDT",SCTPIEN,0)
17 S SCCNT=0
18 S SCTOP=0
19 S SCACT=-9999999 ;act dt
20 F S SCACT=$O(SCX(1,SCACT)) Q:'SCACT D
21 . S SCACT1="" ;act ien
22 . F S SCACT1=$O(SCX(1,SCACT,SCACT1),-1) Q:'SCACT1 D
23 . . S SCINACT=SCACT ;inact dt
24 . . I $D(SCX(0,SCINACT)) Q:$$INACT()
25 . . S SCINACT=$O(SCX(0,SCINACT),-1) ;next? inact dt
26 . . I SCINACT="" D Q ;current asgn
27 . . . Q:SCTOP
28 . . . D VALID
29 . . . S SCTOP=1
30 . . . Q
31 . . S SCX=$$INACT()
32 . . Q
33 . Q
34 ;
35 S SCFIRST=0_U_0
36 I $G(@SCVAL@(0))>0 D
37 . S SCCNT=@SCVAL@(0)
38 . S SCACT=$O(@SCVAL@(SCCNT,0))
39 . S SCACT1=$O(@SCVAL@(SCCNT,SCACT,0))
40 . S SCFIRST=SCACT_U_SCACT1
41 . Q
42 Q ($D(SCX(1)))!($D(SCX(0)))_U_SCFIRST
43 ;
44INACT() S SCSTOP=0
45 S SCINACT1=SCACT1 ;inact ien
46 F S SCINACT1=$O(SCX(0,SCINACT,SCINACT1)) Q:'SCINACT1!(SCSTOP) D
47 . I "^404.58^404.59^"[SCFILE D VALID Q
48 . I SCFILE=404.52,$$CP(3) D VALID Q
49 . I SCFILE=404.53,$$CP(6) D VALID Q
50 . Q
51 Q SCSTOP
52 ;
53VALID S SCCNT=SCCNT+1
54 S SCX=$S(+$G(SCINACT):-SCINACT,1:"")_U_$S(+$G(SCINACT1):SCINACT1,1:"")
55 I SCX=U,SCCNT>1 S SCCNT=SCCNT-1 Q ;latest entry ONLY should have empty inact data
56 S @SCVAL@(SCCNT,-SCACT,SCACT1)=SCX
57 S @SCVAL@(0)=SCCNT
58 S @SCVAL@("I",SCACT1,SCCNT)=""
59 K SCX(1,SCACT,SCACT1)
60 I SCINACT'="",SCINACT1'="" K SCX(0,SCINACT,SCINACT1)
61 S SCSTOP=1
62 Q
63 ;
64CP(SCX) ; if 404.52, practitioner (.03)s must match
65 ; if 404.53, preceptor (.06)s must match
66 Q $P(^SCTM(SCFILE,SCACT1,0),U,SCX)=$P(^SCTM(SCFILE,SCINACT1,0),U,SCX)
67 ;
68 ;
69ACTHIST(SCVAL,SCDATES) ;given val hist array, prior active?
70 ; input: scval = scval array produced by $$valhist call, above
71 ; scdates = standard PCMM date array
72 ;
73 ; output: p1 = prior activation: 1=yes, 0=no
74 ; p2 = active as of end date: 1=yes, 0=no
75 ; p3 = if p2=1, activation ien, else inactivation ien
76 ;
77 N SCX,SCX1,SCX2,SCA,SCDATE,SCP1,SCP2
78 I '$D(@SCVAL)!($G(@SCVAL@(0))<1) Q $$S(4)
79 I '$D(@SCDATES) Q $$S(5)
80 S SCDATE=$G(@SCDATES@("END"),DT)+.000001
81 ; arrange scval by assign date
82 F SCX=1:1:@SCVAL@(0) D
83 . S SCX1=$O(@SCVAL@(SCX,0))
84 . S SCX2=$O(@SCVAL@(SCX,SCX1,0))
85 . S SCA(SCX1,SCX2)=@SCVAL@(SCX,SCX1,SCX2)
86 . Q
87 S SCX1=+$O(SCA(SCDATE),-1)
88 S SCP1=(SCX1>0)
89 S (SCP2,SCP3)=0
90 I +SCP1 D
91 . S SCX2=$O(SCA(SCX1,""),-1)
92 . S SCX=$P(SCA(SCX1,SCX2),U)
93 . S SCDATE=SCDATE-.000001
94 . I (SCX="")!(SCX'<SCDATE) S SCP2=1
95 . S SCP3=$S(SCP2=1:SCX2,1:$P(SCA(SCX1,SCX2),U,2))
96 Q SCP1_U_SCP2_U_SCP3
97 ;
98S(SCX) Q "Invalid "_$P($T(T+SCX),";;",2)
99 ;
100T ;
101 ;;File Number;;
102 ;;Team Position Ien;;
103 ;;(null) Result Array;;
104 ;;(null) History Array;;
105 ;;(null) Date Array;;
106 ;
Note: See TracBrowser for help on using the repository browser.