PRSXP134 ;WCIOFO/RRG - COMP TIME REPORT FOR NNU SETTLEMENT ;2/7/12 11:49
;;4.0;PAID;**134**;Sep 21, 1995;Build 11
;;Per VHA Directive 2004-038, this routine should not be modified.
QUIT
;
;
ENTRYPNT ;
N %ZIS,POP,IOP
S %ZIS="MQ"
D ^%ZIS
Q:POP
I $D(IO("Q")) D
. K IO("Q")
. N ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTUCI,ZTCPU,ZTPRI,ZTKIL,ZTSYNC
. S ZTDESC="NNU CT SETTLEMENT REPORT"
. S ZTRTN="MAIN^PRSXP134"
. D ^%ZTLOAD
. I $D(ZTSK) S ZTREQ="@" W !,"Request "_ZTSK_" Queued."
E D
. D MAIN^PRSXP134
D ^%ZISC
Q
MAIN ;
K ^XTMP("PRSXP134")
;S BPPD=$O(^PRST(458,"B","07-23",BPPD))
;S EPPD=$O(^PRST(458,"B","11-23",EPPD))
;
S DFN=0,S8B=""
F S DFN=$O(^PRSPC(DFN)) Q:'DFN!(DFN'?1.99N) D
. I $P(^PRSPC(DFN,0),"^",17)["061050" S PAYPER="07-22" D
. . F S PPI=0 S PAYPER=$O(^PRST(458,"B",PAYPER)) Q:PAYPER=""!(PAYPER]"11-23") S PPI=$O(^(PAYPER,PPI)) D
. . . S S8B=$$GET8B^PRSPUT3(PPI,DFN) ;GETS PROPER 8B STRING
. . . F I="CE^3","CT^3","CU^3","CO^3" N AMT D
. . . . S AMT=$$EXTR8BT^PRSPUT3(S8B,I) Q:AMT'>"0.0"
. . . . S ^XTMP("PRSXP134",DFN,PPI,I)=AMT
D REPORT
K BPPD,EPPD,DFN,S8B,PPI,AMT,PAGE,DAT,PRSIEN,CETOT,CUTOT,STOP,I,FLAG,PAYPER,ZTREQ
Q
;
REPORT ; report construct
N PAGE,DAT S (PRSIEN,CETOT,CUTOT)=0
S (PAGE,STOP)=0
D HDR
I '$D(^XTMP("PRSXP134")) W !,"NO RECORDS SELECTED" Q
F S PRSIEN=$O(^XTMP("PRSXP134",PRSIEN)) Q:PRSIEN="" S PPI=0 D
. F S PPI=$O(^XTMP("PRSXP134",PRSIEN,PPI)) Q:PPI="" S I="" D
. . F S I=$O(^XTMP("PRSXP134",PRSIEN,PPI,I)) Q:I="" D
. . . S CETOT=$S(I="CE^3":CETOT+(+^(I)),I="CT^3":CETOT+(+^(I)),1:CETOT)
. . . S CUTOT=$S(I="CU^3":CUTOT+(+^(I)),I="CO^3":CUTOT+(+^(I)),1:CUTOT)
. . D LINE Q:STOP
Q
;
LINE ;
Q:STOP
I (IOSL-5)<$Y S STOP=$$ASK^PRSLIB00() D HDR
I $G(FLAG) S STOP=$$ASK^PRSLIB00()
W !,$E($P(^PRSPC(PRSIEN,0),"^",1),1,20),?24,$P($G(^PRST(458,PPI,0)),"^",1),?38,CETOT,?58,CUTOT
S (CETOT,CUTOT)=0
Q
;
HDR ;
W @IOF
S PAGE=PAGE+1
W ?30,"NNU Comp Time Settlement Report",?68,"PAGE ",PAGE
W !,"NAME",?21,"PAY PERIOD",?35,"COMP TIME EARNED",?55,"COMP TIME USED"
W !,"======================================================================="
Q
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSXP134 2204 printed Apr 09, 2024@21:31:19 Page 2
PRSXP134 ;WCIOFO/RRG - COMP TIME REPORT FOR NNU SETTLEMENT ;2/7/12 11:49
+1 ;;4.0;PAID;**134**;Sep 21, 1995;Build 11
+2 ;;Per VHA Directive 2004-038, this routine should not be modified.
+3 QUIT
+4 ;
+5 ;
ENTRYPNT ;
+1 NEW %ZIS,POP,IOP
+2 SET %ZIS="MQ"
+3 DO ^%ZIS
+4 if POP
QUIT
+5 IF $DATA(IO("Q"))
Begin DoDot:1
+6 KILL IO("Q")
+7 NEW ZTSK,ZTDESC,ZTDTH,ZTIO,ZTRTN,ZTSAVE,ZTUCI,ZTCPU,ZTPRI,ZTKIL,ZTSYNC
+8 SET ZTDESC="NNU CT SETTLEMENT REPORT"
+9 SET ZTRTN="MAIN^PRSXP134"
+10 DO ^%ZTLOAD
+11 IF $DATA(ZTSK)
SET ZTREQ="@"
WRITE !,"Request "_ZTSK_" Queued."
End DoDot:1
+12 IF '$TEST
Begin DoDot:1
+13 DO MAIN^PRSXP134
End DoDot:1
+14 DO ^%ZISC
+15 QUIT
MAIN ;
+1 KILL ^XTMP("PRSXP134")
+2 ;S BPPD=$O(^PRST(458,"B","07-23",BPPD))
+3 ;S EPPD=$O(^PRST(458,"B","11-23",EPPD))
+4 ;
+5 SET DFN=0
SET S8B=""
+6 FOR
SET DFN=$ORDER(^PRSPC(DFN))
if 'DFN!(DFN'?1.99N)
QUIT
Begin DoDot:1
+7 IF $PIECE(^PRSPC(DFN,0),"^",17)["061050"
SET PAYPER="07-22"
Begin DoDot:2
+8 FOR
SET PPI=0
SET PAYPER=$ORDER(^PRST(458,"B",PAYPER))
if PAYPER=""!(PAYPER]"11-23")
QUIT
SET PPI=$ORDER(^(PAYPER,PPI))
Begin DoDot:3
+9 ;GETS PROPER 8B STRING
SET S8B=$$GET8B^PRSPUT3(PPI,DFN)
+10 FOR I="CE^3","CT^3","CU^3","CO^3"
NEW AMT
Begin DoDot:4
+11 SET AMT=$$EXTR8BT^PRSPUT3(S8B,I)
if AMT'>"0.0"
QUIT
+12 SET ^XTMP("PRSXP134",DFN,PPI,I)=AMT
End DoDot:4
End DoDot:3
End DoDot:2
End DoDot:1
+13 DO REPORT
+14 KILL BPPD,EPPD,DFN,S8B,PPI,AMT,PAGE,DAT,PRSIEN,CETOT,CUTOT,STOP,I,FLAG,PAYPER,ZTREQ
+15 QUIT
+16 ;
REPORT ; report construct
+1 NEW PAGE,DAT
SET (PRSIEN,CETOT,CUTOT)=0
+2 SET (PAGE,STOP)=0
+3 DO HDR
+4 IF '$DATA(^XTMP("PRSXP134"))
WRITE !,"NO RECORDS SELECTED"
QUIT
+5 FOR
SET PRSIEN=$ORDER(^XTMP("PRSXP134",PRSIEN))
if PRSIEN=""
QUIT
SET PPI=0
Begin DoDot:1
+6 FOR
SET PPI=$ORDER(^XTMP("PRSXP134",PRSIEN,PPI))
if PPI=""
QUIT
SET I=""
Begin DoDot:2
+7 FOR
SET I=$ORDER(^XTMP("PRSXP134",PRSIEN,PPI,I))
if I=""
QUIT
Begin DoDot:3
+8 SET CETOT=$SELECT(I="CE^3":CETOT+(+^(I)),I="CT^3":CETOT+(+^(I)),1:CETOT)
+9 SET CUTOT=$SELECT(I="CU^3":CUTOT+(+^(I)),I="CO^3":CUTOT+(+^(I)),1:CUTOT)
End DoDot:3
+10 DO LINE
if STOP
QUIT
End DoDot:2
End DoDot:1
+11 QUIT
+12 ;
LINE ;
+1 if STOP
QUIT
+2 IF (IOSL-5)<$Y
SET STOP=$$ASK^PRSLIB00()
DO HDR
+3 IF $GET(FLAG)
SET STOP=$$ASK^PRSLIB00()
+4 WRITE !,$EXTRACT($PIECE(^PRSPC(PRSIEN,0),"^",1),1,20),?24,$PIECE($GET(^PRST(458,PPI,0)),"^",1),?38,CETOT,?58,CUTOT
+5 SET (CETOT,CUTOT)=0
+6 QUIT
+7 ;
HDR ;
+1 WRITE @IOF
+2 SET PAGE=PAGE+1
+3 WRITE ?30,"NNU Comp Time Settlement Report",?68,"PAGE ",PAGE
+4 WRITE !,"NAME",?21,"PAY PERIOD",?35,"COMP TIME EARNED",?55,"COMP TIME USED"
+5 WRITE !,"======================================================================="
+6 QUIT
+7 ;
