source: FOIAVistA/trunk/r/PAID-PRS/PRSDRPT.m@ 1328

Last change on this file since 1328 was 628, checked in by George Lilly, 15 years ago

initial load of FOIAVistA 6/30/08 version
File size: 3.1 KB
Line 
1PRSDRPT ;HISC/GWB-FISCAL REPORTS
2 ;;4.0;PAID;;Sep 21, 1995
3SELPP K DIC S DIC="^PRST(458,",DIC(0)="AEMQZ" D ^DIC I Y'>0 D EXIT Q
4 S PP=+Y,PPNAME=$P(^PRST(458,PP,0),U,1)
5 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
6 .S (AN,DA,DB,DC,OA,OB,OC,AL,DE,DF,DG,OE,OF,OG)=""
7 .I RCD8B["AN",(RCD8B["DA")!(RCD8B["DB")!(RCD8B["DC")!(RCD8B["OA")!(RCD8B["OB")!(RCD8B["OC") D SETWK1
8 .I RCD8B["AL",(RCD8B["DE")!(RCD8B["DF")!(RCD8B["DG")!(RCD8B["OE")!(RCD8B["OF")!(RCD8B["OG") D SETWK2
9 I '$D(^TMP("PRS","RPT")) W !,"No employees had Annual Leave and Overtime in the same week." G EXIT
10ASKDEV S %ZIS="M",%ZIS("B")="" D ^%ZIS G EXIT:POP
11PRINT U IO S PRTC="" D HDR
12 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
13EXIT D:$E(IOST,1)'="C" ^%ZISC K ^TMP("PRS","RPT") D KILL^XUSCLEAN
14 Q
15WRITE W !,?5,NAME,?30
16 F I=1:1:14 I $P(^TMP("PRS","RPT",SVC,NAME),"^",I)'="" W $P(^TMP("PRS","RPT",SVC,NAME),"^",I)_" "
17 Q
18SETWK1 S NAME=$P(^PRSPC(IEN,0),"^",1)
19 S SVC=$P(^PRSPC(IEN,0),"^",49) S Y=SVC X ^DD(450,458,2) S SVC=Y
20 S ^TMP("PRS","RPT",SVC,NAME)=""
21 S:$F(RCD8B,"AN")>0 AN=$E(RCD8B,$F(RCD8B,"AN")-2,$F(RCD8B,"AN")+2),$P(^TMP("PRS","RPT",SVC,NAME),"^",1)=AN
22 S:$F(RCD8B,"DA")>0 DA=$E(RCD8B,$F(RCD8B,"DA")-2,$F(RCD8B,"DA")+2),$P(^TMP("PRS","RPT",SVC,NAME),"^",2)=DA
23 S:$F(RCD8B,"DB")>0 DB=$E(RCD8B,$F(RCD8B,"DB")-2,$F(RCD8B,"DB")+2),$P(^TMP("PRS","RPT",SVC,NAME),"^",3)=DB
24 S:$F(RCD8B,"DC")>0 DC=$E(RCD8B,$F(RCD8B,"DC")-2,$F(RCD8B,"DC")+2),$P(^TMP("PRS","RPT",SVC,NAME),"^",4)=DC
25 S:$F(RCD8B,"OA")>0 OA=$E(RCD8B,$F(RCD8B,"OA")-2,$F(RCD8B,"OA")+2),$P(^TMP("PRS","RPT",SVC,NAME),"^",5)=OA
26 S:$F(RCD8B,"OB")>0 OB=$E(RCD8B,$F(RCD8B,"OB")-2,$F(RCD8B,"OB")+2),$P(^TMP("PRS","RPT",SVC,NAME),"^",6)=OB
27 S:$F(RCD8B,"OC")>0 OC=$E(RCD8B,$F(RCD8B,"OC")-2,$F(RCD8B,"OC")+2),$P(^TMP("PRS","RPT",SVC,NAME),"^",7)=OC
28 Q
29SETWK2 S NAME=$P(^PRSPC(IEN,0),"^",1)
30 S SVC=$P(^PRSPC(IEN,0),"^",49) S Y=SVC X ^DD(450,458,2) S SVC=Y
31 S:'$D(^TMP("PRS","RPT",SVC,NAME)) ^TMP("PRS","RPT",SVC,NAME)=""
32 S:$F(RCD8B,"AL")>0 AL=$E(RCD8B,$F(RCD8B,"AL")-2,$F(RCD8B,"AL")+2),$P(^TMP("PRS","RPT",SVC,NAME),"^",8)=AL
33 S:$F(RCD8B,"DE")>0 DE=$E(RCD8B,$F(RCD8B,"DE")-2,$F(RCD8B,"DE")+2),$P(^TMP("PRS","RPT",SVC,NAME),"^",9)=DE
34 S:$F(RCD8B,"DF")>0 DF=$E(RCD8B,$F(RCD8B,"DF")-2,$F(RCD8B,"DF")+2),$P(^TMP("PRS","RPT",SVC,NAME),"^",10)=DF
35 S:$F(RCD8B,"DG")>0 DG=$E(RCD8B,$F(RCD8B,"DG")-2,$F(RCD8B,"DG")+2),$P(^TMP("PRS","RPT",SVC,NAME),"^",11)=DG
36 S:$F(RCD8B,"OE")>0 OE=$E(RCD8B,$F(RCD8B,"OE")-2,$F(RCD8B,"OE")+2),$P(^TMP("PRS","RPT",SVC,NAME),"^",12)=OE
37 S:$F(RCD8B,"OF")>0 OF=$E(RCD8B,$F(RCD8B,"OF")-2,$F(RCD8B,"OF")+2),$P(^TMP("PRS","RPT",SVC,NAME),"^",13)=OF
38 S:$F(RCD8B,"OG")>0 OG=$E(RCD8B,$F(RCD8B,"OG")-2,$F(RCD8B,"OG")+2),$P(^TMP("PRS","RPT",SVC,NAME),"^",14)=OG
39 Q
40HDR W:$Y>0 @IOF
41 W !,"EMPLOYEES WITH ANNUAL LEAVE AND OVERTIME IN THE SAME WEEK FOR PAY PERIOD ",PPNAME
42 Q
43PRTC 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
44 Q
Note: See TracBrowser for help on using the repository browser.