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