PRSDRPT ;HISC/GWB-FISCAL REPORTS
;;4.0;PAID;;Sep 21, 1995
SELPP K DIC S DIC="^PRST(458,",DIC(0)="AEMQZ" D ^DIC I Y'>0 D EXIT Q
S PP=+Y,PPNAME=$P(^PRST(458,PP,0),U,1)
S IEN=0 F CNT=1:1 S IEN=$O(^PRST(458,PP,"E",IEN)) Q:IEN'>0 W:CNT#100=0 "." I $D(^PRST(458,PP,"E",IEN,5)) S RCD8B=$E(^PRST(458,PP,"E",IEN,5),19,999) D
.S (AN,DA,DB,DC,OA,OB,OC,AL,DE,DF,DG,OE,OF,OG)=""
.I RCD8B["AN",(RCD8B["DA")!(RCD8B["DB")!(RCD8B["DC")!(RCD8B["OA")!(RCD8B["OB")!(RCD8B["OC") D SETWK1
.I RCD8B["AL",(RCD8B["DE")!(RCD8B["DF")!(RCD8B["DG")!(RCD8B["OE")!(RCD8B["OF")!(RCD8B["OG") D SETWK2
I '$D(^TMP("PRS","RPT")) W !,"No employees had Annual Leave and Overtime in the same week." G EXIT
ASKDEV S %ZIS="M",%ZIS("B")="" D ^%ZIS G EXIT:POP
PRINT U IO S PRTC="" D HDR
S SVC="" F S SVC=$O(^TMP("PRS","RPT",SVC)) Q:SVC="" W !!,SVC S NAME="" F S NAME=$O(^TMP("PRS","RPT",SVC,NAME)) Q:NAME="" D WRITE I $Y>(IOSL-4) D:$E(IOST,1)="C" PRTC G:PRTC=0 EXIT D HDR
EXIT D:$E(IOST,1)'="C" ^%ZISC K ^TMP("PRS","RPT") D KILL^XUSCLEAN
Q
WRITE W !,?5,NAME,?30
F I=1:1:14 I $P(^TMP("PRS","RPT",SVC,NAME),"^",I)'="" W $P(^TMP("PRS","RPT",SVC,NAME),"^",I)_" "
Q
SETWK1 S NAME=$P(^PRSPC(IEN,0),"^",1)
S SVC=$P(^PRSPC(IEN,0),"^",49) S Y=SVC X ^DD(450,458,2) S SVC=Y
S ^TMP("PRS","RPT",SVC,NAME)=""
S:$F(RCD8B,"AN")>0 AN=$E(RCD8B,$F(RCD8B,"AN")-2,$F(RCD8B,"AN")+2),$P(^TMP("PRS","RPT",SVC,NAME),"^",1)=AN
S:$F(RCD8B,"DA")>0 DA=$E(RCD8B,$F(RCD8B,"DA")-2,$F(RCD8B,"DA")+2),$P(^TMP("PRS","RPT",SVC,NAME),"^",2)=DA
S:$F(RCD8B,"DB")>0 DB=$E(RCD8B,$F(RCD8B,"DB")-2,$F(RCD8B,"DB")+2),$P(^TMP("PRS","RPT",SVC,NAME),"^",3)=DB
S:$F(RCD8B,"DC")>0 DC=$E(RCD8B,$F(RCD8B,"DC")-2,$F(RCD8B,"DC")+2),$P(^TMP("PRS","RPT",SVC,NAME),"^",4)=DC
S:$F(RCD8B,"OA")>0 OA=$E(RCD8B,$F(RCD8B,"OA")-2,$F(RCD8B,"OA")+2),$P(^TMP("PRS","RPT",SVC,NAME),"^",5)=OA
S:$F(RCD8B,"OB")>0 OB=$E(RCD8B,$F(RCD8B,"OB")-2,$F(RCD8B,"OB")+2),$P(^TMP("PRS","RPT",SVC,NAME),"^",6)=OB
S:$F(RCD8B,"OC")>0 OC=$E(RCD8B,$F(RCD8B,"OC")-2,$F(RCD8B,"OC")+2),$P(^TMP("PRS","RPT",SVC,NAME),"^",7)=OC
Q
SETWK2 S NAME=$P(^PRSPC(IEN,0),"^",1)
S SVC=$P(^PRSPC(IEN,0),"^",49) S Y=SVC X ^DD(450,458,2) S SVC=Y
S:'$D(^TMP("PRS","RPT",SVC,NAME)) ^TMP("PRS","RPT",SVC,NAME)=""
S:$F(RCD8B,"AL")>0 AL=$E(RCD8B,$F(RCD8B,"AL")-2,$F(RCD8B,"AL")+2),$P(^TMP("PRS","RPT",SVC,NAME),"^",8)=AL
S:$F(RCD8B,"DE")>0 DE=$E(RCD8B,$F(RCD8B,"DE")-2,$F(RCD8B,"DE")+2),$P(^TMP("PRS","RPT",SVC,NAME),"^",9)=DE
S:$F(RCD8B,"DF")>0 DF=$E(RCD8B,$F(RCD8B,"DF")-2,$F(RCD8B,"DF")+2),$P(^TMP("PRS","RPT",SVC,NAME),"^",10)=DF
S:$F(RCD8B,"DG")>0 DG=$E(RCD8B,$F(RCD8B,"DG")-2,$F(RCD8B,"DG")+2),$P(^TMP("PRS","RPT",SVC,NAME),"^",11)=DG
S:$F(RCD8B,"OE")>0 OE=$E(RCD8B,$F(RCD8B,"OE")-2,$F(RCD8B,"OE")+2),$P(^TMP("PRS","RPT",SVC,NAME),"^",12)=OE
S:$F(RCD8B,"OF")>0 OF=$E(RCD8B,$F(RCD8B,"OF")-2,$F(RCD8B,"OF")+2),$P(^TMP("PRS","RPT",SVC,NAME),"^",13)=OF
S:$F(RCD8B,"OG")>0 OG=$E(RCD8B,$F(RCD8B,"OG")-2,$F(RCD8B,"OG")+2),$P(^TMP("PRS","RPT",SVC,NAME),"^",14)=OG
Q
HDR W:$Y>0 @IOF
W !,"EMPLOYEES WITH ANNUAL LEAVE AND OVERTIME IN THE SAME WEEK FOR PAY PERIOD ",PPNAME
Q
PRTC W ! K DIR,DIRUT,DIROUT,DTOUT,DUOUT S DIR(0)="E",DIR("A")="Press RETURN to continue" D ^DIR S PRTC=Y S:$D(DIRUT) PRTC=0
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSDRPT 3229 printed Nov 22, 2024@17:36:02 Page 2
PRSDRPT ;HISC/GWB-FISCAL REPORTS
+1 ;;4.0;PAID;;Sep 21, 1995
SELPP KILL DIC
SET DIC="^PRST(458,"
SET DIC(0)="AEMQZ"
DO ^DIC
IF Y'>0
DO EXIT
QUIT
+1 SET PP=+Y
SET PPNAME=$PIECE(^PRST(458,PP,0),U,1)
+2 SET IEN=0
FOR CNT=1:1
SET IEN=$ORDER(^PRST(458,PP,"E",IEN))
if IEN'>0
QUIT
if CNT#100=0
WRITE "."
IF $DATA(^PRST(458,PP,"E",IEN,5))
SET RCD8B=$EXTRACT(^PRST(458,PP,"E",IEN,5),19,999)
Begin DoDot:1
+3 SET (AN,DA,DB,DC,OA,OB,OC,AL,DE,DF,DG,OE,OF,OG)=""
+4 IF RCD8B["AN"
IF (RCD8B["DA")!(RCD8B["DB")!(RCD8B["DC")!(RCD8B["OA")!(RCD8B["OB")!(RCD8B["OC")
DO SETWK1
+5 IF RCD8B["AL"
IF (RCD8B["DE")!(RCD8B["DF")!(RCD8B["DG")!(RCD8B["OE")!(RCD8B["OF")!(RCD8B["OG")
DO SETWK2
End DoDot:1
+6 IF '$DATA(^TMP("PRS","RPT"))
WRITE !,"No employees had Annual Leave and Overtime in the same week."
GOTO EXIT
ASKDEV SET %ZIS="M"
SET %ZIS("B")=""
DO ^%ZIS
if POP
GOTO EXIT
PRINT USE IO
SET PRTC=""
DO HDR
+1 SET SVC=""
FOR
SET SVC=$ORDER(^TMP("PRS","RPT",SVC))
if SVC=""
QUIT
WRITE !!,SVC
SET NAME=""
FOR
SET NAME=$ORDER(^TMP("PRS","RPT",SVC,NAME))
if NAME=""
QUIT
DO WRITE
IF $Y>(IOSL-4)
if $EXTRACT(IOST,1)="C"
DO PRTC
if PRTC=0
GOTO EXIT
DO HDR
EXIT if $EXTRACT(IOST,1)'="C"
DO ^%ZISC
KILL ^TMP("PRS","RPT")
DO KILL^XUSCLEAN
+1 QUIT
WRITE WRITE !,?5,NAME,?30
+1 FOR I=1:1:14
IF $PIECE(^TMP("PRS","RPT",SVC,NAME),"^",I)'=""
WRITE $PIECE(^TMP("PRS","RPT",SVC,NAME),"^",I)_" "
+2 QUIT
SETWK1 SET NAME=$PIECE(^PRSPC(IEN,0),"^",1)
+1 SET SVC=$PIECE(^PRSPC(IEN,0),"^",49)
SET Y=SVC
XECUTE ^DD(450,458,2)
SET SVC=Y
+2 SET ^TMP("PRS","RPT",SVC,NAME)=""
+3 if $FIND(RCD8B,"AN")>0
SET AN=$EXTRACT(RCD8B,$FIND(RCD8B,"AN")-2,$FIND(RCD8B,"AN")+2)
SET $PIECE(^TMP("PRS","RPT",SVC,NAME),"^",1)=AN
+4 if $FIND(RCD8B,"DA")>0
SET DA=$EXTRACT(RCD8B,$FIND(RCD8B,"DA")-2,$FIND(RCD8B,"DA")+2)
SET $PIECE(^TMP("PRS","RPT",SVC,NAME),"^",2)=DA
+5 if $FIND(RCD8B,"DB")>0
SET DB=$EXTRACT(RCD8B,$FIND(RCD8B,"DB")-2,$FIND(RCD8B,"DB")+2)
SET $PIECE(^TMP("PRS","RPT",SVC,NAME),"^",3)=DB
+6 if $FIND(RCD8B,"DC")>0
SET DC=$EXTRACT(RCD8B,$FIND(RCD8B,"DC")-2,$FIND(RCD8B,"DC")+2)
SET $PIECE(^TMP("PRS","RPT",SVC,NAME),"^",4)=DC
+7 if $FIND(RCD8B,"OA")>0
SET OA=$EXTRACT(RCD8B,$FIND(RCD8B,"OA")-2,$FIND(RCD8B,"OA")+2)
SET $PIECE(^TMP("PRS","RPT",SVC,NAME),"^",5)=OA
+8 if $FIND(RCD8B,"OB")>0
SET OB=$EXTRACT(RCD8B,$FIND(RCD8B,"OB")-2,$FIND(RCD8B,"OB")+2)
SET $PIECE(^TMP("PRS","RPT",SVC,NAME),"^",6)=OB
+9 if $FIND(RCD8B,"OC")>0
SET OC=$EXTRACT(RCD8B,$FIND(RCD8B,"OC")-2,$FIND(RCD8B,"OC")+2)
SET $PIECE(^TMP("PRS","RPT",SVC,NAME),"^",7)=OC
+10 QUIT
SETWK2 SET NAME=$PIECE(^PRSPC(IEN,0),"^",1)
+1 SET SVC=$PIECE(^PRSPC(IEN,0),"^",49)
SET Y=SVC
XECUTE ^DD(450,458,2)
SET SVC=Y
+2 if '$DATA(^TMP("PRS","RPT",SVC,NAME))
SET ^TMP("PRS","RPT",SVC,NAME)=""
+3 if $FIND(RCD8B,"AL")>0
SET AL=$EXTRACT(RCD8B,$FIND(RCD8B,"AL")-2,$FIND(RCD8B,"AL")+2)
SET $PIECE(^TMP("PRS","RPT",SVC,NAME),"^",8)=AL
+4 if $FIND(RCD8B,"DE")>0
SET DE=$EXTRACT(RCD8B,$FIND(RCD8B,"DE")-2,$FIND(RCD8B,"DE")+2)
SET $PIECE(^TMP("PRS","RPT",SVC,NAME),"^",9)=DE
+5 if $FIND(RCD8B,"DF")>0
SET DF=$EXTRACT(RCD8B,$FIND(RCD8B,"DF")-2,$FIND(RCD8B,"DF")+2)
SET $PIECE(^TMP("PRS","RPT",SVC,NAME),"^",10)=DF
+6 if $FIND(RCD8B,"DG")>0
SET DG=$EXTRACT(RCD8B,$FIND(RCD8B,"DG")-2,$FIND(RCD8B,"DG")+2)
SET $PIECE(^TMP("PRS","RPT",SVC,NAME),"^",11)=DG
+7 if $FIND(RCD8B,"OE")>0
SET OE=$EXTRACT(RCD8B,$FIND(RCD8B,"OE")-2,$FIND(RCD8B,"OE")+2)
SET $PIECE(^TMP("PRS","RPT",SVC,NAME),"^",12)=OE
+8 if $FIND(RCD8B,"OF")>0
SET OF=$EXTRACT(RCD8B,$FIND(RCD8B,"OF")-2,$FIND(RCD8B,"OF")+2)
SET $PIECE(^TMP("PRS","RPT",SVC,NAME),"^",13)=OF
+9 if $FIND(RCD8B,"OG")>0
SET OG=$EXTRACT(RCD8B,$FIND(RCD8B,"OG")-2,$FIND(RCD8B,"OG")+2)
SET $PIECE(^TMP("PRS","RPT",SVC,NAME),"^",14)=OG
+10 QUIT
HDR if $Y>0
WRITE @IOF
+1 WRITE !,"EMPLOYEES WITH ANNUAL LEAVE AND OVERTIME IN THE SAME WEEK FOR PAY PERIOD ",PPNAME
+2 QUIT
PRTC WRITE !
KILL DIR,DIRUT,DIROUT,DTOUT,DUOUT
SET DIR(0)="E"
SET DIR("A")="Press RETURN to continue"
DO ^DIR
SET PRTC=Y
if $DATA(DIRUT)
SET PRTC=0
+1 QUIT
