1 | SCAPMC8A ;bp/cmf - Build "ALL" array for $$PRTP^SCAPCM8 ;13 June 1999
|
---|
2 | ;;5.3;Scheduling;**177,204**;AUG 13, 1993
|
---|
3 | ;
|
---|
4 | TPALL(SCFILE) ;
|
---|
5 | N SCD1,SCD0,SCAN,SCX,SCIEN,SCFLD
|
---|
6 | N SCP1,SCP2,SCP3,SCP4,SCP5,SCP6,SCP7
|
---|
7 | ;
|
---|
8 | G:'$D(^SCTM(SCFILE,"B",SCTP)) TPQUIT
|
---|
9 | S SCD1=@SCDATES@("BEGIN") ;begin date range
|
---|
10 | S SCD0=@SCDATES@("END") ;end date range
|
---|
11 | ;
|
---|
12 | LOOP S SCAN=0 ;incrementor
|
---|
13 | S SCP7=0 ;pos asgn ien
|
---|
14 | F S SCP7=$O(^SCTM(SCFILE,"B",SCTP,SCP7)) Q:'SCP7 D
|
---|
15 | . N SCX,SCP1,SCP2,SCP3,SCP4,SCP5,SCP6
|
---|
16 | . Q:'$D(^SCTM(SCFILE,SCP7,0))
|
---|
17 | . S SCIEN=SCP7_","
|
---|
18 | . S SCFLD=$S(SCFILE=404.52:".02;.03;.04",1:".02;.04;.06")
|
---|
19 | . D GETS^DIQ(SCFILE,SCIEN,SCFLD,"IE","SCX")
|
---|
20 | . Q:'$D(SCX)
|
---|
21 | . S SCP3=$G(SCX(SCFILE,SCIEN,.02,"I")) ;pos asgn date int
|
---|
22 | . Q:(SCP3<SCD1)!(SCP3>SCD0)
|
---|
23 | . S SCAN=SCAN+1
|
---|
24 | . S SCP1=$G(SCX(SCFILE,SCIEN,.04,"I")) ;status int code
|
---|
25 | . S SCP2=$G(SCX(SCFILE,SCIEN,.04,"E")) ;status ext form
|
---|
26 | . S SCP4=$G(SCX(SCFILE,SCIEN,.02,"E")) ;pos asgn date ext
|
---|
27 | . D:SCFILE=404.52
|
---|
28 | . . S SCP5=$G(SCX(SCFILE,SCIEN,.03,"I")) ;practition ien
|
---|
29 | . . S SCP6=$G(SCX(SCFILE,SCIEN,.03,"E")) ;practitioner name
|
---|
30 | . . Q
|
---|
31 | . D:SCFILE=404.53
|
---|
32 | . . S SCP5=$G(SCX(SCFILE,SCIEN,.06,"I")) ;precept posn ien
|
---|
33 | . . S SCP6=$G(SCX(SCFILE,SCIEN,.06,"E")) ;precept posn name
|
---|
34 | . . Q
|
---|
35 | . S @SCLIST@("ALL",SCFILE,0)=SCAN
|
---|
36 | . S @SCLIST@("ALL",SCFILE,SCAN)=SCP1_U_SCP2_U_SCP3_U_SCP4_U_SCP5_U_SCP6_U_SCP7
|
---|
37 | ;
|
---|
38 | TPQUIT Q
|
---|
39 | ;
|
---|