source: WorldVistAEHR/trunk/r/PAID-PRS/PRSDPTYP.m@ 738

Last change on this file since 738 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 1.3 KB
RevLine 
[613]1PRSDPTYP ;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
Note: See TracBrowser for help on using the repository browser.