[613] | 1 | PRSDMISC ;HISC/MGD-PAID MISCELLANEOUS SUB-ROUTINES ;09/13/2003
|
---|
| 2 | ;;4.0;PAID;**82**;Sep 21, 1995
|
---|
| 3 | SEPIND ;Separation Ind
|
---|
| 4 | S SEPNAME=$P(^PRSPC(IEN,0),U,1),TL=$P(^PRSPC(IEN,0),U,8)
|
---|
| 5 | S CCORG=$P(^PRSPC(IEN,0),U,49)
|
---|
| 6 | S SEPIND="" S:$D(^PRSPC(IEN,1)) SEPIND=$P(^PRSPC(IEN,1),U,33)
|
---|
| 7 | I DATA="Y" D
|
---|
| 8 | .I TL'="",TYPE'="E" S $P(^PRSPC(IEN,0),U,8)="" K ^PRSPC("ATL"_TL,SEPNAME,IEN)
|
---|
| 9 | .I CCORG'="" K ^PRSPC("ACC",CCORG,IEN)
|
---|
| 10 | I DATA="N" D
|
---|
| 11 | .I CCORG'="" S ^PRSPC("ACC",CCORG,IEN)=""
|
---|
| 12 | .I TYPE="E",SEPIND="Y" D
|
---|
| 13 | ..I $D(^PRSPC(IEN,"ANNUAL")) F P=2,3,4,5,6,7,9,10,11,12,13,14 S $P(^PRSPC(IEN,"ANNUAL"),U,P)=""
|
---|
| 14 | ..I $D(^PRSPC(IEN,"LWOP")) F P=2,3,5,6,7,8,9,11 S $P(^PRSPC(IEN,"LWOP"),U,P)=""
|
---|
| 15 | ..K ^PRSPC(IEN,"BAYLOR"),^PRSPC(IEN,"COMP")
|
---|
| 16 | ..K ^PRSPC(IEN,"MILITARY"),^PRSPC(IEN,"SICK")
|
---|
| 17 | ..S ^TMP($J,"PRS",SEPNAME,SSN)=""
|
---|
| 18 | K SEPNAME,TL,CCORG,SEPIND,P Q
|
---|
| 19 | ACCSEP ;Accession/Separation fields
|
---|
| 20 | I TYPE="I",DATA="" S NODE="" Q
|
---|
| 21 | I TYPE="E",DATA="" S NODE="" Q
|
---|
| 22 | I TYPE="T",DBNAME="MBSACODE",DATA="" S DATA="A" Q
|
---|
| 23 | I TYPE="T",DBNAME="MBSADATE",DATA="" S DATA=$P(^PRSPC(IEN,0),"^",3) Q
|
---|
| 24 | I TYPE="T",DBNAME="MBSANOAC",DATA="" S DATA="ACC" Q
|
---|