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

SCAPMC8A.m

Go to the documentation of this file.
  1. SCAPMC8A ;bp/cmf - Build "ALL" array for $$PRTP^SCAPCM8 ;13 June 1999
  1. ;;5.3;Scheduling;**177,204**;AUG 13, 1993
  1. ;
  1. TPALL(SCFILE) ;
  1. N SCD1,SCD0,SCAN,SCX,SCIEN,SCFLD
  1. N SCP1,SCP2,SCP3,SCP4,SCP5,SCP6,SCP7
  1. ;
  1. G:'$D(^SCTM(SCFILE,"B",SCTP)) TPQUIT
  1. S SCD1=@SCDATES@("BEGIN") ;begin date range
  1. S SCD0=@SCDATES@("END") ;end date range
  1. ;
  1. LOOP S SCAN=0 ;incrementor
  1. S SCP7=0 ;pos asgn ien
  1. F S SCP7=$O(^SCTM(SCFILE,"B",SCTP,SCP7)) Q:'SCP7 D
  1. . N SCX,SCP1,SCP2,SCP3,SCP4,SCP5,SCP6
  1. . Q:'$D(^SCTM(SCFILE,SCP7,0))
  1. . S SCIEN=SCP7_","
  1. . S SCFLD=$S(SCFILE=404.52:".02;.03;.04",1:".02;.04;.06")
  1. . D GETS^DIQ(SCFILE,SCIEN,SCFLD,"IE","SCX")
  1. . Q:'$D(SCX)
  1. . S SCP3=$G(SCX(SCFILE,SCIEN,.02,"I")) ;pos asgn date int
  1. . Q:(SCP3<SCD1)!(SCP3>SCD0)
  1. . S SCAN=SCAN+1
  1. . S SCP1=$G(SCX(SCFILE,SCIEN,.04,"I")) ;status int code
  1. . S SCP2=$G(SCX(SCFILE,SCIEN,.04,"E")) ;status ext form
  1. . S SCP4=$G(SCX(SCFILE,SCIEN,.02,"E")) ;pos asgn date ext
  1. . D:SCFILE=404.52
  1. . . S SCP5=$G(SCX(SCFILE,SCIEN,.03,"I")) ;practition ien
  1. . . S SCP6=$G(SCX(SCFILE,SCIEN,.03,"E")) ;practitioner name
  1. . . Q
  1. . D:SCFILE=404.53
  1. . . S SCP5=$G(SCX(SCFILE,SCIEN,.06,"I")) ;precept posn ien
  1. . . S SCP6=$G(SCX(SCFILE,SCIEN,.06,"E")) ;precept posn name
  1. . . Q
  1. . S @SCLIST@("ALL",SCFILE,0)=SCAN
  1. . S @SCLIST@("ALL",SCFILE,SCAN)=SCP1_U_SCP2_U_SCP3_U_SCP4_U_SCP5_U_SCP6_U_SCP7
  1. ;
  1. TPQUIT Q
  1. ;