[613] | 1 | PRSDPTYP ;HISC/GWB-PAID PAYRUN DOWNLOAD MESSAGE PROCESSOR ;22-JAN-1998
|
---|
| 2 | ;;4.0;PAID;**35**;Sep 21, 1995
|
---|
| 3 | S YR=$E(DATE,1,4),MO=$E(DATE,5,6),PP=$P(RCD,":",9),PP=$E(PP,17,18)
|
---|
| 4 | I (PP="")!(PP="00")!(PP=" ") S PP="" Q
|
---|
| 5 | S:(PP>24)&(MO="01") YR=YR-1 S PP=$E(YR,3,4)_"-"_PP
|
---|
| 6 | I '$D(^PRST(459,"B",PP)) D
|
---|
| 7 | .S DIC="^PRST(459,",DIC(0)="L",DLAYGO=459,X=PP K DD,DO D FILE^DICN
|
---|
| 8 | .S PP459=+Y,^PRST(459,PP459,"P",0)="^459.01P^0^0"
|
---|
| 9 | .S PPE=PP D NX^PRSAPPU S X1=D1,X2=23 D C^%DTC S PAYDT=X
|
---|
| 10 | .S $P(^PRST(459,PP459,0),"^",2)=PAYDT,^PRST(459,"AC",PAYDT,PP459)=""
|
---|
| 11 | S PPIEN=0,(DA(1),PPIEN)=$O(^PRST(459,"B",PP,PPIEN))
|
---|
| 12 | Q:$D(^PRST(459,PPIEN,"P",IEN))
|
---|
| 13 | S Z=IEN,$P(Z,U,2)=SSN
|
---|
| 14 | S $P(Z,U,3)=$P(^PRSPC(IEN,0),U,21)
|
---|
| 15 | S $P(Z,U,4)=$P(^PRSPC(IEN,0),U,14)
|
---|
| 16 | S $P(Z,U,5)=$P(^PRSPC(IEN,0),U,39)
|
---|
| 17 | S $P(Z,U,6)=$P(^PRSPC(IEN,0),U,10)
|
---|
| 18 | S $P(Z,U,7)=$P(^PRSPC(IEN,0),U,16)
|
---|
| 19 | S $P(Z,U,8)=$P(^PRSPC(IEN,0),U,18)
|
---|
| 20 | S $P(Z,U,9)=$P(^PRSPC(IEN,0),U,19)
|
---|
| 21 | S:$D(^PRSPC(IEN,"MISC4")) $P(Z,U,10)=$P(^PRSPC(IEN,"MISC4"),U,12)
|
---|
| 22 | S:$D(^PRSPC(IEN,"MISC4")) $P(Z,U,11)=$P(^PRSPC(IEN,"MISC4"),U,11)
|
---|
| 23 | S $P(Z,U,12)=$P(^PRSPC(IEN,0),U,50)
|
---|
| 24 | S $P(Z,U,13)=$P(^PRSPC(IEN,0),U,8)
|
---|
| 25 | S $P(Z,U,14)=$P(^PRSPC(IEN,0),U,29)
|
---|
| 26 | S ^PRST(459,PPIEN,"P",IEN,0)=Z,^PRST(459,PPIEN,"P","B",IEN,IEN)=""
|
---|
| 27 | S Z=$G(^PRST(459,PPIEN,"P",0)),$P(^(0),U,3,4)=IEN_"^"_($P(Z,U,4)+1)
|
---|
| 28 | D ^PRSDPRIN
|
---|
| 29 | K DIC,DLAYGO,X,PP458,PP459,X1,X2,PAYDT,Z
|
---|
| 30 | Q
|
---|