| 1 | SCAPMCU5 ;bp/cmf - TEAM API UTILITIES ; 2 june 1999
|
|---|
| 2 | ;;5.3;Scheduling;**177**;AUG 13, 1993
|
|---|
| 3 | ;;1.0
|
|---|
| 4 | ;
|
|---|
| 5 | VALHIST(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 | ;
|
|---|
| 44 | INACT() 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 | ;
|
|---|
| 53 | VALID 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 | ;
|
|---|
| 64 | CP(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 | ;
|
|---|
| 69 | ACTHIST(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 | ;
|
|---|
| 98 | S(SCX) Q "Invalid "_$P($T(T+SCX),";;",2)
|
|---|
| 99 | ;
|
|---|
| 100 | T ;
|
|---|
| 101 | ;;File Number;;
|
|---|
| 102 | ;;Team Position Ien;;
|
|---|
| 103 | ;;(null) Result Array;;
|
|---|
| 104 | ;;(null) History Array;;
|
|---|
| 105 | ;;(null) Date Array;;
|
|---|
| 106 | ;
|
|---|
