PRSDDL ;HISC/GWB-PAID SEPARATION DOWNLOAD ROUTINE ;8/20/93  11:35
 ;;4.0;PAID;;Sep 21, 1995
 K ^TMP($J)
 S ECNT=0,XMPOS=2 F AA=1:1:EMPCNT D LOOP
 D REMSB^PRSDSERV
 S MTYPE="Separation" D ^PRSDSTAT
 K ^TMP($J),^XTMP("PRS",STA,"NOSEP"),TL,CCORG,OST,OSTX,Y,DATA,X1,X2,X
 Q
LOOP S ECOUNT=0 D REC^XMS3 S RCD=$P(XMRG,":",1),RCD=$E(RCD,4,999)
 F BB=1:9 S SSN=$E(RCD,BB,BB+8) Q:(SSN="")!(SSN=999999999)  D PROC K STANUM
 S ECNT=ECNT+ECOUNT Q
PROC I $D(^XTMP("PRS",STA,"NOSEP",SSN)) K ^XTMP("PRS",STA,"NOSEP",SSN) Q
 I '$D(^PRSPC("SSN",SSN)) S ERRMSG="SSN "_$E(SSN,1,3)_"-"_$E(SSN,4,5)_"-"_$E(SSN,6,9)_" not found" D ERR^PRSDSERV Q
 S IEN=$O(^PRSPC("SSN",SSN,0)) Q:IEN=""  S STANUM=$P(^PRSPC(IEN,0),U,7) Q:STANUM'=STA  D
 .S NAME=$P(^PRSPC(IEN,0),U,1),TL=$P(^PRSPC(IEN,0),U,8)
 .S CCORG=$P(^PRSPC(IEN,0),U,49)
 .I TL'="" K ^PRSPC("ATL"_TL,NAME,IEN)
 .I CCORG'="" K ^PRSPC("ACC",CCORG,IEN)
 .S $P(^PRSPC(IEN,0),U,8)=""
 .I $D(^PRSPC(IEN,1)),$P(^PRSPC(IEN,1),U,1)'="S" D
 ..S $P(^PRSPC(IEN,1),U,1)="S"
 ..S DATA=DATE D DATE^PRSDUTIL S X1=DATA,X2=-5 D C^%DTC
 ..S $P(^PRSPC(IEN,1),U,2)=X
 ..S $P(^PRSPC(IEN,1),U,3)="SEP"
 .S $P(^PRSPC(IEN,1),U,33)="Y",ECOUNT=ECOUNT+1
 .S OST=$P(^PRSPC(IEN,0),U,17),OSTX="",Y=OST X ^DD(450,16,2)
 .S:OST'=OSTX OSTX=Y
 .S ^TMP($J,"PRS",NAME,SSN)=$E(OST,1,4)_U_OSTX
 Q