source: WorldVistAEHR/trunk/r/PAID-PRS/PRSATE4.m

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

initial load of WorldVistAEHR

File size: 1.5 KB
Line 
1PRSATE4 ; HISC/REL-Second Tour Entry ;8/12/94 10:12
2 ;;4.0;PAID;;Sep 21, 1995
3 W:'TYP !!,"Warning: This second tour will be temporary and will not carry forward."
4 R !!,"For which Day (1-14) do you wish to enter a second Tour? ",DAY:DTIME Q:'$T!(DAY["^")
5 I DAY'?1.2N!(DAY<1)!(DAY>14) W *7,!!,"Enter a Day Number from 1 to 14." G PRSATE4
6 S TD=$P($G(^PRST(458,PPI,"E",DFN,"D",DAY,0)),"^",13) G:'TD P0
7 W !!,"Existing Second Tour ",$P($G(^PRST(457.1,TD,0)),"^",1)," will be deleted."
8 S $P(^PRST(458,PPI,"E",DFN,"D",DAY,0),"^",13,15)="^^" K ^(4)
9P0 I $P($G(^PRST(458,PPI,"E",DFN,"D",DAY,0)),"^",2)<6 W *7,!!,"A second Tour is not valid on this day." G PRSATE4
10 K DIC S DIC="^PRST(455.5,",DIC(0)="AEQM",DIC("A")="T&L on which Tour will be worked: ",DIC("B")=TLE W ! D ^DIC Q:Y<1 K DIC S WTL=+Y
11P1 S DIC="^PRST(457.1,",DIC(0)="AEQMN"
12 S DIC("S")="I Y>5,$P(^PRST(457.1,+Y,0),U,4)!($D(^PRST(457.1,+Y,""T"",""B"",WTL)))"
13 S DIC("A")="Select TOUR OF DUTY: " W ! D ^DIC K DIC Q:Y'>0
14 S TD=+Y,Y=$G(^PRST(457.1,TD,1)),TDH=$P(^(0),"^",6)
15 S (ZENT,STR)="" D OT^PRSATP,VS^PRSATE0 I STR'="" W *7,!!,STR G P1
16 K ^PRST(458,PPI,"E",DFN,"D",DAY,2),^(3),^(4),^(10)
17 S $P(^PRST(458,PPI,"E",DFN,"D",DAY,0),"^",13,15)=TD_"^"_TDH_"^"_$S(WTL=TLI:"",1:WTL),^(4)=Y
18 S ^PRST(458,"ATC",DFN,PPI,DAY)=""
19 S HRS=0 F DAY=1:1:14 S Z=$P($G(^PRST(458,PPI,"E",DFN,"D",DAY,0)),"^",8) S:Z HRS=HRS+Z S Z=$P($G(^(0)),"^",14) S:Z HRS=HRS+Z
20 W " ... done" D:HRS'=NH W1 Q
21W1 Q:NH=112 W *7,!!,"Warning: Normal Hours are "_NH_"; Tour Hours are "_HRS Q
Note: See TracBrowser for help on using the repository browser.