PRSATE3 ; HISC/REL-Display Detailed Tour ;12/8/92 08:33
;;4.0;PAID;**132**;Sep 21, 1995;Build 13
F0 ; Display Frames
N PRSA,PRSB
K Y1,Y2 S TD=$P($G(^PRST(458,PPI,"E",DFN,"D",DAY,0)),"^",2),Y1=$G(^(1)),Y4=$G(^(4)),PRSA=$P($G(^(8)),U) I SRT="N" S Y4="" I $P($G(^(0)),"^",3) S PRSA=$P($G(^(8)),U,5),TD=$P(^(0),"^",4),Y1=$G(^PRST(457.1,+TD,1))
I Y1="" S Y1=$S(TD=1:"Day Off",TD=2:"Day Tour",TD=3!(TD=4):"Intermittent",1:"")
S TD=$P($G(^PRST(458,PPI,"E",DFN,"D",DAY+7,0)),"^",2),Y2=$G(^(1)),Y5=$G(^(4)),PRSB=$P($G(^(8)),U) I SRT="N" S Y5="" I $P($G(^(0)),"^",3) S PRSB=$P($G(^(8)),U,5),TD=$P(^(0),"^",4),Y2=$G(^PRST(457.1,+TD,1))
I Y2="" S Y2=$S(TD=1:"Day Off",TD=2:"Day Tour",TD=3!(TD=4):"Intermittent",1:"")
S DTE=$P("Sun Mon Tue Wed Thu Fri Sat"," ",DAY)
W !?2,DTE S (L2,L3)=0 I Y1="",Y2="" G EX
S0 ; Set Schedule Array
F L1=1:3:19 S A1=$P(Y1,"^",L1) Q:A1="" S L2=L2+1,Y1(L2)=A1 S:$P(Y1,"^",L1+1)'="" Y1(L2)=Y1(L2)_"-"_$P(Y1,"^",L1+1) I $P(Y1,"^",L1+2)'="" S L2=L2+1,Y1(L2)=" "_$P($G(^PRST(457.2,+$P(Y1,"^",L1+2),0)),"^",1)
G:Y4="" S1
F L1=1:3:19 S A1=$P(Y4,"^",L1) Q:A1="" S L2=L2+1,Y1(L2)=A1 S:$P(Y4,"^",L1+1)'="" Y1(L2)=Y1(L2)_"-"_$P(Y4,"^",L1+1) I $P(Y4,"^",L1+2)'="" S L2=L2+1,Y1(L2)=" "_$P($G(^PRST(457.2,+$P(Y4,"^",L1+2),0)),"^",1)
S1 ; Set Schedule Array
F L1=1:3:19 S A1=$P(Y2,"^",L1) Q:A1="" S L3=L3+1,Y2(L3)=A1 S:$P(Y2,"^",L1+1)'="" Y2(L3)=Y2(L3)_"-"_$P(Y2,"^",L1+1) I $P(Y2,"^",L1+2)'="" S L3=L3+1,Y2(L3)=" "_$P($G(^PRST(457.2,+$P(Y2,"^",L1+2),0)),"^",1)
G:Y5="" S2
F L1=1:3:19 S A1=$P(Y5,"^",L1) Q:A1="" S L3=L3+1,Y2(L3)=A1 S:$P(Y5,"^",L1+1)'="" Y2(L3)=Y2(L3)_"-"_$P(Y5,"^",L1+1) I $P(Y5,"^",L1+2)'="" S L3=L3+1,Y2(L3)=" "_$P($G(^PRST(457.2,+$P(Y5,"^",L1+2),0)),"^",1)
S2 F K=1:1 Q:'$D(Y1(K))&'$D(Y2(K)) W:K>1 ! W:K=1 ?7,PRSA W:$D(Y1(K)) ?11,Y1(K) W:K=1 ?41,PRSB W:$D(Y2(K)) ?45,Y2(K)
EX Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSATE3 1845 printed Jan 18, 2025@03:25:40 Page 2
PRSATE3 ; HISC/REL-Display Detailed Tour ;12/8/92 08:33
+1 ;;4.0;PAID;**132**;Sep 21, 1995;Build 13
F0 ; Display Frames
+1 NEW PRSA,PRSB
+2 KILL Y1,Y2
SET TD=$PIECE($GET(^PRST(458,PPI,"E",DFN,"D",DAY,0)),"^",2)
SET Y1=$GET(^(1))
SET Y4=$GET(^(4))
SET PRSA=$PIECE($GET(^(8)),U)
IF SRT="N"
SET Y4=""
IF $PIECE($GET(^(0)),"^",3)
SET PRSA=$PIECE($GET(^(8)),U,5)
SET TD=$PIECE(^(0),"^",4)
SET Y1=$GET(^PRST(457.1,+TD,1))
+3 IF Y1=""
SET Y1=$SELECT(TD=1:"Day Off",TD=2:"Day Tour",TD=3!(TD=4):"Intermittent",1:"")
+4 SET TD=$PIECE($GET(^PRST(458,PPI,"E",DFN,"D",DAY+7,0)),"^",2)
SET Y2=$GET(^(1))
SET Y5=$GET(^(4))
SET PRSB=$PIECE($GET(^(8)),U)
IF SRT="N"
SET Y5=""
IF $PIECE($GET(^(0)),"^",3)
SET PRSB=$PIECE($GET(^(8)),U,5)
SET TD=$PIECE(^(0),"^",4)
SET Y2=$GET(^PRST(457.1,+TD,1))
+5 IF Y2=""
SET Y2=$SELECT(TD=1:"Day Off",TD=2:"Day Tour",TD=3!(TD=4):"Intermittent",1:"")
+6 SET DTE=$PIECE("Sun Mon Tue Wed Thu Fri Sat"," ",DAY)
+7 WRITE !?2,DTE
SET (L2,L3)=0
IF Y1=""
IF Y2=""
GOTO EX
S0 ; Set Schedule Array
+1 FOR L1=1:3:19
SET A1=$PIECE(Y1,"^",L1)
if A1=""
QUIT
SET L2=L2+1
SET Y1(L2)=A1
if $PIECE(Y1,"^",L1+1)'=""
SET Y1(L2)=Y1(L2)_"-"_$PIECE(Y1,"^",L1+1)
IF $PIECE(Y1,"^",L1+2)'=""
SET L2=L2+1
SET Y1(L2)=" "_$PIECE($GET(^PRST(457.2,+$PIECE(Y1,"^",L1+2),0)),"^",1)
+2 if Y4=""
GOTO S1
+3 FOR L1=1:3:19
SET A1=$PIECE(Y4,"^",L1)
if A1=""
QUIT
SET L2=L2+1
SET Y1(L2)=A1
if $PIECE(Y4,"^",L1+1)'=""
SET Y1(L2)=Y1(L2)_"-"_$PIECE(Y4,"^",L1+1)
IF $PIECE(Y4,"^",L1+2)'=""
SET L2=L2+1
SET Y1(L2)=" "_$PIECE($GET(^PRST(457.2,+$PIECE(Y4,"^",L1+2),0)),"^",1)
S1 ; Set Schedule Array
+1 FOR L1=1:3:19
SET A1=$PIECE(Y2,"^",L1)
if A1=""
QUIT
SET L3=L3+1
SET Y2(L3)=A1
if $PIECE(Y2,"^",L1+1)'=""
SET Y2(L3)=Y2(L3)_"-"_$PIECE(Y2,"^",L1+1)
IF $PIECE(Y2,"^",L1+2)'=""
SET L3=L3+1
SET Y2(L3)=" "_$PIECE($GET(^PRST(457.2,+$PIECE(Y2,"^",L1+2),0)),"^",1)
+2 if Y5=""
GOTO S2
+3 FOR L1=1:3:19
SET A1=$PIECE(Y5,"^",L1)
if A1=""
QUIT
SET L3=L3+1
SET Y2(L3)=A1
if $PIECE(Y5,"^",L1+1)'=""
SET Y2(L3)=Y2(L3)_"-"_$PIECE(Y5,"^",L1+1)
IF $PIECE(Y5,"^",L1+2)'=""
SET L3=L3+1
SET Y2(L3)=" "_$PIECE($GET(^PRST(457.2,+$PIECE(Y5,"^",L1+2),0)),"^",1)
S2 FOR K=1:1
if '$DATA(Y1(K))&'$DATA(Y2(K))
QUIT
if K>1
WRITE !
if K=1
WRITE ?7,PRSA
if $DATA(Y1(K))
WRITE ?11,Y1(K)
if K=1
WRITE ?41,PRSB
if $DATA(Y2(K))
WRITE ?45,Y2(K)
EX QUIT
