Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: SCAPMCU5

SCAPMCU5.m

Go to the documentation of this file.
  1. SCAPMCU5 ;bp/cmf - TEAM API UTILITIES ; 2 june 1999
  1. ;;5.3;Scheduling;**177**;AUG 13, 1993
  1. ;;1.0
  1. ;
  1. VALHIST(SCFILE,SCTPIEN,SCVAL) ; returns valid act/inact ien pairs in SCVAL
  1. ;
  1. S SCFILE=$G(SCFILE,0)
  1. I "^404.58^404.59^404.52^404.53^"'[SCFILE Q $$S(1)
  1. S SCTPIEN=+$G(SCTPIEN,0)
  1. I SCTPIEN<1!('$D(^SCTM(404.57,SCTPIEN))) Q $$S(2)
  1. S SCVAL=$G(SCVAL,"")
  1. I SCVAL']"" Q $$S(3)
  1. ;
  1. N SCCNT,SCTOP,SCX,SCACT,SCACT1,SCINACT,SCINACT1,SCFIRST,SCSTOP
  1. M SCX(1)=^SCTM(SCFILE,"AIDT",SCTPIEN,1)
  1. M SCX(0)=^SCTM(SCFILE,"AIDT",SCTPIEN,0)
  1. S SCCNT=0
  1. S SCTOP=0
  1. S SCACT=-9999999 ;act dt
  1. F S SCACT=$O(SCX(1,SCACT)) Q:'SCACT D
  1. . S SCACT1="" ;act ien
  1. . F S SCACT1=$O(SCX(1,SCACT,SCACT1),-1) Q:'SCACT1 D
  1. . . S SCINACT=SCACT ;inact dt
  1. . . I $D(SCX(0,SCINACT)) Q:$$INACT()
  1. . . S SCINACT=$O(SCX(0,SCINACT),-1) ;next? inact dt
  1. . . I SCINACT="" D Q ;current asgn
  1. . . . Q:SCTOP
  1. . . . D VALID
  1. . . . S SCTOP=1
  1. . . . Q
  1. . . S SCX=$$INACT()
  1. . . Q
  1. . Q
  1. ;
  1. S SCFIRST=0_U_0
  1. I $G(@SCVAL@(0))>0 D
  1. . S SCCNT=@SCVAL@(0)
  1. . S SCACT=$O(@SCVAL@(SCCNT,0))
  1. . S SCACT1=$O(@SCVAL@(SCCNT,SCACT,0))
  1. . S SCFIRST=SCACT_U_SCACT1
  1. . Q
  1. Q ($D(SCX(1)))!($D(SCX(0)))_U_SCFIRST
  1. ;
  1. INACT() S SCSTOP=0
  1. S SCINACT1=SCACT1 ;inact ien
  1. F S SCINACT1=$O(SCX(0,SCINACT,SCINACT1)) Q:'SCINACT1!(SCSTOP) D
  1. . I "^404.58^404.59^"[SCFILE D VALID Q
  1. . I SCFILE=404.52,$$CP(3) D VALID Q
  1. . I SCFILE=404.53,$$CP(6) D VALID Q
  1. . Q
  1. Q SCSTOP
  1. ;
  1. VALID S SCCNT=SCCNT+1
  1. S SCX=$S(+$G(SCINACT):-SCINACT,1:"")_U_$S(+$G(SCINACT1):SCINACT1,1:"")
  1. I SCX=U,SCCNT>1 S SCCNT=SCCNT-1 Q ;latest entry ONLY should have empty inact data
  1. S @SCVAL@(SCCNT,-SCACT,SCACT1)=SCX
  1. S @SCVAL@(0)=SCCNT
  1. S @SCVAL@("I",SCACT1,SCCNT)=""
  1. K SCX(1,SCACT,SCACT1)
  1. I SCINACT'="",SCINACT1'="" K SCX(0,SCINACT,SCINACT1)
  1. S SCSTOP=1
  1. Q
  1. ;
  1. CP(SCX) ; if 404.52, practitioner (.03)s must match
  1. ; if 404.53, preceptor (.06)s must match
  1. Q $P(^SCTM(SCFILE,SCACT1,0),U,SCX)=$P(^SCTM(SCFILE,SCINACT1,0),U,SCX)
  1. ;
  1. ;
  1. ACTHIST(SCVAL,SCDATES) ;given val hist array, prior active?
  1. ; input: scval = scval array produced by $$valhist call, above
  1. ; scdates = standard PCMM date array
  1. ;
  1. ; output: p1 = prior activation: 1=yes, 0=no
  1. ; p2 = active as of end date: 1=yes, 0=no
  1. ; p3 = if p2=1, activation ien, else inactivation ien
  1. ;
  1. N SCX,SCX1,SCX2,SCA,SCDATE,SCP1,SCP2
  1. I '$D(@SCVAL)!($G(@SCVAL@(0))<1) Q $$S(4)
  1. I '$D(@SCDATES) Q $$S(5)
  1. S SCDATE=$G(@SCDATES@("END"),DT)+.000001
  1. ; arrange scval by assign date
  1. F SCX=1:1:@SCVAL@(0) D
  1. . S SCX1=$O(@SCVAL@(SCX,0))
  1. . S SCX2=$O(@SCVAL@(SCX,SCX1,0))
  1. . S SCA(SCX1,SCX2)=@SCVAL@(SCX,SCX1,SCX2)
  1. . Q
  1. S SCX1=+$O(SCA(SCDATE),-1)
  1. S SCP1=(SCX1>0)
  1. S (SCP2,SCP3)=0
  1. I +SCP1 D
  1. . S SCX2=$O(SCA(SCX1,""),-1)
  1. . S SCX=$P(SCA(SCX1,SCX2),U)
  1. . S SCDATE=SCDATE-.000001
  1. . I (SCX="")!(SCX'<SCDATE) S SCP2=1
  1. . S SCP3=$S(SCP2=1:SCX2,1:$P(SCA(SCX1,SCX2),U,2))
  1. Q SCP1_U_SCP2_U_SCP3
  1. ;
  1. S(SCX) Q "Invalid "_$P($T(T+SCX),";;",2)
  1. ;
  1. T ;
  1. ;;File Number;;
  1. ;;Team Position Ien;;
  1. ;;(null) Result Array;;
  1. ;;(null) History Array;;
  1. ;;(null) Date Array;;
  1. ;