source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCAPMC8A.m@ 1361

Last change on this file since 1361 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.5 KB
RevLine 
[613]1SCAPMC8A ;bp/cmf - Build "ALL" array for $$PRTP^SCAPCM8 ;13 June 1999
2 ;;5.3;Scheduling;**177,204**;AUG 13, 1993
3 ;
4TPALL(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 ;
12LOOP 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 ;
38TPQUIT Q
39 ;
Note: See TracBrowser for help on using the repository browser.