- 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 Mar 13, 2025@21:31:01 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
