SCAPMC8A.m

SCAPMC8A ;bp/cmf - Build "ALL" array for $$PRTP^SCAPCM8 ;13 June 1999

 ;;5.3;Scheduling;**177,204,1015**;AUG 13, 1993;Build 21

 ;

TPALL(SCFILE) ;

 N SCD1,SCD0,SCAN,SCX,SCIEN,SCFLD

 N SCP1,SCP2,SCP3,SCP4,SCP5,SCP6,SCP7

 ;

 G:'$D(^SCTM(SCFILE,"B",SCTP)) TPQUIT

 S SCD1=@SCDATES@("BEGIN")                  ;begin date range

 S SCD0=@SCDATES@("END")                    ;end date range

 ;

LOOP S SCAN=0                                   ;incrementor

 S SCP7=0                                   ;pos asgn ien

 F  S SCP7=$O(^SCTM(SCFILE,"B",SCTP,SCP7)) Q:'SCP7  D

 . N SCX,SCP1,SCP2,SCP3,SCP4,SCP5,SCP6

 . Q:'$D(^SCTM(SCFILE,SCP7,0))

 . S SCIEN=SCP7_","

 . S SCFLD=$S(SCFILE=404.52:".02;.03;.04",1:".02;.04;.06")

 . D GETS^DIQ(SCFILE,SCIEN,SCFLD,"IE","SCX")

 . Q:'$D(SCX)

 . S SCP3=$G(SCX(SCFILE,SCIEN,.02,"I"))         ;pos asgn date int

 . Q:(SCP3<SCD1)!(SCP3>SCD0)

 . S SCAN=SCAN+1

 . S SCP1=$G(SCX(SCFILE,SCIEN,.04,"I"))         ;status int code

 . S SCP2=$G(SCX(SCFILE,SCIEN,.04,"E"))         ;status ext form

 . S SCP4=$G(SCX(SCFILE,SCIEN,.02,"E"))         ;pos asgn date ext

 . D:SCFILE=404.52

 . . S SCP5=$G(SCX(SCFILE,SCIEN,.03,"I"))         ;practition ien

 . . S SCP6=$G(SCX(SCFILE,SCIEN,.03,"E"))         ;practitioner name

 . . Q

 . D:SCFILE=404.53

 . . S SCP5=$G(SCX(SCFILE,SCIEN,.06,"I"))         ;precept posn ien

 . . S SCP6=$G(SCX(SCFILE,SCIEN,.06,"E"))         ;precept posn name

 . . Q

 . S @SCLIST@("ALL",SCFILE,0)=SCAN

 . S @SCLIST@("ALL",SCFILE,SCAN)=SCP1_U_SCP2_U_SCP3_U_SCP4_U_SCP5_U_SCP6_U_SCP7

 ;

TPQUIT Q

 ;

SCAPMC8A  ;bp/cmf - Build "ALL" array for $$PRTP^SCAPCM8 ;13 June 1999

 +1       ;;5.3;Scheduling;**177,204,1015**;AUG 13, 1993;Build 21

 +2       ;

TPALL(SCFILE) ;

 +1        NEW SCD1,SCD0,SCAN,SCX,SCIEN,SCFLD

 +2        NEW SCP1,SCP2,SCP3,SCP4,SCP5,SCP6,SCP7

 +3       ;

 +4        IF '$DATA(^SCTM(SCFILE,"B",SCTP))

               GOTO TPQUIT

 +5       ;begin date range

           SET SCD1=@SCDATES@("BEGIN")

 +6       ;end date range

           SET SCD0=@SCDATES@("END")

 +7       ;

LOOP      ;incrementor

           SET SCAN=0

 +1       ;pos asgn ien

           SET SCP7=0

 +2        FOR 

               SET SCP7=$ORDER(^SCTM(SCFILE,"B",SCTP,SCP7))

               IF 'SCP7

                   QUIT 

               Begin DoDot:1

 +3                NEW SCX,SCP1,SCP2,SCP3,SCP4,SCP5,SCP6

 +4                IF '$DATA(^SCTM(SCFILE,SCP7,0))

                       QUIT 

 +5                SET SCIEN=SCP7_","

 +6                SET SCFLD=$SELECT(SCFILE=404.52:".02;.03;.04",1:".02;.04;.06")

 +7                DO GETS^DIQ(SCFILE,SCIEN,SCFLD,"IE","SCX")

 +8                IF '$DATA(SCX)

                       QUIT 

 +9       ;pos asgn date int

                   SET SCP3=$GET(SCX(SCFILE,SCIEN,.02,"I"))

 +10               IF (SCP3<SCD1)!(SCP3>SCD0)

                       QUIT 

 +11               SET SCAN=SCAN+1

 +12      ;status int code

                   SET SCP1=$GET(SCX(SCFILE,SCIEN,.04,"I"))

 +13      ;status ext form

                   SET SCP2=$GET(SCX(SCFILE,SCIEN,.04,"E"))

 +14      ;pos asgn date ext

                   SET SCP4=$GET(SCX(SCFILE,SCIEN,.02,"E"))

 +15               IF SCFILE=404.52

                       Begin DoDot:2

 +16      ;practition ien

                           SET SCP5=$GET(SCX(SCFILE,SCIEN,.03,"I"))

 +17      ;practitioner name

                           SET SCP6=$GET(SCX(SCFILE,SCIEN,.03,"E"))

 +18                       QUIT 

                       End DoDot:2

 +19               IF SCFILE=404.53

                       Begin DoDot:2

 +20      ;precept posn ien

                           SET SCP5=$GET(SCX(SCFILE,SCIEN,.06,"I"))

 +21      ;precept posn name

                           SET SCP6=$GET(SCX(SCFILE,SCIEN,.06,"E"))

 +22                       QUIT 

                       End DoDot:2

 +23               SET @SCLIST@("ALL",SCFILE,0)=SCAN

 +24               SET @SCLIST@("ALL",SCFILE,SCAN)=SCP1_U_SCP2_U_SCP3_U_SCP4_U_SCP5_U_SCP6_U_SCP7

               End DoDot:1

 +25      ;

TPQUIT     QUIT 

 +1       ;