[628] | 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 | ;
|
---|