- 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 Feb 18, 2025@23:51:31 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
