| 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 | ; | 
|---|