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
|
---|