PRSDPTYP ;HISC/GWB-PAID PAYRUN DOWNLOAD MESSAGE PROCESSOR ;22-JAN-1998
;;4.0;PAID;**35**;Sep 21, 1995
S YR=$E(DATE,1,4),MO=$E(DATE,5,6),PP=$P(RCD,":",9),PP=$E(PP,17,18)
I (PP="")!(PP="00")!(PP=" ") S PP="" Q
S:(PP>24)&(MO="01") YR=YR-1 S PP=$E(YR,3,4)_"-"_PP
I '$D(^PRST(459,"B",PP)) D
.S DIC="^PRST(459,",DIC(0)="L",DLAYGO=459,X=PP K DD,DO D FILE^DICN
.S PP459=+Y,^PRST(459,PP459,"P",0)="^459.01P^0^0"
.S PPE=PP D NX^PRSAPPU S X1=D1,X2=23 D C^%DTC S PAYDT=X
.S $P(^PRST(459,PP459,0),"^",2)=PAYDT,^PRST(459,"AC",PAYDT,PP459)=""
S PPIEN=0,(DA(1),PPIEN)=$O(^PRST(459,"B",PP,PPIEN))
Q:$D(^PRST(459,PPIEN,"P",IEN))
S Z=IEN,$P(Z,U,2)=SSN
S $P(Z,U,3)=$P(^PRSPC(IEN,0),U,21)
S $P(Z,U,4)=$P(^PRSPC(IEN,0),U,14)
S $P(Z,U,5)=$P(^PRSPC(IEN,0),U,39)
S $P(Z,U,6)=$P(^PRSPC(IEN,0),U,10)
S $P(Z,U,7)=$P(^PRSPC(IEN,0),U,16)
S $P(Z,U,8)=$P(^PRSPC(IEN,0),U,18)
S $P(Z,U,9)=$P(^PRSPC(IEN,0),U,19)
S:$D(^PRSPC(IEN,"MISC4")) $P(Z,U,10)=$P(^PRSPC(IEN,"MISC4"),U,12)
S:$D(^PRSPC(IEN,"MISC4")) $P(Z,U,11)=$P(^PRSPC(IEN,"MISC4"),U,11)
S $P(Z,U,12)=$P(^PRSPC(IEN,0),U,50)
S $P(Z,U,13)=$P(^PRSPC(IEN,0),U,8)
S $P(Z,U,14)=$P(^PRSPC(IEN,0),U,29)
S ^PRST(459,PPIEN,"P",IEN,0)=Z,^PRST(459,PPIEN,"P","B",IEN,IEN)=""
S Z=$G(^PRST(459,PPIEN,"P",0)),$P(^(0),U,3,4)=IEN_"^"_($P(Z,U,4)+1)
D ^PRSDPRIN
K DIC,DLAYGO,X,PP458,PP459,X1,X2,PAYDT,Z
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPRSDPTYP 1367 printed Dec 13, 2024@02:25:58 Page 2
PRSDPTYP ;HISC/GWB-PAID PAYRUN DOWNLOAD MESSAGE PROCESSOR ;22-JAN-1998
+1 ;;4.0;PAID;**35**;Sep 21, 1995
+2 SET YR=$EXTRACT(DATE,1,4)
SET MO=$EXTRACT(DATE,5,6)
SET PP=$PIECE(RCD,":",9)
SET PP=$EXTRACT(PP,17,18)
+3 IF (PP="")!(PP="00")!(PP=" ")
SET PP=""
QUIT
+4 if (PP>24)&(MO="01")
SET YR=YR-1
SET PP=$EXTRACT(YR,3,4)_"-"_PP
+5 IF '$DATA(^PRST(459,"B",PP))
Begin DoDot:1
+6 SET DIC="^PRST(459,"
SET DIC(0)="L"
SET DLAYGO=459
SET X=PP
KILL DD,DO
DO FILE^DICN
+7 SET PP459=+Y
SET ^PRST(459,PP459,"P",0)="^459.01P^0^0"
+8 SET PPE=PP
DO NX^PRSAPPU
SET X1=D1
SET X2=23
DO C^%DTC
SET PAYDT=X
+9 SET $PIECE(^PRST(459,PP459,0),"^",2)=PAYDT
SET ^PRST(459,"AC",PAYDT,PP459)=""
End DoDot:1
+10 SET PPIEN=0
SET (DA(1),PPIEN)=$ORDER(^PRST(459,"B",PP,PPIEN))
+11 if $DATA(^PRST(459,PPIEN,"P",IEN))
QUIT
+12 SET Z=IEN
SET $PIECE(Z,U,2)=SSN
+13 SET $PIECE(Z,U,3)=$PIECE(^PRSPC(IEN,0),U,21)
+14 SET $PIECE(Z,U,4)=$PIECE(^PRSPC(IEN,0),U,14)
+15 SET $PIECE(Z,U,5)=$PIECE(^PRSPC(IEN,0),U,39)
+16 SET $PIECE(Z,U,6)=$PIECE(^PRSPC(IEN,0),U,10)
+17 SET $PIECE(Z,U,7)=$PIECE(^PRSPC(IEN,0),U,16)
+18 SET $PIECE(Z,U,8)=$PIECE(^PRSPC(IEN,0),U,18)
+19 SET $PIECE(Z,U,9)=$PIECE(^PRSPC(IEN,0),U,19)
+20 if $DATA(^PRSPC(IEN,"MISC4"))
SET $PIECE(Z,U,10)=$PIECE(^PRSPC(IEN,"MISC4"),U,12)
+21 if $DATA(^PRSPC(IEN,"MISC4"))
SET $PIECE(Z,U,11)=$PIECE(^PRSPC(IEN,"MISC4"),U,11)
+22 SET $PIECE(Z,U,12)=$PIECE(^PRSPC(IEN,0),U,50)
+23 SET $PIECE(Z,U,13)=$PIECE(^PRSPC(IEN,0),U,8)
+24 SET $PIECE(Z,U,14)=$PIECE(^PRSPC(IEN,0),U,29)
+25 SET ^PRST(459,PPIEN,"P",IEN,0)=Z
SET ^PRST(459,PPIEN,"P","B",IEN,IEN)=""
+26 SET Z=$GET(^PRST(459,PPIEN,"P",0))
SET $PIECE(^(0),U,3,4)=IEN_"^"_($PIECE(Z,U,4)+1)
+27 DO ^PRSDPRIN
+28 KILL DIC,DLAYGO,X,PP458,PP459,X1,X2,PAYDT,Z
+29 QUIT
