source: WorldVistAEHR/trunk/r/PAID-PRS/PRSALVU.m@ 619

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

initial load of WorldVistAEHR

File size: 1.8 KB
Line 
1PRSALVU ; HISC/REL-Leave Length ;5/31/95 12:21
2 ;;4.0;PAID;;Sep 21, 1995
3 S Z=$G(^PRST(458.1,DA,0)) I $E(ENT,1,2)["D" G D
4 I $P(Z,"^",7)="ML" G D
5H ; Calculate Hours
6 S TYL="H",D1=$P(Z,"^",3) D PP^PRSAPPU
7 I D1=$P(Z,"^",5) G 1
8 ; Calculate first day
9 D TC S X1=$G(^PRST(457.1,+TC,1))
10 S X2="MID" F K=1:3 Q:$P(X1,"^",K)="" S %=$P(X1,"^",K+2) I $S('%:1,1:$P($G(^PRST(457.2,%,0)),"^",2)="RG") S X2=$P(X1,"^",K+1)
11 S X=$P(Z,"^",4)_"^"_X2 D CNV^PRSATIM S TIM=$P(Y,"^",2)-$P(Y,"^",1)/60 S:TIM<0 TIM=0
12 D RG I TIM>RG S TIM=RG
13 E S X1=$P(X1,"^",3) I X1,TIM>4.75 S TIM=TIM-(X1/60)
14 ; Calculate intermediate days
150 S DAY=DAY+1 S:DAY=15 DAY=1,PPI=$S('PPI:PPI,$D(^PRST(458,PPI+1)):PPI+1,1:"")
16 S X1=D1,X2=1 D C^%DTC S D1=X I X'<$P(Z,"^",5) G L
17 D TC,RG S TIM=TIM+RG G 0
18L ; Calculate last day
19 D TC S X1=$G(^PRST(457.1,+TC,1))
20 S X2="MID" F K=1:3 Q:$P(X1,"^",K)="" S %=$P(X1,"^",K+2) I $S('%:1,1:$P($G(^PRST(457.2,%,0)),"^",2)="RG") S X2=$P(X1,"^",K) Q
21 S X=X2_"^"_$P(Z,"^",6) D CNV^PRSATIM S T1=$P(Y,"^",2)-$P(Y,"^",1)/60 S:T1<0 T1=0
22 D RG I T1>RG S T1=RG
23 E S X1=$P(X1,"^",3) I X1,T1>4.75 S T1=T1-(X1/60)
24 S TIM=TIM+T1 G S
251 ; One Day
26 S X=$P(Z,"^",4)_"^"_$P(Z,"^",6) D CNV^PRSATIM S TIM=$P(Y,"^",2)-$P(Y,"^",1)/60
27 D TC,RG I TIM>RG S TIM=RG G S
28 S X1=$P(X1,"^",3) I X1,TIM>4.75 S TIM=TIM-(X1/60)
29 G S
30TC ; Get tour
31 I PPI S X1=$G(^PRST(458,PPI,"E",DFN,"D",DAY,0)),TC=$P(X1,"^",2)
32 E S PPI=$P(^PRST(458,0),"^",3),X1=$G(^PRST(458,PPI,"E",DFN,"D",DAY,0)),TC=$P(X1,"^",2) I $P(X1,"^",3),$P(X1,"^",4) S TC=$P(X1,"^",4)
33 Q
34RG ; Get X1,RG
35 S X1=$G(^PRST(457.1,+TC,0)),RG=$P(X1,"^",6) Q:RG'="" I TC<5 S RG=0 Q
36 I $E(AC,2)=1,NH=48 S RG=12 Q
37 S RG=$S(NH>80:24,NH<80:NH\10,1:8) Q
38D ; Calculate Days
39 S X2=$P(Z,"^",3),X1=$P(Z,"^",5) I 'X1!('X2) Q
40 D ^%DTC S TIM=X+1,TYL="D" G S
41S ; Store length
42 S $P(^PRST(458.1,DA,0),"^",15,16)=TIM_"^"_TYL Q
Note: See TracBrowser for help on using the repository browser.