PRSAXSR ; HISC/REL-Generate 8B Stub Record ;9/18/92 15:07
;;4.0;PAID;;Sep 21, 1995
;; DFN = Employee # PPE = Pay Period (e.g., 92-18) PPI= Internal PayPer #
S C0=$G(^PRSPC(DFN,0)),STA=$P(C0,"^",7) S:STA'?3N STA=" "
S SSN=$P(C0,"^",9) S:SSN'?9N SSN=999999999
S NCODE=$E($P(C0,"^",1),1,3) S:$L(NCODE)'=3 NCODE=" "
S TLB=$P(C0,"^",8) S:$L(TLB)'=3 TLB=" "
S LVGP=$P(C0,"^",15) S:LVGP="" LVGP=" "
S NH=$P(C0,"^",16),NH=$S(NH="":" ",NH<10:"0"_NH,NH<100:NH,1:$E("+ABCDEF",$E(NH,1,2)-9)_$E(NH,3))
S PYPL=$P(C0,"^",21) S:PYPL="" PYPL=" "
S DB=$P(C0,"^",10) S:DB="" DB=" "
S DAYNO=" " I $D(^PRST(458,PPI,"E",DFN,3)) S %=$P(^(3),"^",9) S:%?3N DAYNO=%
S PYPR=$P(PPE,"-",2) S:PYPR'?2N PYPR=" "
S HDR=" "_STA_SSN_NCODE_DAYNO_"8B"_TLB_LVGP_NH_PYPL_DB_PYPR Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSAXSR 786 printed Oct 16, 2024@18:25:44 Page 2
PRSAXSR ; HISC/REL-Generate 8B Stub Record ;9/18/92 15:07
+1 ;;4.0;PAID;;Sep 21, 1995
+2 ;; DFN = Employee # PPE = Pay Period (e.g., 92-18) PPI= Internal PayPer #
+3 SET C0=$GET(^PRSPC(DFN,0))
SET STA=$PIECE(C0,"^",7)
if STA'?3N
SET STA=" "
+4 SET SSN=$PIECE(C0,"^",9)
if SSN'?9N
SET SSN=999999999
+5 SET NCODE=$EXTRACT($PIECE(C0,"^",1),1,3)
if $LENGTH(NCODE)'=3
SET NCODE=" "
+6 SET TLB=$PIECE(C0,"^",8)
if $LENGTH(TLB)'=3
SET TLB=" "
+7 SET LVGP=$PIECE(C0,"^",15)
if LVGP=""
SET LVGP=" "
+8 SET NH=$PIECE(C0,"^",16)
SET NH=$SELECT(NH="":" ",NH<10:"0"_NH,NH<100:NH,1:$EXTRACT("+ABCDEF",$EXTRACT(NH,1,2)-9)_$EXTRACT(NH,3))
+9 SET PYPL=$PIECE(C0,"^",21)
if PYPL=""
SET PYPL=" "
+10 SET DB=$PIECE(C0,"^",10)
if DB=""
SET DB=" "
+11 SET DAYNO=" "
IF $DATA(^PRST(458,PPI,"E",DFN,3))
SET %=$PIECE(^(3),"^",9)
if %?3N
SET DAYNO=%
+12 SET PYPR=$PIECE(PPE,"-",2)
if PYPR'?2N
SET PYPR=" "
+13 SET HDR=" "_STA_SSN_NCODE_DAYNO_"8B"_TLB_LVGP_NH_PYPL_DB_PYPR
QUIT
