| 1 | PRSATPH ; HISC/REL-Exception Utilities ;12/9/93 09:53
|
|---|
| 2 | ;;4.0;PAID;;Sep 21, 1995
|
|---|
| 3 | NX ; Determine first start time of next day
|
|---|
| 4 | I DAY<14 S TC1=$P($G(^PRST(458,PPI,"E",DFN,"D",DAY+1,0)),"^",2),TC2=$P($G(^(0)),"^",13) G N1
|
|---|
| 5 | I $D(^PRST(458,PPI+1,"E",DFN,"D",1,0)) S TC1=$P(^(0),"^",2),TC2=$P($G(^(0)),"^",13) G N1
|
|---|
| 6 | S ZPX=$G(^PRST(458,PPI,"E",DFN,"D",1,0)),TC1=$P(ZPX,"^",2),TC2=""
|
|---|
| 7 | S:$P(ZPX,"^",3) TC1=$P(ZPX,"^",4)
|
|---|
| 8 | N1 S TC1=$G(^PRST(457.1,+TC1,1)),Z9=""
|
|---|
| 9 | F KK=1:3 Q:$P(TC1,"^",KK)="" S Z=$P(TC1,"^",KK+2) I $S('Z:1,1:$P($G(^PRST(457.2,Z,0)),"^",2)="RG") S Z9=$P(TC1,"^",KK) Q
|
|---|
| 10 | S TC1=Z9 G:'TC2 N2
|
|---|
| 11 | S TC2=$G(^PRST(457.1,TC2,1)),Z9=""
|
|---|
| 12 | F KK=1:3 Q:$P(TC2,"^",KK)="" S Z=$P(TC2,"^",KK+2) I $S('Z:1,1:$P($G(^PRST(457.2,Z,0)),"^",2)="RG") S Z9=$P(TC2,"^",KK) Q
|
|---|
| 13 | S TC2=Z9
|
|---|
| 14 | N2 N X,Y S X=TC1,Y=0 D MIL^PRSATIM S TC1=Y
|
|---|
| 15 | I TC2'="" S X=TC2,Y=0 D MIL^PRSATIM S:Y<TC1 TC1=Y
|
|---|
| 16 | S TC1=TC1\100*60+(TC1#100) I $P(Y0,"^",2)>TC1 S ERR=10 D ERR^PRSATPE
|
|---|
| 17 | Q
|
|---|
| 18 | PR ; Determine last end time of previous day
|
|---|
| 19 | I DAY>1 S TC1=$P($G(^PRST(458,PPI,"E",DFN,"D",DAY-1,0)),"^",2),TC2=$P($G(^(0)),"^",13)
|
|---|
| 20 | E Q:'$D(^PRST(458,PPI-1,"E",DFN,"D",14,0)) S TC1=$P(^(0),"^",2),TC2=$P($G(^(0)),"^",13)
|
|---|
| 21 | I $P($G(^PRST(457.1,+TC1,0)),"^",5)="Y" S ZPX=$G(^(1))
|
|---|
| 22 | E Q:$P($G(^PRST(457.1,+TC2,0)),"^",5)'="Y" S ZPX=$G(^(1))
|
|---|
| 23 | N X,Y S Z="",DY2=1 F KK=1:3:19 S X=$P(ZPX,"^",KK,KK+1) Q:"^"[X D CNV^PRSATIM S:$P(Y,"^",2)'>$P(Y,"^",1) DY2=2 I DY2=2 S Z9=$P(ZPX,"^",KK+2) I $S('Z9:1,1:$P($G(^PRST(457.2,Z9,0)),"^",2)="RG") S Z=$P(Y,"^",2)
|
|---|
| 24 | Q:Z="" I Z>$P(Y0,"^",1) S ERR=11 D ERR^PRSATPE
|
|---|
| 25 | Q
|
|---|
| 26 | UN ; Check UN against OT CT ON SB in tour
|
|---|
| 27 | K TUN F KK=1:3 Q:$P(X1,"^",KK)="" S Z=$P(X1,"^",KK+2) I $S('Z:0,1:$P($G(^PRST(457.2,Z,0)),"^",2)'="RG") D
|
|---|
| 28 | .S X=$P(X1,"^",KK,KK+1) D CNV^PRSATIM S Z1=$P(Y,"^",1),Z2=$P(Y,"^",2) D V0
|
|---|
| 29 | .I Z1'="",$G(TUN(Z1))="*" K TUN(Z1) S TUN(Z2)="*" Q
|
|---|
| 30 | .S TUN(Z1)="",TUN(Z2)="*" Q
|
|---|
| 31 | I X4'="" F KK=1:3 Q:$P(X4,"^",KK)="" S Z=$P(X4,"^",KK+2) I $S('Z:0,1:$P($G(^PRST(457.2,Z,0)),"^",2)'="RG") D
|
|---|
| 32 | .S X=$P(X4,"^",KK,KK+1) D CNV^PRSATIM S Z1=$P(Y,"^",1),Z2=$P(Y,"^",2) D V0
|
|---|
| 33 | .I Z1'="",$G(TUN(Z1))="*" K TUN(Z1) S TUN(Z2)="*" Q
|
|---|
| 34 | .S TUN(Z1)="",TUN(Z2)="*" Q
|
|---|
| 35 | S Z1=$P(Y0,"^",1),Z2=$P(Y0,"^",2) D V0
|
|---|
| 36 | S Z1=$O(TUN(Z1)) S:Z1'="" Z1=TUN(Z1)
|
|---|
| 37 | S Z2=$O(TUN(Z2-1)) S:Z2'="" Z2=TUN(Z2)
|
|---|
| 38 | I Z1'="*"!(Z2'="*") S ERR=12 D ERR^PRSATPE
|
|---|
| 39 | Q
|
|---|
| 40 | V0 I Z2>Z1 S:$O(TUN(""))'<Z2 Z1=Z1+1440,Z2=Z2+1440 Q
|
|---|
| 41 | S Z2=Z2+1440 Q
|
|---|
