- PRSDW450 ;HISC/GWB-WRITE PAID EMPLOYEE DATA ;03/14/03
- ;;4.0;PAID;**2,78,106**;Sep 21, 1995;Build 5
- ;;Per VHA Directive 2004-038, this routine should not be modified.
- WRITE S NODEDD=^DD(450,FIELDN,0)
- S NODEUTIL=$G(^UTILITY("DIQ1",$J,450,DA,FIELDN,"E"))
- I CATEGORY="VERIFICATION OF EMPLOYMENT",FIELDN=556 D DSPYTD^PRSDYTD Q:PRTC=0
- I CATEGORY="BENEFITS",FIELDN=427 D D CHECK Q:PRTC=0
- .W:TSPYTD'=0 !,"TSP EMP DED YTD",?30,$J($FN(TSPYTD,",",2),14) K TSPYTD
- I CATEGORY="BENEFITS",FIELDN=232 D D CHECK Q:PRTC=0
- .W:HBDYTD'=0 !,"HEALTH BENEFITS DEDUCTION YTD",?30,$J($FN(HBDYTD,",",2),14) K HBDYTD
- I (NODEUTIL="")!(NODEUTIL="NA") K NODEDD,NODEUTIL Q
- S INTERNAL=^UTILITY("DIQ1",$J,450,DA,FIELDN,"I")
- S DESC=^UTILITY("DIQ1",$J,450,DA,FIELDN,"E")
- I CATEGORY="VERIFICATION OF EMPLOYMENT",FIELDN=28,INTERNAL<50 W !,"HOURLY RATE",?30,$J($FN(INTERNAL,",",2),14) D CHECK Q:PRTC=0 S INTERNAL=INTERNAL*2087,DESC=DESC_" X 2087"
- I $P(NODEDD,U,2)["NJ",+INTERNAL=0 K NODEDD,NODEUTIL Q
- I PRTC=1 D HDR^PRSDSRS S PRTC=""
- W !,$P(NODEDD,U,1)
- I FIELDN>88,FIELDN<116.3 S INTERNAL="",FNM=$P(NODEDD,U,1) D G CHECK
- .I $D(^PRSP(454,1,"PUC","C",FNM)) S FUIEN=$O(^PRSP(454,1,"PUC","C",FNM,0)),INTERNAL=$P(^PRSP(454,1,"PUC",FUIEN,0),U,1)
- .I INTERNAL'="",$P(^PRSP(454,1,"PUC",FUIEN,0),U,3)'="" S INTERNAL=INTERNAL_" "_$P(^PRSP(454,1,"PUC",FUIEN,0),U,3)
- .W ?30,$J(DESC,14),?47,INTERNAL
- I (FIELDN=349)!(FIELDN=355)!(FIELDN=363)!(FIELDN=369) W ?47,DESC G CHECK
- I (FIELDN=725)!(FIELDN=731)!(FIELDN=740)!(FIELDN=746) W ?47,DESC G CHECK
- I FIELDN=565 W ?38,$J(INTERNAL,6,4) G CHECK
- W ?30,$S($P(NODEDD,U,5)["""$""":$J($FN(INTERNAL,",",2),14),$P(NODEDD,U,2)["NJ":$J(INTERNAL,14,2),$P(NODEDD,U,2)["D":$J(DESC,14),1:$J(INTERNAL,14))
- I $P(NODEDD,U,2)'["D",INTERNAL'=DESC D DESC
- K DESC,INTERNAL,NODEDD,NODEUTIL,FNM,FUIEN
- CHECK I $E(IOST,1)="C",$Y>(IOSL-4) D PRTC
- 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
- DESC I $L(DESC)<33 W ?47,DESC Q
- S COLUMN=47,LGTH=0
- F L1=1:1 Q:LGTH=$L(DESC)!(LGTH>($L(DESC))) W:$L($P(DESC," ",L1))>(80-COLUMN) ! S:$L($P(DESC," ",L1))>(80-COLUMN) COLUMN=47 W ?COLUMN,$P(DESC," ",L1) S COLUMN=COLUMN+$L($P(DESC," ",L1))+1,LGTH=LGTH+$L($P(DESC," ",L1))+1
- K COLUMN,LGTH,L1
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSDW450 2306 printed Feb 18, 2025@23:52:46 Page 2
- PRSDW450 ;HISC/GWB-WRITE PAID EMPLOYEE DATA ;03/14/03
- +1 ;;4.0;PAID;**2,78,106**;Sep 21, 1995;Build 5
- +2 ;;Per VHA Directive 2004-038, this routine should not be modified.
- WRITE SET NODEDD=^DD(450,FIELDN,0)
- +1 SET NODEUTIL=$GET(^UTILITY("DIQ1",$JOB,450,DA,FIELDN,"E"))
- +2 IF CATEGORY="VERIFICATION OF EMPLOYMENT"
- IF FIELDN=556
- DO DSPYTD^PRSDYTD
- if PRTC=0
- QUIT
- +3 IF CATEGORY="BENEFITS"
- IF FIELDN=427
- Begin DoDot:1
- +4 if TSPYTD'=0
- WRITE !,"TSP EMP DED YTD",?30,$JUSTIFY($FNUMBER(TSPYTD,",",2),14)
- KILL TSPYTD
- End DoDot:1
- DO CHECK
- if PRTC=0
- QUIT
- +5 IF CATEGORY="BENEFITS"
- IF FIELDN=232
- Begin DoDot:1
- +6 if HBDYTD'=0
- WRITE !,"HEALTH BENEFITS DEDUCTION YTD",?30,$JUSTIFY($FNUMBER(HBDYTD,",",2),14)
- KILL HBDYTD
- End DoDot:1
- DO CHECK
- if PRTC=0
- QUIT
- +7 IF (NODEUTIL="")!(NODEUTIL="NA")
- KILL NODEDD,NODEUTIL
- QUIT
- +8 SET INTERNAL=^UTILITY("DIQ1",$JOB,450,DA,FIELDN,"I")
- +9 SET DESC=^UTILITY("DIQ1",$JOB,450,DA,FIELDN,"E")
- +10 IF CATEGORY="VERIFICATION OF EMPLOYMENT"
- IF FIELDN=28
- IF INTERNAL<50
- WRITE !,"HOURLY RATE",?30,$JUSTIFY($FNUMBER(INTERNAL,",",2),14)
- DO CHECK
- if PRTC=0
- QUIT
- SET INTERNAL=INTERNAL*2087
- SET DESC=DESC_" X 2087"
- +11 IF $PIECE(NODEDD,U,2)["NJ"
- IF +INTERNAL=0
- KILL NODEDD,NODEUTIL
- QUIT
- +12 IF PRTC=1
- DO HDR^PRSDSRS
- SET PRTC=""
- +13 WRITE !,$PIECE(NODEDD,U,1)
- +14 IF FIELDN>88
- IF FIELDN<116.3
- SET INTERNAL=""
- SET FNM=$PIECE(NODEDD,U,1)
- Begin DoDot:1
- +15 IF $DATA(^PRSP(454,1,"PUC","C",FNM))
- SET FUIEN=$ORDER(^PRSP(454,1,"PUC","C",FNM,0))
- SET INTERNAL=$PIECE(^PRSP(454,1,"PUC",FUIEN,0),U,1)
- +16 IF INTERNAL'=""
- IF $PIECE(^PRSP(454,1,"PUC",FUIEN,0),U,3)'=""
- SET INTERNAL=INTERNAL_" "_$PIECE(^PRSP(454,1,"PUC",FUIEN,0),U,3)
- +17 WRITE ?30,$JUSTIFY(DESC,14),?47,INTERNAL
- End DoDot:1
- GOTO CHECK
- +18 IF (FIELDN=349)!(FIELDN=355)!(FIELDN=363)!(FIELDN=369)
- WRITE ?47,DESC
- GOTO CHECK
- +19 IF (FIELDN=725)!(FIELDN=731)!(FIELDN=740)!(FIELDN=746)
- WRITE ?47,DESC
- GOTO CHECK
- +20 IF FIELDN=565
- WRITE ?38,$JUSTIFY(INTERNAL,6,4)
- GOTO CHECK
- +21 WRITE ?30,$SELECT($PIECE(NODEDD,U,5)["""$""":$JUSTIFY($FNUMBER(INTERNAL,",",2),14),$PIECE(NODEDD,U,2)["NJ":$JUSTIFY(INTERNAL,14,2),$PIECE(NODEDD,U,2)["D":$JUSTIFY(DESC,14),1:$JUSTIFY(INTERNAL,14))
- +22 IF $PIECE(NODEDD,U,2)'["D"
- IF INTERNAL'=DESC
- DO DESC
- +23 KILL DESC,INTERNAL,NODEDD,NODEUTIL,FNM,FUIEN
- CHECK IF $EXTRACT(IOST,1)="C"
- IF $Y>(IOSL-4)
- DO PRTC
- +1 QUIT
- PRTC WRITE !
- KILL DIR,DIRUT,DIROUT,DTOUT,DUOUT
- +1 SET DIR(0)="E"
- SET DIR("A")="Press RETURN to continue"
- DO ^DIR
- SET PRTC=Y
- +2 if $DATA(DIRUT)
- SET PRTC=0
- +3 QUIT
- DESC IF $LENGTH(DESC)<33
- WRITE ?47,DESC
- QUIT
- +1 SET COLUMN=47
- SET LGTH=0
- +2 FOR L1=1:1
- if LGTH=$LENGTH(DESC)!(LGTH>($LENGTH(DESC)))
- QUIT
- if $LENGTH($PIECE(DESC," ",L1))>(80-COLUMN)
- WRITE !
- if $LENGTH($PIECE(DESC," ",L1))>(80-COLUMN)
- SET COLUMN=47
- WRITE ?COLUMN,$PIECE(DESC," ",L1)
- SET COLUMN=COLUMN+$LENGTH($PIECE(DESC," ",L1))+1
- SET LGTH=LGTH+$LENGTH($PIECE(DESC," ",L1))+1
- +3 KILL COLUMN,LGTH,L1
- +4 QUIT